From dd4b79cbedb909f428e5a8ef34ffa2d9a6fb5194 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Tue, 14 Nov 2023 12:32:55 -0600
Subject: [PATCH] Better error message in `req_retry()`

Fixes #385
---
 NEWS.md                              |  3 +++
 R/req-retries.R                      | 16 +++++++++++++++-
 tests/testthat/_snaps/req-retries.md |  8 ++++++++
 tests/testthat/test-req-retries.R    | 20 ++++++++++++++++++++
 4 files changed, 46 insertions(+), 1 deletion(-)
 create mode 100644 tests/testthat/_snaps/req-retries.md

diff --git a/NEWS.md b/NEWS.md
index ceecdfe9f..262413541 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,8 @@
 # httr2 (development version)
 
+* `req_retry()` gives a clearer error if `after` returns the wrong type of 
+  value (#385).
+
 # httr2 1.0.0
 
 ## Function lifecycle
diff --git a/R/req-retries.R b/R/req-retries.R
index f4589349d..47bfd5fbf 100644
--- a/R/req-retries.R
+++ b/R/req-retries.R
@@ -110,8 +110,18 @@ retry_backoff <- function(req, i) {
   req_policy_call(req, "retry_backoff", list(i), default = backoff_default)
 }
 
-retry_after <- function(req, resp, i) {
+retry_after <- function(req, resp, i, error_call = caller_env()) {
   after <- req_policy_call(req, "retry_after", list(resp), default = resp_retry_after)
+
+  # TODO: apply this idea to all callbacks
+  if (!is_number_or_na(after)) {
+    not <- obj_type_friendly(after)
+    cli::cli_abort(
+      "The {.code after} callback to {.fn req_retry} must return a single number or NA, not {not}.",
+      call = error_call
+    )
+  }
+
   if (is.na(after)) {
     retry_backoff(req, i)
   } else {
@@ -119,6 +129,10 @@ retry_after <- function(req, resp, i) {
   }
 }
 
+is_number_or_na <- function(x) {
+  (is.numeric(x) && length(x) == 1) || identical(x, NA)
+}
+
 # Helpers -----------------------------------------------------------------
 
 # Exponential backoff with full-jitter, capped to 60s wait
diff --git a/tests/testthat/_snaps/req-retries.md b/tests/testthat/_snaps/req-retries.md
new file mode 100644
index 000000000..dfc446984
--- /dev/null
+++ b/tests/testthat/_snaps/req-retries.md
@@ -0,0 +1,8 @@
+# useful message if `after` wrong
+
+    Code
+      req_perform(req)
+    Condition
+      Error in `req_perform()`:
+      ! The `after` callback to `req_retry()` must return a single number or NA, not a <httr2_response> object.
+
diff --git a/tests/testthat/test-req-retries.R b/tests/testthat/test-req-retries.R
index 5a7461868..216052cf6 100644
--- a/tests/testthat/test-req-retries.R
+++ b/tests/testthat/test-req-retries.R
@@ -55,3 +55,23 @@ test_that("missing retry-after uses backoff", {
 
   expect_equal(retry_after(req, response(429), 1), 10)
 })
+
+test_that("useful message if `after` wrong", {
+  req <- request_test() %>%
+    req_retry(
+      is_transient = function(resp) TRUE,
+      after = function(resp) resp
+    )
+
+  expect_snapshot(req_perform(req), error = TRUE)
+})
+
+test_that("is_number_or_na implemented correctly", {
+  expect_equal(is_number_or_na(1), TRUE)
+  expect_equal(is_number_or_na(NA_real_), TRUE)
+  expect_equal(is_number_or_na(NA), TRUE)
+
+  expect_equal(is_number_or_na(1:2), FALSE)
+  expect_equal(is_number_or_na(numeric()), FALSE)
+  expect_equal(is_number_or_na("x"), FALSE)
+})