Implement circuit breaking

Fixes #370

NEWS.md

@@ -1,5 +1,6 @@
 # httr2 (development version)
 
+* `req_retry()` now implements "circuit breaking" so that if a request fails many times (i.e. if the server is done), you can choose to immediately error (#370).
 * `url_parse()` now uses `curl::curl_parse_url()` which is much faster and more correct (#577).
 * `req_retry()` now defaults to `max_tries = 2` with a message.
   Set to `max_tries = 1` to disable retries.

R/httr2-package.R

@@ -11,6 +11,7 @@ NULL
 
 the <- new_environment()
 the$throttle <- list()
+the$breaker <- new_environment()
 the$cache_throttle <- list()
 the$token_cache <- new_environment()
 the$last_response <- NULL

R/req-perform-connection.R

@@ -58,6 +58,8 @@ req_perform_connection <- function(req, blocking = TRUE) {
 
     if (retry_is_transient(req, resp)) {
       tries <- tries + 1
+      retry_check_breaker(req, tries)
+
       delay <- retry_after(req, resp, tries)
       signal(class = "httr2_retry", tries = tries, delay = delay)
     } else {

R/req-perform.R

@@ -107,6 +107,7 @@ req_perform <- function(
 
   delay <- 0
   while (tries < max_tries && Sys.time() < deadline) {
+    retry_check_breaker(req, tries, error_call = error_call)
     sys_sleep(delay, "for retry backoff")
     n <- n + 1
 
@@ -161,6 +162,7 @@ handle_resp <- function(req, resp, error_call = caller_env()) {
 req_perform1 <- function(req, path = NULL, handle = NULL) {
   the$last_request <- req
   the$last_response <- NULL
+  signal(class = "httr2_peform")
 
   if (!is.null(path)) {
     res <- curl::curl_fetch_disk(req$url, path, handle)

R/req-retries.R

@@ -50,6 +50,13 @@
 #'   returns either a number of seconds to wait or `NA`. `NA` indicates
 #'   that a precise wait time is not available and that the `backoff` strategy
 #'   should be used instead.
+#' @param failure_threshold,failure_timeout,failure_realm
+#'   Set `failure_threshold` to activate "circuit breaking" where if a request
+#'   continues to fail after `failure_threshold` times, cause the request to
+#'   error until a timeout of `failure_timeout` seconds has elapsed. This
+#'   timeout will persist across all requests with the same `failure_realm`
+#'   (which defaults to the hostname of the request) and is intended to detect
+#'   failing servers without needing to wait each time.
 #' @returns A modified HTTP [request].
 #' @export
 #' @seealso [req_throttle()] if the API has a rate-limit but doesn't expose
@@ -85,11 +92,16 @@ req_retry <- function(req,
                       retry_on_failure = FALSE,
                       is_transient = NULL,
                       backoff = NULL,
-                      after = NULL) {
+                      after = NULL,
+                      failure_threshold = Inf,
+                      failure_timeout = 30,
+                      failure_realm = NULL) {
 
   check_request(req)
   check_number_whole(max_tries, min = 1, allow_null = TRUE)
   check_number_whole(max_seconds, min = 0, allow_null = TRUE)
+  check_number_whole(failure_threshold, min = 1, allow_infinite = TRUE)
+  check_number_whole(failure_timeout, min = 1)
 
   if (is.null(max_tries) && is.null(max_seconds)) {
     max_tries <- 2
@@ -104,7 +116,10 @@ req_retry <- function(req,
     retry_on_failure = retry_on_failure,
     retry_is_transient = as_callback(is_transient, 1, "is_transient"),
     retry_backoff = as_callback(backoff, 1, "backoff"),
-    retry_after = as_callback(after, 1, "after")
+    retry_after = as_callback(after, 1, "after"),
+    retry_failure_threshold = failure_threshold,
+    retry_failure_timeout = failure_timeout,
+    retry_realm = failure_realm %||% url_parse(req$url)$hostname
   )
 }
 
@@ -117,6 +132,37 @@ retry_max_seconds <- function(req) {
   req$policies$retry_max_wait %||% Inf
 }
 
+retry_check_breaker <- function(req, i, error_call = caller_env()) {
+  realm <- req$policies$retry_realm
+  if (is.null(realm)) {
+    return(invisible())
+  }
+
+  now <- unix_time()
+  if (env_has(the$breaker, realm)) {
+    triggered <- the$breaker[[realm]]
+  } else if (i > req$policies$retry_failure_threshold) {
+    the$breaker[[realm]] <- triggered <- now
+  } else {
+    return(invisible())
+  }
+
+  remaining <- req$policies$retry_failure_timeout - (now - triggered)
+  if (remaining <= 0) {
+    env_unbind(the$breaker, realm)
+  } else {
+    cli::cli_abort(
+      c(
+        "Too many request failures: circuit breaker triggered for realm {.str {realm}}.",
+        i = "Wait {remaining} seconds before retrying."
+
+      ),
+      call = error_call,
+      class = "httr2_breaker"
+    )
+  }
+}
+
 retry_is_transient <- function(req, resp) {
   if (is_error(resp)) {
     return(req$policies$retry_on_failure %||% FALSE)

tests/testthat/test-req-perform.R

@@ -55,11 +55,11 @@ test_that("persistent HTTP errors only get single attempt", {
 })
 
 test_that("don't retry curl errors by default", {
-  req <- request("") %>% req_retry(max_tries = 2)
+  req <- request("https://doesntexist") %>% req_retry(max_tries = 2)
   expect_error(req_perform(req), class = "httr2_failure")
 
   # But can opt-in to it
-  req <- request("") %>% req_retry(max_tries = 2, retry_on_failure = TRUE)
+  req <- request("https://doesntexist") %>% req_retry(max_tries = 2, retry_on_failure = TRUE)
   cnd <- catch_cnd(req_perform(req), "httr2_retry")
   expect_equal(cnd$tries, 1)
 })

tests/testthat/test-req-retries.R

@@ -92,3 +92,33 @@ test_that("is_number_or_na implemented correctly", {
   expect_equal(is_number_or_na(numeric()), FALSE)
   expect_equal(is_number_or_na("x"), FALSE)
 })
+
+
+# circuit breaker --------------------------------------------------------
+
+test_that("triggered after specified requests", {
+  req <- request_test("/status/:status", status = 429) %>%
+    req_retry(
+      after = \(resp) 0,
+      max_tries = 10,
+      failure_threshold = 1
+    )
+
+  # First attempt performs, retries, then errors
+  req_perform(req) %>%
+    expect_condition(class = "httr_perform") %>%
+    expect_condition(class = "httr2_retry") %>%
+    expect_error(class = "httr2_breaker")
+
+  # Second attempt errors without performing
+  req_perform(req) %>%
+    expect_no_condition(class = "httr_perform") %>%
+    expect_error(class = "httr2_breaker")
+
+  # Attempt on same realm errors without trying at all
+  req2 <- request_test("/status/:status", status = 200) |>
+    req_retry()
+  req_perform(req) %>%
+    expect_no_condition(class = "httr_perform") %>%
+    expect_error(class = "httr2_breaker")
+})