Improvements to RETRY (r-lib#404)

* Add new `terminate_on` parameter that allows status_codes that
prevent retries to be specified;
* Catch error conditions using `tryCatch` and retry if they occur.

R/retry.R

@@ -1,7 +1,11 @@
 #' Retry a request until it succeeds.
 #'
-#' Safely retry a request until it succeeds (returns an HTTP status code
-#' below 400). It is designed to be kind to the server: after each failure
+#' Safely retry a request until it succeeds, as defined by the \code{terminate_on}
+#' parameter, which by default means a response for which \code{\link{http_error}()}
+#' is \code{FALSE}. Will also retry on error conditions raised by the underlying curl code,
+#' but if the last retry still raises one, \code{RETRY} will raise it again with
+#' \code{\link{stop}()} to maintain backwards compatibility.
+#' It is designed to be kind to the server: after each failure
 #' randomly waits up to twice as long. (Technically it uses exponential
 #' backoff with jitter, using the approach outlined in
 #' \url{https://www.awsarchitectureblog.com/2015/03/backoff.html}.)
@@ -16,6 +20,10 @@
 #'   \code{pause_cap} seconds.
 #' @param quiet If \code{FALSE}, will print a message displaying how long
 #'   until the next request.
+#' @param terminate_on Optional vector of numeric or integer HTTP status codes
+#'   that if found on the response will immediately stop the retries. If missing
+#'   or NULL, will keep retrying while \code{\link{http_error}()} is \code{TRUE}
+#'   for the response.
 #' @return The last response. Note that if the request doesn't succeed after
 #'   \code{times} times this will be a failed request, i.e. you still need
 #'   to use \code{\link{stop_for_status}()}.
@@ -25,32 +33,53 @@
 #' RETRY("GET", "http://httpbin.org/status/200")
 #' # Never succeeds
 #' RETRY("GET", "http://httpbin.org/status/500")
+#' # Invalid hostname generates curl error condition and is retried but eventually
+#' # raises an error condition.
+#' RETRY("GET", "http://invalidhostname/")
 RETRY <- function(verb, url = NULL, config = list(), ...,
                   body = NULL, encode = c("multipart", "form", "json", "raw"),
                   times = 3, pause_base = 1, pause_cap = 60,
-                  handle = NULL, quiet = FALSE) {
+                  handle = NULL, quiet = FALSE, terminate_on = NULL) {
   stopifnot(is.numeric(times), length(times) == 1L)
   stopifnot(is.numeric(pause_base), length(pause_base) == 1L)
   stopifnot(is.numeric(pause_cap), length(pause_cap) == 1L)
+  stopifnot(is.integer(terminate_on) || is.numeric(terminate_on) || is.null(terminate_on))
 
   hu <- handle_url(handle, url, ...)
   req <- request_build(verb, hu$url, body_config(body, match.arg(encode)), config, ...)
-  resp <- request_perform(req, hu$handle$handle)
+  resp <- tryCatch(request_perform(req, hu$handle$handle), error = function(e) e)
 
   i <- 1
-  while (i < times && http_error(resp)) {
-    backoff_full_jitter(i, status_code(resp), pause_base, pause_cap, quiet = quiet)
+  while (!retry_should_stop(i, times, resp, terminate_on)) {
+    backoff_full_jitter(i, resp, pause_base, pause_cap, quiet = quiet)
 
     i <- i + 1
-    resp <- request_perform(req, hu$handle$handle)
+    resp <- tryCatch(request_perform(req, hu$handle$handle), error = function(e) e)
   }
 
-  resp
+  if ("error" %in% class(resp)) {
+    stop(resp)
+  } else {
+    return(resp)
+  }
+}
+
+retry_should_stop <- function(i, times, resp, terminate_on) {
+  if (i >= times) {
+    return(TRUE)
+  } else if ("error" %in% class(resp)) {
+    return(FALSE)
+  } else if (!is.null(terminate_on)) {
+    return(status_code(resp) %in% terminate_on)
+  } else {
+    return(http_error(resp))
+  }
 }
 
-backoff_full_jitter <- function(i, status, pause_base = 1, pause_cap = 60, quiet = FALSE) {
+backoff_full_jitter <- function(i, resp, pause_base = 1, pause_cap = 60, quiet = FALSE) {
   length <- ceiling(stats::runif(1, max = min(pause_cap, pause_base * (2 ^ i))))
   if (!quiet) {
+    status = if ("error" %in% class(resp)) as.character(resp) else status_code(resp)
     message("Request failed [", status, "]. Retrying in ", length, " seconds...")
   }
   Sys.sleep(length)