Update async

DESCRIPTION

@@ -43,4 +43,4 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE, r6 = FALSE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1.9000

R/aaa-async.R

@@ -2622,9 +2622,12 @@ http_head <- mark_as_async(http_head)
 #' @inheritParams http_get
 #' @param data Data to send. Either a raw vector, or a character string
 #'   that will be converted to raw with [base::charToRaw]. At most one of
-#'   `data` and `data_file` must be non `NULL`.
-#' @param data_file Data file to send. At most one of `data` and
-#'   `data_file` must be non `NULL`.
+#'   `data`, `data_file` and `data_form` can be non `NULL`.
+#' @param data_file Data file to send. At most one of `data`, `data_file`
+#'   and `data_form` can be non `NULL`.
+#' @param data_form Form data to send. A name list, where each element
+#'   is created with either [curl::form_data()] or [curl::form_file()].
+#'   At most one of `data`, `data_file` and `data_form` can be non `NULL`.
 #' @param on_progress Progress handler function. It is only used if the
 #'   response body is written to a file. See details at [http_get()].
 #'
@@ -2644,17 +2647,20 @@ http_head <- mark_as_async(http_head)
 #' synchronise(do())
 
 http_post <- function(url, data = NULL, data_file = NULL,
-                      headers = character(), file = NULL,
+                      data_form = NULL, headers = character(), file = NULL,
                       options = list(), on_progress = NULL) {
 
-  url; data; data_file; headers; file; options; on_progress
-  if (!is.null(data) && !is.null(data_file)) {
-    stop("At most one of `data` and `data_file` can be non `NULL`.")
+  url; data; data_file; data_form; headers; file; options; on_progress
+  if ((!is.null(data) + !is.null(data_file) + !is.null(data_form)) > 1) {
+    stop(
+      "At most one of `data`, `data_file` and `data_form` ",
+      "can be non `NULL`."
+    )
   }
   if (!is.null(data_file)) {
     data <- readBin(data_file, "raw", file.size(data_file))
   }
-  if (!is.raw(data)) data <- charToRaw(data)
+  if (!is.null(data) && !is.raw(data)) data <- charToRaw(data)
   options <- get_default_curl_options(options)
 
   make_deferred_http(
@@ -2665,6 +2671,9 @@ http_post <- function(url, data = NULL, data_file = NULL,
       curl::handle_setopt(handle, customrequest = "POST",
                     postfieldsize = length(data), postfields = data,
                     .list = options)
+      if (!is.null(data_form)) {
+        curl::handle_setform(handle, .list = data_form)
+      }
       list(handle = handle, options = options)
     },
     file

tests/async/_snaps/http.md

@@ -0,0 +1,23 @@
+# http_post form
+
+    Code
+      obj$files
+    Output
+      $baz
+      $baz$filename
+      [1] "mrfile"
+      
+      $baz$value
+      [1] "data:application/octet-stream;base64,MDEyMzQ1Njc4OQ=="
+      
+      
+
+---
+
+    Code
+      obj$form
+    Output
+      $foo
+      [1] "bar"
+      
+

tests/async/test-http.R

@@ -292,6 +292,29 @@ test_that("http_post file", {
   expect_equal(cnt$json, obj)
 })
 
+test_that("http_post form", {
+  resp <- NULL
+  tmp <- tempfile()
+  on.exit(unlink(tmp), add = TRUE)
+  writeBin(charToRaw("0123456789"), tmp)
+
+  do <- function() {
+    form <- list(
+      foo = curl::form_data("bar"),
+      baz = curl::form_file(tmp, type = "text/plain", name = "mrfile")
+    )
+    http_post(http$url("/post"), data_form = form)$
+      then(http_stop_for_status)$
+      then(function(x) resp <<- x)
+  }
+
+  resp <- synchronise(do())
+  obj <- jsonlite::fromJSON(rawToChar(resp$content))
+  expect_snapshot(obj$files)
+  expect_snapshot(obj$form)
+
+})
+
 test_that("curl multi options", {
   # It is not possible to query the options that were set on a handle,
   # so this is not a great test case.