#220 httr working now, i think

DESCRIPTION

@@ -30,6 +30,7 @@ SystemRequirements: C++11
 LinkingTo: 
     cpp11
 Imports:
+    curl,
     crul (>= 0.8.4),
     httr,
     webmockr (>= 0.7.4.93),
@@ -46,7 +47,6 @@ Suggests:
     desc,
     crayon,
     cli,
-    curl,
     withr
 Remotes: ropensci/webmockr@httr-url-redirects
 X-schema.org-applicationCategory: Web

Makefile

@@ -28,12 +28,12 @@ test:
 	${RSCRIPT} -e "devtools::test()"
 
 check: build
-	_R_CHECK_CRAN_INCOMING_=FALSE R CMD CHECK --as-cran --no-manual `ls -1tr ${PACKAGE}*gz | tail -n1`
+	_R_CHECK_CRAN_INCOMING_=FALSE R CMD CHECK --as-cran --no-manual --ignore-vignettes `ls -1tr ${PACKAGE}*gz | tail -n1`
 	@rm -f `ls -1tr ${PACKAGE}*gz | tail -n1`
 	@rm -rf ${PACKAGE}.Rcheck
 
 check_windows:
-	${RSCRIPT} -e "devtools::check_win_devel(); devtools::check_win_release()"
+	${RSCRIPT} -e "devtools::check_win_devel(quiet=TRUE); devtools::check_win_release(quiet=TRUE)"
 
 readme:
 	${RSCRIPT} -e "source('make_readme.R')"

NAMESPACE

@@ -53,6 +53,7 @@ importFrom(base64enc,base64decode)
 importFrom(base64enc,base64encode)
 importFrom(crul,HttpClient)
 importFrom(crul,mock)
+importFrom(curl,handle_setopt)
 importFrom(httr,content)
 importFrom(httr,http_status)
 importFrom(urltools,url_compose)

R/request_handler-crul.R

@@ -1,4 +1,4 @@
-sac <- new.env()
+# sac <- new.env()
 
 
 #' @title RequestHandlerCrul

R/request_handler-httr.R

@@ -1,3 +1,5 @@
+sac <- new.env()
+
 #' @title RequestHandlerHttr
 #' @description Methods for the httr package, building on [RequestHandler]
 #' @export
@@ -48,7 +50,10 @@ RequestHandlerHttr <- R6::R6Class(
           webmockr::pluck_body(request), request$headers,
           fields = request$fields, output = request$output)
       }
-      self$cassette <- tryCatch(current_cassette(), error = function(e) e)
+      self$cassette <- current_cassette()
+      # place original http request into the cassette to enable
+      # the record_separate_redirects=TRUE option
+      if (length(self$cassette)) self$cassette$set_request(self$request_original)
     }
   ),
 
@@ -110,11 +115,17 @@ RequestHandlerHttr <- R6::R6Class(
       )
       response <- webmockr::build_httr_response(self$request_original, tmp2)
 
+      sac$response <- response
+      sac$self <- self
+      sac$tmp2 <- tmp2
+
       # make vcr response | then record interaction
       self$vcr_response <- private$response_for(response)
       cas <- tryCatch(current_cassette(), error = function(e) e)
       if (inherits(cas, "error")) stop("no cassette in use")
       cas$record_http_interaction(response)
+
+      sac$cas <- cas
 
       # return real response
       return(response)

R/use_cassette.R

@@ -183,9 +183,12 @@ use_cassette <- function(name, ...,
   if (record_separate_redirects) {
     while (redirects_remaining(cassette)) {
       rel_path <- last(cassette$merged_interactions())[[1]]$response$headers$location
-      cassette$request_original <- 
+      cassette$request_original <-
         update_relative(cassette$request_original, rel_path)
-      RequestHandlerCrul$new(cassette$request_original)$handle()
+      switch(http_client(cassette$request_original),
+        crul = RequestHandlerCrul$new(cassette$request_original)$handle(),
+        httr = RequestHandlerHttr$new(cassette$request_original)$handle()
+      )
     }
     # what we need to do:
     # 1. before any real requests, set followlocation=0L, then
@@ -196,20 +199,35 @@ use_cassette <- function(name, ...,
   return(cassette)
 }
 
+
+scode <- function(x) {
+  if ("status_code" %in% names(x)) return(x$status_code)
+  return(x$status$status_code)
+}
 last_http_status <- function(cas) {
   z <- last(cas$merged_interactions())
-  if (!length(z)) "" else z[[1]]$response$status$status_code
+  if (!length(z)) "" else scode(z[[1]]$response)
+  # $status$status_code
 }
 redirects_remaining <- function(cas) {
   stat <- as.character(last_http_status(cas))
   sac$last_http_status_code <- stat
   if (!nzchar(stat)) return(TRUE)
   stat %in% c("301", "302", "303", "307", "308")
 }
+http_client <- function(x) {
+  ifelse(is.list(x$url), "crul", "httr")
+}
 update_relative <- function(req, path) {
-  tmp <- urltools::url_parse(req$url$url)
+  pkg <- http_client(req)
+  tmp <- urltools::url_parse(switch(pkg, crul=req$url$url, httr=req$url))
   tmp$path <- sub("^/", "", path)
-  req$url$url <- urltools::url_compose(tmp)
-  curl::handle_setopt(req$url$handle, followlocation = 0L)
+  if (pkg == "crul") {
+    req$url$url <- urltools::url_compose(tmp)
+  } else {
+    req$url <- urltools::url_compose(tmp)
+  }
+  if (pkg == "crul")
+    curl::handle_setopt(req$url$handle, followlocation = 0L)
   return(req)
 }

R/vcr-package.R

@@ -38,6 +38,7 @@
 #' @importFrom crul HttpClient mock
 #' @importFrom httr http_status content
 #' @importFrom webmockr pluck_body
+#' @importFrom curl handle_setopt
 #' @useDynLib vcr, .registration = TRUE
 #' @author Scott Chamberlain \email{myrmecocystus@@gmail.com}
 #' @docType package

tests/testthat/test-redirects.R

@@ -40,4 +40,55 @@ test_that("redirects: w/ crul", {
   expect_is(x2, "HttpResponse")
   ## FIXME: this should be: expect_match(x1$url, "/get")
   expect_match(x2$url, "/redirect/3")
+
+  # cleanup
+  unlink(mydir, recursive = TRUE)
 })
+
+test_that("redirects: w/ httr", {
+  library(httr)
+  mydir <- file.path(tempdir(), "bunnybear2")
+  invisible(vcr_configure(dir = mydir))
+  unlink(file.path(vcr_c$dir, "testing1.yml"))
+
+  # first recording
+  cas1 <- use_cassette("testing3", {
+    x1 <- GET("https://hb.opencpu.org/redirect/3")
+  }, record_separate_redirects = TRUE)
+
+  # cassette
+  expect_is(cas1, "Cassette")
+  expect_true(cas1$record_separate_redirects)
+  cas_file <- yaml.load_file(cas1$file())
+  expect_length(cas_file$http_interactions, 4)
+  locs <- unlist(lapply(cas_file$http_interactions, function(w) w$response$headers$location))
+  expect_equal(locs, c("/relative-redirect/2", "/relative-redirect/1", "/get"))
+  # response
+  expect_is(x1, "response")
+  ## FIXME: this should be: expect_match(x1$url, "/get")
+  expect_match(x1$url, "/redirect/3")
+
+  # second recording
+  cas2 <- use_cassette("testing4", {
+    x2 <- GET("https://hb.opencpu.org/redirect/3")
+  }, record_separate_redirects = TRUE)
+
+  # cassette
+  expect_is(cas2, "Cassette")
+  expect_true(cas2$record_separate_redirects)
+  cas2_file <- yaml.load_file(cas2$file())
+  expect_length(cas2_file$http_interactions, 4)
+  locs2 <- unlist(lapply(cas2_file$http_interactions, function(w) w$response$headers$location))
+  expect_equal(locs2, c("/relative-redirect/2", "/relative-redirect/1", "/get"))
+  # response
+  expect_is(x2, "response")
+  ## FIXME: this should be: expect_match(x1$url, "/get")
+  expect_match(x2$url, "/redirect/3")
+
+  # cleanup
+  unlink(mydir, recursive = TRUE)
+})
+
+# cleanup
+# reset configuration
+vcr_configure_reset()