Implement httr2_translate() (#797)

Fixes #795

Author: JosiahParry

NAMESPACE

@@ -25,6 +25,7 @@ export(curl_help)
 export(curl_translate)
 export(example_github_client)
 export(example_url)
+export(httr2_translate)
 export(is_online)
 export(iterate_with_cursor)
 export(iterate_with_link_url)

NEWS.md

@@ -1,6 +1,7 @@
 # httr2 (development version)
 
 * Mocked and cached responses now include the originating request in `resp$request`, just like real responses (#841).
+* New `httr2_translate()` translates an httr2 request into the equivalent curl command (#795).
 * `last_response_json()` now works with content-types that end with `+json`, e.g. `application/problem+json` (@cgiachalis, #782).
 * `oauth_*()` token refresh now forwards `token_params` from the original flow, so extra token-endpoint parameters (e.g. a `scope` required on the token exchange) are sent on refresh as well as on the initial token request (@simonpcouch).
 * `oauth_client()` gains a `metadata` argument: pass the result of `oauth_server_metadata()` and the client carries all of the server's endpoints, so the OAuth flows pick them up automatically instead of threading them into each call (#846).

R/curl.R

@@ -1,4 +1,4 @@
-#' Translate curl syntax to httr2
+#' Translate a curl command to a httr2 request
 #'
 #' @description
 #' The curl command line tool is commonly used to demonstrate HTTP APIs and can
@@ -24,6 +24,7 @@
 #'   was copied from the clipboard, the translation will be copied back
 #'   to the clipboard.
 #' @export
+#' @seealso [httr2_translate()]
 #' @examples
 #' curl_translate("curl http://example.com")
 #' curl_translate("curl http://example.com -X DELETE")

R/httr2-translate.R

@@ -0,0 +1,216 @@
+#' Translate a httr2 request to a curl command
+#'
+#' Convert a httr2 request object to an approximate curl command line call.
+#' This is useful for debugging, for sharing a request with someone who doesn't
+#' use R, or for handing off to another tool.
+#'
+#' @inheritParams req_perform
+#' @inheritParams req_get_body
+#' @return A string containing the curl command.
+#' @seealso [curl_translate()] to translate in the other direction.
+#' @export
+#' @examples
+#' # Basic GET request
+#' request("https://httpbin.org/get") |>
+#'   httr2_translate()
+#'
+#' # POST with JSON body
+#' request("https://httpbin.org/post") |>
+#'   req_body_json(list(name = "value")) |>
+#'   httr2_translate()
+#'
+#' # Secrets are redacted by default, but can be revealed
+#' request("https://example.com") |>
+#'   req_headers_redacted(Authorization = "secret") |>
+#'   httr2_translate(obfuscated = "reveal")
+httr2_translate <- function(req, obfuscated = c("redact", "reveal")) {
+  check_request(req)
+  obfuscated <- arg_match(obfuscated)
+
+  req <- req_prepare(req)
+  req <- auth_sign(req)
+
+  body <- curl_body(req, obfuscated)
+  args <- c(
+    dquote(req_get_url(req)),
+    curl_method(req, has_body = !is.null(body)),
+    curl_headers(req, obfuscated),
+    curl_options(req),
+    body
+  )
+  indent <- c("", rep("  ", length(args) - 1))
+  backslash <- c(rep(" \\", length(args) - 1), "")
+  out <- paste0("curl ", paste0(indent, args, backslash, collapse = "\n"))
+
+  structure(out, class = "httr2_cmd")
+}
+
+curl_method <- function(req, has_body = FALSE) {
+  method <- req_get_method(req)
+  if (method == "GET" || (method == "POST" && has_body)) {
+    NULL
+  } else if (method == "HEAD") {
+    "--head"
+  } else {
+    paste0("--request ", method)
+  }
+}
+
+curl_headers <- function(req, obfuscated = c("redact", "reveal")) {
+  obfuscated <- arg_match(obfuscated)
+
+  headers <- req_get_headers(req, redacted = obfuscated)
+  if (is_empty(headers)) {
+    return(NULL)
+  }
+  paste0("--header ", dquote(paste0(names(headers), ": ", unlist(headers))))
+}
+
+curl_options <- function(req) {
+  options <- req$options
+
+  known_options <- c(
+    "timeout_ms", # req_timeout()
+    "connecttimeout", # req_timeout()
+    "proxy", # req_proxy()
+    "proxyport", # req_proxy()
+    "proxyuserpwd", # req_proxy()
+    "useragent", # req_user_agent()
+    "followlocation",
+    "verbose", # req_verbose()
+    "cookiejar", # req_cookie_preserve()
+    "cookiefile", # req_cookie_preserve()
+    "cookie" # req_cookies_set()
+  )
+  # R callbacks and the like, with no command line equivalent
+  ignored_options <- c(
+    "debugfunction", # req_verbose()
+    "xferinfofunction", # req_progress()
+    "noprogress", # req_progress()
+    "proxyauth", # req_proxy()
+    "forbid_reuse", # req_verbose_test()
+    "nobody", # req_method_apply()
+    "customrequest", # req_method_apply()
+    "post", # req_body_apply()
+    "postfieldsize", # req_body_apply()
+    "postfields", # req_body_apply()
+    "readfunction", # req_body_apply()
+    "seekfunction", # req_body_apply()
+    "postfieldsize_large" # req_body_apply()
+  )
+  unknown <- setdiff(names(options), c(known_options, ignored_options))
+  if (length(unknown) > 0) {
+    cli::cli_warn("Can't translate option{?s} {.val {unknown}}.")
+  }
+
+  args <- lapply(names(options), function(name) {
+    value <- options[[name]]
+    switch(
+      name,
+      timeout_ms = paste0("--max-time ", value / 1000),
+      connecttimeout = paste0("--connect-timeout ", value),
+      proxy = paste0(
+        "--proxy ",
+        dquote(paste0(c(value, options$proxyport), collapse = ":"))
+      ),
+      proxyuserpwd = paste0("--proxy-user ", dquote(value)),
+      useragent = paste0("--user-agent ", dquote(value)),
+      verbose = if (value) "--verbose",
+      cookiejar = paste0("--cookie-jar ", dquote(value)),
+      cookiefile = paste0("--cookie ", dquote(value)),
+      cookie = paste0("--cookie ", dquote(value))
+    )
+  })
+
+  # httr2 follows redirects by default, but command line curl doesn't
+  follow <- if (!isFALSE(options$followlocation)) "--location"
+
+  c(follow, unlist(args))
+}
+
+curl_body <- function(req, obfuscated = c("redact", "reveal")) {
+  obfuscated <- arg_match(obfuscated)
+
+  body <- req_get_body(req, obfuscated = obfuscated)
+  if (is.null(body)) {
+    return(NULL)
+  }
+  type <- req_get_body_type(req)
+  if (type == "raw") {
+    cli::cli_abort("Can't translate a request with a raw body.", call = NULL)
+  }
+
+  c(
+    curl_content_type(req, type),
+    curl_body_data(body, type, params = req$body$params)
+  )
+}
+
+# Skip if Content-Type is already set as a header
+curl_content_type <- function(req, type) {
+  if ("content-type" %in% tolower(names(req_get_headers(req)))) {
+    return(NULL)
+  }
+
+  content_type <- req$body$content_type %||%
+    switch(
+      type,
+      json = "application/json",
+      form = "application/x-www-form-urlencoded"
+    )
+  if (is.null(content_type) || !nzchar(content_type)) {
+    return(NULL)
+  }
+  paste0("--header ", dquote(paste0("Content-Type: ", content_type)))
+}
+
+curl_body_data <- function(body, type, params = list(auto_unbox = TRUE)) {
+  switch(
+    type,
+    string = paste0("--data ", dquote(body)),
+    file = paste0("--data-binary ", dquote(paste0("@", body))),
+    json = paste0("--data ", dquote(exec(jsonlite::toJSON, body, !!!params))),
+    form = paste0("--data ", dquote(url_query_build(body))),
+    multipart = curl_body_multipart(body)
+  )
+}
+
+curl_body_multipart <- function(body) {
+  unlist(Map(curl_body_multipart_field, names(body), body), use.names = FALSE)
+}
+
+curl_body_multipart_field <- function(name, value) {
+  if (inherits(value, "form_file")) {
+    spec <- paste0(name, "=@", curl_form_quote(value$path))
+    if (!is.null(value$type)) {
+      spec <- paste0(spec, ";type=", value$type)
+    }
+    if (!is.null(value$name)) {
+      spec <- paste0(spec, ";filename=", curl_form_quote(value$name))
+    }
+    paste0("--form ", dquote(spec))
+  } else if (inherits(value, "form_data")) {
+    type <- value$type
+    value <- rawToChar(value$value)
+    if (is.null(type)) {
+      paste0("--form-string ", dquote(paste0(name, "=", value)))
+    } else {
+      spec <- paste0(name, "=", curl_form_quote(value), ";type=", type)
+      paste0("--form ", dquote(spec))
+    }
+  } else {
+    paste0("--form-string ", dquote(paste0(name, "=", value)))
+  }
+}
+
+curl_form_quote <- function(x) {
+  paste0('"', gsub('(["\\\\])', "\\\\\\1", x), '"')
+}
+
+dquote <- function(x) {
+  ifelse(
+    grepl("[^A-Za-z0-9._~:/@%+=,-]", x),
+    paste0("'", gsub("'", "'\"'\"'", x, fixed = TRUE), "'"),
+    x
+  )
+}

_pkgdown.yml

@@ -77,6 +77,7 @@ reference:
 - title: Miscellaneous helpers
   contents:
   - curl_translate
+  - httr2_translate
   - is_online
 
 - title: OAuth