httr2 done

.github/workflows/revdep-check.yaml

@@ -11,6 +11,7 @@ jobs:
 
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
+      GITHUB_PAT: ${{ secrets.GH_PAT }}
 
     steps:
       - uses: actions/checkout@v3

DESCRIPTION

@@ -29,9 +29,12 @@ Language: en-US
 LazyData: true
 VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)
+Depends:
+    R (>= 3.5)
 Imports:
     crul (>= 0.8.4),
     httr,
+    httr2,
     webmockr (>= 0.8.0),
     urltools,
     yaml,
@@ -50,7 +53,8 @@ Suggests:
     curl,
     withr,
     webfakes
+Remotes: ropensci/webmockr@httr2
 X-schema.org-applicationCategory: Web
 X-schema.org-keywords: http, https, API, web-services, curl, mock, mocking, http-mocking, testing, testing-tools, tdd
 X-schema.org-isPartOf: https://ropensci.org
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2

Makefile

@@ -13,7 +13,7 @@ rmd2md:
 		mv configuration.md configuration.Rmd
 
 install: doc build
-	R CMD INSTALL --no-build-vignettes . && rm *.tar.gz
+	R CMD INSTALL . && rm *.tar.gz
 
 build:
 	R CMD build --no-build-vignettes .

NAMESPACE

@@ -16,6 +16,7 @@ export(Request)
 export(RequestHandler)
 export(RequestHandlerCrul)
 export(RequestHandlerHttr)
+export(RequestHandlerHttr2)
 export(RequestMatcherRegistry)
 export(Serializers)
 export(UnhandledHTTPRequestError)
@@ -55,6 +56,8 @@ importFrom(crul,HttpClient)
 importFrom(crul,mock)
 importFrom(httr,content)
 importFrom(httr,http_status)
+importFrom(httr2,req_perform)
+importFrom(httr2,resp_status_desc)
 importFrom(urltools,url_compose)
 importFrom(urltools,url_parse)
 importFrom(utils,getParseData)

R/cassette_class.R

@@ -556,7 +556,7 @@ Cassette <- R6::R6Class(
     },
 
     #' @description record an http interaction (doesn't write to disk)
-    #' @param x an crul or httr response object, with the request at `$request`
+    #' @param x a crul, httr, or httr2 response object, with the request at `$request`
     #' @return nothing returned
     record_http_interaction = function(x) {
       int <- self$make_http_interaction(x)
@@ -619,9 +619,12 @@ Cassette <- R6::R6Class(
     },
 
     #' @description Make an `HTTPInteraction` object
-    #' @param x an crul or httr response object, with the request at `$request`
+    #' @param x A crul, httr, or httr2 response object, with the request at `$request`
     #' @return an object of class [HTTPInteraction]
     make_http_interaction = function(x) {
+      # for httr2, duplicate `body` slot in `content`
+      if (inherits(x, "httr2_response")) x$content <- x$body
+
       # content must be raw or character
       assert(unclass(x$content), c('raw', 'character'))
       new_file_path <- ""
@@ -646,7 +649,7 @@ Cassette <- R6::R6Class(
         } else { # crul
           webmockr::pluck_body(x$request)
         },
-        headers = if (inherits(x, "response")) {
+        headers = if (inherits(x, c("response", "httr2_response"))) {
           as.list(x$request$headers)
         } else {
           x$request_headers
@@ -659,9 +662,17 @@ Cassette <- R6::R6Class(
       response <- VcrResponse$new(
         status = if (inherits(x, "response")) {
           c(list(status_code = x$status_code), httr::http_status(x))
-        } else unclass(x$status_http()),
-        headers = if (inherits(x, "response")) x$headers else x$response_headers,
-        body = if (is.raw(x$content)) {
+        } else if (inherits(x, "httr2_response")) {
+          list(status_code = x$status_code, message = httr2::resp_status_desc(x))
+        } else {
+          unclass(x$status_http())
+        },
+        headers = if (inherits(x, c("response", "httr2_response"))) {
+          x$headers
+        } else {
+          x$response_headers
+        },
+        body = if (is.raw(x$content) || is.null(x$content)) {
           if (can_rawToChar(x$content)) rawToChar(x$content) else x$content
         } else {
           stopifnot(inherits(unclass(x$content), "character"))
@@ -754,6 +765,6 @@ empty_cassette_message <- function(x) {
   c(
     sprintf("Empty cassette (%s) deleted; consider the following:\n", x),
     " - If an error occurred resolve that first, then check:\n",
-    " - vcr only supports crul & httr; requests w/ curl, download.file, etc. are not supported\n",
-    " - If you are using crul/httr, are you sure you made an HTTP request?\n")
+    " - vcr only supports crul, httr & httr2; requests w/ curl, download.file, etc. are not supported\n",
+    " - If you are using crul/httr/httr2, are you sure you made an HTTP request?\n")
 }

R/request_class.R

@@ -51,6 +51,8 @@ Request <- R6::R6Class(
     fields = NULL,
     #' @field output (various) request output details, disk, memory, etc
     output = NULL,
+    #' @field policies (various) http policies, used in httr2 only
+    policies = NULL,
 
     #' @description Create a new `Request` object
     #' @param method (character) the HTTP method (i.e. head, options, get,
@@ -62,12 +64,12 @@ Request <- R6::R6Class(
     #' @param disk (boolean), is body a file on disk
     #' @param fields (various) post fields
     #' @param output (various) output details
+    #' @param policies (various) http policies, used in httr2 only
     #' @param skip_port_stripping (logical) whether to strip the port.
     #' default: `FALSE`
     #' @return A new `Request` object
     initialize = function(method, uri, body, headers, opts, disk,
-      fields, output, skip_port_stripping = FALSE) {
-
+      fields, output, policies, skip_port_stripping = FALSE) {
       if (!missing(method)) self$method <- tolower(method)
       if (!missing(body)) {
         if (inherits(body, "list")) {
@@ -93,6 +95,7 @@ Request <- R6::R6Class(
        if (!missing(disk)) self$disk <- disk
        if (!missing(fields)) self$fields <- fields
        if (!missing(output)) self$output <- output
+       if (!missing(policies)) self$policies <- policies
      },
 
     #' @description Convert the request to a list

R/request_handler-httr2.R

@@ -0,0 +1,115 @@
+#' @title RequestHandlerHttr2
+#' @description Methods for the httr2 package, building on [RequestHandler]
+#' @export
+#' @param request The request from an object of class `HttpInteraction`
+#' @examples \dontrun{
+#' # GET request
+#' library(httr2)
+#' req <- request("https://hb.opencpu.org/post") %>%
+#'    req_body_json(list(foo = "bar"))
+#' x <- RequestHandlerHttr2$new(req)
+#' # x$handle()
+#'
+#' # POST request
+#' library(httr2)
+#' mydir <- file.path(tempdir(), "testing_httr2")
+#' invisible(vcr_configure(dir = mydir))
+#' req <- request("https://hb.opencpu.org/post") %>%
+#'   req_body_json(list(foo = "bar"))
+#' use_cassette(name = "testing3", {
+#'   response <- req_perform(req)
+#' }, match_requests_on = c("method", "uri", "body"))
+#' use_cassette(name = "testing3", {
+#'   response2 <- req_perform(req)
+#' }, match_requests_on = c("method", "uri", "body"))
+#' }
+RequestHandlerHttr2 <- R6::R6Class(
+  "RequestHandlerHttr2",
+  inherit = RequestHandler,
+
+  public = list(
+    #' @description Create a new `RequestHandlerHttr2` object
+    #' @param request The request from an object of class `HttpInteraction`
+    #' @return A new `RequestHandlerHttr2` object
+    initialize = function(request) {
+      if (!length(request$method)) {
+        request$method <- webmockr:::req_method_get_w(request)
+      }
+      self$request_original <- request
+      self$request <- {
+        Request$new(request$method, request$url,
+          webmockr::pluck_body(request), request$headers,
+          fields = request$fields, opts = request$options,
+          policies = request$policies)
+      }
+      self$cassette <- tryCatch(current_cassette(), error = function(e) e)
+    }
+  ),
+
+  private = list(
+    # make a `vcr` response
+    response_for = function(x) {
+      VcrResponse$new(
+        list(status_code = x$status_code, description = httr2::resp_status_desc(x)),
+        x$headers,
+        x$body,
+        "",
+        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
+      webmockr::httr2_mock(FALSE)
+      on.exit(webmockr::httr2_mock(TRUE), add = TRUE)
+      tmp2 <- httr2::req_perform(request)
+
+      # run through response_for()
+      self$vcr_response <- private$response_for(tmp2)
+
+      # return real response
+      return(response)
+    },
+
+    on_stubbed_by_vcr_request = function(request) {
+      # print("------- on_stubbed_by_vcr_request -------")
+      # return stubbed vcr response - no real response to do
+      serialize_to_httr2(request, super$get_stubbed_response(request))
+    },
+
+    on_recordable_request = function(request) {
+      # print("------- on_recordable_request -------")
+      # do real request - then stub response - then return stubbed vcr response
+      # real request
+      webmockr::httr2_mock(FALSE)
+      on.exit(webmockr::httr2_mock(TRUE), add = TRUE)
+      xx <- self$request_original %>% 
+        httr2::req_error(is_error = function(resp) FALSE)
+      # print(xx)
+      tryCatch(httr2::req_perform(xx), error = function(e) e)
+      tmp2 <- httr2::last_response()
+      # print("------- after the req_perform -------")
+
+      response <- webmockr::build_httr2_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")
+      response$request <- self$request_original
+      response$request$method <- webmockr:::req_method_get_w(response$request)
+      cas$record_http_interaction(response)
+
+      # return real response
+      # print("------- before return -------")
+      return(response)
+    }
+  )
+)
+

R/serialize_to_httr2.R

@@ -0,0 +1,37 @@
+# generate actual httr2 response
+# request <- httr2::request("https://hb.opencpu.org/301")
+# 
+serialize_to_httr2 <- 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,
+      disk = if (inherits(response$body, "httr2_path")) response$body %||% NULL,
+      fields = request$fields %||% NULL,
+      output = request$output %||% NULL
+    )
+  )
+
+  # response
+  resp <- webmockr::Response$new()
+  resp$set_url(request$uri)
+  resp$set_body(response$body, inherits(response$body, "httr2_path"))
+  resp$set_request_headers(request$headers, capitalize = FALSE)
+  resp$set_response_headers(response$headers, capitalize = FALSE)
+  resp$set_status(status = response$status$status_code %||% 200)
+
+  # generate httr2 response
+  webmockr::build_httr2_response(as_httr2_request(req), resp)
+}
+
+as_httr2_request <- function(x) {
+  structure(list(url = x$url$url, method = toupper(x$method),
+    headers = x$headers, body = x$body, fields = x$fields,
+    options = x$options, policies = x$policies),
+  class = "httr2_request")
+}

R/vcr-package.R

@@ -33,6 +33,7 @@
 #' @importFrom urltools url_parse url_compose
 #' @importFrom crul HttpClient mock
 #' @importFrom httr http_status content
+#' @importFrom httr2 resp_status_desc req_perform
 #' @importFrom webmockr pluck_body
 ## usethis namespace: end
 NULL

README.Rmd

@@ -59,6 +59,7 @@ Check out the [HTTP testing book](https://books.ropensci.org/http-testing/) and
 
 * [crul][]
 * [httr](https://httr.r-lib.org/)
+* [httr2](https://httr2.r-lib.org/)
 
 ## Getting Started
 

README.md

@@ -58,6 +58,7 @@ Check out the [HTTP testing book](https://books.ropensci.org/http-testing/) and
 
 * [crul][]
 * [httr](https://httr.r-lib.org/)
+* [httr2](https://httr2.r-lib.org/)
 
 ## Getting Started
 

_pkgdown.yml

@@ -60,6 +60,7 @@ reference:
       - RequestHandler
       - RequestHandlerCrul
       - RequestHandlerHttr
+      - RequestHandlerHttr2
       - RequestMatcherRegistry
       - Serializers
       - serializer_fetch