From cd038f3e291e7c4741446d6d10ddcff01341f2c7 Mon Sep 17 00:00:00 2001 From: Scott Chamberlain Date: Sun, 17 Jun 2018 08:25:24 -0700 Subject: [PATCH 1/7] httr integration work, #73 --- DESCRIPTION | 1 + NAMESPACE | 1 + R/request_handler-httr.R | 79 +++++++++++++++++++++++++++++++++++++++ R/request_handler.R | 2 +- R/serialize_to_httr.R | 26 +++++++++++++ R/use_cassette.R | 12 ++++++ R/write.R | 2 +- man/RequestHandlerHttr.Rd | 72 +++++++++++++++++++++++++++++++++++ 8 files changed, 193 insertions(+), 2 deletions(-) create mode 100644 R/request_handler-httr.R create mode 100644 R/serialize_to_httr.R create mode 100644 man/RequestHandlerHttr.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 79f9d7d..c020bf4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,6 +31,7 @@ Suggests: testthat, knitr, rmarkdown +Remotes: ropensci/webmockr@adapter-httr RoxygenNote: 6.0.1 X-schema.org-applicationCategory: Web X-schema.org-keywords: http, https, API, web-services, curl, mock, mocking, http-mocking, testing, testing-tools, tdd diff --git a/NAMESPACE b/NAMESPACE index c708a81..65918e4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ export(Persisters) export(Request) export(RequestHandler) export(RequestHandlerCrul) +export(RequestHandlerHttr) export(RequestMatcherRegistry) export(Serializers) export(UnhandledHTTPRequestError) diff --git a/R/request_handler-httr.R b/R/request_handler-httr.R new file mode 100644 index 0000000..019e2fc --- /dev/null +++ b/R/request_handler-httr.R @@ -0,0 +1,79 @@ +#' RequestHandlerHttr - methods for httr package +#' @export +#' @inherit RequestHandler +#' @examples \dontrun{ +#' vcr_configure( +#' dir = tempdir(), +#' record = "once" +#' ) +#' +#' library(httr) +#' load("~/httr_req.rda") +#' req +#' x <- RequestHandlerHttr$new(req) +#' # x$handle() +#' x$ +#' } +RequestHandlerHttr <- R6::R6Class( + 'RequestHandlerHttr', + inherit = RequestHandler, + + public = list( + initialize = function(request) { + self$request_original <- request + self$request <- { + Request$new(request$method, request$url, + request$body, request$headers) + } + self$cassette <- tryCatch(current_cassette(), error = function(e) e) + } + ), + + private = list( + # make a `vcr` response + response_for = function(x) { + VcrResponse$new(x$status_http(), x$response_headers, + x$parse("UTF-8"), x$response_headers$status, super$cassette$cassette_opts) + }, + + # these will replace those in + on_ignored_request = function(request) { + # perform and return REAL http response + # * make real request + # * run through response_for() to make vcr response, store vcr response + # * give back real response + + # real request + response <- eval(parse(text = paste0("httr::", request$method)))(request$url) + + # run through response_for() + self$vcr_response <- private$response_for(response) + + # return real response + return(response) + }, + + on_stubbed_by_vcr_request = function(request) { + # return stubbed vcr response - no real response to do + serialize_to_httr(request, super$get_stubbed_response(request)) + }, + + on_recordable_request = function(request) { + # do real request - then stub response - then return stubbed vcr response + # - this may need to be called from webmockr httradapter? + + # real request + tmp2 <- eval(parse(text = paste0("httr::", self$request_original$method)))(self$request_original$url) + response <- webmockr::build_httr_response(self$request_original, 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) + + # return real response + return(response) + } + ) +) diff --git a/R/request_handler.R b/R/request_handler.R index 7856de8..2b5cd9c 100644 --- a/R/request_handler.R +++ b/R/request_handler.R @@ -71,7 +71,7 @@ RequestHandler <- R6::R6Class( initialize = function(request) { self$request_original <- request self$request <- { - Request$new(request$method, request$url$url, + Request$new(request$method, request$url$url %||% request$url, request$body, request$headers) } self$cassette <- tryCatch(current_cassette(), error = function(e) e) diff --git a/R/serialize_to_httr.R b/R/serialize_to_httr.R new file mode 100644 index 0000000..dc1f9c8 --- /dev/null +++ b/R/serialize_to_httr.R @@ -0,0 +1,26 @@ +# generate actual httr response +serialize_to_httr <- function(request, response) { + # request + req <- webmockr::RequestSignature$new( + method = request$method, + uri = request$uri, + options = list( + body = request$body %||% NULL, + headers = request$headers %||% NULL, + proxies = NULL, + auth = NULL + ) + ) + + # response + resp <- webmockr::Response$new() + resp$set_url(request$uri) + bod <- response$body + resp$set_body(if ("string" %in% names(bod)) bod$string else bod) + resp$set_request_headers(request$headers, capitalize = FALSE) + resp$set_response_headers(response$headers, capitalize = FALSE) + resp$set_status(status = response$status %||% 200) + + # generate httr response + webmockr::build_httr_response(req, resp) +} diff --git a/R/use_cassette.R b/R/use_cassette.R index 4300088..63af735 100644 --- a/R/use_cassette.R +++ b/R/use_cassette.R @@ -79,6 +79,18 @@ #' #' # cleanup #' unlink(file.path(tempdir(), c("things4.yml", "apple7.yml"))) +#' +#' +#' # with httr +#' library(vcr) +#' library(httr) +#' vcr_configure(dir = tempdir()) +#' +#' use_cassette(name = "foobar", { +#' res <- GET("https://httpbin.org/get") +#' }) +#' readLines(file.path(tempdir(), "foobar.yml")) +#' #' } use_cassette <- function(name, ..., record = "once", diff --git a/R/write.R b/R/write.R index 191258a..f3bb5e5 100644 --- a/R/write.R +++ b/R/write.R @@ -108,7 +108,7 @@ pkg_versions <- function() { paste( paste0("vcr/", utils::packageVersion("vcr")), paste0("webmockr/", utils::packageVersion("webmockr")), - paste0("crul/", utils::packageVersion("crul")), + # paste0("crul/", utils::packageVersion("crul")), sep = ", " ) } diff --git a/man/RequestHandlerHttr.Rd b/man/RequestHandlerHttr.Rd new file mode 100644 index 0000000..9ceb645 --- /dev/null +++ b/man/RequestHandlerHttr.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/request_handler-httr.R +\docType{data} +\name{RequestHandlerHttr} +\alias{RequestHandlerHttr} +\title{RequestHandlerHttr - methods for httr package} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +RequestHandlerHttr +} +\description{ +RequestHandlerHttr - methods for httr package +} +\details{ +\strong{Public Methods} +\describe{ +\item{\code{handle(request)}}{ +Top level function to interaction with. Handle the request +} +} + +\strong{Private Methods} +\describe{ +\item{\code{request_type(request)}}{ +Get the request type +} +\item{\code{externally_stubbed()}}{ +just returns FALSE +} +\item{\code{should_ignore()}}{ +should we ignore the request, depends on request ignorer +infrastructure that's not workking yet +} +\item{\code{has_response_stub()}}{ +Check if there is a matching response stub in the +http interaction list +} +\item{\code{get_stubbed_response()}}{ +Check for a response and get it +} +\item{\code{request_summary(request)}}{ +get a request summary +} +\item{\code{on_externally_stubbed_request(request)}}{ +on externally stubbed request do nothing +} +\item{\code{on_ignored_request(request)}}{ +on ignored request, do something +} +\item{\code{on_recordable_request(request)}}{ +on recordable request, record the request +} +\item{\code{on_unhandled_request(request)}}{ +on unhandled request, run UnhandledHTTPRequestError +} +} +} +\examples{ +\dontrun{ +vcr_configure( + dir = tempdir(), + record = "once" +) + +data(crul_request) +crul_request$url$handle <- curl::new_handle() +crul_request +x <- RequestHandlerHttr$new(crul_request) +# x$handle() +} +} +\keyword{datasets} From 248a75c8de678e42539ba992d3a65f1fd3905dfb Mon Sep 17 00:00:00 2001 From: Scott Chamberlain Date: Thu, 26 Jul 2018 15:41:08 -0700 Subject: [PATCH 2/7] fixes for httr intergation --- DESCRIPTION | 2 +- R/cassette_class.R | 21 +++++++++++++------ R/insert_cassette.R | 2 ++ R/request_handler-httr.R | 11 +++++++--- R/response_class.R | 44 +++++++++++++++++++++++++++++++++++++++ R/use_cassette.R | 8 +++---- man/RequestHandlerHttr.Rd | 8 +++---- man/use_cassette.Rd | 12 +++++++++++ 8 files changed, 90 insertions(+), 18 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c020bf4..680632e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,7 +20,7 @@ VignetteBuilder: knitr Roxygen: list(markdown = TRUE) Imports: crul (>= 0.5.2), - webmockr (>= 0.2.4), + webmockr (>= 0.2.6.9323), urltools, yaml, R6, diff --git a/R/cassette_class.R b/R/cassette_class.R index de5238f..c28ca42 100644 --- a/R/cassette_class.R +++ b/R/cassette_class.R @@ -278,6 +278,10 @@ Cassette <- R6::R6Class( } # allow http interactions - disallow at end of call_block() below webmockr::webmockr_allow_net_connect() + + # FIXME: temporary attempt to make it work: turn on mocking for httr + webmockr::httr_mock() + # evaluate request resp <- lazyeval::lazy_eval(tmp) # disallow http interactions - allow at start of call_block() above @@ -484,15 +488,20 @@ Cassette <- R6::R6Class( request <- Request$new( x$request$method, x$url, - x$body, - x$request_headers, + if (inherits(x, "response")) { + bd <- x$request$options$postfields + if (inherits(bd, "raw")) rawToChar(bd) else bd + } else { + x$request$fields + }, + if (inherits(x, "response")) as.list(x$request$headers) else x$request_headers, self$cassette_opts ) response <- VcrResponse$new( - x$status_http(), - headers = x$response_headers, - body = rawToChar(x$content), - http_version = x$response_headers$status, + if (inherits(x, "response")) 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, self$cassette_opts ) if (self$update_content_length_header) response$update_content_length_header() diff --git a/R/insert_cassette.R b/R/insert_cassette.R index 4565c28..740b0f2 100644 --- a/R/insert_cassette.R +++ b/R/insert_cassette.R @@ -41,6 +41,8 @@ insert_cassette <- function(name, record="once", # enable webmockr webmockr::enable() + # FIXME: temporary attempt to make it work: turn on mocking for httr + # webmockr::httr_mock() # record cassete name for use in logging, etc. vcr__env$current_cassette <- name diff --git a/R/request_handler-httr.R b/R/request_handler-httr.R index 019e2fc..844441f 100644 --- a/R/request_handler-httr.R +++ b/R/request_handler-httr.R @@ -12,7 +12,6 @@ #' req #' x <- RequestHandlerHttr$new(req) #' # x$handle() -#' x$ #' } RequestHandlerHttr <- R6::R6Class( 'RequestHandlerHttr', @@ -32,8 +31,13 @@ RequestHandlerHttr <- R6::R6Class( private = list( # make a `vcr` response response_for = function(x) { - VcrResponse$new(x$status_http(), x$response_headers, - x$parse("UTF-8"), x$response_headers$status, super$cassette$cassette_opts) + VcrResponse$new( + httr::http_status(x), + x$headers, + httr::content(x, encoding = "UTF-8"), + x$all_headers[[1]]$version, + super$cassette$cassette_opts + ) }, # these will replace those in @@ -63,6 +67,7 @@ RequestHandlerHttr <- R6::R6Class( # - this may need to be called from webmockr httradapter? # real request + webmockr::httr_mock(FALSE) tmp2 <- eval(parse(text = paste0("httr::", self$request_original$method)))(self$request_original$url) response <- webmockr::build_httr_response(self$request_original, tmp2) diff --git a/R/response_class.R b/R/response_class.R index 26a913f..85ad429 100644 --- a/R/response_class.R +++ b/R/response_class.R @@ -209,3 +209,47 @@ extract_http_version <- function(x) { return(x) } } + + +vcr_request_httr <- function(x) { + Request$new( + x$request$method, + x$url, + x$body, # FIXME: body not a field, probably index to x$request$fields + as.list(x$request$headers), + self$cassette_opts + ) +} + +vcr_request_crul <- function(x) { + Request$new( + x$request$method, + x$url, + x$body, + x$request_headers, + self$cassette_opts + ) +} + + + +vcr_response_httr <- function(x) { + VcrResponse$new( + httr::http_status(x), + x$headers, + httr::content(x, encoding = "UTF-8"), + x$all_headers[[1]]$version, + super$cassette$cassette_opts + ) +} + +vcr_response_crul <- function(x) { + VcrResponse$new( + x$status_http(), + headers = x$response_headers, + body = rawToChar(x$content), + http_version = x$response_headers$status, + self$cassette_opts + ) +} + diff --git a/R/use_cassette.R b/R/use_cassette.R index 63af735..c7f67b7 100644 --- a/R/use_cassette.R +++ b/R/use_cassette.R @@ -84,12 +84,12 @@ #' # with httr #' library(vcr) #' library(httr) -#' vcr_configure(dir = tempdir()) +#' vcr_configure(dir = tempdir(), log = TRUE) #' -#' use_cassette(name = "foobar", { -#' res <- GET("https://httpbin.org/get") +#' use_cassette(name = "stuff345", { +#' res <- GET("https://httpbin.org") #' }) -#' readLines(file.path(tempdir(), "foobar.yml")) +#' readLines(file.path(tempdir(), "stuff345.yml")) #' #' } diff --git a/man/RequestHandlerHttr.Rd b/man/RequestHandlerHttr.Rd index 9ceb645..dd5f3c7 100644 --- a/man/RequestHandlerHttr.Rd +++ b/man/RequestHandlerHttr.Rd @@ -62,10 +62,10 @@ vcr_configure( record = "once" ) -data(crul_request) -crul_request$url$handle <- curl::new_handle() -crul_request -x <- RequestHandlerHttr$new(crul_request) +library(httr) +load("~/httr_req.rda") +req +x <- RequestHandlerHttr$new(req) # x$handle() } } diff --git a/man/use_cassette.Rd b/man/use_cassette.Rd index 5047baa..804c5c5 100644 --- a/man/use_cassette.Rd +++ b/man/use_cassette.Rd @@ -107,6 +107,18 @@ readLines(file.path(tempdir(), "things4.yml")) # cleanup unlink(file.path(tempdir(), c("things4.yml", "apple7.yml"))) + + +# with httr +library(vcr) +library(httr) +vcr_configure(dir = tempdir(), log = TRUE) + +use_cassette(name = "stuff345", { + res <- GET("https://httpbin.org") +}) +readLines(file.path(tempdir(), "stuff345.yml")) + } } \seealso{ From 24585e6c102208278df9188d3a81155298e63831 Mon Sep 17 00:00:00 2001 From: Scott Chamberlain Date: Thu, 26 Jul 2018 18:42:40 -0700 Subject: [PATCH 3/7] tweaks --- DESCRIPTION | 2 +- R/use_cassette.R | 14 +++++++++----- man/use_cassette.Rd | 10 +++++++--- 3 files changed, 17 insertions(+), 9 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 680632e..e90cc8d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,7 +20,7 @@ VignetteBuilder: knitr Roxygen: list(markdown = TRUE) Imports: crul (>= 0.5.2), - webmockr (>= 0.2.6.9323), + webmockr (>= 0.2.6.9326), urltools, yaml, R6, diff --git a/R/use_cassette.R b/R/use_cassette.R index c7f67b7..72867e1 100644 --- a/R/use_cassette.R +++ b/R/use_cassette.R @@ -79,17 +79,21 @@ #' #' # cleanup #' unlink(file.path(tempdir(), c("things4.yml", "apple7.yml"))) -#' -#' +#' +#' #' # with httr #' library(vcr) #' library(httr) #' vcr_configure(dir = tempdir(), log = TRUE) #' -#' use_cassette(name = "stuff345", { -#' res <- GET("https://httpbin.org") +#' use_cassette(name = "stuff350", { +#' res <- GET("https://httpbin.org/get") +#' }) +#' readLines(file.path(tempdir(), "stuff350.yml")) +#' +#' use_cassette(name = "catfact456", { +#' res <- GET("https://catfact.ninja/fact") #' }) -#' readLines(file.path(tempdir(), "stuff345.yml")) #' #' } diff --git a/man/use_cassette.Rd b/man/use_cassette.Rd index 804c5c5..e015b82 100644 --- a/man/use_cassette.Rd +++ b/man/use_cassette.Rd @@ -114,10 +114,14 @@ library(vcr) library(httr) vcr_configure(dir = tempdir(), log = TRUE) -use_cassette(name = "stuff345", { - res <- GET("https://httpbin.org") +use_cassette(name = "stuff350", { + res <- GET("https://httpbin.org/get") +}) +readLines(file.path(tempdir(), "stuff350.yml")) + +use_cassette(name = "catfact456", { + res <- GET("https://catfact.ninja/fact") }) -readLines(file.path(tempdir(), "stuff345.yml")) } } From e4289b2f751f9b9574aa44557fc4d0e824dc296e Mon Sep 17 00:00:00 2001 From: Scott Chamberlain Date: Tue, 16 Oct 2018 17:37:26 -0700 Subject: [PATCH 4/7] use newest webmockr v0.2.8 --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7884374..e112faa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,7 +20,7 @@ VignetteBuilder: knitr Roxygen: list(markdown = TRUE) Imports: crul (>= 0.5.2), - webmockr (>= 0.2.6.9326), + webmockr (>= 0.2.8), urltools, yaml, R6, @@ -31,7 +31,7 @@ Suggests: testthat, knitr, rmarkdown -Remotes: ropensci/webmockr@adapter-httr +Remotes: ropensci/webmockr RoxygenNote: 6.1.0 X-schema.org-applicationCategory: Web X-schema.org-keywords: http, https, API, web-services, curl, mock, mocking, http-mocking, testing, testing-tools, tdd From 7e8cf5229853c5231087e60f7d67b3b114fb5973 Mon Sep 17 00:00:00 2001 From: Scott Chamberlain Date: Tue, 16 Oct 2018 17:44:19 -0700 Subject: [PATCH 5/7] httr to imports --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e112faa..6c5d20b 100644 --- a/DESCRIPTION +++ b/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.1.0.9110 +Version: 0.1.0.9111 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) @@ -20,6 +20,7 @@ VignetteBuilder: knitr Roxygen: list(markdown = TRUE) Imports: crul (>= 0.5.2), + httr, webmockr (>= 0.2.8), urltools, yaml, From e7adf1acb33789320f21fe3024405cc6a2bbef3f Mon Sep 17 00:00:00 2001 From: Scott Chamberlain Date: Thu, 18 Oct 2018 11:29:08 -0700 Subject: [PATCH 6/7] encodign utf-8 in description file --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 6c5d20b..1d384e9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,6 +15,7 @@ URL: https://github.com/ropensci/vcr/ (devel) https://ropensci.github.io/http-testing-book/ (user manual) BugReports: https://github.com/ropensci/vcr/issues License: MIT + file LICENSE +Encoding: UTF-8 LazyData: true VignetteBuilder: knitr Roxygen: list(markdown = TRUE) From c10c47e72ed9d2c0f8b3d069d98bedac433f5369 Mon Sep 17 00:00:00 2001 From: Scott Chamberlain Date: Thu, 18 Oct 2018 11:29:25 -0700 Subject: [PATCH 7/7] comment out fxns in response_class file that seem to not be used anywhere --- R/response_class.R | 82 +++++++++++++++++++++++----------------------- 1 file changed, 41 insertions(+), 41 deletions(-) diff --git a/R/response_class.R b/R/response_class.R index 85ad429..0c0faa9 100644 --- a/R/response_class.R +++ b/R/response_class.R @@ -211,45 +211,45 @@ extract_http_version <- function(x) { } -vcr_request_httr <- function(x) { - Request$new( - x$request$method, - x$url, - x$body, # FIXME: body not a field, probably index to x$request$fields - as.list(x$request$headers), - self$cassette_opts - ) -} - -vcr_request_crul <- function(x) { - Request$new( - x$request$method, - x$url, - x$body, - x$request_headers, - self$cassette_opts - ) -} - - - -vcr_response_httr <- function(x) { - VcrResponse$new( - httr::http_status(x), - x$headers, - httr::content(x, encoding = "UTF-8"), - x$all_headers[[1]]$version, - super$cassette$cassette_opts - ) -} - -vcr_response_crul <- function(x) { - VcrResponse$new( - x$status_http(), - headers = x$response_headers, - body = rawToChar(x$content), - http_version = x$response_headers$status, - self$cassette_opts - ) -} +# vcr_request_httr <- function(x) { +# Request$new( +# x$request$method, +# x$url, +# x$body, # FIXME: body not a field, probably index to x$request$fields +# as.list(x$request$headers), +# self$cassette_opts +# ) +# } + +# vcr_request_crul <- function(x) { +# Request$new( +# x$request$method, +# x$url, +# x$body, +# x$request_headers, +# self$cassette_opts +# ) +# } + + + +# vcr_response_httr <- function(x) { +# VcrResponse$new( +# httr::http_status(x), +# x$headers, +# httr::content(x, encoding = "UTF-8"), +# x$all_headers[[1]]$version, +# super$cassette$cassette_opts +# ) +# } + +# vcr_response_crul <- function(x) { +# VcrResponse$new( +# x$status_http(), +# headers = x$response_headers, +# body = rawToChar(x$content), +# http_version = x$response_headers$status, +# self$cassette_opts +# ) +# }