Equip tidy_download() with retries (with a longer connect timeout) (#1083)

Closes #988

Author: jennybc

NEWS.md

@@ -113,6 +113,10 @@
 
 * `use_code_of_conduct()` now generates absolute link to code of conduct on 
   pkgdown website or original source to avoid R CMD check issues (#772).
+  
+* `use_course()` and `use_zip()` are now equipped with some retry capability,
+  to cope with intermittent failure or the need for a longer connect timeout
+  (#988).
 
 * `use_data()` automatically bumps R dependency to 2.10 (#962).
 

R/course.R

@@ -51,7 +51,7 @@ NULL
 #'  highlight the download destination. Workflow:
 #' * User executes, e.g., `use_course("bit.ly/xxx-yyy-zzz")`.
 #' * User is asked to notice and confirm the location of the new folder. Specify
-#'   `destdir` to prevent this.
+#'   `destdir` or configure the `"usethis.destdir"` option to prevent this.
 #' * User is asked if they'd like to delete the ZIP file.
 #' * If new folder contains an `.Rproj` file, a new instance of RStudio is
 #'   launched. Otherwise, the folder is opened in the file manager, e.g. Finder
@@ -130,6 +130,10 @@ use_zip <- function(url,
 #' filename is generated from the input URL. In either case, the filename is
 #' sanitized. Returns the path to downloaded ZIP file, invisibly.
 #'
+#' `tidy_download()` is setup to retry after a download failure. In an
+#' interactive session, it asks for user's consent. All retries use a longer
+#' connect timeout.
+#'
 #' ## DropBox
 #'
 #' To make a folder available for ZIP download, create a shared link for it:
@@ -236,21 +240,22 @@ use_zip <- function(url,
 NULL
 
 # 1. downloads from `url`
-# 2. determines filename from content-description header (with fallbacks)
-# 3. returned path has content-type and content-description as attributes
+# 2. calls a retry-capable helper to download the ZIP file
+# 3. determines filename from content-description header (with fallbacks)
+# 4. returned path has content-type and content-description as attributes
 tidy_download <- function(url, destdir = getwd()) {
   check_path_is_directory(destdir)
   tmp <- file_temp("tidy-download-")
-  h <- curl::new_handle(noprogress = FALSE, progressfunction = progress_fun)
-  curl::curl_download(url, tmp, quiet = FALSE, mode = "wb", handle = h)
+
+  h <- download_url(url, destfile = tmp)
   ui_line()
 
   cd <- content_disposition(h)
   base_name <- make_filename(cd, fallback = path_file(url))
   full_path <- path(destdir, base_name)
 
   if (!can_overwrite(full_path)) {
-    ui_stop("Aborting.")
+    ui_stop("Aborting to avoid overwriting {ui_path(full_path)}")
   }
   attr(full_path, "content-type") <- content_type(h)
   attr(full_path, "content-disposition") <- cd
@@ -259,6 +264,81 @@ tidy_download <- function(url, destdir = getwd()) {
   invisible(full_path)
 }
 
+download_url <- function(url,
+                         destfile,
+                         handle = curl::new_handle(),
+                         n_tries = 3,
+                         retry_connecttimeout = 40L) {
+  handle_options <- list(noprogress = FALSE, progressfunction = progress_fun)
+  curl::handle_setopt(handle, .list = handle_options)
+
+  we_should_retry <- function(i, n_tries, status) {
+    if (i >= n_tries) {
+      FALSE
+    } else if (inherits(status, "error")) {
+      # TODO: find a way to detect a (connect) timeout more specifically?
+      # https://github.com/jeroen/curl/issues/154
+      # https://ec.haxx.se/usingcurl/usingcurl-timeouts
+      # "Failing to connect within the given time will cause curl to exit with a
+      # timeout exit code (28)."
+      # (however, note that all timeouts lead to this same exit code)
+      # https://ec.haxx.se/usingcurl/usingcurl-returns
+      # "28. Operation timeout. The specified time-out period was reached
+      # according to the conditions. curl offers several timeouts, and this exit
+      # code tells one of those timeout limits were reached."
+      # https://github.com/curl/curl/blob/272282a05416e42d2cc4a847a31fd457bc6cc827/lib/strerror.c#L143-L144
+      # "Timeout was reached" <-- actual message we could potentially match
+      TRUE
+    } else {
+      FALSE
+    }
+  }
+
+  status <- try_download(url, destfile, handle = handle)
+  if (inherits(status, "error") && interactive()) {
+    ui_oops(status$message)
+    if (ui_nope("
+      Download failed :(
+      See above for everything we know about why it failed.
+      Shall we try a couple more times, with a longer timeout?
+    ")) {
+      n_tries <- 1
+    }
+  }
+
+  i <- 1
+  # invariant: we have made i download attempts
+  while (we_should_retry(i, n_tries, status)) {
+    if (i == 1) {
+      curl::handle_setopt(
+        handle,
+        .list = c(connecttimeout = retry_connecttimeout))
+    }
+    i <- i + 1
+    ui_info("Retrying download ... attempt {i}")
+    status <- try_download(url, destfile, handle = handle)
+  }
+
+  if (inherits(status, "error")) {
+    stop(status)
+  }
+
+  invisible(handle)
+}
+
+try_download <- function(url, destfile, quiet = FALSE, mode = "wb", handle) {
+  tryCatch(
+    curl::curl_download(
+      url      = url,
+      destfile = destfile,
+      quiet    = quiet,
+      mode     = mode,
+      handle   = handle
+    ),
+    error = function(e) e
+  )
+}
+
 tidy_unzip <- function(zipfile, cleanup = FALSE) {
   base_path <- path_dir(zipfile)
 

man/use_course_details.Rd

@@ -1,3 +1,62 @@
+## download_url ----
+
+test_that("download_url() retry logic works as advertised", {
+  faux_download <- function(n_failures) {
+    i <- 0
+    function(url, destfile, quiet, mode, handle) {
+      i <<- i + 1
+      if (i <= n_failures) simpleError(paste0("try ", i)) else "success"
+    }
+  }
+  withr::local_options(list(usethis.quiet = FALSE))
+
+  # succeed on first try
+  out <- with_mock(
+    `usethis:::try_download` = faux_download(0),
+    download_url(url = "URL", destfile = "destfile")
+  )
+  expect_s3_class(out, "curl_handle")
+
+  # fail, then succeed
+  expect_message(
+    out <- with_mock(
+      `usethis:::try_download` = faux_download(1),
+      download_url(url = "URL", destfile = "destfile")
+    ),
+    "Retrying.*attempt 2"
+  )
+  expect_s3_class(out, "curl_handle")
+
+  # fail, fail, then succeed (default n_tries = 3, so should allow)
+  expect_message(
+    out <- with_mock(
+      `usethis:::try_download` = faux_download(2),
+      download_url(url = "URL", destfile = "destfile")
+    ),
+    "Retrying.*attempt 3"
+  )
+  expect_s3_class(out, "curl_handle")
+
+  # fail, fail, fail (exceed n_failures > n_tries = 3)
+  expect_error(
+    out <- with_mock(
+      `usethis:::try_download` = faux_download(5),
+      download_url(url = "URL", destfile = "destfile", n_tries = 3)
+    ),
+    "try 3"
+  )
+
+  # fail, fail, fail, succeed (make sure n_tries is adjustable)
+  expect_message(
+    out <- with_mock(
+      `usethis:::try_download` = faux_download(3),
+      download_url(url = "URL", destfile = "destfile", n_tries = 10)
+    ),
+    "Retrying.*attempt 4"
+  )
+  expect_s3_class(out, "curl_handle")
+})
+
 ## tidy_download ----
 
 test_that("tidy_download() errors early if destdir is not a directory", {