Provide more info around possible CRAN closure

NEWS.md

@@ -1,5 +1,7 @@
 # devtools (development version)
 
+* `submit_cran()` gives a more informative error when the CRAN submission form can't be used, suggesting that the user consult <https://cran.r-project.org> to see if there's a CRAN closure (#2700).
+
 # devtools 2.5.2
 
 * `install()` uses a new feature of `pak::local_install_deps()` to consider the current `.libPaths()` when resolving dependencies, instead of consulting only `.libPaths()[1]`. This was an unintended behavioral change introduced in 2.5.0 (#2691).

R/release.R

@@ -307,7 +307,7 @@ upload_cran <- function(pkg, built_path, call = parent.frame()) {
     comment = comments,
     upload = "Upload package"
   )
-  resp <- httr2::req_perform(req)
+  resp <- req_perform_cran(req, call = call)
   new_url <- httr2::url_parse(httr2::resp_url(resp))
 
   # Confirmation -----------
@@ -323,20 +323,43 @@ upload_cran <- function(pkg, built_path, call = parent.frame()) {
     submit = "Submit package"
   )
 
-  resp <- httr2::req_perform(req)
+  resp <- req_perform_cran(req, call = call)
   new_url <- httr2::url_parse(httr2::resp_url(resp))
-  if (new_url$query$submit == "1") {
+  if (identical(new_url$query$submit, "1")) {
     cli::cli_inform(c(
       "v" = "Package submission successful",
       "i" = "Check your email for confirmation link."
     ))
   } else {
-    cli::cli_abort("Package failed to upload.", call = call)
+    cli::cli_abort("Unable to confirm package submission.", call = call)
   }
 
   invisible(TRUE)
 }
 
+# The submission form is periodically unavailable: during planned CRAN vacations
+# and sporadically at other times. This can take various forms, e.g. a 503 or a
+# 404 or a failure to connect at all when the server is down.
+req_perform_cran <- function(req, call = caller_env()) {
+  url <- httr2::req_get_url(req)
+  withCallingHandlers(
+    httr2::req_perform(req),
+    httr2_error = function(cnd) {
+      cli::cli_abort(
+        c(
+          "Can't submit to CRAN right now.",
+          "i" = "Request to {.url {url}} failed.",
+          "i" = "Check {.url https://cran.r-project.org} to see if there is a
+                 planned closure or known outage."
+        ),
+        # Chain so that we surface more detail from httr2 or even curl.
+        parent = cnd,
+        call = call
+      )
+    }
+  )
+}
+
 as.object_size <- function(x) structure(x, class = "object_size")
 
 flag_release <- function(pkg = ".") {

tests/testthat/_snaps/release.md

@@ -9,3 +9,15 @@
       Error in `release()`:
       ! Interactive session required.
 
+# req_perform_cran() reports an unavailable submission form
+
+    Code
+      req_perform_cran(httr2::request(cran_submission_url))
+    Condition
+      Error:
+      ! Can't submit to CRAN right now.
+      i Request to <https://xmpalantir.wu.ac.at/cransubmit/index2.php> failed.
+      i Check <https://cran.r-project.org> to see if there is a planned closure or known outage.
+      Caused by error in `httr2::req_perform()`:
+      ! HTTP 503 Service Unavailable.
+

tests/testthat/test-release.R

@@ -1,3 +1,16 @@
 test_that("release() is deprecated", {
   expect_snapshot(. <- release(), error = TRUE)
 })
+
+test_that("req_perform_cran() reports an unavailable submission form", {
+  skip_if_not_installed("httr2")
+
+  httr2::local_mocked_responses(list(
+    httr2::response(503, url = cran_submission_url)
+  ))
+
+  expect_snapshot(
+    req_perform_cran(httr2::request(cran_submission_url)),
+    error = TRUE
+  )
+})