From 56da0630a1cfa2701802282ac69063754788cedb Mon Sep 17 00:00:00 2001 From: Scott Chamberlain Date: Thu, 25 Feb 2021 12:17:30 -0800 Subject: [PATCH] #220 httr working now, i think --- DESCRIPTION | 2 +- Makefile | 4 +-- NAMESPACE | 1 + R/request_handler-crul.R | 2 +- R/request_handler-httr.R | 13 ++++++++- R/use_cassette.R | 30 +++++++++++++++---- R/vcr-package.R | 1 + tests/testthat/test-redirects.R | 51 +++++++++++++++++++++++++++++++++ 8 files changed, 93 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index fcd20bb..0cee925 100644 --- a/DESCRIPTION +++ b/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 diff --git a/Makefile b/Makefile index aef46c6..2dc999a 100644 --- a/Makefile +++ b/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')" diff --git a/NAMESPACE b/NAMESPACE index 034874f..1cba3e6 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/request_handler-crul.R b/R/request_handler-crul.R index 94af041..45f18df 100644 --- a/R/request_handler-crul.R +++ b/R/request_handler-crul.R @@ -1,4 +1,4 @@ -sac <- new.env() +# sac <- new.env() #' @title RequestHandlerCrul diff --git a/R/request_handler-httr.R b/R/request_handler-httr.R index 5af7d13..76955ec 100644 --- a/R/request_handler-httr.R +++ b/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) diff --git a/R/use_cassette.R b/R/use_cassette.R index 8447282..90ea48a 100644 --- a/R/use_cassette.R +++ b/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,9 +199,15 @@ 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)) @@ -206,10 +215,19 @@ redirects_remaining <- function(cas) { 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) } diff --git a/R/vcr-package.R b/R/vcr-package.R index 3968f45..9d7c56e 100644 --- a/R/vcr-package.R +++ b/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 diff --git a/tests/testthat/test-redirects.R b/tests/testthat/test-redirects.R index e2818e1..5c16862 100644 --- a/tests/testthat/test-redirects.R +++ b/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()