fix #92 problem with httr -

we werent collecting status_code as http_status fxn doesnt actually give a status_code slot
add httr specific test file bump dev version

DESCRIPTION

@@ -8,7 +8,7 @@ Description: Record test suite 'HTTP' requests and replays them during
     real 'HTTP' responses on disk in 'cassettes'. Subsequent 'HTTP' requests 
     matching any previous requests in the same 'cassette' use a cached 
     'HTTP' response. 
-Version: 0.2.2.9132
+Version: 0.2.2.9311
 Authors@R: c(person("Scott", "Chamberlain", role = c("aut", "cre"),
     email = "sckott@protonmail.com", comment = c(ORCID="0000-0003-1444-9135")))
 URL: https://github.com/ropensci/vcr/ (devel)

R/cassette_class.R

@@ -220,10 +220,10 @@ Cassette <- R6::R6Class(
             tmp <- webmockr::stub_request(req$method, req$uri)
             webmockr::wi_th(tmp, .list = list(query = req$headers))
           } else if (
-            all(m %in% c("method", "uri", "headers", "query")) && 
+            all(m %in% c("method", "uri", "headers", "query")) &&
             length(m) == 4) {
             tmp <- webmockr::stub_request(req$method, req$uri)
-            webmockr::wi_th(tmp, .list = list(query = uripp$parameter, 
+            webmockr::wi_th(tmp, .list = list(query = uripp$parameter,
               headers = req$headers))
           }
         }))
@@ -502,17 +502,26 @@ Cassette <- R6::R6Class(
         } else {
           x$request$fields
         },
-        if (inherits(x, "response")) as.list(x$request$headers) else x$request_headers,
+        if (inherits(x, "response")) {
+          as.list(x$request$headers)
+        } else {
+          x$request_headers
+        },
         self$cassette_opts
       )
       response <- VcrResponse$new(
-        if (inherits(x, "response")) httr::http_status(x) else unclass(x$status_http()),
+        if (inherits(x, "response")) {
+          c(list(status_code = x$status_code), httr::http_status(x))
+        } else unclass(x$status_http()),
         if (inherits(x, "response")) x$headers else x$response_headers,
         rawToChar(x$content),
-        if (inherits(x, "response")) x$all_headers[[1]]$version else x$response_headers$status,
+        if (inherits(x, "response")) {
+          x$all_headers[[1]]$version
+        } else x$response_headers$status,
         self$cassette_opts
       )
-      if (self$update_content_length_header) response$update_content_length_header()
+      if (self$update_content_length_header)
+        response$update_content_length_header()
       HTTPInteraction$new(request = request, response = response)
     },
 

R/request_handler-httr.R

@@ -32,7 +32,7 @@ RequestHandlerHttr <- R6::R6Class(
     # make a `vcr` response
     response_for = function(x) {
       VcrResponse$new(
-        httr::http_status(x),
+        c(list(status_code = x$status_code), httr::http_status(x)),
         x$headers,
         httr::content(x, encoding = "UTF-8"),
         x$all_headers[[1]]$version,

tests/testthat/test-httr.R

@@ -0,0 +1,97 @@
+library("httr")
+
+vcr_configure(dir = tempdir())
+
+context("httr: status code works")
+test_that("httr status code works", {
+  load("httr_obj.rda")
+
+  expect_is(httr_obj, "request")
+
+  x <- RequestHandlerHttr$new(httr_obj)
+
+  expect_is(x, "RequestHandlerHttr")
+  expect_is(x$handle, "function")
+  expect_error(x$handle())
+
+  # do request
+  insert_cassette("foobar")
+  response <- x$handle()
+
+  expect_is(response, "response")
+  # status code is correct
+  expect_equal(response$status_code, 404)
+
+  eject_cassette("foobar")
+
+  # call again
+  insert_cassette("foobar")
+  response2 <- x$handle()
+
+  expect_is(response2, "response")
+  # status code is correct
+  expect_equal(response2$status_code, 404)
+
+  eject_cassette("foobar")
+
+  # cleanup
+  unlink(file.path(vcr_configuration()$dir, "foobar.yml"))
+})
+
+
+context("httr: use_cassette works")
+test_that("httr use_cassette works", {
+  out <- use_cassette("httr_test1", {
+    x <- GET("https://httpbin.org/404")
+  })
+
+  # cassette
+  expect_is(out, "Cassette")
+  expect_match(out$manfile, "httr_test1")
+  expect_false(out$is_empty())
+  expect_is(out$recorded_at, "POSIXct")
+
+  # response
+  expect_is(x, "response")
+  expect_equal(x$status_code, 404)
+  expect_equal(x$url, "https://httpbin.org/404")
+
+  # response body
+  str <- yaml::yaml.load_file(out$manfile)$http_interactions
+  expect_is(str[[1]]$response$body$string, "character")
+  expect_match(str[[1]]$response$body$string, "404")
+  expect_match(str[[1]]$response$body$string, "DOCTYPE HTML")
+
+  # cleanup
+  unlink(file.path(vcr_configuration()$dir, "httr_test2.yml"))
+})
+
+
+context("httr: use_cassette w/ preserve_exact_body_bytes")
+test_that("httr use_cassette works", {
+  out <- use_cassette("httr_test2", {
+    x <- GET("https://httpbin.org/404")
+  }, preserve_exact_body_bytes = TRUE)
+
+  # cassette
+  expect_is(out, "Cassette")
+  expect_match(out$manfile, "httr_test2")
+  expect_false(out$is_empty())
+  expect_is(out$recorded_at, "POSIXct")
+
+  # response
+  expect_is(x, "response")
+  expect_equal(x$status_code, 404)
+  expect_equal(x$url, "https://httpbin.org/404")
+
+  # response body
+  str <- yaml::yaml.load_file(out$manfile)
+  str <- rawToChar(base64enc::base64decode(
+    str$http_interactions[[1]]$response$body$string))
+  expect_is(str, "character")
+  expect_match(str, "404")
+  expect_match(str, "DOCTYPE HTML")
+
+  # cleanup
+  unlink(file.path(vcr_configuration()$dir, "httr_test2.yml"))
+})