RC submission improvements

Handle errors better, print error message. E.g. error for the
five minute delay.

DESCRIPTION

@@ -21,20 +21,25 @@ Imports:
     callr,
     cli,
     curl,
+    desc,
     gert,
     glue,
     gitcreds,
     jsonlite,
+    pkgbuild,
     processx,
+    rappdirs,
     rematch,
     R6,
     rprojroot,
-    utils
+    utils,
+    whoami
 Suggests:
     asciicast,
     debugme,
     knitr,
     pillar,
     rmarkdown,
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    webfakes
 Encoding: UTF-8

R/aaa-async.R

@@ -1338,6 +1338,7 @@ def__resolve <- function(self, private, value) {
 #' @param private private self
 #' @return error object
 #'
+#' @noRd
 #' @keywords internal
 
 def__make_error_object <- function(self, private, err) {
@@ -2539,7 +2540,7 @@ sse_events <- R6Class(
   inherit = event_emitter,
   public = list(
     initialize = function(http_handle) {
-      super$initialize()
+      super$initialize(async = FALSE)
       http_handle$event_emitter$listen_on("data", function(bytes) {
         private$data <- c(private$data, bytes)
         private$emit_events()
@@ -4122,6 +4123,7 @@ get_private <- function(x) {
 #'   or the error thrown.
 #' @param info Extra info to add to the error object. Must be a named list.
 #'
+#' @noRd
 #' @keywords internal
 
 call_with_callback <- function(func, callback, info = NULL) {

R/api.R

@@ -11,11 +11,80 @@ default_headers <- c(
 #' @importFrom jsonlite toJSON
 
 query <- function(endpoint, method = "GET", headers = character(),
-                  data = NULL, data_form = NULL) {
+                  data = NULL, data_form = NULL, sse = FALSE) {
 
   url <- paste0(baseurl(), endpoint)
   headers <- update(default_headers, headers)
 
+  response <- if (sse) {
+    query_sse(method, url, headers, data, data_form)
+  } else {
+    query_plain(method, url, headers, data, data_form)
+  }
+
+  if (response$status_code >= 400) {
+    cnd <- http_error(response)
+    tryCatch({
+      bdy <- jsonlite::fromJSON(
+        rawToChar(response$content),
+        simplifyVector = FALSE
+      )
+    }, error = function(err) { stop(cnd) })
+    if ("message" %in% names(bdy)) {
+      throw(new_error(bdy[["message"]]), parent = cnd)
+    } else {
+      stop(cnd)
+    }
+  }
+
+  response
+}
+
+query_sse <- function(method, url, headers, data, data_form) {
+  synchronise(
+    query_sse_async(method, url, headers, data, data_form)
+  )
+}
+
+query_sse_async <- function(method, url, headers, data, data_form) {
+  if (method == "GET") {
+    q <- http_get(url, headers = headers)
+  } else if (method == "POST") {
+    q <- http_post(
+      url,
+      headers = headers,
+      data = data,
+      data_form = data_form
+    )
+  } else {
+    stop("Unexpected HTTP verb, internal rhub error")
+  }
+
+  msgs <- list()
+  handle_sse <- function(evt) {
+    msgs <<- c(msgs, list(evt))
+    if (evt[["event"]] == "progress") {
+      msg <- jsonlite::fromJSON(evt[["data"]])
+      cli::cli_alert(msg, .envir = emptyenv())
+    } else if (evt[["event"]] == "result") {
+      cli::cli_alert_success("Done.")
+    } else if (evt[["event"]] == "error") {
+      msg <- jsonlite::fromJSON(evt[["data"]])
+      cli::cli_alert_danger(msg, .envir = emptyenv())
+      stop("Aborting")
+    }
+  }
+
+  evs <- sse_events$new(q)
+  evs$listen_on("event", handle_sse)
+
+  q$then(function(response) {
+    response$sse <- msgs
+    response
+  })
+}
+
+query_plain <- function(method, url, headers, data, data_form) {
   response <- if (method == "GET") {
     synchronise(http_get(url, headers = headers))
 
@@ -31,7 +100,5 @@ query <- function(endpoint, method = "GET", headers = character(),
     stop("Unexpected HTTP verb, internal rhub error")
   }
 
-  http_stop_for_status(response)
-
   response
-}
+}

R/rc.R

@@ -124,9 +124,11 @@ rc_submit <- function(path = ".", platforms = NULL, email = NULL) {
     id = curl::form_data(id),
     package = curl::form_file(path)
   )
-  query(
+
+  resp <- query(
     method = "POST",
     ep,
+    sse = TRUE,
     data_form = form,
     headers = c(
       get_auth_header(email),
@@ -136,6 +138,17 @@ rc_submit <- function(path = ".", platforms = NULL, email = NULL) {
       "connection" = "keep-alive"
     )
   )
+
+  resevt <- Filter(function(x) x[["event"]] == "result", resp$sse)
+  if (length(resevt) == 0) {
+    stop("Invalid response from R-hub server, please report this.")
+  }
+
+  retval <- jsonlite::fromJSON(
+    resevt[[1]][["data"]],
+    simplifyVector = FALSE
+  )
+  invisible(retval)
 }
 
 # =========================================================================

R/utils.R

@@ -154,10 +154,10 @@ get_maintainer_email <- function(path = ".") {
     parse_email(desc::desc_get_maintainer(path))
   } else {
     dir.create(tmp <- tempfile())
-    files <- untar(path, list = TRUE, tar = "internal")
+    files <- utils::untar(path, list = TRUE, tar = "internal")
     desc <- grep("^[^/]+/DESCRIPTION$", files, value = TRUE)
     if (length(desc) < 1) stop("No 'DESCRIPTION' file in package")
-    untar(path, desc, exdir = tmp, tar = "internal")
+    utils::untar(path, desc, exdir = tmp, tar = "internal")
     parse_email(desc::desc_get_maintainer(file.path(tmp, desc)))
   }
 }