Improved printing of the HTTP error message.

ArtifactDB · Apr 23, 2024 · fefa204 · fefa204
1 parent 74f3565
commit fefa204
Show file tree

Hide file tree

Showing 5 changed files with 18 additions and 5 deletions.
diff --git a/R/fetchDirectory.R b/R/fetchDirectory.R
@@ -68,7 +68,7 @@ fetchDirectory <- function(path, registry, url, cache=NULL, forceRemote=FALSE, o
     }
 
     req <- request(paste0(url, "/list?path=", URLencode(path), "&recursive=true"))
-    req <- req_error(req, body = function(res) resp_body_json(res)$reason)
+    req <- handle_error(req)
     res <- req_perform(req)
     listing <- resp_body_json(res)
 

diff --git a/R/listFiles.R b/R/listFiles.R
@@ -65,7 +65,7 @@ listFiles <- function(project, asset, version, registry, url, prefix=NULL, inclu
             target <- paste0(target, "/", prefix) 
         }
         req <- request(paste0(url, "/list?path=", URLencode(target, reserved=TRUE), "&recursive=true"))
-        req <- req_error(req, body = function(res) resp_body_json(res)$reason)
+        req <- handle_error(req)
         res <- req_perform(req)
 
         listing <- unlist(resp_body_json(res))

diff --git a/R/listProjects.R b/R/listProjects.R
@@ -45,7 +45,7 @@ list_registry_directories <- function(path, registry, url, forceRemote) {
             url <- paste0(url, "?path=", URLencode(path, reserved=TRUE))
         }
         req <- request(url)
-        req <- req_error(req, body = function(res) resp_body_json(res)$reason)
+        req <- handle_error(req)
         res <- req_perform(req)
         listing <- unlist(resp_body_json(res))
         dirs <- listing[endsWith(listing, "/")]

diff --git a/R/serviceInfo.R b/R/serviceInfo.R
@@ -16,7 +16,7 @@
 #' @import httr2
 serviceInfo <- function(url) {
     req <- request(paste0(url, "/info"))
-    req <- req_error(req, body = function(res) resp_body_json(res)$reason)
+    req <- handle_error(req)
     res <- req_perform(req)
     resp_body_json(res)
 }
diff --git a/R/utils.R b/R/utils.R
@@ -28,6 +28,19 @@ sanitize_uploaders <- function(uploaders) {
     uploaders
 }
 
+handle_error <- function(req) {
+    req_error(req, body = function(res) {
+        ct <- resp_content_type(res)
+        if (ct == "application/json") {
+            resp_body_json(res)$reason
+        } else if (ct == "text/plain") {
+            resp_body_string(res)
+        } else {
+            NULL
+        }
+    })
+}
+
 #' @importFrom jsonlite toJSON
 #' @import httr2
 dump_request <- function(staging, url, action, payload) {
@@ -46,7 +59,7 @@ dump_request <- function(staging, url, action, payload) {
 
     req <- request(paste0(url, "/new/", basename(actual)))
     req <- req_method(req, "POST")
-    req <- req_error(req, body = function(res) resp_body_json(res)$reason)
+    req <- handle_error(req)
     res <- req_perform(req)
     resp_body_json(res)
 }