fixes for multiple requests and to make sure all record modes work

bumped patch version
#93 multiple queries in a single use_cassette block now works fix #94
add tests specifically for httr
add tests for all the 4 record modes to make sure they work as expected

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.2.2.9312
+Version: 0.2.4.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)

R/cassette_class.R

@@ -286,10 +286,6 @@ 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
@@ -366,9 +362,11 @@ Cassette <- R6::R6Class(
                                   self$match_requests_on)
         old_interactions <-
           Filter(function(x) {
-            req <- Request$new()$from_hash(x$request)
-            new_interaction_list$response_for(req)
-          }, old_interactions)
+              req <- Request$new()$from_hash(x$request)
+              !unlist(new_interaction_list$has_interaction_matching(req))
+            },
+            old_interactions
+          )
       }
 
       # FIXME: add up_to_date_interactions usage here
@@ -377,7 +375,8 @@ Cassette <- R6::R6Class(
 
     # FIXME: not used yet, from newer version of vcr
     up_to_date_interactions = function(interactions) {
-      if (self$clean_outdated_http_interactions &&
+      if (
+        self$clean_outdated_http_interactions &&
         !is.null(re_record_interval)
       ) {
         return(interactions)
@@ -387,7 +386,13 @@ Cassette <- R6::R6Class(
       }, interactions)
     },
 
-    should_remove_matching_existing_interactions = function() self$record == "all",
+    should_stub_requests = function() {
+      self$record != "all"
+    },
+
+    should_remove_matching_existing_interactions = function() {
+      self$record == "all"
+    },
     storage_key = function() self$serializer$path,
 
     raw_cassette_bytes = function() {
@@ -413,14 +418,17 @@ Cassette <- R6::R6Class(
 
     previously_recorded_interactions = function() {
       if (nchar(self$raw_cassette_bytes()) > 0) {
-        tmp <- compact(lapply(self$deserialized_hash()[["http_interactions"]], function(z) {
+        tmp <- compact(
+          lapply(self$deserialized_hash()[["http_interactions"]], function(z) {
           response <- VcrResponse$new(
-            z$response$status$status_code,
+            # z$response$status$status_code,
+            z$response$status,
             z$response$headers,
             z$response$body$string,
             self$cassette_opts
           )
-          if (self$update_content_length_header) response$update_content_length_header()
+          if (self$update_content_length_header) 
+            response$update_content_length_header()
           zz <- HTTPInteraction$new(
             request = Request$new(z$request$method,
                                   z$request$uri,
@@ -487,7 +495,13 @@ Cassette <- R6::R6Class(
 
     http_interactions = function() {
       self$http_interactions_ <- HTTPInteractionList$new(
-        interactions = self$previously_recorded_interactions(),
+        interactions = {
+          if (self$should_stub_requests()) {
+            self$previously_recorded_interactions()
+          } else {
+            list()
+          }
+        },
         request_matchers = vcr_configuration()$match_requests_on
       )
     },

R/errors.R

@@ -76,7 +76,7 @@ UnhandledHTTPRequestError <- R6::R6Class(
     run = function() {
       any_errors <- FALSE
       if (!is.null(self$cassette) && !identical(self$cassette, list())) {
-        if (self$cassette$record == "once") {
+        if (self$cassette$record %in% c("once", "none")) {
           any_errors <- TRUE
         }
       } else {
@@ -103,13 +103,13 @@ UnhandledHTTPRequestError <- R6::R6Class(
 
     request_description = function() {
       lines <- c()
-      lines <- c(lines, 
+      lines <- c(lines,
         paste(
-          toupper(self$request$method), 
+          toupper(self$request$method),
           sensitive_remove(self$request$uri), # remove sensitive data
           sep = " "))
       if (self$match_request_on_headers()) {
-        lines <- c(lines, 
+        lines <- c(lines,
           sprintf("  Headers:\n%s",
             sensitive_remove(self$formatted_headers())
           )
@@ -184,7 +184,7 @@ UnhandledHTTPRequestError <- R6::R6Class(
         fn <- self$format_foot_note(bp$url, index)
         list(fp = fp, fn = fn)
       }, sugs, seq_along(sugs) - 1)
-      paste0(c(vapply(xx, '[[', "", 1), vapply(xx, '[[', "", 2)),
+      paste0(c(vapply(xx, "[[", "", 1), vapply(xx, "[[", "", 2)),
              collapse = "\n", sep = "\n")
     },
 
@@ -210,7 +210,8 @@ UnhandledHTTPRequestError <- R6::R6Class(
 
       tmp <- c("try_debug_logger", "use_new_episodes", "ignore_request")
       tmp <- c(tmp, self$record_mode_suggestion())
-      if (self$has_used_interaction_matching()) tmp <- c(tmp, "allow_playback_repeats")
+      if (self$has_used_interaction_matching())
+        tmp <- c(tmp, "allow_playback_repeats")
       tmp <- lapply(tmp, self$suggestion_for)
       compact(c(tmp, list(self$match_requests_on_suggestion())))
     },

R/real_connections.R

@@ -1,12 +1,13 @@
 #' Are real http connections allowed?
-#' 
+#'
 #' @export
 #' @return boolean, `TRUE` if real HTTP requests allowed; `FALSE` if not
 #' @examples
 #' real_http_connections_allowed()
 real_http_connections_allowed <- function() {
   trycurr <- tryCatch(current_cassette(), error = function(e) e)
-  if (!inherits(trycurr, c("error", "list"))) return(current_cassette()$recording())
+  if (!inherits(trycurr, c("error", "list")))
+    return(current_cassette()$recording())
   if (identical(trycurr, list())) return(FALSE)
   !(vcr_c$allow_http_connections_when_no_cassette || !turned_on())
 }

R/recording.R

@@ -43,7 +43,7 @@
 #' - Never replay previously recorded interactions.
 #'
 #'
-#' This can be temporarily used to force VCR to re-record
+#' This can be temporarily used to force \pkg{vcr} to re-record
 #' a cassette (i.e. to ensure the responses are not out of date)
 #' or can be used when you simply want to log all HTTP requests.
 #'

R/request_handler-crul.R

@@ -20,7 +20,8 @@ RequestHandlerCrul <- R6::R6Class(
     # 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)
+        x$parse("UTF-8"), x$response_headers$status,
+        super$cassette$cassette_opts)
     },
 
     # these will replace those in

R/request_handler-httr.R

@@ -69,6 +69,7 @@ RequestHandlerHttr <- R6::R6Class(
 
       # real request
       webmockr::httr_mock(FALSE)
+      on.exit(webmockr::httr_mock(TRUE), add = TRUE)
       tmp2 <- eval(parse(text = paste0("httr::",
         self$request_original$method)))(self$request_original$url)
       response <- webmockr::build_httr_response(self$request_original, tmp2)

R/request_handler.R

@@ -48,6 +48,7 @@
 #' @format NULL
 #' @usage NULL
 #' @examples \dontrun{
+#' # record mode: once
 #' vcr_configure(
 #'  dir = tempdir(),
 #'  record = "once"
@@ -58,6 +59,24 @@
 #' crul_request
 #' x <- RequestHandler$new(crul_request)
 #' # x$handle()
+#'
+#' # record mode: none
+#' vcr_configure(
+#'  dir = tempdir(),
+#'  record = "none"
+#' )
+#' data(crul_request)
+#' crul_request$url$handle <- curl::new_handle()
+#' crul_request
+#' insert_cassette("testing_record_mode_none", record = "none")
+#' file.path(vcr_c$dir, "testing_record_mode_none.yml")
+#' x <- RequestHandlerCrul$new(crul_request)
+#' # x$handle()
+#' crul_request$url$url <- "https://api.crossref.org/works/10.1039/c8sm90002g/"
+#' crul_request$url$handle <- curl::new_handle()
+#' z <- RequestHandlerCrul$new(crul_request)
+#' # z$handle()
+#' eject_cassette("testing_record_mode_none")
 #' }
 RequestHandler <- R6::R6Class(
   'RequestHandler',
@@ -95,7 +114,10 @@ RequestHandler <- R6::R6Class(
 
   private = list(
     request_summary = function(request) {
-      request_matchers <- if (!inherits(self$cassette, c("error", "list")) && !is.null(self$cassette)) {
+      request_matchers <- if (
+        !inherits(self$cassette, c("error", "list")) &&
+        !is.null(self$cassette)
+      ) {
         self$cassette$match_requests_on
       } else {
         vcr_c$match_requests_on

R/serialize_to_crul.R

@@ -19,8 +19,8 @@ serialize_to_crul <- function(request, response) {
   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)
-  # resp$set_status(status = response$status$status_code %||% 200)
+  # resp$set_status(status = response$status %||% 200)
+  resp$set_status(status = response$status$status_code %||% 200)
 
   # generate crul response
   webmockr::build_crul_response(req, resp)

R/serialize_to_httr.R

@@ -19,7 +19,8 @@ serialize_to_httr <- function(request, response) {
   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)
+  # resp$set_status(status = response$status %||% 200)
+  resp$set_status(status = response$status$status_code %||% 200)
 
   # generate httr response
   webmockr::build_httr_response(req, resp)

inst/examples/record.yml

@@ -0,0 +1,35 @@
+http_interactions:
+- request:
+    method: get
+    uri: https://eu.httpbin.org/get
+    body:
+      encoding: ''
+      string: ''
+    headers:
+      User-Agent: libcurl/7.54.0 r-curl/3.3 crul/0.7.0.9100
+      Accept-Encoding: gzip, deflate
+      Accept: application/json, text/xml, application/xml, */*
+  response:
+    status:
+      status_code: '200'
+      message: OK
+      explanation: Request fulfilled, document follows
+    headers:
+      status: HTTP/1.1 200 OK
+      connection: keep-alive
+      server: gunicorn/19.9.0
+      date: Fri, 08 Feb 2019 18:38:58 GMT
+      content-type: application/json
+      content-length: '336'
+      access-control-allow-origin: '*'
+      access-control-allow-credentials: 'true'
+      via: 1.1 vegur
+    body:
+      encoding: UTF-8
+      string: "{\n  \"args\": {}, \n  \"headers\": {\n    \"Accept\": \"application/json,
+        text/xml, application/xml, */*\", \n    \"Accept-Encoding\": \"gzip, deflate\",
+        \n    \"Connection\": \"close\", \n    \"Host\": \"eu.httpbin.org\", \n    \"User-Agent\":
+        \"libcurl/7.54.0 r-curl/3.3 crul/0.7.0.9100\"\n  }, \n  \"origin\": \"24.21.229.59\",
+        \n  \"url\": \"https://eu.httpbin.org/get\"\n}\n"
+  recorded_at: 2019-02-08 18:38:58 GMT
+  recorded_with: vcr/0.2.2.9312, webmockr/0.3.1.9311

tests/testthat/test-ause_cassette.R

@@ -1,4 +1,4 @@
-context("use_cassette works")
+context("use_cassette: works as expected")
 test_that("use_cassette works as expected", {
   skip_on_cran()