fixes for redirects

DESCRIPTION

@@ -33,7 +33,7 @@ Imports:
     curl,
     crul (>= 0.8.4),
     httr,
-    webmockr (>= 0.7.4.94),
+    webmockr (>= 0.7.4.95),
     urltools,
     yaml,
     R6,
@@ -49,7 +49,7 @@ Suggests:
     crayon,
     cli,
     withr
-Remotes: ropensci/webmockr
+Remotes: ropensci/webmockr@httr-url-redirects
 X-schema.org-applicationCategory: Web
 X-schema.org-keywords: http, https, API, web-services, curl, mock, mocking, http-mocking, testing, testing-tools, tdd
 X-schema.org-isPartOf: https://ropensci.org

R/request_handler-httr.R

@@ -54,6 +54,8 @@ RequestHandlerHttr <- R6::R6Class(
       # 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)
+      # put requesthandler in cassette?
+      if (length(self$cassette)) self$cassette$set_handler(self)
     }
   ),
 

R/use_cassette.R

@@ -224,12 +224,19 @@ http_client <- function(x) {
 }
 update_relative <- function(req, path) {
   pkg <- http_client(req)
-  tmp <- urltools::url_parse(switch(pkg, crul=req$url$url, httr=req$url))
-  tmp$path <- sub("^/", "", path)
+  next_url <- path
+  if (!grepl('://', path, fixed = TRUE)) {
+    # server <- sub("^(.*://[^/]+).*", "\\1", url)
+    # nexturl <- paste0(server, nexturl)
+    tmp <- urltools::url_parse(switch(pkg, crul=req$url$url, httr=req$url))
+    tmp$path <- sub("^/", "", path)
+    next_url <- urltools::url_compose(tmp)
+  }
+
   if (pkg == "crul") {
-    req$url$url <- urltools::url_compose(tmp)
+    req$url$url <- next_url
   } else {
-    req$url <- urltools::url_compose(tmp)
+    req$url <- next_url
   }
   if (pkg == "crul")
     curl::handle_setopt(req$url$handle, followlocation = 0L)

tests/testthat/test-redirects.R

@@ -2,12 +2,18 @@ context("redirects")
 
 test_that("redirects: w/ crul", {
   library(crul)
-  mydir <- file.path(tempdir(), "bunnybear")
+  mydir <- file.path(tempdir(), "bunnybear2")
   invisible(vcr_configure(dir = mydir))
   unlink(file.path(vcr_c$dir, "testing1.yml"))
   con <- HttpClient$new(url = "https://hb.opencpu.org")
 
   # first recording
+  # cas1 <- insert_cassette("testing2", record_separate_redirects = TRUE)
+  # x1 <- con$get("redirect/3")
+  # cassette <- cas1
+  # cassette$redirect_pool
+  # cassette$record_separate_redirects
+
   cas1 <- use_cassette("testing2", {
     x1 <- con$get("redirect/3")
   }, record_separate_redirects = TRUE)
@@ -44,6 +50,17 @@ test_that("redirects: w/ crul", {
   ## FIXME: this should be: expect_match(x1$url, "/get")
   expect_match(x2$url, "/redirect/3")
 
+
+  ## Works when Location header gives complete URL
+  # above with redirect/3 gives relative URLs in Location header
+  cas3 <- use_cassette("testing22", {
+    x2 <- HttpClient$new("http://bit.ly/2SfWO3K")$get()
+  }, record_separate_redirects = TRUE)
+  cas3_file <- yaml.load_file(cas3$file())
+  expect_length(cas3_file$http_interactions, 2)
+  locs <- unlist(lapply(cas3_file$http_interactions, function(w) w$response$headers$location))
+  expect_equal(locs, "https://www.aect.org/about_us.php")
+
   # cleanup
   unlink(mydir, recursive = TRUE)
 })