Merge pull request #166 from mrc-ide/mrc-5706-error-no-json

Improve handling of non-JSON errors.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orderly2
 Title: Orderly Next Generation
-Version: 1.99.26
+Version: 1.99.27
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "[email protected]"),
              person("Robert", "Ashton", role = "aut"),

R/outpack_http_client.R

@@ -64,13 +64,17 @@ http_client_handle_error <- function(response) {
   ## for that and then reauthenticate; that requires that a callback
   ## is passed through here too.
   code <- httr::status_code(response)
-  if (code >= 400) {
-    txt <- httr::content(response, "text", encoding = "UTF-8")
-    res <- from_json(txt)
-    ## I am seeing Packit returning an element 'error' not a list of
-    ## errors
-    errors <- if ("error" %in% names(res)) list(res$error) else res$errors
-    stop(http_client_error(errors[[1]]$detail, code, errors))
+  if (httr::http_error(code)) {
+    if (httr::http_type(response) == "application/json") {
+      txt <- httr::content(response, "text", encoding = "UTF-8")
+      res <- from_json(txt)
+      ## I am seeing Packit returning an element 'error' not a list of
+      ## errors
+      errors <- if ("error" %in% names(res)) list(res$error) else res$errors
+      stop(http_client_error(errors[[1]]$detail, code, errors))
+    } else {
+      stop(http_client_error(httr::http_status(code)$message, code, NULL))
+    }
   }
   response
 }

tests/testthat/helper-outpack-http.R

@@ -2,7 +2,8 @@ mock_headers <- function(...) {
   structure(list(...), class = c("insensitive", "list"))
 }
 
-mock_response <- function(content, status = 200, wrap = TRUE, download = NULL) {
+mock_response <- function(content, status = 200L, wrap = TRUE,
+                          download = NULL) {
   headers <- mock_headers()
   if (!is.null(download)) {
     headers <- mock_headers("content-type" = "application/octet-stream")
@@ -15,6 +16,9 @@ mock_response <- function(content, status = 200, wrap = TRUE, download = NULL) {
     }
     class(content) <- NULL
     content <- c(writeBin(content, raw()), as.raw(0L))
+  } else if (inherits(content, "character")) {
+    headers <- mock_headers("content-type" = "text/plain")
+    content <- c(writeBin(content, raw()), as.raw(0L))
   } else {
     stop("Unhandled mock response type")
   }

tests/testthat/test-outpack-http-client.R

@@ -53,7 +53,7 @@ test_that("handle errors", {
     '{"status":"failure",',
     '"errors":[{"error":"NOT_FOUND","detail":"Resource not found"}],',
     '"data":null}')
-  r <-  mock_response(json_string(str), status = 404, wrap = FALSE)
+  r <-  mock_response(json_string(str), status = 404L, wrap = FALSE)
   err <- expect_error(http_client_handle_error(r),
                       "Resource not found")
   expect_s3_class(err, "outpack_http_client_error")
@@ -68,7 +68,7 @@ test_that("handle errors from packit", {
     '{"status":"failure",',
     '"error":{"error":"NOT_FOUND","detail":"Resource not found"},',
     '"data":null}')
-  r <-  mock_response(json_string(str), status = 404, wrap = FALSE)
+  r <-  mock_response(json_string(str), status = 404L, wrap = FALSE)
   err <- expect_error(http_client_handle_error(r),
                       "Resource not found")
   expect_s3_class(err, "outpack_http_client_error")
@@ -78,6 +78,15 @@ test_that("handle errors from packit", {
 })
 
 
+test_that("handle plain text errors", {
+  r <- mock_response("foobar", status = 503L, wrap = FALSE)
+  err <- expect_error(http_client_handle_error(r),
+                      "Server error: \\(503\\) Service Unavailable")
+  expect_s3_class(err, "outpack_http_client_error")
+  expect_equal(err$code, 503)
+})
+
+
 test_that("can construct sensible download options", {
   path <- temp_file()
   res <- http_client_download_options(path)