added more verbose error message to httr::stop_for_status

DESCRIPTION

@@ -34,6 +34,9 @@ Authors@R: c(
   ),
   person(
     "Jan", "Kanis", role = "ctb"
+  ),
+  person(
+    "Edward", "Jee", role = "ctb"
   ))
 Imports:
     checkmate,

NEWS.md

@@ -1,3 +1,6 @@
+# CHANGES in dataverse 0.3.3
+* More verbose error messages returned on httr failure. (#31 @EdJeeOnGithub)
+
 # CHANGES in dataverse 0.3.1
 
 * Avoids tests in R Check if the dataverse server is not available (#77)

R/SWORD.R

@@ -18,7 +18,7 @@
 service_document <- function(key = Sys.getenv("DATAVERSE_KEY"), server = Sys.getenv("DATAVERSE_SERVER"), ...) {
     u <- paste0(api_url(server, prefix="dvn/api/"), "data-deposit/v1.1/swordv2/service-document")
     r <- httr::GET(u, httr::authenticate(key, ""), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     x <- xml2::as_list(xml2::read_xml(httr::content(r, "text")))
     w <- x$workspace
     out <- list()
@@ -75,7 +75,7 @@ list_datasets <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), server =
     }
     u <- paste0(api_url(server, prefix="dvn/api/"), "data-deposit/v1.1/swordv2/collection/dataverse/", dataverse)
     r <- httr::GET(u, httr::authenticate(key, ""), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
 
     # clean up response structure
     x <- xml2::as_list(xml2::read_xml(r$content))

R/SWORD_dataset.R

@@ -60,7 +60,7 @@ initiate_sword_dataset <- function(dataverse, body, key = Sys.getenv("DATAVERSE_
         b <- do.call("build_metadata", c(body, metadata_format = "dcterms"))
     }
     r <- httr::POST(u, httr::authenticate(key, ""), httr::add_headers("Content-Type" = "application/atom+xml"), body = b, ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     structure(parse_atom(httr::content(r, as = "text", encoding = "UTF-8")))
 }
 
@@ -107,7 +107,7 @@ delete_sword_dataset <- function(dataset, key = Sys.getenv("DATAVERSE_KEY"), ser
     }
 
     r <- httr::DELETE(u, httr::authenticate(key, ""), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     cont <- httr::content(r, as = "text", encoding = "UTF-8")
     if (cont == "") {
         return(TRUE)
@@ -162,7 +162,7 @@ publish_sword_dataset <- function(dataset, key = Sys.getenv("DATAVERSE_KEY"), se
     }
 
     r <- httr::POST(u, httr::authenticate(key, ""), httr::add_headers("In-Progress" = "false"), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     out <- xml2::as_list(xml2::read_xml(httr::content(r, as = "text", encoding = "UTF-8")))
     out
 }
@@ -206,7 +206,7 @@ dataset_atom <- function(dataset, key = Sys.getenv("DATAVERSE_KEY"), server = Sy
     }
 
     r <- httr::GET(u, httr::authenticate(key, ""), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     out <- parse_atom(rawToChar(r$content))
     out
 }
@@ -230,6 +230,6 @@ dataset_statement <- function(dataset, key = Sys.getenv("DATAVERSE_KEY"), server
         u <- paste0(api_url(server, prefix="dvn/api/"), "data-deposit/v1.1/swordv2/statement/study/", dataset)
     }
     r <- httr::GET(u, httr::authenticate(key, ""), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     parse_dataset_statement(rawToChar(r$content))
 }

R/SWORD_files.R

@@ -89,7 +89,7 @@ add_file <- function(dataset, file, key = Sys.getenv("DATAVERSE_KEY"), server =
                            "Content-Type" = "application/zip",
                            "Packaging" = "http://purl.org/net/sword/package/SimpleZip")
     r <- httr::POST(u, httr::authenticate(key, ""), h, body = httr::upload_file(file), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     parse_atom(httr::content(r, as = "text", encoding = "UTF-8"))
 }
 
@@ -134,7 +134,7 @@ delete_file <- function(id, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.gete
         u <- paste0(api_url(server, prefix="dvn/api/"), "data-deposit/v1.1/swordv2/edit-media/file/", id)
     }
     r <- httr::DELETE(u, httr::authenticate(key, ""), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     cont <- httr::content(r, as = "text", encoding = "UTF-8")
     if (cont == "") {
         return(TRUE)

R/add_dataset_file.R

@@ -56,7 +56,7 @@ function(file,
                     body = list(file = httr::upload_file(file),
                                 jsonData = jsondata),
                     encode = "multipart")
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     out <- jsonlite::fromJSON(httr::content(r, "text", encoding = "UTF-8"))
     out$data$files$dataFile$id[1L]
 }
@@ -97,6 +97,6 @@ function(file,
                                 jsonData = jsondata
                                 ),
                     encode = "multipart")
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     structure(jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"), simplifyDataFrame = FALSE)$data$files[[1L]], class = "dataverse_file")
 }

R/create_dataset.R

@@ -28,7 +28,7 @@ create_dataset <- function(dataverse, body, key = Sys.getenv("DATAVERSE_KEY"), s
     dataverse <- dataverse_id(dataverse, key = key, server = server, ...)
     u <- paste0(api_url(server), "dataverses/", dataverse, "/datasets/")
     r <- httr::POST(u, httr::add_headers("X-Dataverse-key" = key), body = body, encode = "json", ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     httr::content(r)
 }
 
@@ -38,6 +38,6 @@ update_dataset <- function(dataset, body, key = Sys.getenv("DATAVERSE_KEY"), ser
     dataset <- dataset_id(dataset, key = key, server = server, ...)
     u <- paste0(api_url(server), "datasets/", dataset, "/versions/:draft")
     r <- httr::PUT(u, httr::add_headers("X-Dataverse-key" = key), body = body, encode = "json", ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     httr::content(r, as = "text", encoding = "UTF-8")
 }

R/create_dataverse.R

@@ -24,6 +24,6 @@ create_dataverse <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), serve
         u <- paste0(api_url(server), "dataverses/", dataverse)
     }
     r <- httr::POST(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     httr::content(r, as = "text", encoding = "UTF-8")
 }

R/dataset_versions.R

@@ -21,7 +21,7 @@ dataset_versions <- function(dataset, key = Sys.getenv("DATAVERSE_KEY"), server
     dataset <- dataset_id(dataset, key = key, server = server, ...)
     u <- paste0(api_url(server), "datasets/", dataset, "/versions")
     r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     out <- httr::content(r, as = "text", encoding = "UTF-8")$data
     lapply(out, function(x) {
         x <- `class<-`(x, "dataverse_dataset_version")

R/dataverse_metadata.R

@@ -19,7 +19,7 @@ dataverse_metadata <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), ser
     dataverse <- dataverse_id(dataverse, key = key, server = server, ...)
     u <- paste0(api_url(server), "dataverses/", dataverse, "/metadatablocks")
     r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"), simplifyDataFrame = FALSE)$data
 }
 
@@ -38,6 +38,6 @@ set_dataverse_metadata <- function(dataverse, body, root = TRUE, key = Sys.geten
     dataverse <- dataverse_id(dataverse, key = key, server = server, ...)
     u <- paste0(api_url(server), "dataverses/", dataverse, "/metadatablocks/", tolower(as.character(root)))
     r <- httr::POST(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     httr::content(r, as = "text", encoding = "UTF-8")$data
 }

R/dataverse_search.R

@@ -104,7 +104,7 @@ function(...,
 
     # execute request
     r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), query = query)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     out <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))
     if (isTRUE(verbose)) {
         n_total <- ngettext(out$data$total_count, "result", "results")

R/delete_dataset.R

@@ -18,6 +18,6 @@ delete_dataset <- function(dataset, key = Sys.getenv("DATAVERSE_KEY"), server =
     dataset <- dataset_id(dataset, key = key, server = server, ...)
     u <- paste0(api_url(server), "datasets/", dataset, "/versions/:draft")
     r <- httr::DELETE(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     httr::content(r, as = "text", encoding = "UTF-8")
 }

R/delete_dataverse.R

@@ -16,6 +16,6 @@ delete_dataverse <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), serve
     dataverse <- dataverse_id(dataverse, key = key, server = server, ...)
     u <- paste0(api_url(server), "dataverses/", dataverse)
     r <- httr::DELETE(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     httr::content(r, as = "text", encoding = "UTF-8")
 }

R/get_dataset.R

@@ -60,7 +60,7 @@ get_dataset <- function(
     u <- paste0(api_url(server), "datasets/", dataset)
   }
   r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-  httr::stop_for_status(r)
+  httr::stop_for_status(r, task = httr::content(r)$message)
   parse_dataset(httr::content(r, as = "text", encoding = "UTF-8"))
 }
 
@@ -84,7 +84,7 @@ dataset_metadata <- function(
   }
 
   r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-  httr::stop_for_status(r)
+  httr::stop_for_status(r, task = httr::content(r)$message)
   out <- httr::content(r, as = "text", encoding = "UTF-8")
   jsonlite::fromJSON(out)[["data"]]
 }
@@ -101,7 +101,7 @@ dataset_files <- function(
   dataset <- dataset_id(dataset, key = key, server = server, ...)
   u <- paste0(api_url(server), "datasets/", dataset, "/versions/", version, "/files")
   r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-  httr::stop_for_status(r)
+  httr::stop_for_status(r, task = httr::content(r)$message)
   out <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"), simplifyDataFrame = FALSE)$data
   structure(lapply(out, `class<-`, "dataverse_file"))
 }

R/get_dataverse.R

@@ -45,7 +45,7 @@ get_dataverse <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), server =
     }
     u <- paste0(api_url(server), "dataverses/", dataverse)
     r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     out <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))
     structure(out$data, class = "dataverse")
 }
@@ -56,7 +56,7 @@ dataverse_contents <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), ser
     dataverse <- dataverse_id(dataverse, key = key, server = server, ...)
     u <- paste0(api_url(server), "dataverses/", dataverse, "/contents")
     r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     out <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"), simplifyDataFrame = FALSE)
     structure(lapply(out$data, function(x) {
         `class<-`(x, if (x$type == "dataset") "dataverse_dataset" else "dataverse")

R/get_facets.R

@@ -21,6 +21,6 @@ get_facets <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), server = Sy
     dataverse <- dataverse_id(dataverse, key = key, server = server, ...)
     u <- paste0(api_url(server), "dataverses/", dataverse, "/facets")
     r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data
 }

R/get_file_by_id.R

@@ -78,7 +78,7 @@ get_file_by_id <- function(
     u <- paste0(api_url(server), u_part, fileid)
     r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), query = query, ...)
 
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     httr::content(r, as = "raw")
   }
 

R/get_file_metadata.R

@@ -40,7 +40,7 @@ get_file_metadata <-
     }
 
     r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     out <- httr::content(r, as = "text", encoding = "UTF-8")
     return(out)
   }

R/native_role_groups.R

@@ -36,7 +36,7 @@ create_group <- function(dataverse, alias, name, description, key = Sys.getenv("
     dataverse <- dataverse_id(dataverse, key = key, server = server, ...)
     u <- paste0(api_url(server), "dataverses/", dataverse, "/groups")
     r <- httr::POST(u, httr::add_headers("X-Dataverse-key" = key), body = b, encode = "json", ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data
     j$dataverse <- dataverse
     structure(j, class = "dataverse_group")
@@ -68,7 +68,7 @@ update_group <- function(group, name, description, dataverse, key = Sys.getenv("
         u <- paste0(api_url(server), "dataverses/", dataverse, "/groups/", group)
     }
     r <- httr::PUT(u, httr::add_headers("X-Dataverse-key" = key), body = b, encode = "json", ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data
     j$dataverse <- dataverse
     structure(j, class = "dataverse_group")
@@ -80,7 +80,7 @@ list_groups <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), server = S
     dataverse <- dataverse_id(dataverse, key = key, server = server, ...)
     u <- paste0(api_url(server), "dataverses/", dataverse, "/groups")
     r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"), simplifyDataFrame = FALSE)$data
     lapply(j, function(x) {
         x$dataverse <- dataverse
@@ -100,7 +100,7 @@ get_group <- function(group, dataverse, key = Sys.getenv("DATAVERSE_KEY"), serve
         u <- paste0(api_url(server), "dataverses/", dataverse, "/groups/", group)
     }
     r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data
     j$dataverse <- dataverse
     structure(j, class = "dataverse_group")
@@ -117,7 +117,7 @@ delete_group <- function(group, dataverse, key = Sys.getenv("DATAVERSE_KEY"), se
     }
     u <- paste0(api_url(server), "dataverses/", dataverse, "/groups/", group)
     r <- httr::DELETE(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     out <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))
     if (out$status == "OK") {
         return(TRUE)
@@ -153,7 +153,7 @@ add_roles_to_group <- function(group, role, dataverse, key = Sys.getenv("DATAVER
     }
     u <- paste0(api_url(server), "dataverses/", dataverse, "/groups/", group, "/roleAssignees/", role)
     r <- httr::PUT(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data
     j
 }
@@ -169,6 +169,6 @@ remove_role_from_group <- function(group, role, dataverse, key = Sys.getenv("DAT
     }
     u <- paste0(api_url(server), "dataverses/", dataverse, "/groups/", group, "/roleAssignees/", role)
     r <- httr::DELETE(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     httr::content(r, as = "text", encoding = "UTF-8")
 }

R/native_roles.R

@@ -22,7 +22,7 @@
 get_role <- function(role, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.getenv("DATAVERSE_SERVER"), ...) {
     u <- paste0(api_url(server), "roles/", role)
     r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data
     j
 }
@@ -32,7 +32,7 @@ get_role <- function(role, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.geten
 delete_role <- function(role, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.getenv("DATAVERSE_SERVER"), ...) {
     u <- paste0(api_url(server), "roles/", role)
     r <- httr::DELETE(u, httr::add_headers("X-Dataverse-key" = key), ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data
     j
 }
@@ -44,13 +44,13 @@ list_roles <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), server = Sy
         dataverse <- dataverse_id(dataverse, key = key, server = server, ...)
         u <- paste0(api_url(server), "dataverses/", dataverse, "/roles")
         r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-        httr::stop_for_status(r)
+        httr::stop_for_status(r, task = httr::content(r)$message)
         out <- jsonlite::fromJSON(httr::content(r, "text", encoding = "UTF-8"))$data
         structure(lapply(out, `class<-`, "dataverse_role"))
     } else {
         u <- paste0(api_url(server), "admin/roles")
         r <- httr::GET(u, httr::add_headers("X-Dataverse-key" = key), ...)
-        httr::stop_for_status(r)
+        httr::stop_for_status(r, task = httr::content(r)$message)
         out <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data
         structure(lapply(out, `class<-`, "dataverse_role"))
     }
@@ -68,7 +68,7 @@ create_role <- function(dataverse, alias, name, description, permissions,
     }
     u <- paste0(api_url(server), "dataverses/", dataverse, "/roles")
     r <- httr::POST(u, httr::add_headers("X-Dataverse-key" = key), body = b, encode = "json", ...)
-    httr::stop_for_status(r)
+    httr::stop_for_status(r, task = httr::content(r)$message)
     j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data
     structure(j, class = "dataverse_role")
 }