#33 added error handling for http requests to expose actual cromwell …

…server error messages, bump version

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rcromwell
 Title: Convenience Tools for Managing WDL Workflows via Cromwell
-Version: 3.2.1
+Version: 3.2.1.92
 Authors@R: c(
     person("Amy", "Paguirigan", role = "aut",
            comment = c(ORCID = "0000-0002-6819-9736")),
@@ -27,11 +27,13 @@ Roxygen: list(markdown = TRUE, roclets = c("collate", "namespace", "rd",
 RoxygenNote: 7.2.3
 Encoding: UTF-8
 Suggests:
+    curl,
     knitr,
     rmarkdown,
     roxyglobals,
     testthat (>= 3.0.0),
-    vcr (>= 0.6.0)
+    vcr (>= 0.6.0),
+    webmockr
 Remotes:
     ropensci/vcr
 Config/testthat/edition: 3

NAMESPACE

@@ -24,6 +24,7 @@ importFrom(dplyr,tibble)
 importFrom(httr,GET)
 importFrom(httr,POST)
 importFrom(httr,content)
+importFrom(httr,status_code)
 importFrom(httr,stop_for_status)
 importFrom(httr,upload_file)
 importFrom(jsonlite,fromJSON)
@@ -37,6 +38,9 @@ importFrom(purrr,map)
 importFrom(purrr,map_dfr)
 importFrom(purrr,pluck)
 importFrom(purrr,reduce)
+importFrom(rlang,abort)
+importFrom(rlang,caller_env)
+importFrom(rlang,has_name)
 importFrom(rlang,is_character)
 importFrom(rlang,is_logical)
 importFrom(rlang,set_names)

R/cromwellSubmitBatch.R

@@ -50,7 +50,7 @@ cromwell_submit_batch <-
     }
     if (!is.null(options)) {
       body <- c(body,
-        workflowOptions = list(httr::upload_file(options))
+        workflow_options = list(httr::upload_file(options))
       )
     }
     if (!is.null(labels)) {
@@ -67,4 +67,4 @@ cromwell_submit_batch <-
         token = token
       )
     dplyr::as_tibble(crom_dat)
-  }
+}

R/http.R

@@ -5,20 +5,45 @@ cw_url <- function() {
   Sys.getenv("CROMWELLURL")
 }
 
+con_utf8 <- function(response, as = NULL, ...) {
+  httr::content(response, as = as, encoding = "utf-8", ...)
+}
+
+#' @importFrom rlang has_name
+#' @importFrom httr status_code
+#' @importFrom rlang abort caller_env
+handle_error <- function(response, call = caller_env()) {
+  status <- httr::status_code(response)
+  if (status >= 400) {
+    err <- con_utf8(response, as = "parsed")
+    if (rlang::has_name(err, "error")) {
+      mssg <- err$error
+    } else if (rlang::has_name(err, "message")) {
+      mssg <- err$message
+    } else {
+      httr::stop_for_status(response)
+    }
+    abort(
+      sprintf("(HTTP %s) - %s", as.character(status), mssg),
+      call = call
+    )
+  }
+}
+
 #' @importFrom httr GET POST stop_for_status content upload_file
 #' @noRd
 #' @keywords internal
 #' @author Scott Chamberlain
-http_get <- function(url, as = NULL, token = NULL, ...) {
+http_get <- function(url, as = NULL, token = NULL, call = caller_env(), ...) {
   result <- httr::GET(url, try_auth_header(token), ...)
-  httr::stop_for_status(result)
-  httr::content(result, as = as)
+  handle_error(result, call)
+  con_utf8(result, as = as)
 }
 
-http_post <- function(url, as = NULL, token = NULL, ...) {
+http_post <- function(url, as = NULL, token = NULL, call = caller_env(), ...) {
   result <- httr::POST(url, try_auth_header(token), ...)
-  httr::stop_for_status(result)
-  httr::content(result, as = as)
+  handle_error(result, call)
+  con_utf8(result, as = as)
 }
 
 make_url <- function(base_url, ...) {

tests/testthat/helper-stubs.R

@@ -0,0 +1,3 @@
+response_proof_401 <- list(
+	error = "Unauthorized"
+)

tests/testthat/test-error-handling.R

@@ -0,0 +1,45 @@
+# try_url <- function(url) {
+#   tryCatch(httr::GET(url), error = function(e) e)
+# }
+
+# skip_if_offline("proof-api.fredhutch.org")
+
+test_that("proof api or DIY cromwell server down", {
+  # This should happen whether proof or DIY if not on
+  # campus or VPN for Fred Hutch at least
+  # and happens if someone puts in a bad url
+
+  httr::set_callback("response", \(req, res) curl::nslookup("abcdefg"))
+  expect_error(
+    cromwell_submit_batch(wdl = file_hello, params = file_inputs),
+    "Unable to resolve host"
+  )
+  httr::set_callback("response", NULL)
+})
+
+test_that("401 unauthorized for proof api", {
+  # This should only happen with proof api
+  # regular cromwell server
+
+  webmockr::stub_registry_clear()
+  webmockr::stub_request("get", make_url(cw_url(), "engine/v1/version")) %>%
+    webmockr::to_return(
+      body = jsonlite::toJSON(response_proof_401, auto_unbox = TRUE),
+      status = 401L,
+      headers = list("Content-type" = "application/json")
+    )
+
+  unloadNamespace("vcr")
+  webmockr::enable(quiet = TRUE)
+
+  expect_error(
+    cromwell_version(),
+    "Unauthorized"
+  )
+
+  webmockr::stub_registry_clear()
+  webmockr::disable(quiet = TRUE)
+})
+
+# reload vcr
+attachNamespace("vcr")