ncurl() now returns $status; refactor SHA functions

Author: shikokuchuo

NAMESPACE

@@ -8,6 +8,7 @@ S3method("$<-",sendAio)
 S3method("[",nano)
 S3method("[[",nano)
 S3method(.DollarNames,nano)
+S3method(.DollarNames,ncurlAio)
 S3method(.DollarNames,recvAio)
 S3method(.DollarNames,sendAio)
 S3method(as.character,nanoHash)
@@ -24,6 +25,7 @@ S3method(print,nanoListener)
 S3method(print,nanoObject)
 S3method(print,nanoSocket)
 S3method(print,nanoStream)
+S3method(print,ncurlAio)
 S3method(print,recvAio)
 S3method(print,sendAio)
 S3method(print,unresolvedValue)

NEWS.md

@@ -4,6 +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 'ca_file' for optionally specifying a certificate authority certificate chain file when connecting to secure sites.
+* `ncurl()` now returns an additional `$status` field.
 * `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

@@ -269,6 +269,15 @@ print.sendAio <- function(x, ...) {
 
 }
 
+#' @export
+#'
+print.ncurlAio <- function(x, ...) {
+
+  cat("< ncurlAio >\n - $status for status code\n - $raw for raw message\n - $data for message data\n", file = stdout())
+  invisible(x)
+
+}
+
 #' @export
 #'
 print.unresolvedValue <- function(x, ...) {
@@ -330,3 +339,7 @@ print.errorValue <- function(x, ...) {
 .DollarNames.sendAio <- function(x, pattern = "") grep(pattern, "result",
                                                        value = TRUE, fixed = TRUE)
 
+#' @export
+#'
+.DollarNames.ncurlAio <- function(x, pattern = "") grep(pattern, c("status", "raw", "data"),
+                                                        value = TRUE, fixed = TRUE)

R/ncurl.R

@@ -34,16 +34,18 @@
 #'     certificate authority certificate chain. If missing or NULL, certificates
 #'     are not validated.
 #'
-#' @return Named list of 2 elements:
+#' @return Named list of 3 elements:
 #'     \itemize{
+#'     \item{\code{$status}} {- integer HTTP repsonse status code (200 - OK)}
 #'     \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}
 #'     and content is a recognised text format), or NULL otherwise. Other tools
 #'     can be used to further parse this as html, json, xml etc. if required.}
 #'     }
 #'
-#'     Or else, if \code{async = TRUE}, a 'recvAio' (object of class 'recvAio').
+#'     Or else, if \code{async = TRUE}, an 'ncurlAio' (object of class 'ncurlAio'
+#'     and 'recvAio').
 #'
 #' @section Redirects:
 #'
@@ -72,39 +74,41 @@ ncurl <- function(url,
 
   data <- if (!missing(data)) writeBin(object = data, con = raw())
 
-  if (missing(async) || !isTRUE(async)) {
-
-    res <- .Call(rnng_ncurl, url, method, headers, data, ca_file)
-    is.integer(res) && return(res)
-
-    if (is.character(res)) {
-      continue <- if (interactive()) readline(sprintf("Follow redirect to <%s>? [Y/n] ", res)) else "n"
-      continue %in% c("n", "N", "no", "NO") && return(res)
-      return(ncurl(res))
-    }
-
-    data <- if (missing(convert) || isTRUE(convert)) tryCatch(rawToChar(res), error = function(e) NULL)
-
-    list(raw = res, data = data)
-
-  } else {
+  if (async) {
 
     aio <- .Call(rnng_ncurl_aio, url, method, headers, data, ca_file)
     is.integer(aio) && return(aio)
 
     convert <- missing(convert) || isTRUE(convert)
-    data <- raw <- NULL
+    status <- raw <- data <- NULL
     unresolv <- TRUE
     env <- new.env(hash = FALSE)
+    makeActiveBinding(sym = "status", 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]]
+          data <<- if (convert) tryCatch(rawToChar(raw), error = function(e) NULL)
+        }
+        aio <<- env[["aio"]] <<- NULL
+        unresolv <<- FALSE
+      }
+      status
+    }, env = env)
     makeActiveBinding(sym = "raw", 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 {
-          raw <<- res
-          data <<- if (convert) tryCatch(rawToChar(res), error = function(e) NULL)
+          status <<- res[[1L]]
+          raw <<- res[[2L]]
+          data <<- if (convert) tryCatch(rawToChar(raw), error = function(e) NULL)
         }
         aio <<- env[["aio"]] <<- NULL
         unresolv <<- FALSE
@@ -118,15 +122,30 @@ ncurl <- function(url,
         if (is.integer(res)) {
           data <<- raw <<- res
         } else {
-          raw <<- res
-          data <<- if (convert) tryCatch(rawToChar(res), error = function(e) NULL)
+          status <<- res[[1L]]
+          raw <<- res[[2L]]
+          data <<- if (convert) tryCatch(rawToChar(raw), error = function(e) NULL)
         }
         aio <<- env[["aio"]] <<- NULL
         unresolv <<- FALSE
       }
       data
     }, env = env)
-    `class<-`(`[[<-`(`[[<-`(env, "keep.raw", TRUE), "aio", aio), "recvAio")
+
+    `class<-`(`[[<-`(env, "aio", aio), c("ncurlAio", "recvAio"))
+
+  } else {
+
+    res <- .Call(rnng_ncurl, url, convert, method, headers, data, ca_file)
+
+    is.integer(res) && return(res)
+    is.character(res) && {
+      continue <- if (interactive()) readline(sprintf("Follow redirect to <%s>? [Y/n] ", res)) else "n"
+      continue %in% c("n", "N", "no", "NO") && return(res)
+      return(ncurl(res))
+    }
+
+    res
 
   }
 }

R/sha.R

@@ -49,18 +49,9 @@ sha224 <- function(x, key = NULL) {
 
   if (!is.raw(x))
     x <- if (is.character(x)) charToRaw(x) else serialize(x, NULL)
-
-  if (missing(key) || is.null(key)) {
-
-    .Call(rnng_sha224, x)
-
-  } else {
-
-    if (!is.raw(key))
-      key <- if (is.character(key)) charToRaw(key) else serialize(key, NULL)
-    .Call(rnng_sha224hmac, x, key)
-
-  }
+  if (!is.null(key) && !is.raw(key))
+    key <- if (is.character(key)) charToRaw(key) else serialize(key, NULL)
+  .Call(rnng_sha224, x, key)
 
 }
 
@@ -97,18 +88,9 @@ sha256 <- function(x, key = NULL) {
 
   if (!is.raw(x))
     x <- if (is.character(x)) charToRaw(x) else serialize(x, NULL)
-
-  if (missing(key) || is.null(key)) {
-
-    .Call(rnng_sha256, x)
-
-  } else {
-
-    if (!is.raw(key))
+  if (!is.null(key) && !is.raw(key))
       key <- if (is.character(key)) charToRaw(key) else serialize(key, NULL)
-    .Call(rnng_sha256hmac, x, key)
-
-  }
+  .Call(rnng_sha256, x, key)
 
 }
 
@@ -145,18 +127,9 @@ sha384 <- function(x, key = NULL) {
 
   if (!is.raw(x))
     x <- if (is.character(x)) charToRaw(x) else serialize(x, NULL)
-
-  if (missing(key) || is.null(key)) {
-
-    .Call(rnng_sha384, x)
-
-  } else {
-
-    if (!is.raw(key))
-      key <- if (is.character(key)) charToRaw(key) else serialize(key, NULL)
-    .Call(rnng_sha384hmac, x, key)
-
-  }
+  if (!is.null(key) && !is.raw(key))
+    key <- if (is.character(key)) charToRaw(key) else serialize(key, NULL)
+  .Call(rnng_sha384, x, key)
 
 }
 
@@ -193,18 +166,9 @@ sha512 <- function(x, key = NULL) {
 
   if (!is.raw(x))
     x <- if (is.character(x)) charToRaw(x) else serialize(x, NULL)
-
-  if (missing(key) || is.null(key)) {
-
-    .Call(rnng_sha512, x)
-
-  } else {
-
-    if (!is.raw(key))
-      key <- if (is.character(key)) charToRaw(key) else serialize(key, NULL)
-    .Call(rnng_sha512hmac, x, key)
-
-  }
+  if (!is.null(key) && !is.raw(key))
+    key <- if (is.character(key)) charToRaw(key) else serialize(key, NULL)
+  .Call(rnng_sha512, x, key)
 
 }
 

README.Rmd

@@ -411,7 +411,7 @@ Above it can be seen that the final value resolves into a timeout, which is an i
 
 `ncurl()` is a minimalist http(s) client.
 
-By setting `async = TRUE`, it performs requests asynchronously, returning immediately with a 'recvAio'.
+By setting `async = TRUE`, it performs requests asynchronously, returning immediately with an 'ncurlAio'.
 
 For normal use, it takes just the URL. It can follow redirects.
 

README.md

@@ -384,7 +384,7 @@ aio
 #> < recvAio >
 #>  - $data for message data
 aio$data |> str()
-#>  num [1:100000000] -1.531 1.139 -0.256 -0.362 0.17 ...
+#>  num [1:100000000] -1.431 -1.057 0.272 -0.784 0.329 ...
 ```
 
 As `call_aio()` is blocking and will wait for completion, an alternative
@@ -527,21 +527,24 @@ message values.
 `ncurl()` is a minimalist http(s) client.
 
 By setting `async = TRUE`, it performs requests asynchronously,
-returning immediately with a ‘recvAio’.
+returning immediately with an ‘ncurlAio’.
 
 For normal use, it takes just the URL. It can follow redirects.
 
 ``` r
 ncurl("https://httpbin.org/headers")
+#> $status
+#> [1] 200
+#> 
 #> $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 30 66 36 62 39 63 2d 30 39 35 66 35 66 35 31 37 66 38 32 37 61 35
-#> [101] 35 36 36 32 31 38 35 31 37 22 0a 20 20 7d 0a 7d 0a
+#>  [76] 2d 36 33 30 66 64 66 37 33 2d 30 65 34 33 63 35 34 62 31 37 38 39 36 37 34
+#> [101] 31 33 64 66 32 64 30 62 39 22 0a 20 20 7d 0a 7d 0a
 #> 
 #> $data
-#> [1] "{\n  \"headers\": {\n    \"Host\": \"httpbin.org\", \n    \"X-Amzn-Trace-Id\": \"Root=1-630f6b9c-095f5f517f827a5566218517\"\n  }\n}\n"
+#> [1] "{\n  \"headers\": {\n    \"Host\": \"httpbin.org\", \n    \"X-Amzn-Trace-Id\": \"Root=1-630fdf73-0e43c54b178967413df2d0b9\"\n  }\n}\n"
 ```
 
 For advanced use, supports additional HTTP methods such as POST or PUT.
@@ -551,12 +554,13 @@ res <- ncurl("http://httpbin.org/post", async = TRUE, method = "POST",
              headers = c(`Content-Type` = "application/json", Authorization = "Bearer APIKEY"),
              data = '{"key": "value"}')
 res
-#> < recvAio >
-#>  - $data for message data
+#> < ncurlAio >
+#>  - $status for status code
 #>  - $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-630f6b9c-0b5c391a11ad759e225b0401\"\n  }, \n  \"json\": {\n    \"key\": \"value\"\n  }, \n  \"origin\": \"79.173.129.2\", \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-630fdf73-5800665b2a82f9933933d8b3\"\n  }, \n  \"json\": {\n    \"key\": \"value\"\n  }, \n  \"origin\": \"185.225.45.49\", \n  \"url\": \"http://httpbin.org/post\"\n}\n"
 ```
 
 In this respect, it may be used as a performant and lightweight method
@@ -599,10 +603,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\":1.00133,\"b\":1.00131,\"dc\":\"-0.1009\",\"dd\":\"-0.0010\",\"ppms\":false,\"t\":1661954973000}"
+#> [1] "{\"s\":\"EURUSD\",\"a\":1.00522,\"b\":1.0052,\"dc\":\"0.2865\",\"dd\":\"0.0029\",\"ppms\":false,\"t\":1661984634000}"
 
 s |> recv(keep.raw = FALSE)
-#> [1] "{\"s\":\"EURUSD\",\"a\":1.00131,\"b\":1.00129,\"dc\":\"-0.1029\",\"dd\":\"-0.0010\",\"ppms\":false,\"t\":1661954974000}"
+#> [1] "{\"s\":\"EURUSD\",\"a\":1.00519,\"b\":1.00517,\"dc\":\"0.2835\",\"dd\":\"0.0029\",\"ppms\":false,\"t\":1661984637000}"
 
 close(s)
 ```

man/ncurl.Rd

@@ -742,13 +742,17 @@ SEXP rnng_aio_http(SEXP aio) {
 
   void *dat;
   size_t sz;
-  SEXP vec;
+  SEXP out, vec;
 
+  PROTECT(out = Rf_allocVector(VECSXP, 2));
+  SET_VECTOR_ELT(out, 0, Rf_ScalarInteger(code));
   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);
 
-  return vec;
+  UNPROTECT(1);
+  return out;
 
 }