Improvements to RETRY (#404) (#459)

* Improvements to RETRY (#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.

* Coding style fix

* Fix for R CMD check

Since the example raises an error condition, need to place in a
`contest` block.

* Fix logic error

* Incorporating comments

* Small comment adjustment

* Update documentation

* Improve parameter documentation

* Improve message output for error conditions

* Added NEWS entry and small update to retry message (Fixes #404)

* Fix comment

* Updated comment

NEWS.md

@@ -1,5 +1,9 @@
 # httr 1.2.1.9000
 
+* `RETRY()` gains a new parameter `terminate_on` that gives caller greater control
+  over which status codes make it stop retrying, and also now retries if an
+  error condition (i.e., a call to `stop()`) occurs during the request (@asieira #404)
+
 * Fix bug with cert bundle lookup: `find_cert_bundle()` will now return cert bundle
   in "R_HOME/etc" (@jiwalker-usgs #386).
 

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}()}.
+#' 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,9 @@
 #'   \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 HTTP status codes that if found
+#'   on the response will terminate the retry process. If \code{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,33 +32,62 @@
 #' RETRY("GET", "http://httpbin.org/status/200")
 #' # Never succeeds
 #' RETRY("GET", "http://httpbin.org/status/500")
+#' \donttest{
+#' # 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.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_terminate(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)
+  }
+
+  if (inherits(resp, "error")) {
+    stop(resp)
   }
 
   resp
 }
 
-backoff_full_jitter <- function(i, status, pause_base = 1, pause_cap = 60, quiet = FALSE) {
+retry_should_terminate <- function(i, times, resp, terminate_on) {
+  if (i >= times) {
+    TRUE
+  } else if (inherits(resp, "error")) {
+    FALSE
+  } else if (!is.null(terminate_on)) {
+    status_code(resp) %in% terminate_on
+  } else {
+    !http_error(resp)
+  }
+}
+
+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) {
-    message("Request failed [", status, "]. Retrying in ", length, " seconds...")
+    if (inherits(resp, "error")) {
+      error_description <- gsub("[\n\r]*$", "\n", as.character(resp))
+      status <- "ERROR"
+    } else {
+      error_description <- ""
+      status <- status_code(resp)
+    }
+    message(error_description, "Request failed [", status, "]. Retrying in ", length, " seconds...")
   }
   Sys.sleep(length)
 }