Merge pull request #79 from ropensci/httr-integration

httr integration done

DESCRIPTION

@@ -8,19 +8,21 @@ 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)
     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)
 Imports:
     crul (>= 0.5.2),
-    webmockr (>= 0.2.4),
+    httr,
+    webmockr (>= 0.2.8),
     urltools,
     yaml,
     R6,
@@ -31,6 +33,7 @@ Suggests:
     testthat,
     knitr,
     rmarkdown
+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

NAMESPACE

@@ -15,6 +15,7 @@ export(Persisters)
 export(Request)
 export(RequestHandler)
 export(RequestHandlerCrul)
+export(RequestHandlerHttr)
 export(RequestMatcherRegistry)
 export(Serializers)
 export(UnhandledHTTPRequestError)

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 = if (is.raw(x$content)) rawToChar(x$content) else 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()

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

R/request_handler-httr.R

@@ -0,0 +1,84 @@
+#' 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()
+#' }
+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(
+        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
+    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
+      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)
+
+      # 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)
+    }
+  )
+)

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)

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
+#   )
+# }
+

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)
+}

R/use_cassette.R

@@ -79,6 +79,22 @@
 #'
 #' # 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 = "stuff350", {
+#'   res <- GET("https://httpbin.org/get")
+#' })
+#' readLines(file.path(tempdir(), "stuff350.yml"))
+#'
+#' use_cassette(name = "catfact456", {
+#'   res <- GET("https://catfact.ninja/fact")
+#' })
+#'
 #' }
 
 use_cassette <- function(name, ..., record = "once",

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 = ", "
   )
 }