#60 intermediate headers fix: new slot response_headers_all in HttpRe…

…sponse

changes to HttpClient and HttpResponse, fixes for tests, bump dev version

DESCRIPTION

@@ -6,7 +6,7 @@ Description: A simple HTTP client, with tools for making HTTP requests,
     The package name is a play on curl, the widely used command line tool
     for HTTP, and this package is built on top of the R package 'curl', an
     interface to 'libcurl' (<https://curl.haxx.se/libcurl>).
-Version: 0.6.2.9331
+Version: 0.6.2.9334
 License: MIT + file LICENSE
 Authors@R: c(
     person("Scott", "Chamberlain", role = c("aut", "cre"),

R/client.R

@@ -120,6 +120,9 @@
 #' x$url
 #' class(out)
 #' out$handle
+#' out$request_headers
+#' out$response_headers
+#' out$response_headers_all
 #' 
 #' # if you just pass a url, we create a handle for you
 #' #  this is how most people will use HttpClient
@@ -467,24 +470,25 @@ HttpClient <- R6::R6Class(
         resp <- crul_fetch(opts)
       }
 
+      # prep headers
+      if (grepl("^ftp://", resp$url)) {
+        headers <- list()
+      } else {
+        hh <- rawToChar(resp$headers %||% raw(0))
+        if (is.null(hh) || nchar(hh) == 0) {
+          headers <- list()
+        } else {
+          headers <- lapply(curl::parse_headers(hh, multiple = TRUE), headers_parse)
+        }
+      }
       # build response
       HttpResponse$new(
         method = opts$method,
         url = resp$url,
         status_code = resp$status_code,
         request_headers = c('User-Agent' = opts$options$useragent, opts$headers),
-        response_headers = {
-          if (grepl("^ftp://", resp$url)) {
-            list()
-          } else {
-            hh <- rawToChar(resp$headers %||% raw(0))
-            if (is.null(hh) || nchar(hh) == 0) {
-              list()
-            } else {
-              headers_parse(curl::parse_headers(hh))
-            }
-          }
-        },
+        response_headers = headers[[length(headers)]],
+        response_headers_all = headers,
         modified = resp$modified,
         times = resp$times,
         content = resp$content,

R/response.R

@@ -8,6 +8,8 @@
 #' @param status_code (integer) status code
 #' @param request_headers (list) request headers, named list
 #' @param response_headers (list) response headers, named list
+#' @param response_headers_all (list) all response headers, including
+#' intermediate redirect headers, unnamed list of named lists
 #' @param modified (character) modified date
 #' @param times (vector) named vector
 #' @param content (raw) raw binary content response
@@ -69,6 +71,7 @@ HttpResponse <- R6::R6Class(
     status_code = NULL,
     request_headers = NULL,
     response_headers = NULL,
+    response_headers_all = NULL,
     modified = NULL,
     times = NULL,
     content = NULL,
@@ -107,7 +110,8 @@ HttpResponse <- R6::R6Class(
     },
 
     initialize = function(method, url, opts, handle, status_code,
-                          request_headers, response_headers, modified, times,
+                          request_headers, response_headers, 
+                          response_headers_all, modified, times,
                           content, request) {
 
       if (!missing(method)) self$method <- method
@@ -117,6 +121,8 @@ HttpResponse <- R6::R6Class(
       if (!missing(status_code)) self$status_code <- as.numeric(status_code)
       if (!missing(request_headers)) self$request_headers <- request_headers
       if (!missing(response_headers)) self$response_headers <- response_headers
+      if (!missing(response_headers_all)) 
+        self$response_headers_all <- response_headers_all
       if (!missing(modified)) self$modified <- modified
       if (!missing(times)) self$times <- times
       if (!missing(content)) self$content <- content

tests/testthat/test-headers.R

@@ -1,5 +1,4 @@
-context("headers")
-
+context("headers: default headers")
 test_that("headers work - just default headers", {
   skip_on_cran()
 
@@ -10,6 +9,7 @@ test_that("headers work - just default headers", {
   expect_named(aa$request_headers, c('User-Agent', 'Accept-Encoding', 'Accept'))
 })
 
+context("headers: user defined headers")
 test_that("headers work - user headers passed", {
   skip_on_cran()
 
@@ -25,3 +25,62 @@ test_that("headers work - user headers passed", {
   expect_true(
     any(grepl("Hello", names(jsonlite::fromJSON(bb$parse("UTF-8"))$headers))))
 })
+
+context("headers: all response headers")
+test_that("headers - all response headers, WITH redirect", {
+  skip_on_cran()
+
+  x <- HttpClient$new("https://doi.org/10.1007/978-3-642-40455-9_52-1")
+  bb <- x$get()
+
+  # response headers are the final set of headers and are named
+  expect_is(bb, "HttpResponse")
+  expect_is(bb$response_headers, "list")
+  expect_named(bb$response_headers)
+
+  # response headers all are all headers and are not named
+  expect_is(bb$response_headers_all, "list")
+  expect_named(bb$response_headers_all, NULL)
+  # individual header sets are named 
+  expect_is(bb$response_headers_all[[1]], "list")
+  expect_named(bb$response_headers_all[[1]])
+  # response_headers == the last response_headers_all list
+  expect_identical(
+    bb$response_headers, 
+    bb$response_headers_all[[length(bb$response_headers_all)]]
+  )
+  # for redirects, intermediate headers have 3** series status codes
+  expect_true(
+    any(grepl("3[0-9]{2}", 
+      vapply(bb$response_headers_all, "[[", "", "status"))))
+})
+
+test_that("headers - all response headers, WITHOUT redirect", {
+  skip_on_cran()
+
+  x <- HttpClient$new(url = hb())
+  bb <- x$get()
+
+  # response headers are the final set of headers and are named
+  expect_is(bb, "HttpResponse")
+  expect_is(bb$response_headers, "list")
+  expect_named(bb$response_headers)
+
+  # response headers all are all headers and are not named
+  expect_is(bb$response_headers_all, "list")
+  expect_named(bb$response_headers_all, NULL)
+  # individual header sets are named 
+  expect_is(bb$response_headers_all[[1]], "list")
+  expect_named(bb$response_headers_all[[1]])
+  # response_headers == the last response_headers_all list
+  expect_identical(
+    bb$response_headers, 
+    bb$response_headers_all[[length(bb$response_headers_all)]]
+  )
+  # w/o redirects, no 3** series status codes
+  expect_false(
+    any(grepl("3[0-9]{2}", 
+      vapply(bb$response_headers_all, "[[", "", "status"))))
+  # w/o redirects, only 1 header set
+  expect_equal(length(bb$response_headers_all), 1)
+})