Provide helpers to get last JSON body from request/response (#743)

Fixes #734

Author: hadley

NAMESPACE

@@ -7,6 +7,7 @@ S3method(close,httr2_response)
 S3method(format,httr2_redacted)
 S3method(print,httr2_cmd)
 S3method(print,httr2_headers)
+S3method(print,httr2_json)
 S3method(print,httr2_oauth_client)
 S3method(print,httr2_obfuscated)
 S3method(print,httr2_request)
@@ -29,7 +30,9 @@ export(jwt_claim)
 export(jwt_encode_hmac)
 export(jwt_encode_sig)
 export(last_request)
+export(last_request_json)
 export(last_response)
+export(last_response_json)
 export(local_mock)
 export(local_mocked_responses)
 export(local_verbosity)

NEWS.md

@@ -1,5 +1,6 @@
 # httr2 (development version)
 
+* 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.
 * `resp_timing()` exposes timing information about the request measured by libcurl (@arcresu, #725).
 * `req_url_query()` now re-calculates n lengths when using `.multi = "explode"` to avoid select/recycling issues (@Kevanness, #719).

R/last.R

@@ -0,0 +1,84 @@
+#' Retrieve most recent request/response
+#'
+#' @description
+#' `last_request()` and `last_response()` retrieve the most recent request
+#' made by httr2 and the response it received, to facilitate debugging problems
+#' _after_ they occur.
+#'
+#' `last_request_json()` and `last_response_json()` return the JSON bodies of
+#' the most recent request and response. They will error if not JSON.
+#'
+#' @returns `last_request()` and `last_response()` return an HTTP
+#'   [request] or [response] respectively. If no request has been made,
+#'   `last_request()` will return `NULL`; if no request has been made
+#'   or the last request was unsuccessful, `last_response()` will return
+#'   `NULL`.
+#'
+#'   `last_request_json()` and `last_response_json()` always return a string.
+#'   They will error if `last_request()` or `last_response()` are `NULL` or
+#'   don't have JSON bodies.
+#' @export
+#' @examples
+#' . <- request("http://httr2.r-lib.org") |> req_perform()
+#' last_request()
+#' last_response()
+#'
+#' . <- request(example_url("/post")) |>
+#'   req_body_json(list(a = 1, b = 2)) |>
+#'   req_perform()
+#' last_request_json()
+#' last_request_json(pretty = FALSE)
+#' last_response_json()
+#' last_response_json(pretty = FALSE)
+last_response <- function() {
+  the$last_response
+}
+
+#' @export
+#' @rdname last_response
+last_request <- function() {
+  the$last_request
+}
+
+#' @export
+#' @rdname last_response
+last_request_json <- function(pretty = TRUE) {
+  req <- last_request()
+  if (is.null(req)) {
+    cli::cli_abort("No request has been made yet.")
+  }
+  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)
+}
+
+#' @param pretty Should the JSON be pretty-printed?
+#' @export
+#' @rdname last_response
+last_response_json <- function(pretty = TRUE) {
+  resp <- last_response()
+  if (is.null(resp)) {
+    cli::cli_abort("No request has been made successfully yet.")
+  }
+  if (!identical(resp_content_type(resp), "application/json")) {
+    cli::cli_abort("Last response doesn't have a JSON body.")
+  }
+  httr2_json(resp_body_string(resp), pretty = pretty)
+}
+
+httr2_json <- function(x, pretty = TRUE) {
+  check_string(x)
+  structure(x, pretty = pretty, class = "httr2_json")
+}
+#' @export
+print.httr2_json <- function(x, ...) {
+  if (attr(x, "pretty")) {
+    cat(pretty_json(x))
+  } else {
+    cat(x)
+  }
+
+  cat("\n")
+  invisible(x)
+}

R/req-perform.R

@@ -219,29 +219,6 @@ req_verbosity <- function(req, verbosity, error_call = caller_env()) {
   )
 }
 
-#' Retrieve most recent request/response
-#'
-#' These functions retrieve the most recent request made by httr2 and
-#' the response it received, to facilitate debugging problems _after_ they
-#' occur. If the request did not succeed (or no requests have been made)
-#' `last_response()` will be `NULL`.
-#'
-#' @returns An HTTP [response]/[request].
-#' @export
-#' @examples
-#' invisible(request("http://httr2.r-lib.org") |> req_perform())
-#' last_request()
-#' last_response()
-last_response <- function() {
-  the$last_response
-}
-
-#' @export
-#' @rdname last_response
-last_request <- function() {
-  the$last_request
-}
-
 # Must call req_prepare(), then req_handle(), then after the request has been
 # performed, req_completed() (on the prepared requests)
 req_prepare <- function(req) {

man/last_response.Rd

@@ -0,0 +1,52 @@
+# can get json response
+
+    Code
+      last_response_json()
+    Output
+      {
+        "x": 1
+      }
+    Code
+      last_response_json(pretty = FALSE)
+    Output
+      {"x":1}
+
+# can get json request
+
+    Code
+      last_request_json()
+    Output
+      {
+        "x": 1
+      }
+    Code
+      last_request_json(pretty = FALSE)
+    Output
+      {"x":1}
+
+# useful errors if not json request/response
+
+    Code
+      last_request_json()
+    Condition
+      Error in `last_request_json()`:
+      ! Last request doesn't have a JSON body.
+    Code
+      last_response_json()
+    Condition
+      Error in `last_response_json()`:
+      ! Last response doesn't have a JSON body.
+
+# useful errors if no last request/response
+
+    Code
+      last_request_json()
+    Condition
+      Error in `last_request_json()`:
+      ! No request has been made yet.
+    Code
+      last_response_json()
+    Condition
+      Error in `last_response_json()`:
+      ! No request has been made successfully yet.
+

tests/testthat/_snaps/last.md

@@ -0,0 +1,67 @@
+test_that("can retrieve last request and response", {
+  req <- request_test()
+  resp <- req_perform(req)
+
+  expect_equal(last_request(), req)
+  expect_equal(last_response(), resp)
+})
+
+test_that("last response is NULL if it fails", {
+  req <- request("")
+  try(req_perform(req), silent = TRUE)
+
+  expect_equal(last_request(), req)
+  expect_equal(last_response(), NULL)
+})
+
+test_that("returns NULL if no last request/response", {
+  the$last_request <- NULL
+  the$last_response <- NULL
+
+  expect_equal(last_request(), NULL)
+  expect_equal(last_response(), NULL)
+})
+
+# JSON -----------------------------------------------------------------------
+
+test_that("can get json response", {
+  req <- local_app_request(function(req, res) {
+    res$set_status(200L)$send_json(text = '{"x":1}')
+  })
+  req_perform(req)
+
+  expect_snapshot({
+    last_response_json()
+    last_response_json(pretty = FALSE)
+  })
+})
+
+test_that("can get json request", {
+  request(example_url("/post")) |>
+    req_body_json(list(x = 1)) |>
+    req_perform()
+
+  expect_snapshot({
+    last_request_json()
+    last_request_json(pretty = FALSE)
+  })
+})
+
+test_that("useful errors if not json request/response", {
+  req_perform(request(example_url("/xml")))
+
+  expect_snapshot(error = TRUE, {
+    last_request_json()
+    last_response_json()
+  })
+})
+
+test_that("useful errors if no last request/response", {
+  the$last_request <- NULL
+  the$last_response <- NULL
+
+  expect_snapshot(error = TRUE, {
+    last_request_json()
+    last_response_json()
+  })
+})

tests/testthat/test-last.R

@@ -195,22 +195,6 @@ test_that("can cache requests with paths (if-modified-since)", {
   expect_equal(resp2$body[[1]], path2)
 })
 
-test_that("can retrieve last request and response", {
-  req <- request_test()
-  resp <- req_perform(req)
-
-  expect_equal(last_request(), req)
-  expect_equal(last_response(), resp)
-})
-
-test_that("last response is NULL if it fails", {
-  req <- request("")
-  try(req_perform(req), silent = TRUE)
-
-  expect_equal(last_request(), req)
-  expect_equal(last_response(), NULL)
-})
-
 test_that("checks input types", {
   req <- request_test()
   expect_snapshot(error = TRUE, {