Export req_get_method() and req_get_body() (#744)

Formerly known as `req_method_get()` and `req_body_get()`, but I think it's better to put exported accessors behind a common prefix.

Fixes #718

Author: hadley

NAMESPACE

@@ -74,6 +74,8 @@ export(req_cookie_preserve)
 export(req_cookies_set)
 export(req_dry_run)
 export(req_error)
+export(req_get_body)
+export(req_get_method)
 export(req_headers)
 export(req_headers_redacted)
 export(req_method)

NEWS.md

@@ -1,5 +1,6 @@
 # httr2 (development version)
 
+* New `req_get_method()` and `req_get_body()` allow you to do some limited prediction of what a request _will_ do when it's performed (#718).
 * Functions that capture interrutps (like `req_perform_parallel()` and friends) are now easier to escape if they're called inside a loop: you can press Ctrl + C twice to guarantee an exit (#1810).
 * New `last_request_json()` and `last_response_json()` to conveniently see JSON bodies (#734).
 * `req_body_json_modify()` can now be used on a request with an empty body.

R/last.R

@@ -50,7 +50,7 @@ last_request_json <- function(pretty = TRUE) {
   if (req_body_type(req) != "json") {
     cli::cli_abort("Last request doesn't have a JSON body.")
   }
-  httr2_json(req_body_get(req), pretty = pretty)
+  httr2_json(req_get_body(req), pretty = pretty)
 }
 
 #' @param pretty Should the JSON be pretty-printed?

R/req-auth-aws.R

@@ -71,7 +71,7 @@ auth_aws_sign <- function(
 ) {
   current_time <- Sys.time()
 
-  body_sha256 <- openssl::sha256(req_body_get(req))
+  body_sha256 <- openssl::sha256(req_get_body(req))
 
   # We begin by adding some necessary headers that must be added before
   # canoncalization even thought they aren't documented until later
@@ -83,7 +83,7 @@ auth_aws_sign <- function(
   )
 
   signature <- aws_v4_signature(
-    method = req_method_get(req),
+    method = req_get_method(req),
     url = url_parse(req$url),
     headers = req$headers,
     body_sha256 = body_sha256,

R/req-body.R

@@ -217,7 +217,23 @@ req_body_info <- function(req) {
     multipart = "multipart data"
   )
 }
-req_body_get <- function(req) {
+
+
+#' Retrieve the body that a request will use
+#'
+#' Mimics the algorithm that curl uses to determine the body.
+#'
+#' @inheritParams req_perform
+#' @keywords internal
+#' @export
+#' @examples
+#' req <- request(example_url())
+#' req |> req_body_raw("abc") |> req_get_body()
+#' req |> req_body_file(system.file("DESCRIPTION")) |> req_get_body()
+#' req |> req_body_json(list(x = 1, y = 2)) |> req_get_body()
+#' req |> req_body_form(x = 1, y = 2) |> req_get_body()
+#' req |> req_body_multipart(x = "x", y = "y") |> req_get_body() |> cat()
+req_get_body <- function(req) {
   switch(
     req_body_type(req),
     empty = NULL,
@@ -244,8 +260,8 @@ req_body_apply <- function(req) {
     raw = req_body_apply_raw(req, req$body$data),
     string = req_body_apply_string(req, req$body$data),
     file = req_body_apply_connection(req, req$body$data),
-    json = req_body_apply_string(req, req_body_get(req)),
-    form = req_body_apply_string(req, req_body_get(req)),
+    json = req_body_apply_string(req, req_get_body(req)),
+    form = req_body_apply_string(req, req_get_body(req)),
     multipart = req_body_apply_multipart(req, req$body$data),
   )
 

R/req-cache.R

@@ -209,7 +209,7 @@ cache_pre_fetch <- function(req, path = NULL) {
 
   # Only GET requests should be retrieved from cache. It's not sufficient to
   # only save GET requests, because the method is not part of the cache key
-  if (req_method_get(req) != "GET") {
+  if (req_get_method(req) != "GET") {
     return(req)
   }
 

R/req-method.R

@@ -33,9 +33,21 @@ req_method_apply <- function(req) {
   )
 }
 
-# Guess the method that curl will used based on options
-# https://everything.curl.dev/libcurl-http/requests#request-method
-req_method_get <- function(req) {
+#' Retrieve the method that a request will use
+#'
+#' Mimics the algorithm that curl uses to determine the method.
+#'
+#' @inheritParams req_perform
+#' @export
+#' @keywords internal
+#' @examples
+#' req <- request(example_url())
+#' req_get_method(req)
+#' req_get_method(req |> req_body_raw("abc"))
+#' req_get_method(req |> req_method("DELETE"))
+#' req_get_method(req |> req_method("HEAD"))
+req_get_method <- function(req) {
+  # https://everything.curl.dev/libcurl-http/requests#request-method
   if (!is.null(req$method)) {
     req$method
   } else if (has_name(req$options, "nobody")) {

R/req.R

@@ -24,7 +24,7 @@ request <- function(base_url) {
 #' @export
 print.httr2_request <- function(x, ..., redact_headers = TRUE) {
   cli::cli_text("{.cls {class(x)}}")
-  method <- toupper(req_method_get(x))
+  method <- toupper(req_get_method(x))
   cli::cli_text("{.strong {method}} {x$url}")
 
   bullets_with_header(