req_promise() improvements (#639)

Add verbosity argument and improve argument checking (doing it all eagerly). Extract helper out into helper file.

Author: hadley

NEWS.md

@@ -47,6 +47,7 @@
 
 * `req_perform_connection()` gains a `verbosity` argument, which is useful for
   understanding exactly how data is streamed back to you (#599).
+  `req_perform_promise()` also gains a `verbosity` argument.
 
 * `req_url_query()` can control how spaces are encoded with `.space` (#432).
 

R/req-promise.R

@@ -69,9 +69,13 @@
 #' }
 req_perform_promise <- function(req,
                                 path = NULL,
-                                pool = NULL) {
+                                pool = NULL,
+                                verbosity = NULL) {
   check_installed(c("promises", "later"))
+
+  check_request(req)
   check_string(path, allow_null = TRUE)
+  verbosity <- verbosity %||% httr2_verbosity()
 
   if (missing(pool)) {
     if (!identical(later::current_loop(), later::global_loop())) {
@@ -80,7 +84,14 @@ req_perform_promise <- function(req,
         i = "Do you need {.code pool = curl::new_pool()}?"
       ))
     }
-  }
+  } else {
+    if (!is.null(pool) && !inherits(pool, "curl_multi")) {
+      stop_input_type(pool, "a {curl} pool", allow_null = TRUE)
+      }
+    }
+  # verbosity checked by req_verbosity
+
+  req <- req_verbosity(req, verbosity)
 
   promises::promise(
     function(resolve, reject) {

man/req_perform_promise.Rd

@@ -1,3 +1,44 @@
+# checks its inputs
+
+    Code
+      req_perform_promise(1)
+    Condition
+      Error in `req_perform_promise()`:
+      ! `req` must be an HTTP request object, not the number 1.
+    Code
+      req_perform_promise(req, path = 1)
+    Condition
+      Error in `req_perform_promise()`:
+      ! `path` must be a single string or `NULL`, not the number 1.
+    Code
+      req_perform_promise(req, pool = "INVALID")
+    Condition
+      Error in `req_perform_promise()`:
+      ! `pool` must be a {curl} pool or `NULL`, not the string "INVALID".
+    Code
+      req_perform_promise(req, verbosity = "INVALID")
+    Condition
+      Error in `req_perform_promise()`:
+      ! `verbosity` must 0, 1, 2, or 3.
+
+# correctly prepares request
+
+    Code
+      . <- extract_promise(req_perform_promise(req, verbosity = 1))
+    Output
+      -> GET /get HTTP/1.1
+      -> Host: <variable>
+      -> User-Agent: <variable>
+      -> Accept: */*
+      -> Accept-Encoding: <variable>
+      -> 
+      <- HTTP/1.1 200 OK
+      <- Date: <variable>
+      <- Content-Type: application/json
+      <- Content-Length: <variable>
+      <- ETag: <variable>
+      <- 
+
 # req_perform_promise uses the default loop
 
     Code

tests/testthat/_snaps/req-promise.md

@@ -0,0 +1,26 @@
+# promises package test helper
+extract_promise <- function(promise, timeout = 30) {
+  promise_value <- NULL
+  error <- NULL
+  promises::then(
+    promise,
+    onFulfilled = function(value) promise_value <<- value,
+    onRejected = function(reason) {
+      error <<- reason
+    }
+  )
+
+  start <- Sys.time()
+  while (!later::loop_empty()) {
+    if (difftime(Sys.time(), start, units = "secs") > timeout) {
+      stop("Waited too long")
+    }
+    later::run_now()
+    Sys.sleep(0.01)
+  }
+
+  if (!is.null(error)) {
+    cnd_signal(error)
+  } else
+    promise_value
+}

tests/testthat/helper-promise.R

@@ -1,29 +1,13 @@
-# promises package test helper
-extract_promise <- function(promise, timeout = 30) {
-  promise_value <- NULL
-  error <- NULL
-  promises::then(
-    promise,
-    onFulfilled = function(value) promise_value <<- value,
-    onRejected = function(reason) {
-      error <<- reason
-    }
-  )
-
-  start <- Sys.time()
-  while (!later::loop_empty()) {
-    if (difftime(Sys.time(), start, units = "secs") > timeout) {
-      stop("Waited too long")
-    }
-    later::run_now()
-    Sys.sleep(0.01)
-  }
-
-  if (!is.null(error)) {
-    cnd_signal(error)
-  } else
-    promise_value
-}
+test_that("checks its inputs", {
+  req <- request_test("/status/:status", status = 200)
+
+  expect_snapshot(error = TRUE, {
+    req_perform_promise(1)
+    req_perform_promise(req, path = 1)
+    req_perform_promise(req, pool = "INVALID")
+    req_perform_promise(req, verbosity = "INVALID")
+  })
+})
 
 test_that("returns a promise that resolves", {
   p1 <- req_perform_promise(request_test("/delay/:secs", secs = 0.25))
@@ -42,6 +26,16 @@ test_that("correctly prepares request", {
   expect_no_error(extract_promise(prom))
 })
 
+test_that("correctly prepares request", {
+  req <- request_test("/get")
+  expect_snapshot(
+    . <- extract_promise(req_perform_promise(req, verbosity = 1)),
+    transform = function(x) {
+      gsub("(Date|Host|User-Agent|ETag|Content-Length|Accept-Encoding): .*", "\\1: <variable>", x)
+    }
+  )
+})
+
 test_that("can promise to download files", {
   req <- request_test("/json")
   path <- withr::local_tempfile()
@@ -81,12 +75,6 @@ test_that("both curl and HTTP errors in promises are rejected", {
     ),
     class = "httr2_failure"
   )
-  expect_error(
-    extract_promise(
-      req_perform_promise(request_test("/status/:status", status = 200), pool = "INVALID")
-    ),
-    'inherits\\(pool, "curl_multi"\\) is not TRUE'
-  )
 })
 
 test_that("req_perform_promise doesn't leave behind poller", {