Allow supplying a raw vector as ncurl() data

NEWS.md

@@ -2,6 +2,7 @@
 
 #### Updates
 
+* `ncurl()` and variants now accept request data supplied as a raw vector (thanks @thomasp85, #158).
 * `cv_reset()` now correctly resets the flag in the case a flag event has already been registered with `pipe_notify()`.
 * The previous `listen()` and `dial()` argument `error`, removed in v1.6.0, is now defunct.
 * The previous `serial_config()` argument `vec`, unutilised since v1.6.0, is removed.

R/ncurl.R

@@ -17,9 +17,11 @@
 #'   request headers, for example: \cr
 #'   `c(Authorization = "Bearer APIKEY", "Content-Type" = "text/plain")` \cr
 #'   A non-character or non-named vector will be ignored.
-#' @param data (optional) character string request data to be submitted. If a
-#'   vector, only the first element is taken, and non-character objects are
-#'   ignored.
+#' @param data (optional) request data to be submitted. Must be a character
+#'   string or raw vector, and other objects are ignored. If a character vector,
+#'   only the first element is taken. When supplying binary data, the
+#'   appropriate 'Content-Type' header should be set to specify the binary
+#'   format.
 #' @param response (optional) a character vector specifying the response headers
 #'   to return e.g. `c("date", "server")`. These are case-insensitive and
 #'   will return NULL if not present. A non-character vector will be ignored.

src/ncurl.c

@@ -52,9 +52,16 @@ static SEXP mk_error_ncurlaio(const int xc) {
 
 static nano_buf nano_char_buf(const SEXP data) {
 
-  nano_buf buf;
-  const char *s = NANO_STRING(data);
-  NANO_INIT(&buf, (unsigned char *) s, strlen(s));
+  nano_buf buf = {0};
+  switch (TYPEOF(data)) {
+  case STRSXP: ;
+    const char *s = NANO_STRING(data);
+    NANO_INIT(&buf, (unsigned char *) s, strlen(s));
+    break;
+  case RAWSXP:
+    NANO_INIT(&buf, NANO_DATAPTR(data), XLENGTH(data));
+    break;
+  }
 
   return buf;
 
@@ -175,9 +182,9 @@ SEXP rnng_ncurl(SEXP http, SEXP convert, SEXP follow, SEXP method, SEXP headers,
       }
     }
   }
-  if (data != R_NilValue && TYPEOF(data) == STRSXP) {
+  if (data != R_NilValue) {
     nano_buf enc = nano_char_buf(data);
-    if ((xc = nng_http_req_set_data(req, enc.buf, enc.cur)))
+    if (enc.cur && (xc = nng_http_req_set_data(req, enc.buf, enc.cur)))
       goto fail;
   }
 
@@ -345,9 +352,9 @@ SEXP rnng_ncurl_aio(SEXP http, SEXP convert, SEXP method, SEXP headers, SEXP dat
       }
     }
   }
-  if (data != R_NilValue && TYPEOF(data) == STRSXP) {
+  if (data != R_NilValue) {
     nano_buf enc = nano_char_buf(data);
-    if ((xc = nng_http_req_set_data(handle->req, enc.buf, enc.cur)))
+    if (enc.cur && (xc = nng_http_req_copy_data(handle->req, enc.buf, enc.cur)))
       goto fail;
   }
 
@@ -550,9 +557,9 @@ SEXP rnng_ncurl_session(SEXP http, SEXP convert, SEXP method, SEXP headers, SEXP
       }
     }
   }
-  if (data != R_NilValue && TYPEOF(data) == STRSXP) {
+  if (data != R_NilValue) {
     nano_buf enc = nano_char_buf(data);
-    if ((xc = nng_http_req_set_data(handle->req, enc.buf, enc.cur)))
+    if (enc.cur && (xc = nng_http_req_copy_data(handle->req, enc.buf, enc.cur)))
       goto fail;
   }
 

tests/tests.R

@@ -430,15 +430,15 @@ test_error(socket(listen = "test"), "argument")
 test_type("list", ncurl("http://www.cam.ac.uk/"))
 test_type("list", ncurl("http://www.cam.ac.uk/", follow = FALSE, response = "date"))
 test_type("list", ncurl("http://www.cam.ac.uk/", follow = TRUE))
-test_type("list", ncurl("http://postman-echo.com/post", convert = FALSE, method = "POST", headers = c(`Content-Type` = "text/plain"), data = "test", response = c("Date", "Server"), timeout = 3000))
+test_type("list", ncurl("https://postman-echo.com/post", convert = FALSE, method = "POST", headers = c(`Content-Type` = "application/octet-stream"), data = as.raw(1L), response = c("Date", "Server"), timeout = 3000))
 test_class("errorValue", ncurl("http")$data)
 test_class("recvAio", haio <- ncurl_aio("http://example.com/"))
 test_true(is_aio(haio))
 test_type("integer", call_aio(haio)$status)
 test_class("ncurlAio", haio <- ncurl_aio("https://example.com/", convert = FALSE, response = "server"))
 test_notnull(haio$status)
 if (call_aio(haio)$status == 200L) test_notnull(haio$headers)
-test_class("ncurlAio", put1 <- ncurl_aio("http://postman-echo.com/put", method = "PUT", headers = c(Authorization = "Bearer token"), data = "test", response = c("Date", "server"), timeout = 3000L))
+test_class("ncurlAio", put1 <- ncurl_aio("https://postman-echo.com/put", method = "PUT", headers = c(`Content-Type` = "text/plain", Authorization = "Bearer token"), data = "test", response = c("Date", "server"), timeout = 3000L))
 test_print(put1)
 test_type("integer", call_aio_(put1)$status)
 if (put1$status == 200L) test_notnull(put1$headers)