add code and time metadata for ncurl requests

Author: shikokuchuo

NEWS.md

@@ -4,7 +4,7 @@
 
 * Implements `sha224()`, `sha256()`, `sha384()` and `sha512()` series of fast, optimised cryptographic hash and HMAC generation functions using the 'Mbed TLS' library.
 * `ncurl()` and `stream()` gain the argmument 'pem' for optionally specifying a certificate authority certificate chain PEM file for authenticating secure sites.
-* `ncurl()` now returns an additional `$status` field.
+* `ncurl()` now returns additional `$code` (response status code) and `$time` (server date header) fields.
 * `messenger()` gains the argument 'auth' for authenticating communications based on a pre-shared key.
 * `random()` gains the argument 'n' for generating a vector of random numbers.
 

R/nano.R

@@ -273,7 +273,7 @@ print.sendAio <- function(x, ...) {
 #'
 print.ncurlAio <- function(x, ...) {
 
-  cat("< ncurlAio >\n - $status for status code\n - $raw for raw message\n - $data for message data\n", file = stdout())
+  cat("< ncurlAio >\n - $code for response status code\n - $time for server date header\n - $raw for raw message\n - $data for message data\n", file = stdout())
   invisible(x)
 
 }
@@ -341,5 +341,5 @@ print.errorValue <- function(x, ...) {
 
 #' @export
 #'
-.DollarNames.ncurlAio <- function(x, pattern = "") grep(pattern, c("status", "raw", "data"),
+.DollarNames.ncurlAio <- function(x, pattern = "") grep(pattern, c("code", "time", "raw", "data"),
                                                         value = TRUE, fixed = TRUE)

R/ncurl.R

@@ -34,9 +34,10 @@
 #'     certificate authority certificate chain (and revocation list if present).
 #'     If missing or NULL, certificates are not validated.
 #'
-#' @return Named list of 3 elements:
+#' @return Named list of 4 elements:
 #'     \itemize{
-#'     \item{\code{$status}} {- integer HTTP repsonse status code (200 - OK)}
+#'     \item{\code{$code}} {- integer HTTP repsonse status code (200 - OK).}
+#'     \item{\code{$time}} {- character server response header 'Date'.}
 #'     \item{\code{$raw}} {- raw vector of the received resource (use
 #'     \code{\link{writeBin}} to save to a file).}
 #'     \item{\code{$data}} {- converted character string (if \code{'convert' = TRUE}
@@ -80,24 +81,42 @@ ncurl <- function(url,
     is.integer(aio) && return(aio)
 
     convert <- missing(convert) || isTRUE(convert)
-    status <- raw <- data <- NULL
+    code <- time <- raw <- data <- NULL
     unresolv <- TRUE
     env <- new.env(hash = FALSE)
-    makeActiveBinding(sym = "status", fun = function(x) {
+    makeActiveBinding(sym = "code", fun = function(x) {
       if (unresolv) {
         res <- .Call(rnng_aio_http, aio)
         missing(res) && return(.Call(rnng_aio_unresolv))
         if (is.integer(res)) {
           data <<- raw <<- res
         } else {
-          status <<- res[[1L]]
-          raw <<- res[[2L]]
+          code <<- res[[1L]]
+          time <<- res[[2L]]
+          raw <<- res[[3L]]
           data <<- if (convert) tryCatch(rawToChar(raw), error = function(e) NULL)
         }
         aio <<- env[["aio"]] <<- NULL
         unresolv <<- FALSE
       }
-      status
+      code
+    }, env = env)
+    makeActiveBinding(sym = "time", fun = function(x) {
+      if (unresolv) {
+        res <- .Call(rnng_aio_http, aio)
+        missing(res) && return(.Call(rnng_aio_unresolv))
+        if (is.integer(res)) {
+          data <<- raw <<- res
+        } else {
+          code <<- res[[1L]]
+          time <<- res[[2L]]
+          raw <<- res[[3L]]
+          data <<- if (convert) tryCatch(rawToChar(raw), error = function(e) NULL)
+        }
+        aio <<- env[["aio"]] <<- NULL
+        unresolv <<- FALSE
+      }
+      time
     }, env = env)
     makeActiveBinding(sym = "raw", fun = function(x) {
       if (unresolv) {
@@ -106,8 +125,9 @@ ncurl <- function(url,
         if (is.integer(res)) {
           data <<- raw <<- res
         } else {
-          status <<- res[[1L]]
-          raw <<- res[[2L]]
+          code <<- res[[1L]]
+          time <<- res[[2L]]
+          raw <<- res[[3L]]
           data <<- if (convert) tryCatch(rawToChar(raw), error = function(e) NULL)
         }
         aio <<- env[["aio"]] <<- NULL
@@ -122,8 +142,9 @@ ncurl <- function(url,
         if (is.integer(res)) {
           data <<- raw <<- res
         } else {
-          status <<- res[[1L]]
-          raw <<- res[[2L]]
+          code <<- res[[1L]]
+          time <<- res[[2L]]
+          raw <<- res[[3L]]
           data <<- if (convert) tryCatch(rawToChar(raw), error = function(e) NULL)
         }
         aio <<- env[["aio"]] <<- NULL

README.md

@@ -384,7 +384,7 @@ aio
 #> < recvAio >
 #>  - $data for message data
 aio$data |> str()
-#>  num [1:100000000] -1.07171 -1.2844 0.69956 -0.00593 0.55111 ...
+#>  num [1:100000000] -0.428 0.206 0.609 0.309 -1.545 ...
 ```
 
 As `call_aio()` is blocking and will wait for completion, an alternative
@@ -533,18 +533,21 @@ For normal use, it takes just the URL. It can follow redirects.
 
 ``` r
 ncurl("https://httpbin.org/headers")
-#> $status
+#> $code
 #> [1] 200
 #> 
+#> $time
+#> [1] "Thu, 01 Sep 2022 16:11:56 GMT"
+#> 
 #> $raw
 #>   [1] 7b 0a 20 20 22 68 65 61 64 65 72 73 22 3a 20 7b 0a 20 20 20 20 22 48 6f 73
 #>  [26] 74 22 3a 20 22 68 74 74 70 62 69 6e 2e 6f 72 67 22 2c 20 0a 20 20 20 20 22
 #>  [51] 58 2d 41 6d 7a 6e 2d 54 72 61 63 65 2d 49 64 22 3a 20 22 52 6f 6f 74 3d 31
-#>  [76] 2d 36 33 31 30 64 30 34 38 2d 37 30 63 39 65 34 30 38 30 62 61 63 38 62 35
-#> [101] 31 36 64 32 30 62 34 30 31 22 0a 20 20 7d 0a 7d 0a
+#>  [76] 2d 36 33 31 30 64 39 63 63 2d 31 63 35 32 65 61 66 33 37 31 38 38 61 64 34
+#> [101] 37 35 64 37 36 62 30 64 37 22 0a 20 20 7d 0a 7d 0a
 #> 
 #> $data
-#> [1] "{\n  \"headers\": {\n    \"Host\": \"httpbin.org\", \n    \"X-Amzn-Trace-Id\": \"Root=1-6310d048-70c9e4080bac8b516d20b401\"\n  }\n}\n"
+#> [1] "{\n  \"headers\": {\n    \"Host\": \"httpbin.org\", \n    \"X-Amzn-Trace-Id\": \"Root=1-6310d9cc-1c52eaf37188ad475d76b0d7\"\n  }\n}\n"
 ```
 
 For advanced use, supports additional HTTP methods such as POST or PUT.
@@ -555,12 +558,13 @@ res <- ncurl("http://httpbin.org/post", async = TRUE, method = "POST",
              data = '{"key": "value"}')
 res
 #> < ncurlAio >
-#>  - $status for status code
+#>  - $code for response status code
+#>  - $time for server date header
 #>  - $raw for raw message
 #>  - $data for message data
 
 call_aio(res)$data
-#> [1] "{\n  \"args\": {}, \n  \"data\": \"{\\\"key\\\": \\\"value\\\"}\", \n  \"files\": {}, \n  \"form\": {}, \n  \"headers\": {\n    \"Authorization\": \"Bearer APIKEY\", \n    \"Content-Length\": \"16\", \n    \"Content-Type\": \"application/json\", \n    \"Host\": \"httpbin.org\", \n    \"X-Amzn-Trace-Id\": \"Root=1-6310d048-43a6602f3a64cf211e9e8636\"\n  }, \n  \"json\": {\n    \"key\": \"value\"\n  }, \n  \"origin\": \"79.173.189.133\", \n  \"url\": \"http://httpbin.org/post\"\n}\n"
+#> [1] "{\n  \"args\": {}, \n  \"data\": \"{\\\"key\\\": \\\"value\\\"}\", \n  \"files\": {}, \n  \"form\": {}, \n  \"headers\": {\n    \"Authorization\": \"Bearer APIKEY\", \n    \"Content-Length\": \"16\", \n    \"Content-Type\": \"application/json\", \n    \"Host\": \"httpbin.org\", \n    \"X-Amzn-Trace-Id\": \"Root=1-6310d9cc-620688304f76281859c78bf2\"\n  }, \n  \"json\": {\n    \"key\": \"value\"\n  }, \n  \"origin\": \"79.173.189.133\", \n  \"url\": \"http://httpbin.org/post\"\n}\n"
 ```
 
 In this respect, it may be used as a performant and lightweight method
@@ -603,10 +607,10 @@ s |> send('{"action": "subscribe", "symbols": "EURUSD"}')
 #> [26] 73 79 6d 62 6f 6c 73 22 3a 20 22 45 55 52 55 53 44 22 7d 00
 
 s |> recv(keep.raw = FALSE)
-#> [1] "{\"s\":\"EURUSD\",\"a\":0.9944,\"b\":0.9941,\"dc\":\"-0.9443\",\"dd\":\"-0.0094\",\"ppms\":false,\"t\":1662046284000}"
+#> [1] "{\"s\":\"EURUSD\",\"a\":0.99541,\"b\":0.99534,\"dc\":\"-0.8419\",\"dd\":\"-0.0084\",\"ppms\":false,\"t\":1662048718000}"
 
 s |> recv(keep.raw = FALSE)
-#> [1] "{\"s\":\"EURUSD\",\"a\":0.99413,\"b\":0.99411,\"dc\":\"-0.9717\",\"dd\":\"-0.0097\",\"ppms\":false,\"t\":1662046284000}"
+#> [1] "{\"s\":\"EURUSD\",\"a\":0.99537,\"b\":0.99535,\"dc\":\"-0.8459\",\"dd\":\"-0.0084\",\"ppms\":false,\"t\":1662048718000}"
 
 close(s)
 ```

man/ncurl.Rd

@@ -671,9 +671,10 @@ SEXP rnng_aio_http(SEXP aio) {
     REprintf("HTTP Server Response: %d %s\n", code, nng_http_res_get_reason(handle->res));
     if (code >= 300 && code < 400) {
       SEXP out;
-      PROTECT(out = Rf_allocVector(VECSXP, 2));
+      PROTECT(out = Rf_allocVector(VECSXP, 3));
       SET_VECTOR_ELT(out, 0, Rf_ScalarInteger(code));
-      SET_VECTOR_ELT(out, 1, Rf_mkString(nng_http_res_get_header(handle->res, "Location")));
+      SET_VECTOR_ELT(out, 1, Rf_mkString(nng_http_res_get_header(handle->res, "Date")));
+      SET_VECTOR_ELT(out, 2, Rf_mkString(nng_http_res_get_header(handle->res, "Location")));
       UNPROTECT(1);
       return out;
     }
@@ -683,12 +684,13 @@ SEXP rnng_aio_http(SEXP aio) {
   size_t sz;
   SEXP out, vec;
 
-  PROTECT(out = Rf_allocVector(VECSXP, 2));
+  PROTECT(out = Rf_allocVector(VECSXP, 3));
   SET_VECTOR_ELT(out, 0, Rf_ScalarInteger(code));
+  SET_VECTOR_ELT(out, 1, Rf_mkString(nng_http_res_get_header(handle->res, "Date")));
   nng_http_res_get_data(handle->res, &dat, &sz);
   vec = Rf_allocVector(RAWSXP, sz);
   memcpy(RAW(vec), dat, sz);
-  SET_VECTOR_ELT(out, 1, vec);
+  SET_VECTOR_ELT(out, 2, vec);
 
   UNPROTECT(1);
   return out;

src/aio.c

@@ -220,22 +220,23 @@ SEXP rnng_ncurl(SEXP http, SEXP convert, SEXP method, SEXP headers, SEXP data, S
 
   nng_http_res_get_data(res, &dat, &sz);
 
-  const char *names[] = {"status", "raw", "data", ""};
+  const char *names[] = {"code", "time", "raw", "data", ""};
   PROTECT(out = Rf_mkNamed(VECSXP, names));
 
   SET_VECTOR_ELT(out, 0, Rf_ScalarInteger(code));
+  SET_VECTOR_ELT(out, 1, Rf_mkString(nng_http_res_get_header(res, "Date")));
 
   vec = Rf_allocVector(RAWSXP, sz);
   memcpy(RAW(vec), dat, sz);
-  SET_VECTOR_ELT(out, 1, vec);
+  SET_VECTOR_ELT(out, 2, vec);
 
   if (Rf_asLogical(convert)) {
     SEXP expr;
     PROTECT(expr = Rf_lang2(nano_RtcSymbol, vec));
     cvec = R_tryEvalSilent(expr, R_BaseEnv, &xc);
     UNPROTECT(1);
   }
-  SET_VECTOR_ELT(out, 2, cvec);
+  SET_VECTOR_ELT(out, 3, cvec);
 
   nng_http_res_free(res);
   nng_http_req_free(req);