Don't automatically unbox vectors when making requests.

When upgrading to httr2, I rewrote some of the http client code and
forgot to keep the `auto_unbox = FALSE` flag. This has caused uploads to
outpack_server to break, as requests were now malformed.

The issue is that it is ambiguous whether `list(x = 1)` should be
serialized as `{"x": 1}` or as `{"x": [ 1 ]}`, because R does not
differentiate between scalar and vectors of length one.

By default, httr2 applies `auto_unbox = TRUE`, which leads to all length
1 vectors being unboxed into a JSON scalar. By explictly choosing
setting that flag to `FALSE`, we may override this behaviour and keep
all vectors as vectors by default. Scalars need to be marked as such
with the `scalar(x)` function (defined as `jsonlite::unbox(x)`).

Frustratingly this did not get caught by our testsuite because we were
always pushing more than one packet at a time. I've added a test for
this particular case, pushing one packet and one file, to make sure
regressions don't get introduced in the future.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orderly2
 Title: Orderly Next Generation
-Version: 1.99.32
+Version: 1.99.33
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "[email protected]"),
              person("Robert", "Ashton", role = "aut"),

R/location_http.R

@@ -56,16 +56,16 @@ orderly_location_http <- R6::R6Class(
 
     ## TODO: we could get the schemas here from outpack_server too
     list_unknown_packets = function(ids) {
-      res <- private$client$request("/packets/missing", function(r) {
-        httr2::req_body_json(r, list(ids = ids, unpacked = scalar(TRUE)))
-      })
+      res <- private$client$request(
+        "/packets/missing",
+        function(r) http_body_json(r, list(ids = ids, unpacked = scalar(TRUE))))
       list_to_character(res$data)
     },
 
     list_unknown_files = function(hashes) {
       res <- private$client$request(
         "/files/missing",
-        function(r) httr2::req_body_json(r, list(hashes = hashes)))
+        function(r) http_body_json(r, list(hashes = hashes)))
       list_to_character(res$data)
     },
 

R/outpack_hash.R

@@ -59,7 +59,7 @@ hash_files <- function(paths, algorithm = "sha256", named = FALSE) {
 }
 
 
-hash_data <- function(data, algorithm, call = NULL) {
+hash_data <- function(data, algorithm = "sha256", call = NULL) {
   assert_scalar_character(algorithm, call = call)
   value <- openssl::multihash(data, algorithm)[[algorithm]]
   sprintf("%s:%s", algorithm, as.character(value))

R/outpack_http_client.R

@@ -33,6 +33,10 @@ outpack_http_client <- R6::R6Class(
     }
   ))
 
+http_body_json <- function(request, body) {
+  httr2::req_body_json(request, body, auto_unbox = FALSE)
+}
+
 http_client_request <- function(url, customize = identity, download = NULL,
                                 parse_json = TRUE) {
   req <- httr2::request(url)
@@ -106,8 +110,7 @@ http_client_login <- function(name, auth) {
   if (is.null(auth_cache[[key]])) {
     cli::cli_alert_info("Logging in to {name}")
 
-    res <- http_client_request(auth$url,
-                               function(r) httr2::req_body_json(r, auth$data))
+    res <- http_client_request(auth$url, json_body = auth$data)
 
     cli::cli_alert_success("Logged in successfully")
     auth_cache[[key]] <- list("Authorization" = paste("Bearer", res$token))

tests/testthat/test-zzz-location-http.R

@@ -48,6 +48,22 @@ describe("server integration tests", {
       msg)
     expect_false(file.exists(dest))
   })
+
+  it("can list missing packets", {
+     new_id <- outpack_id()
+     expect_setequal(client_http$list_unknown_packets(new_id), new_id)
+     expect_setequal(client_http$list_unknown_packets(ids), character(0))
+     expect_setequal(client_http$list_unknown_packets(c(new_id, ids)), new_id)
+  })
+
+  it("can list missing files", {
+    existing_hashes <- orderly_metadata(ids[[1]], root = path)$files$hash
+    new_hash <- hash_data(toString(runif(100)), algorithm = "sha256")
+
+    expect_setequal(client_http$list_unknown_files(new_hash), new_hash)
+    expect_setequal(client_http$list_unknown_files(existing_hashes), character(0))
+    expect_setequal(client_http$list_unknown_files(c(new_hash, existing_hashes)), new_hash)
+  })
 })
 
 
@@ -93,7 +109,23 @@ describe("http location integration tests", {
     expect_false(file.exists(dest))
   })
 
-  it("can push into server", {
+  it("can push a single packet", {
+    root_downstream <- create_temporary_root(use_file_store = TRUE)
+    ids_downstream <- create_random_packet(root_downstream, n_files = 1)
+    orderly_location_add("upstream", "http", list(url = url),
+                         root = root_downstream)
+
+    plan <- orderly_location_push(ids_downstream, "upstream",
+                                  root = root_downstream)
+    expect_equal(length(plan$packet_id), 1)
+    expect_equal(length(plan$files), 1)
+
+    idx <- root$index$data()
+    expect_true(all(ids_downstream %in% names(idx$metadata)))
+    expect_true(all(root_downstream$files$list() %in% root$files$list()))
+  })
+
+  it("can push a packet chain into server", {
     root_downstream <- create_temporary_root(use_file_store = TRUE)
     ids_downstream <- create_random_packet_chain(root_downstream, 3)
     orderly_location_add("upstream", "http", list(url = url),