Mocking change

DESCRIPTION

@@ -36,12 +36,12 @@ Imports:
 Suggests:
     testthat,
     xml2,
-    vcr,
     crul,
     httr,
     httr2,
     diffobj,
     withr
+Remotes: ropensci/crul@change-mocking
 RoxygenNote: 7.3.2
 Config/testthat/edition: 3
 X-schema.org-applicationCategory: Web

Makefile

@@ -6,15 +6,6 @@ FILE_TARGET := "R/${FILE}.R"
 
 all: move rmd2md
 
-move:
-	cp inst/vign/vcr.md vignettes;\
-	cp inst/vign/configuration.md vignettes
-
-rmd2md:
-	cd vignettes;\
-	mv vcr.md vcr.Rmd;\
-	mv configuration.md configuration.Rmd
-
 install: doc build
 	R CMD INSTALL . && rm *.tar.gz
 

R/adapter-crul.R

@@ -75,6 +75,18 @@ build_crul_request <- function(x) {
   )
 }
 
+crul_mock <- function(on = TRUE) {
+  check_installed("crul")
+  if (on) {
+    options(crul_mock = function(req) {
+      webmockr::CrulAdapter$new()$handle_request(req)
+    })
+  } else {
+    options(crul_mock = NULL)
+  }
+  invisible(on)
+}
+
 #' @rdname Adapter
 #' @export
 #' @keywords internal
@@ -89,29 +101,12 @@ CrulAdapter <- R6::R6Class(
   ),
   private = list(
     pluck_url = function(request) request$url$url,
-    mock = function(on) crul::mock(on),
+    # mock = function(on) crul::mock(on),
+    mock = function(on) crul_mock(on),
     build_request = build_crul_request,
     build_response = build_crul_response,
     fetch_request = function(request) {
       private$build_response(request, webmockr_crul_fetch(request))
-    },
-    request_handler = function(request) vcr::RequestHandlerCrul$new(request),
-    update_vcr_disk_path = function(response) {
-      write_disk_path <- vcr::vcr_configuration()$write_disk_path
-
-      # if crul_resp$content is character, it must be a file path (I THINK?)
-      if (is.null(write_disk_path)) {
-        abort(c(
-          "if writing to disk, write_disk_path must be given",
-          "see ?vcr::vcr_configure"
-        ))
-      }
-
-      response$content <- file.path(
-        write_disk_path,
-        basename(response$content)
-      )
-      response
     }
   )
 )

R/adapter-httr.R

@@ -135,7 +135,6 @@ HttrAdapter <- R6::R6Class(
     mock = function(on) httr_mock(on),
     build_request = build_httr_request,
     build_response = build_httr_response,
-    request_handler = function(request) vcr::RequestHandlerHttr$new(request),
     fetch_request = function(request) {
       METHOD <- eval(parse(text = paste0("httr::", request$method)))
       METHOD(

R/adapter-httr2.R

@@ -111,7 +111,6 @@ Httr2Adapter <- R6::R6Class(
     mock = function(on) httr2_mock(on),
     build_request = build_httr2_request,
     build_response = build_httr2_response,
-    request_handler = function(request) vcr::RequestHandlerHttr2$new(request),
     fetch_request = function(request) httr2::req_perform(request)
   )
 )

R/adapter.R

@@ -42,7 +42,7 @@ Adapter <- R6::R6Class(
 
       switch(
         self$client,
-        crul = crul::mock(on = TRUE),
+        crul = crul_mock(on = TRUE),
         httr = httr_mock(on = TRUE),
         httr2 = httr2_mock(on = TRUE)
       )
@@ -61,7 +61,7 @@ Adapter <- R6::R6Class(
 
       switch(
         self$client,
-        crul = crul::mock(on = FALSE),
+        crul = crul_mock(on = FALSE),
         httr = httr_mock(on = FALSE),
         httr2 = httr2_mock(on = FALSE)
       )
@@ -88,87 +88,20 @@ Adapter <- R6::R6Class(
         #   get stub with response and return that
         resp <- private$build_stub_response(ss)
 
-        # generate response / vcr: recordable/ignored
-        if (vcr_cassette_inserted()) {
-          # use RequestHandler - gets current cassette & record interaction
-          resp <- private$request_handler(req)$handle()
-
-          # if written to disk, see if we should modify file path
-          if (self$client == "crul" && is.character(resp$content)) {
-            resp <- private$update_vcr_disk_path(resp)
-          }
-
-          # no vcr
-        } else {
-          resp <- private$build_response(req, resp)
-          # add to_return() elements if given
-          resp <- private$add_response_sequences(ss, resp)
-        }
+        resp <- private$build_response(req, resp)
+        # add to_return() elements if given
+        resp <- private$add_response_sequences(ss, resp)
 
         # request is not in cache but connections are allowed
       } else if (webmockr_net_connect_allowed(uri = private$pluck_url(req))) {
         # if real requests || localhost || certain exceptions ARE
         #   allowed && nothing found above
-
-        # if vcr loaded: record http interaction into vcr namespace
-        # VCR: recordable
-        if (vcr_loaded()) {
-          # FIXME: maybe use RequestHandler instead?
-          #   which gets current cassette for us
-          resp <- private$request_handler(req)$handle()
-
-          # if written to disk, see if we should modify file path
-          if (self$client == "crul" && is.character(resp$content)) {
-            if (file.exists(resp$content)) {
-              resp <- private$update_vcr_disk_path(resp)
-            }
-          }
-
-          if (self$client == "httr2") {
-            req$method <- req_method_get_w(req)
-          }
-
-          # stub request so next time we match it
-          req_url <- private$pluck_url(req)
-          urip <- curl::curl_parse_url(req_url)
-          urip$params <- as.list(urip$params)
-          m <- vcr::vcr_configuration()$match_requests_on
-
-          if (all(m %in% c("method", "uri")) && length(m) == 2) {
-            stub_request(req$method, req_url)
-          } else if (
-            all(m %in% c("method", "uri", "query")) && length(m) == 3
-          ) {
-            tmp <- stub_request(req$method, req_url)
-            wi_th(tmp, .list = list(query = urip$params))
-          } else if (
-            all(m %in% c("method", "uri", "headers")) && length(m) == 3
-          ) {
-            tmp <- stub_request(req$method, req_url)
-            wi_th(tmp, .list = list(headers = req$headers))
-          } else if (
-            all(m %in% c("method", "uri", "headers", "query")) && length(m) == 4
-          ) {
-            tmp <- stub_request(req$method, req_url)
-            wi_th(
-              tmp,
-              .list = list(query = urip$params, headers = req$headers)
-            )
-          }
-        } else {
-          private$mock(on = FALSE)
-          resp <- private$fetch_request(req)
-          private$mock(on = TRUE)
-        }
+        private$mock(on = FALSE)
+        resp <- private$fetch_request(req)
+        private$mock(on = TRUE)
 
         # request is not in cache and connections are not allowed
       } else {
-        # throw vcr error: should happen when user not using
-        #  use_cassette or insert_cassette
-        if (vcr_loaded()) {
-          private$request_handler(req)$handle()
-        }
-
         # no stubs found and net connect not allowed - STOP
         x <- c(
           "Real HTTP connections are disabled.",

R/webmockr-package.R

@@ -5,7 +5,6 @@
 #' - Matching requests based on method, URI, headers and body
 #' - Supports multiple HTTP libraries, including \pkg{crul},
 #' \pkg{httr}, and \pkg{httr2}
-#' - Integration with HTTP test caching library \pkg{vcr}
 #' - Supports async http request mocking with \pkg{crul} only
 #'
 #' @examples

R/zzz.R

@@ -272,16 +272,3 @@ last <- function(x) {
   }
   x[[length(x)]]
 }
-
-
-vcr_loaded <- function() {
-  isNamespaceLoaded("vcr")
-}
-
-# check whether a cassette is inserted without assuming vcr is installed
-vcr_cassette_inserted <- function() {
-  if (vcr_loaded()) {
-    return(length(vcr::current_cassette()) > 0)
-  }
-  return(FALSE)
-}

README.Rmd

@@ -35,7 +35,6 @@ Port of the Ruby gem [webmock](https://github.com/bblimke/webmock)
 * Stubbing HTTP requests at low http client lib level
 * Setting and verifying expectations on HTTP requests
 * Matching requests based on method, URI, headers and body
-* Support for `testthat` via [vcr][]
 * Can be used for testing or outside of a testing context
 * Supports async http request mocking with `crul` only
 
@@ -78,7 +77,7 @@ library(testthat)
 
 # make a stub
 stub_request("get", "https://httpbin.org/get") %>%
-   to_return(body = "success!", status = 200)
+  to_return(body = "success!", status = 200)
 
 # check that it's in the stub registry
 stub_registry()
@@ -119,8 +118,9 @@ set return objects
 ```{r}
 stub_request("get", "https://httpbin.org/get") %>%
   wi_th(
-    query = list(hello = "world")) %>%
-    to_return(status = 418)
+    query = list(hello = "world")
+  ) %>%
+  to_return(status = 418)
 ```
 
 ```{r}
@@ -131,9 +131,13 @@ x$get('get', query = list(hello = "world"))
 
 ```{r}
 stub_request("get", "https://httpbin.org/get") %>%
-  wi_th(query = list(hello = "world"), 
-        headers = list('User-Agent' = 'libcurl/7.51.0 r-curl/2.6 crul/0.3.6', 
-                       'Accept-Encoding' = "gzip, deflate"))
+  wi_th(
+    query = list(hello = "world"),
+    headers = list(
+      'User-Agent' = 'libcurl/7.51.0 r-curl/2.6 crul/0.3.6',
+      'Accept-Encoding' = "gzip, deflate"
+    )
+  )
 ```
 
 ```{r}
@@ -178,9 +182,9 @@ GET("https://httpbin.org/get")
 #> Error: Real HTTP connections are disabled.
 #> Unregistered request:
 #>   GET https://httpbin.org/get   with headers {Accept: application/json, text/xml, application/xml, */*}
-#> 
+#>
 #> You can stub this request with the following snippet:
-#> 
+#>
 #>    stub_request('get', uri = 'https://httpbin.org/get') %>%
 #>      wi_th(
 #>        headers = list('Accept' = 'application/json, text/xml, application/xml, */*')
@@ -193,9 +197,15 @@ make a stub
 ```{r}
 stub_request('get', uri = 'https://httpbin.org/get') %>%
   wi_th(
-    headers = list('Accept' = 'application/json, text/xml, application/xml, */*')
+    headers = list(
+      'Accept' = 'application/json, text/xml, application/xml, */*'
+    )
   ) %>%
-  to_return(status = 418, body = "I'm a teapot!!!", headers = list(im_a = "teapot"))
+  to_return(
+    status = 418,
+    body = "I'm a teapot!!!",
+    headers = list(im_a = "teapot")
+  )
 ```
 
 now returns mocked response
@@ -227,9 +237,9 @@ req_perform(req)
 #> Error: Real HTTP connections are disabled.
 #> Unregistered request:
 #>   GET https://hb.opencpu.org/get
-#> 
+#>
 #> You can stub this request with the following snippet:
-#> 
+#>
 #>    stub_request('get', uri = 'https://hb.opencpu.org/get')
 #> ============================================================
 ```
@@ -238,7 +248,11 @@ make a stub
 
 ```{r}
 stub_request('get', uri = 'https://hb.opencpu.org/get') %>%
-  to_return(status = 418, body = "I'm a teapot!!!", headers = list(im_a = "teapot"))
+  to_return(
+    status = 418,
+    body = "I'm a teapot!!!",
+    headers = list(im_a = "teapot")
+  )
 ```
 
 now returns mocked response
@@ -271,8 +285,10 @@ f <- tempfile(fileext = ".json")
 cat("{\"hello\":\"world\"}\n", file = f)
 readLines(f)
 ## make the stub
-invisible(stub_request("get", "https://httpbin.org/get") %>% 
-  to_return(body = file(f)))
+invisible(
+  stub_request("get", "https://httpbin.org/get") %>%
+    to_return(body = file(f))
+)
 ## make a request
 out <- HttpClient$new("https://httpbin.org/get")$get(disk = f)
 readLines(file(f))
@@ -283,8 +299,10 @@ OR - you can use `mock_file()` to have `webmockr` handle file and contents
 ```{r}
 g <- tempfile(fileext = ".json")
 ## make the stub
-invisible(stub_request("get", "https://httpbin.org/get") %>% 
-  to_return(body = mock_file(g, "{\"hello\":\"mars\"}\n")))
+invisible(
+  stub_request("get", "https://httpbin.org/get") %>%
+    to_return(body = mock_file(g, "{\"hello\":\"mars\"}\n"))
+)
 ## make a request
 out <- crul::HttpClient$new("https://httpbin.org/get")$get(disk = g)
 readLines(out$content)
@@ -336,5 +354,3 @@ simply gives the last response you specified. Although if you set a `to_timeout`
 * License: MIT
 * Get citation information for `webmockr` in R doing `citation(package = 'webmockr')`
 * Please note that this package is released with a [Contributor Code of Conduct](https://ropensci.org/code-of-conduct/). By contributing to this project, you agree to abide by its terms.
-
-[vcr]: https://github.com/ropensci/vcr