Support .multi in req_body_form()

NEWS.md

@@ -1,5 +1,9 @@
 # httr2 (development version)
 
+* `req_body_form()` and `req_body_multipart()` now require data `...`;
+  they no longer accept a single list for compatibility with the 0.1.0
+  API.
+
 * New `req_perform_sequential()` which performs a known set of requests 
   sequentially. It has an interface similar to `req_perform_parallel()` but
   with no limitations, and the cost of being slower (#361).
@@ -28,11 +32,11 @@
 * `resp_body_json()` and `resp_body_xml()` now caches the parsed values so 
   that you can use them repeatedly without worrying about the performance cost.
 
-* `req_url_query()` gains a `.multi` parameter that controls what happens when
-  you supply multiple values in a vector. The default will continue to error 
-  but you can use `.multi = "comma"` to separate with commas, `"pipe"` to 
-  separate with `|`, and `"explode"` to generate one parameter for each 
-  value (e.g. `?a=1&a=2`) (#350).
+* `req_url_query()` and `req_body_form()` gain a `.multi` parameter that 
+  controls what happens when you supply multiple values in a vector. The default 
+  will continue to error  but you can use `.multi = "comma"` to separate with 
+  commas, `"pipe"` to separate with `|`, and `"explode"` to generate one 
+  parameter for each value (e.g. `?a=1&a=2`) (#350).
 
 * The httr2 examples now only run on R 4.2 and later so that we can use
   the base pipe and lambda syntax (#345).

R/req-body.R

@@ -131,10 +131,14 @@ req_body_json_modify <- function(req, ...) {
 #'
 #'   `req_body_json()` uses this argument differently; it takes additional
 #'   arguments passed on to  [jsonlite::toJSON()].
-req_body_form <- function(.req, ...) {
+#' @inheritParams req_url_query
+req_body_form <- function(.req,
+                          ...,
+                          .multi = c("error", "comma", "pipe", "explode")) {
   check_request(.req)
 
-  data <- modify_body_data(.req$body$data, ...)
+  dots <- multi_dots(..., .multi = .multi)
+  data <- modify_list(.req$body$data, !!!dots)
   req_body(
     .req,
     data = data,
@@ -148,7 +152,7 @@ req_body_form <- function(.req, ...) {
 req_body_multipart <- function(.req, ...) {
   check_request(.req)
 
-  data <- modify_body_data(.req$body$data, ...)
+  data <- modify_list(.req$body$data, ...)
   # data must be character, raw, curl::form_file, or curl::form_data
   req_body(
     .req,
@@ -158,16 +162,6 @@ req_body_multipart <- function(.req, ...) {
   )
 }
 
-modify_body_data <- function(.data, ..., error_call = caller_env()) {
-  dots <- list2(...)
-  if (length(dots) == 1 && !is_named(dots) && is.list(dots[[1]])) {
-    warn("This function no longer takes a list, instead supply named arguments in ...", call = caller_env())
-    modify_list(.data, !!!dots[[1]], error_call = error_call)
-  } else {
-    modify_list(.data, ..., error_call = error_call)
-  }
-}
-
 # General structure -------------------------------------------------------
 
 req_body <- function(req, data, type, content_type, params = list()) {

R/req-url.R

@@ -63,66 +63,14 @@ req_url_query <- function(.req,
                           ...,
                           .multi = c("error", "comma", "pipe", "explode")) {
   check_request(.req)
-  if (is.function(.multi)) {
-    multi <- .multi
-  } else {
-    multi <- arg_match(.multi)
-  }
 
-  dots <- list2(...)
-
-  type_ok <- map_lgl(dots, function(x) is_atomic(x) || is.null(x))
-  if (any(!type_ok)) {
-    cli::cli_abort(
-      "All elements of {.code ...} must be either an atomic vector or NULL."
-    )
-  }
-
-  n <- lengths(dots)
-  if (any(n > 1)) {
-    if (is.function(multi)) {
-      dots[n > 1] <- lapply(dots[n > 1], format_query_param)
-      dots[n > 1] <- lapply(dots[n > 1], multi)
-      dots[n > 1] <- lapply(dots[n > 1], I)
-    } else if (multi == "comma") {
-      dots[n > 1] <- lapply(dots[n > 1], format_query_param)
-      dots[n > 1] <- lapply(dots[n > 1], paste0, collapse = ",")
-      dots[n > 1] <- lapply(dots[n > 1], I)
-    } else if (multi == "pipe") {
-      dots[n > 1] <- lapply(dots[n > 1], format_query_param)
-      dots[n > 1] <- lapply(dots[n > 1], paste0, collapse = "|")
-      dots[n > 1] <- lapply(dots[n > 1], I)
-    } else if (multi == "explode") {
-      dots <- explode(dots)
-    } else if (multi == "error") {
-      cli::cli_abort(c(
-        "All vector elements of {.code ...} must be length 1.",
-        i = "Use {.arg .multi} to choose a strategy for handling vectors."
-      ))
-    }
-  }
-  # Force query generation to bubble up errors
-  query_build(dots)
+  dots <- multi_dots(..., .multi = .multi)
 
   url <- url_parse(.req$url)
   url$query <- modify_list(url$query, !!!dots)
   req_url(.req, url_build(url))
 }
 
-explode <- function(x) {
-  expanded <- map(x, function(x) {
-    if (is.null(x)) {
-      list(NULL)
-    } else {
-      map(seq_along(x), function(i) x[i])
-    }
-  })
-  stats::setNames(
-    unlist(expanded, recursive = FALSE, use.names = FALSE),
-    rep(names(x), lengths(expanded))
-  )
-}
-
 #' @export
 #' @rdname req_url
 req_url_path <- function(req, ...) {

R/utils-multi.R

@@ -0,0 +1,79 @@
+multi_dots <- function(...,
+                       .multi = c("error", "comma", "pipe", "explode"),
+                       error_arg = "...",
+                       error_call = caller_env()) {
+  if (is.function(.multi)) {
+    check_function2(.multi, call = error_call, arg = ".multi")
+  } else {
+    .multi <- arg_match(.multi, error_arg = ".multi", error_call = error_call)
+  }
+
+  dots <- list2(...)
+  if (length(dots) == 0) {
+    return(list())
+  }
+
+  if (!is_named(dots)) {
+    cli::cli_abort(
+      "All components of {.arg {error_arg}} must be named.",
+      call = error_call
+    )
+  }
+
+  type_ok <- map_lgl(dots, function(x) is_atomic(x) || is.null(x))
+  if (any(!type_ok)) {
+    cli::cli_abort(
+      "All elements of {.arg {error_arg}} must be either an atomic vector or NULL.",
+      call = error_call
+    )
+  }
+
+  n <- lengths(dots)
+  if (any(n > 1)) {
+    if (is.function(.multi)) {
+      dots[n > 1] <- lapply(dots[n > 1], format_query_param)
+      dots[n > 1] <- lapply(dots[n > 1], .multi)
+      dots[n > 1] <- lapply(dots[n > 1], I)
+    } else if (.multi == "comma") {
+      dots[n > 1] <- lapply(dots[n > 1], format_query_param)
+      dots[n > 1] <- lapply(dots[n > 1], paste0, collapse = ",")
+      dots[n > 1] <- lapply(dots[n > 1], I)
+    } else if (.multi == "pipe") {
+      dots[n > 1] <- lapply(dots[n > 1], format_query_param)
+      dots[n > 1] <- lapply(dots[n > 1], paste0, collapse = "|")
+      dots[n > 1] <- lapply(dots[n > 1], I)
+    } else if (.multi == "explode") {
+      dots <- explode(dots)
+      dots[n > 1] <- lapply(dots[n > 1], format_query_param)
+      dots[n > 1] <- lapply(dots[n > 1], I)
+    } else if (.multi == "error") {
+      cli::cli_abort(
+        c(
+          "All vector elements of {.arg {error_arg}} must be length 1.",
+          i = "Use {.arg .multi} to choose a strategy for handling vectors."
+        ),
+        call = error_call
+      )
+    }
+  }
+
+  # Format other params
+  dots[n == 1] <- lapply(dots[n == 1], format_query_param, error_call = error_call)
+  dots[n == 1] <- lapply(dots[n == 1], I)
+
+  dots
+}
+
+explode <- function(x) {
+  expanded <- map(x, function(x) {
+    if (is.null(x)) {
+      list(NULL)
+    } else {
+      map(seq_along(x), function(i) x[i])
+    }
+  })
+  stats::setNames(
+    unlist(expanded, recursive = FALSE, use.names = FALSE),
+    rep(names(x), lengths(expanded))
+  )
+}

tests/testthat/_snaps/req-body.md

@@ -15,16 +15,3 @@
       ! Unexpected content type "application/xml".
       * Expecting type "application/json" or suffix "json".
 
-# req_body_form() and req_body_multipart() accept list() with warning
-
-    Code
-      req1 <- req %>% req_body_form(list(x = "x"))
-    Condition
-      Warning in `req_body_form()`:
-      This function no longer takes a list, instead supply named arguments in ...
-    Code
-      req2 <- req %>% req_body_multipart(list(x = "x"))
-    Condition
-      Warning in `req_body_multipart()`:
-      This function no longer takes a list, instead supply named arguments in ...
-

tests/testthat/_snaps/req-url.md

@@ -9,6 +9,11 @@
 
 # errors are forwarded correctly
 
+    Code
+      req %>% req_url_query(1)
+    Condition
+      Error in `req_url_query()`:
+      ! All components of `...` must be named.
     Code
       req %>% req_url_query(a = I(1))
     Condition

tests/testthat/_snaps/utils-multi.md

@@ -0,0 +1,24 @@
+# checks its inputs
+
+    Code
+      multi_dots(1)
+    Condition
+      Error:
+      ! All components of `...` must be named.
+    Code
+      multi_dots(x = I(1))
+    Condition
+      Error:
+      ! Escaped query value must be a single string, not the number 1.
+    Code
+      multi_dots(x = 1:2)
+    Condition
+      Error:
+      ! All vector elements of `...` must be length 1.
+      i Use `.multi` to choose a strategy for handling vectors.
+    Code
+      multi_dots(x = mean)
+    Condition
+      Error:
+      ! All elements of `...` must be either an atomic vector or NULL.
+

tests/testthat/test-oauth-client.R

@@ -49,7 +49,7 @@ test_that("can authenticate using header or body", {
   expect_equal(req_h$headers, structure(list(Authorization = "Basic aWQ6c2VjcmV0"), redact = "Authorization"))
 
   req_b <- oauth_client_req_auth(req, client("body"))
-  expect_equal(req_b$body$data, list(client_id = "id", client_secret = "secret"))
+  expect_equal(req_b$body$data, list(client_id = I("id"), client_secret = I("secret")))
 })
 
 

tests/testthat/test-req-body.R

@@ -114,23 +114,13 @@ test_that("can send named elements as form/multipart", {
 
 test_that("can modify body data", {
   req1 <- request_test() %>% req_body_form(a = 1)
-  expect_equal(req1$body$data, list(a = 1))
+  expect_equal(req1$body$data, list(a = I("1")))
 
   req2 <- req1 %>% req_body_form(b = 2)
-  expect_equal(req2$body$data, list(a = 1, b = 2))
+  expect_equal(req2$body$data, list(a = I("1"), b = I("2")))
 
   req3 <- req1 %>% req_body_form(a = 3, a = 4)
-  expect_equal(req3$body$data, list(a = 3, a = 4))
-})
-
-test_that("req_body_form() and req_body_multipart() accept list() with warning", {
-  req <- request_test()
-  expect_snapshot({
-    req1 <- req %>% req_body_form(list(x = "x"))
-    req2 <- req %>% req_body_multipart(list(x = "x"))
-  })
-  expect_equal(req1$body$data, list(x = "x"))
-  expect_equal(req2$body$data, list(x = "x"))
+  expect_equal(req3$body$data, list(a = I("3"), a = I("4")))
 })
 
 test_that("can upload file with multipart", {

tests/testthat/test-req-url.R

@@ -70,11 +70,11 @@ test_that("can handle multi query params", {
 test_that("errors are forwarded correctly", {
   req <- request("http://example.com/")
   expect_snapshot(error = TRUE, {
+    req %>% req_url_query(1)
     req %>% req_url_query(a = I(1))
     req %>% req_url_query(a = 1:2)
     req %>% req_url_query(a = mean)
   })
-
 })
 
 test_that("empty query doesn't affect url", {

tests/testthat/test-utils-multi.R

@@ -0,0 +1,44 @@
+test_that("can handle multi query params", {
+  expect_equal(
+    multi_dots(a = 1:2, .multi = "explode"),
+    list(a = I("1"), a = I("2"))
+  )
+  expect_equal(
+    multi_dots(a = 1:2, .multi = "comma"),
+    list(a = I("1,2"))
+  )
+  expect_equal(
+    multi_dots(a = 1:2, .multi = "pipe"),
+    list(a = I("1|2"))
+  )
+  expect_equal(
+    multi_dots(a = 1:2, .multi = function(x) "X"),
+    list(a = I("X"))
+  )
+})
+
+test_that("can handle empty dots", {
+  expect_equal(multi_dots(), list())
+})
+
+test_that("preserves NULL values", {
+  expect_equal(multi_dots(x = NULL), list(x = NULL))
+})
+
+test_that("preserves duplicates values", {
+  expect_equal(multi_dots(x = 1, x = 2), list(x = I("1"), x = I("2")))
+})
+
+test_that("leaves already escaped values alone", {
+  x <- I("1 + 2")
+  expect_equal(multi_dots(x = x), list(x = x))
+})
+
+test_that("checks its inputs", {
+  expect_snapshot(error = TRUE, {
+    multi_dots(1)
+    multi_dots(x = I(1))
+    multi_dots(x = 1:2)
+    multi_dots(x = mean)
+  })
+})