Clarify body types (#738)

General refactoring of code and tests in prepation for #718. It should now be much clearer what sorts of body types are permissible. Includes a few small improvements to error messages which I noticed while adding additional tests to get to 100% test coverage.

Author: hadley

NEWS.md

@@ -1,5 +1,6 @@
 # httr2 (development version)
 
+* `req_body_json_modify()` can now be used on a request with an empty body.
 * `resp_timing()` exposes timing information about the request measured by libcurl (@arcresu, #725).
 * `req_url_query()` now re-calculates n lengths when using `.multi = "explode"` to avoid select/recycling issues (@Kevanness, #719).
 

R/req-body.R

@@ -11,8 +11,9 @@
 #' Adding a body to a request will automatically switch the method to POST.
 #'
 #' @inheritParams req_perform
-#' @param type MIME content type. Will be ignored if you have manually set
-#'  a `Content-Type` header.
+#' @param type MIME content type. The default, `""`, will not emit a
+#'   `Content-Type` header.  Ignored if you have set a `Content-Type` header
+#'   with [req_headers()].
 #' @returns A modified HTTP [request].
 #' @examples
 #' req <- request(example_url()) |>
@@ -53,36 +54,33 @@ NULL
 #' @export
 #' @rdname req_body
 #' @param body A literal string or raw vector to send as body.
-req_body_raw <- function(req, body, type = NULL) {
+req_body_raw <- function(req, body, type = "") {
   check_request(req)
-  if (!is.raw(body) && !is_string(body)) {
+  check_string(type)
+
+  if (is.raw(body)) {
+    req_body(req, data = body, type = "raw", content_type = type)
+  } else if (is_string(body)) {
+    req_body(req, data = body, type = "string", content_type = type)
+  } else {
     cli::cli_abort("{.arg body} must be a raw vector or string.")
   }
-
-  req_body(
-    req,
-    data = body,
-    type = "raw",
-    content_type = type %||% ""
-  )
 }
 
 #' @export
 #' @rdname req_body
 #' @param path Path to file to upload.
-req_body_file <- function(req, path, type = NULL) {
+req_body_file <- function(req, path, type = "") {
   check_request(req)
+  check_string(path)
   if (!file.exists(path)) {
-    cli::cli_abort("{.arg path} ({.path {path}}) does not exist.")
+    cli::cli_abort("Can't find file {.path {path}}.")
+  } else if (dir.exists(path)) {
+    cli::cli_abort("{.arg path} must be a file, not a directory.")
   }
+  check_string(type)
 
-  # Need to override default content-type "application/x-www-form-urlencoded"
-  req_body(
-    req,
-    data = new_path(path),
-    type = "raw-file",
-    content_type = type %||% ""
-  )
+  req_body(req, data = path, type = "file", content_type = type)
 }
 
 #' @export
@@ -126,11 +124,11 @@ req_body_json <- function(
 #' @rdname req_body
 req_body_json_modify <- function(req, ...) {
   check_request(req)
-  if (req$body$type != "json") {
-    cli::cli_abort("Can only be used after {.fn req_body_json")
+  if (!req_body_type(req) %in% c("empty", "json")) {
+    cli::cli_abort("Can only be used after {.fn req_body_json}.")
   }
 
-  req$body$data <- utils::modifyList(req$body$data, list2(...))
+  req$body$data <- utils::modifyList(req$body$data %||% list(), list2(...))
   req
 }
 
@@ -159,12 +157,7 @@ req_body_form <- function(
 
   dots <- multi_dots(..., .multi = .multi)
   data <- modify_list(.req$body$data, !!!dots)
-  req_body(
-    .req,
-    data = data,
-    type = "form",
-    content_type = "application/x-www-form-urlencoded"
-  )
+  req_body(.req, data = data, type = "form")
 }
 
 #' @export
@@ -174,12 +167,7 @@ req_body_multipart <- function(.req, ...) {
 
   data <- modify_list(.req$body$data, ...)
   # data must be character, raw, curl::form_file, or curl::form_data
-  req_body(
-    .req,
-    data = data,
-    type = "multipart",
-    content_type = NULL
-  )
+  req_body(.req, data = data, type = "multipart")
 }
 
 # General structure -------------------------------------------------------
@@ -188,10 +176,12 @@ req_body <- function(
   req,
   data,
   type,
-  content_type,
+  content_type = NULL,
   params = list(),
   error_call = parent.frame()
 ) {
+  arg_match(type, c("raw", "string", "file", "json", "form", "multipart"))
+
   if (!is.null(req$body) && req$body$type != type) {
     cli::cli_abort(
       c(
@@ -211,94 +201,83 @@ req_body <- function(
   req
 }
 
-req_body_info <- function(req) {
-  if (is.null(req$body)) {
-    "empty"
-  } else {
-    data <- req$body$data
-    if (is.raw(data)) {
-      glue("{length(data)} bytes of raw data")
-    } else if (is_string(data)) {
-      glue("a string")
-    } else if (is_path(data)) {
-      glue("path '{data}'")
-    } else if (is.list(data)) {
-      glue("{req$body$type} encoded data")
-    } else {
-      "invalid"
-    }
-  }
+req_body_type <- function(req) {
+  req$body$type %||% "empty"
 }
 
+req_body_info <- function(req) {
+  switch(
+    req_body_type(req),
+    empty = "empty",
+    raw = glue("a {length(req$body$data)} byte raw vector"),
+    string = "a string",
+    file = glue("a path '{req$body$data}'"),
+    json = "JSON data",
+    form = "form data",
+    multipart = "multipart data"
+  )
+}
 req_body_get <- function(req) {
-  if (is.null(req$body)) {
-    return("")
-  }
   switch(
-    req$body$type,
+    req_body_type(req),
+    empty = NULL,
     raw = req$body$data,
-    form = {
-      data <- unobfuscate(req$body$data)
-      url_query_build(data)
-    },
-    json = exec(jsonlite::toJSON, req$body$data, !!!req$body$params),
-    cli::cli_abort("Unsupported request body type {.str {req$body$type}}.")
+    string = req$body$data,
+    file = readBin(req$body$data, "raw", n = file.size(req$body$data)),
+    json = unclass(exec(jsonlite::toJSON, req$body$data, !!!req$body$params)),
+    form = url_query_build(unobfuscate(req$body$data)),
+    multipart = {
+      # This is a bit clumsy because it requires a real request, which is
+      # currently a bit slow and requires httpuv. But better than nothing.
+      # Details at https://github.com/jeroen/curl/issues/388
+      handle <- req_handle(req_body_apply(req))
+      echo <- curl::curl_echo(handle, progress = FALSE)
+      rawToChar(echo$body)
+    }
   )
 }
 
 req_body_apply <- function(req) {
-  if (is.null(req$body)) {
-    return(req)
-  }
-
-  data <- req$body$data
-  type <- req$body$type
-
-  if (type == "raw-file") {
-    size <- file.info(data)$size
-    # Only open connection if needed
-    delayedAssign("con", file(data, "rb"))
-
-    req <- req_policies(
-      req,
-      done = function() close(con)
-    )
-    req <- req_options(
-      req,
-      post = TRUE,
-      readfunction = function(nbytes, ...) readBin(con, "raw", nbytes),
-      seekfunction = function(offset, ...) seek(con, where = offset),
-      postfieldsize_large = size
-    )
-  } else if (type == "raw") {
-    req <- req_body_apply_raw(req, data)
-  } else if (type == "json") {
-    req <- req_body_apply_raw(req, req_body_get(req))
-  } else if (type == "multipart") {
-    data <- unobfuscate(data)
-    req$fields <- data
-  } else if (type == "form") {
-    req <- req_body_apply_raw(req, req_body_get(req))
-  } else {
-    cli::cli_abort("Unsupported request body {.arg type}.", .internal = TRUE)
-  }
+  req <- switch(
+    req_body_type(req),
+    empty = req,
+    raw = req_body_apply_raw(req, req$body$data),
+    string = req_body_apply_string(req, req$body$data),
+    file = req_body_apply_connection(req, req$body$data),
+    json = req_body_apply_string(req, req_body_get(req)),
+    form = req_body_apply_string(req, req_body_get(req)),
+    multipart = req_body_apply_multipart(req, req$body$data),
+  )
 
-  # Respect existing Content-Type if set
-  type_idx <- match("content-type", tolower(names(req$headers)))
-  if (!is.na(type_idx)) {
-    content_type <- req$headers[[type_idx]]
-    req$headers <- req$headers[-type_idx]
-  } else {
-    content_type <- req$body$content_type
+  # Set Content-Type if not already set
+  if (!is.null(req$body$content_type) && is.null(req$headers$`Content-Type`)) {
+    req <- req_headers(req, `Content-Type` = req$body$content_type)
   }
-  req <- req_headers(req, `Content-Type` = content_type)
 
   req
 }
+req_body_apply_raw <- function(req, data) {
+  req_options(req, post = TRUE, postfieldsize = length(data), postfields = data)
+}
+req_body_apply_string <- function(req, data) {
+  req_body_apply_raw(req, charToRaw(enc2utf8(data)))
+}
+req_body_apply_connection <- function(req, data) {
+  size <- file.info(data)$size
+  # Only open connection if needed
+  delayedAssign("con", file(data, "rb"))
 
-req_body_apply_raw <- function(req, body) {
-  if (is_string(body)) {
-    body <- charToRaw(enc2utf8(body))
-  }
-  req_options(req, post = TRUE, postfieldsize = length(body), postfields = body)
+  req <- req_policies(req, done = function() close(con))
+  req <- req_options(
+    req,
+    post = TRUE,
+    readfunction = function(nbytes, ...) readBin(con, "raw", nbytes),
+    seekfunction = function(offset, ...) seek(con, where = offset),
+    postfieldsize_large = size
+  )
+  req
+}
+req_body_apply_multipart <- function(req, data) {
+  req$fields <- unobfuscate(req$body$data)
+  req
 }

R/req-dry-run.R

@@ -82,6 +82,7 @@ req_dry_run <- function(
   invisible(list(
     method = resp$method,
     path = resp$path,
+    body = resp$body,
     headers = as.list(resp$headers)
   ))
 }

man/req_body.Rd

@@ -1,10 +1,37 @@
-# errors if file doesn't exist
+# can't change body type
+
+    Code
+      req %>% req_body_json(list(x = 1))
+    Condition
+      Error in `req_body_json()`:
+      ! Can't change body type from raw to json.
+      i You must use only one type of `req_body_*()` per request.
+
+# can't send anything else
 
     Code
-      req_body_file(request_test(), "doesntexist", type = "text/plain")
+      req_body_raw(req, 1)
+    Condition
+      Error in `req_body_raw()`:
+      ! `body` must be a raw vector or string.
+
+# errors on invalid input
+
+    Code
+      req_body_file(request_test(), 1)
     Condition
       Error in `req_body_file()`:
-      ! `path` ('doesntexist') does not exist.
+      ! `path` must be a single string, not the number 1.
+    Code
+      req_body_file(request_test(), "doesntexist")
+    Condition
+      Error in `req_body_file()`:
+      ! Can't find file 'doesntexist'.
+    Code
+      req_body_file(request_test(), ".")
+    Condition
+      Error in `req_body_file()`:
+      ! `path` must be a file, not a directory.
 
 # non-json type errors
 
@@ -15,12 +42,26 @@
       ! Unexpected content type "application/xml".
       * Expecting type "application/json" or suffix "json".
 
-# can't change body type
+# can't modify non-json data
 
     Code
-      req %>% req_body_json(list(x = 1))
+      req_body_json_modify(req, a = 1)
     Condition
-      Error in `req_body_json()`:
-      ! Can't change body type from raw to json.
-      i You must use only one type of `req_body_*()` per request.
+      Error in `req_body_json_modify()`:
+      ! Can only be used after `req_body_json()`.
+
+# can send named elements as multipart
+
+    Code
+      cat(req_body_get(req))
+    Output
+      ---{id}
+      Content-Disposition: form-data; name="a"
+      
+      1
+      ---{id}
+      Content-Disposition: form-data; name="b"
+      
+      2
+      ---{id}