From e091e72addd27ad9fbcf1dc94c0b96e0d970b89d Mon Sep 17 00:00:00 2001 From: Christopher Kenny Date: Mon, 23 Feb 2026 18:36:55 -0500 Subject: [PATCH 1/6] update to httr2 --- DESCRIPTION | 3 +- R/SWORD.R | 4 +-- R/SWORD_dataset.R | 40 ++++++++++++++++++-------- R/SWORD_files.R | 29 +++++++++++++------ R/add_dataset_file.R | 36 ++++++++++++++--------- R/create_dataset.R | 23 +++++++++++---- R/create_dataverse.R | 11 +++++-- R/dataverse_metadata.R | 11 +++++-- R/delete_dataset.R | 11 +++++-- R/delete_dataverse.R | 11 +++++-- R/get_file_by_id.R | 8 ++---- R/native_role_groups.R | 56 ++++++++++++++++++++++++++---------- R/native_roles.R | 22 ++++++++++---- R/native_roles_assignments.R | 22 ++++++++++---- R/native_user.R | 11 +++++-- R/onload.R | 2 +- R/publish_dataset.R | 11 +++++-- R/publish_dataverse.R | 23 +++++++++++---- R/utils.R | 47 ++++++++++++++++++++++-------- 19 files changed, 268 insertions(+), 113 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9157d7f..d9830af 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -49,7 +49,8 @@ Authors@R: email = "konrad.oberwimmer@gmail.com")) Imports: checkmate, - httr, + curl, + httr2, memoise, cachem, jsonlite, diff --git a/R/SWORD.R b/R/SWORD.R index acdb793..e04cf42 100644 --- a/R/SWORD.R +++ b/R/SWORD.R @@ -17,7 +17,7 @@ #' @export 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 <- api_get(u, httr::authenticate(key, ""), ...) + r <- api_get(u, ..., key = key, sword = TRUE) x <- xml2::as_list(xml2::read_xml(r)) w <- x$workspace out <- list() @@ -73,7 +73,7 @@ list_datasets <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), server = dataverse <- get_dataverse(dataverse, key = key, server = server, ...)$alias } u <- paste0(api_url(server, prefix = "dvn/api/"), "data-deposit/v1.1/swordv2/collection/dataverse/", dataverse) - r <- api_get(u, httr::authenticate(key, ""), ..., as = "raw") + r <- api_get(u, ..., key = key, sword = TRUE, as = "raw") # clean up response structure x <- xml2::as_list(xml2::read_xml(r)) diff --git a/R/SWORD_dataset.R b/R/SWORD_dataset.R index dcd859f..5618584 100644 --- a/R/SWORD_dataset.R +++ b/R/SWORD_dataset.R @@ -54,14 +54,19 @@ initiate_sword_dataset <- function(dataverse, body, key = Sys.getenv("DATAVERSE_ dataverse <- get_dataverse(dataverse)$alias } u <- paste0(api_url(server, prefix="dvn/api/"), "data-deposit/v1.1/swordv2/collection/dataverse/", dataverse) + req <- httr2::request(u) |> + httr2::req_auth_basic(key, "") if (is.character(body) && file.exists(body)) { - b <- httr::upload_file(body) + req <- httr2::req_body_file(req, body, type = "application/atom+xml") } else { b <- do.call("build_metadata", c(body, metadata_format = "dcterms")) + req <- httr2::req_body_raw(req, b, type = "application/atom+xml") } - r <- httr::POST(u, httr::authenticate(key, ""), httr::add_headers("Content-Type" = "application/atom+xml"), body = b, ...) - httr::stop_for_status(r, task = httr::content(r)$message) - structure(parse_atom(httr::content(r, as = "text", encoding = "UTF-8"))) + req <- httr2::req_error(req, body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + structure(parse_atom(httr2::resp_body_string(r))) } #' @title Delete dataset (SWORD) @@ -106,9 +111,14 @@ delete_sword_dataset <- function(dataset, key = Sys.getenv("DATAVERSE_KEY"), ser u <- paste0(api_url(server, prefix="dvn/api/"), "data-deposit/v1.1/swordv2/edit/study/", dataset) } - r <- httr::DELETE(u, httr::authenticate(key, ""), ...) - httr::stop_for_status(r, task = httr::content(r)$message) - cont <- httr::content(r, as = "text", encoding = "UTF-8") + req <- httr2::request(u) |> + httr2::req_auth_basic(key, "") |> + httr2::req_method("DELETE") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + cont <- httr2::resp_body_string(r) if (cont == "") { return(TRUE) } else { @@ -161,9 +171,15 @@ publish_sword_dataset <- function(dataset, key = Sys.getenv("DATAVERSE_KEY"), se u <- paste0(api_url(server, prefix = "dvn/api/"), "data-deposit/v1.1/swordv2/edit/study/", dataset) } - r <- httr::POST(u, httr::authenticate(key, ""), httr::add_headers("In-Progress" = "false"), ...) - 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"))) + req <- httr2::request(u) |> + httr2::req_auth_basic(key, "") |> + httr2::req_headers("In-Progress" = "false") |> + httr2::req_method("POST") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + out <- xml2::as_list(xml2::read_xml(httr2::resp_body_string(r))) out } @@ -205,7 +221,7 @@ dataset_atom <- function(dataset, key = Sys.getenv("DATAVERSE_KEY"), server = Sy u <- paste0(api_url(server, prefix="dvn/api/"), "data-deposit/v1.1/swordv2/edit/study/", dataset) } - r <- api_get(u, httr::authenticate(key, ""), ..., as = "raw") + r <- api_get(u, ..., key = key, sword = TRUE, as = "raw") out <- parse_atom(rawToChar(r)) out } @@ -228,6 +244,6 @@ dataset_statement <- function(dataset, key = Sys.getenv("DATAVERSE_KEY"), server dataset <- prepend_doi(dataset) u <- paste0(api_url(server, prefix="dvn/api/"), "data-deposit/v1.1/swordv2/statement/study/", dataset) } - r <- api_get(u, httr::authenticate(key, ""), ..., as = "raw") + r <- api_get(u, ..., key = key, sword = TRUE, as = "raw") parse_dataset_statement(rawToChar(r)) } diff --git a/R/SWORD_files.R b/R/SWORD_files.R index 3b5fc8f..760011f 100644 --- a/R/SWORD_files.R +++ b/R/SWORD_files.R @@ -88,12 +88,18 @@ add_file <- function(dataset, file, key = Sys.getenv("DATAVERSE_KEY"), server = # file can be: a character vector of file names, a data.frame, or a list of R objects file <- create_zip(file) - h <- httr::add_headers("Content-Disposition" = paste0("filename=", file), - "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, task = httr::content(r)$message) - parse_atom(httr::content(r, as = "text", encoding = "UTF-8")) + req <- httr2::request(u) |> + httr2::req_auth_basic(key, "") |> + httr2::req_headers( + "Content-Disposition" = paste0("filename=", file), + "Packaging" = "http://purl.org/net/sword/package/SimpleZip" + ) |> + httr2::req_body_file(file, type = "application/zip") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + parse_atom(httr2::resp_body_string(r)) } #' @title Delete file (SWORD) @@ -136,9 +142,14 @@ delete_file <- function(id, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.gete } else { 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, task = httr::content(r)$message) - cont <- httr::content(r, as = "text", encoding = "UTF-8") + req <- httr2::request(u) |> + httr2::req_auth_basic(key, "") |> + httr2::req_method("DELETE") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + cont <- httr2::resp_body_string(r) if (cont == "") { return(TRUE) } else { diff --git a/R/add_dataset_file.R b/R/add_dataset_file.R index 02fb43b..e1138a1 100644 --- a/R/add_dataset_file.R +++ b/R/add_dataset_file.R @@ -74,12 +74,17 @@ add_dataset_file <- jsondata <- as.character(jsonlite::toJSON(bod2, auto_unbox = TRUE)) u <- paste0(api_url(server), "datasets/", dataset, "/add") - r <- httr::POST(u, httr::add_headers("X-Dataverse-key" = key), ..., - body = list(file = httr::upload_file(file), - jsonData = jsondata), - encode = "multipart") - httr::stop_for_status(r, task = httr::content(r)$message) - out <- jsonlite::fromJSON(httr::content(r, "text", encoding = "UTF-8")) + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_body_multipart( + file = curl::form_file(file), + jsonData = jsondata + ) |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + out <- jsonlite::fromJSON(httr2::resp_body_string(r)) out$data$files$dataFile$id[1L] } @@ -114,15 +119,18 @@ update_dataset_file <- jsondata <- as.character(jsonlite::toJSON(bod2, auto_unbox = TRUE)) u <- paste0(api_url(server), "files/", id, "/replace") - r <- httr::POST(u, - httr::add_headers("X-Dataverse-key" = key), ..., - body = list(file = httr::upload_file(file), - jsonData = jsondata - ), - encode = "multipart") - httr::stop_for_status(r, task = httr::content(r)$message) + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_body_multipart( + file = curl::form_file(file), + jsonData = jsondata + ) |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) structure(jsonlite::fromJSON( - httr::content(r, as = "text", encoding = "UTF-8"), + httr2::resp_body_string(r), simplifyDataFrame = FALSE)$data$files[[1L]], class = "dataverse_file" ) } diff --git a/R/create_dataset.R b/R/create_dataset.R index 423b0ae..f81a2d9 100644 --- a/R/create_dataset.R +++ b/R/create_dataset.R @@ -27,9 +27,14 @@ create_dataset <- function(dataverse, body, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.getenv("DATAVERSE_SERVER"), ...) { 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, task = httr::content(r)$message) - httr::content(r) + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_body_json(body) |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + httr2::resp_body_json(r) } #' @rdname create_dataset @@ -37,7 +42,13 @@ create_dataset <- function(dataverse, body, key = Sys.getenv("DATAVERSE_KEY"), s update_dataset <- function(dataset, body, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.getenv("DATAVERSE_SERVER"), ...) { 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, task = httr::content(r)$message) - httr::content(r, as = "text", encoding = "UTF-8") + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_body_json(body) |> + httr2::req_method("PUT") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + httr2::resp_body_string(r) } diff --git a/R/create_dataverse.R b/R/create_dataverse.R index b12c6a8..f7858fa 100644 --- a/R/create_dataverse.R +++ b/R/create_dataverse.R @@ -23,7 +23,12 @@ create_dataverse <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), serve } else { u <- paste0(api_url(server), "dataverses/", dataverse) } - r <- httr::POST(u, httr::add_headers("X-Dataverse-key" = key), ...) - httr::stop_for_status(r, task = httr::content(r)$message) - httr::content(r, as = "text", encoding = "UTF-8") + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("POST") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + httr2::resp_body_string(r) } diff --git a/R/dataverse_metadata.R b/R/dataverse_metadata.R index 6cd63a6..cb4a239 100644 --- a/R/dataverse_metadata.R +++ b/R/dataverse_metadata.R @@ -36,7 +36,12 @@ dataverse_metadata <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), ser set_dataverse_metadata <- function(dataverse, body, root = TRUE, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.getenv("DATAVERSE_SERVER"), ...) { 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, task = httr::content(r)$message) - httr::content(r, as = "text", encoding = "UTF-8")$data + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("POST") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + httr2::resp_body_json(r)$data } diff --git a/R/delete_dataset.R b/R/delete_dataset.R index 5d9e8c0..2938e16 100644 --- a/R/delete_dataset.R +++ b/R/delete_dataset.R @@ -17,7 +17,12 @@ delete_dataset <- function(dataset, key = Sys.getenv("DATAVERSE_KEY"), server = # can only delete a "draft" dataset 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, task = httr::content(r)$message) - httr::content(r, as = "text", encoding = "UTF-8") + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("DELETE") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + httr2::resp_body_string(r) } diff --git a/R/delete_dataverse.R b/R/delete_dataverse.R index 123fb80..ae04e8f 100644 --- a/R/delete_dataverse.R +++ b/R/delete_dataverse.R @@ -15,7 +15,12 @@ delete_dataverse <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.getenv("DATAVERSE_SERVER"), ...) { 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, task = httr::content(r)$message) - httr::content(r, as = "text", encoding = "UTF-8") + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("DELETE") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + httr2::resp_body_string(r) } diff --git a/R/get_file_by_id.R b/R/get_file_by_id.R index cf00c4d..e0c26a7 100644 --- a/R/get_file_by_id.R +++ b/R/get_file_by_id.R @@ -96,12 +96,10 @@ get_file_by_id <- function( # If not bundle, request single file in non-bundle format ---- u <- paste0(api_url(server), u_part, fileid) if (return_url) { - return(httr::modify_url(u, query = query)) + req_tmp <- do.call(httr2::req_url_query, c(list(httr2::request(u)), query)) + return(req_tmp$url) } - # add a progress bar; 'NULL' if progress is not TRUE. 'NULL' arguments - # are not seen by httr::GET() - progress_bar <- if (isTRUE(progress)) httr::progress(type = "down") - api_get(u, query = query, progress_bar, ..., key = key, as = "raw") + api_get(u, query = query, progress = progress, ..., key = key, as = "raw") } #' @rdname files diff --git a/R/native_role_groups.R b/R/native_role_groups.R index 465cf20..cbc3b3a 100644 --- a/R/native_role_groups.R +++ b/R/native_role_groups.R @@ -35,9 +35,14 @@ create_group <- function(dataverse, alias, name, description, key = Sys.getenv(" aliasInOwner = alias) 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, task = httr::content(r)$message) - j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_body_json(b) |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + j <- jsonlite::fromJSON(httr2::resp_body_string(r))$data j$dataverse <- dataverse structure(j, class = "dataverse_group") } @@ -67,9 +72,15 @@ update_group <- function(group, name, description, dataverse, key = Sys.getenv(" dataverse <- dataverse_id(dataverse, key = key, server = server, ...) 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, task = httr::content(r)$message) - j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_body_json(b) |> + httr2::req_method("PUT") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + j <- jsonlite::fromJSON(httr2::resp_body_string(r))$data j$dataverse <- dataverse structure(j, class = "dataverse_group") } @@ -114,9 +125,14 @@ delete_group <- function(group, dataverse, key = Sys.getenv("DATAVERSE_KEY"), se dataverse <- dataverse_id(dataverse, key = key, server = server, ...) } 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, task = httr::content(r)$message) - out <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8")) + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("DELETE") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + out <- jsonlite::fromJSON(httr2::resp_body_string(r)) if (out$status == "OK") { return(TRUE) } else { @@ -150,9 +166,14 @@ add_roles_to_group <- function(group, role, dataverse, key = Sys.getenv("DATAVER stop("'server' is missing, but required") } 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, task = httr::content(r)$message) - j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("PUT") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + j <- jsonlite::fromJSON(httr2::resp_body_string(r))$data j } @@ -166,7 +187,12 @@ remove_role_from_group <- function(group, role, dataverse, key = Sys.getenv("DAT dataverse <- dataverse_id(dataverse, key = key, server = server, ...) } 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, task = httr::content(r)$message) - httr::content(r, as = "text", encoding = "UTF-8") + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("DELETE") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + httr2::resp_body_string(r) } diff --git a/R/native_roles.R b/R/native_roles.R index b1d5a11..301548a 100644 --- a/R/native_roles.R +++ b/R/native_roles.R @@ -30,9 +30,14 @@ get_role <- function(role, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.geten # @export 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, task = httr::content(r)$message) - j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("DELETE") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + j <- jsonlite::fromJSON(httr2::resp_body_string(r))$data j } @@ -61,8 +66,13 @@ create_role <- function(dataverse, alias, name, description, permissions, permissions <- 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, task = httr::content(r)$message) - j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_body_json(b) |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + j <- jsonlite::fromJSON(httr2::resp_body_string(r))$data structure(j, class = "dataverse_role") } diff --git a/R/native_roles_assignments.R b/R/native_roles_assignments.R index 99e042e..9e26835 100644 --- a/R/native_roles_assignments.R +++ b/R/native_roles_assignments.R @@ -34,9 +34,14 @@ assign_role <- function(dataverse, assignee, role, key = Sys.getenv("DATAVERSE_K dataverse <- dataverse_id(dataverse, key = key, server = server, ...) u <- paste0(api_url(server), "dataverses/", dataverse, "/assignments") b <- list(assignee = assignee, role = role) - r <- httr::POST(u, httr::add_headers("X-Dataverse-key" = key), body = b, encode = "json", ...) - httr::stop_for_status(r, task = httr::content(r)$message) - j <- jsonlite::fromJSON(httr::content(r, as = "text", encoding = "UTF-8"))$data + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_body_json(b) |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + j <- jsonlite::fromJSON(httr2::resp_body_string(r))$data j } @@ -45,7 +50,12 @@ assign_role <- function(dataverse, assignee, role, key = Sys.getenv("DATAVERSE_K delete_assignment <- function(dataverse, assignment, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.getenv("DATAVERSE_SERVER"), ...) { dataverse <- dataverse_id(dataverse, key = key, server = server, ...) u <- paste0(api_url(server), "dataverses/", dataverse, "/assignments/", assignment) - r <- httr::DELETE(u, httr::add_headers("X-Dataverse-key" = key), ...) - httr::stop_for_status(r, task = httr::content(r)$message) - httr::content(r, as = "text", encoding = "UTF-8") + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("DELETE") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + httr2::resp_body_string(r) } diff --git a/R/native_user.R b/R/native_user.R index bbb5399..d272255 100644 --- a/R/native_user.R +++ b/R/native_user.R @@ -13,9 +13,14 @@ # @export create_user <- function(password, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.getenv("DATAVERSE_SERVER"), ...) { u <- paste0(api_url(server), "builtin-users?password=", password) - r <- httr::POST(u, httr::add_headers("X-Dataverse-key" = key), ...) - httr::stop_for_status(r, task = httr::content(r)$message) - httr::content(r, as = "text", encoding = "UTF-8") + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("POST") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + httr2::resp_body_string(r) } #' @title Get API Key diff --git a/R/onload.R b/R/onload.R index a129f9e..1bfc0f7 100644 --- a/R/onload.R +++ b/R/onload.R @@ -3,7 +3,7 @@ #' @importFrom memoise memoise .onLoad <- function(libname, pkgname) { ## - ## 'memoise' httr::GET calls + ## 'memoise' api_get_impl calls ## ## API session cache diff --git a/R/publish_dataset.R b/R/publish_dataset.R index 32d3d4a..875252d 100644 --- a/R/publish_dataset.R +++ b/R/publish_dataset.R @@ -18,7 +18,12 @@ publish_dataset <- function(dataset, minor = TRUE, key = Sys.getenv("DATAVERSE_KEY"), server = Sys.getenv("DATAVERSE_SERVER"), ...) { dataset <- dataset_id(dataset, key = key, server = server, ...) u <- paste0(api_url(server), "datasets/", dataset, "/actions/:publish?type=", if (minor) "minor" else "major") - r <- httr::POST(u, httr::add_headers("X-Dataverse-key" = key), ...) - httr::stop_for_status(r, task = httr::content(r)$message) - httr::content(r, as = "text", encoding = "UTF-8") + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("POST") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + httr2::resp_body_string(r) } diff --git a/R/publish_dataverse.R b/R/publish_dataverse.R index f51e808..3fc5f8e 100644 --- a/R/publish_dataverse.R +++ b/R/publish_dataverse.R @@ -17,14 +17,25 @@ publish_dataverse <- function(dataverse, key = Sys.getenv("DATAVERSE_KEY"), serv # publish via native API dataverse <- dataverse_id(dataverse, key = key, server = server, ...) u <- paste0(api_url(server), "dataverses/", dataverse, "/actions/:publish") - r <- httr::POST(u, httr::add_headers("X-Dataverse-key" = key), ...) - httr::stop_for_status(r, task = httr::content(r)$message) - return(httr::content(r)$data) + req <- httr2::request(u) |> + httr2::req_headers_redacted("X-Dataverse-key" = key) |> + httr2::req_method("POST") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + return(httr2::resp_body_json(r)$data) } # publish via sword API - r <- httr::POST(u, httr::authenticate(key, ""), httr::add_headers("In-Progress" = "false"), ...) - 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"))) + req <- httr2::request(u) |> + httr2::req_auth_basic(key, "") |> + httr2::req_headers("In-Progress" = "false") |> + httr2::req_method("POST") |> + httr2::req_error(body = function(resp) { + tryCatch(httr2::resp_body_json(resp, simplifyVector = FALSE)$message, error = function(e) NULL) + }) + r <- httr2::req_perform(req) + out <- xml2::as_list(xml2::read_xml(httr2::resp_body_string(r))) # clean up response structure out } diff --git a/R/utils.R b/R/utils.R index 5bc4bfb..8870a1a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -183,7 +183,8 @@ prepend_doi <- function(dataset) { dataset <- paste0("doi:", strsplit(dataset, "DOI:", fixed = TRUE)[[1]][2]) } else if (!grepl("^doi:", dataset)) { if (grepl("dx\\.doi\\.org", dataset) | grepl("^http", dataset)) { - dataset <- httr::parse_url(dataset)$path + # httr2::url_parse returns path with leading slash; strip it + dataset <- sub("^/", "", httr2::url_parse(dataset)$path) } dataset <- paste0("doi:", dataset) } else { @@ -196,7 +197,9 @@ api_url <- function(server = Sys.getenv("DATAVERSE_SERVER"), prefix = "api/") { if (is.null(server) || server == "") { stop("'server' is missing with no default set in DATAVERSE_SERVER environment variable.") } - server_parsed <- httr::parse_url(server) + # httr2::url_parse requires a scheme; prepend https:// if missing + server_for_parse <- if (!grepl("^https?://", server)) paste0("https://", server) else server + server_parsed <- httr2::url_parse(server_for_parse) if (is.null(server_parsed[["hostname"]]) || server_parsed[["hostname"]] == "") { server_parsed[["hostname"]] <- server } @@ -208,13 +211,18 @@ api_url <- function(server = Sys.getenv("DATAVERSE_SERVER"), prefix = "api/") { return(paste0("https://", domain, "/", prefix)) } -## common httr::GET() uses +## common httr2::request() uses #' @importFrom checkmate assert_string -api_get <- function(url, ..., key = NULL, as = "text", use_cache = Sys.getenv("DATAVERSE_USE_CACHE", "session")) { +api_get <- function(url, ..., key = NULL, as = "text", + use_cache = Sys.getenv("DATAVERSE_USE_CACHE", "session"), + sword = FALSE, progress = FALSE) { assert_string(url) assert_string(key, null.ok = TRUE) assert_string(as, null.ok = TRUE) assert_use_cache(use_cache) + # Extract query from ...; ignore httr-specific objects + dots <- list(...) + query <- dots[["query"]] get <- switch( use_cache, "none" = api_get_impl, @@ -222,20 +230,35 @@ api_get <- function(url, ..., key = NULL, as = "text", use_cache = Sys.getenv("D "disk" = api_get_disk_cache, stop("unknown value for 'use_cache'") ) - get(url, ..., key = key, as = as) + get(url, key = key, as = as, sword = sword, query = query, progress = progress) } ## cache implemented via memoization; memoized functions defined in ## .onLoad() -api_get_impl <- function(url, ..., key = NULL, as = "text") { - if (!is.null(key)) - key <- httr::add_headers("X-Dataverse-key" = key) - r <- httr::GET(url, ..., key) - httr::stop_for_status(r, task = httr::content(r)$message) - httr::content(r, as = as, encoding = "UTF-8") +api_get_impl <- function(url, key = NULL, as = "text", sword = FALSE, query = NULL, progress = FALSE) { + req <- httr2::request(url) + if (!is.null(query)) + req <- do.call(httr2::req_url_query, c(list(req), query, list(.multi = "explode"))) + if (isTRUE(sword)) { + req <- httr2::req_auth_basic(req, if (!is.null(key)) key else "", "") + } else if (!is.null(key)) { + req <- httr2::req_headers_redacted(req, "X-Dataverse-key" = key) + } + if (isTRUE(progress)) + req <- httr2::req_progress(req, type = "down") + req <- httr2::req_error(req, body = function(resp) { + tryCatch( + httr2::resp_body_json(resp, simplifyVector = FALSE)$message, + error = function(e) NULL + ) + }) + resp <- httr2::req_perform(req) + if (identical(as, "raw")) httr2::resp_body_raw(resp) + else if (is.null(as)) httr2::resp_body_json(resp) + else httr2::resp_body_string(resp) } -api_get_session_cache <- NULL # per-session memoisatoin +api_get_session_cache <- NULL # per-session memoisation api_get_disk_cache <- NULL # 'permanent' memoisation From 418180ba06c08c70f24d61f57ea7651c40e95ca7 Mon Sep 17 00:00:00 2001 From: Christopher Kenny Date: Fri, 27 Feb 2026 17:50:26 -0500 Subject: [PATCH 2/6] description, news --- DESCRIPTION | 9 +++++++-- NEWS.md | 4 ++++ 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d9830af..5a6f7f8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: dataverse -Version: 0.3.16 +Version: 0.3.17 Title: Client for Dataverse 4+ Repositories Authors@R: c(person(given = "Shiro", @@ -46,7 +46,12 @@ Authors@R: person(given = "Konrad", family = "Oberwimmer", role = "ctb", - email = "konrad.oberwimmer@gmail.com")) + email = "konrad.oberwimmer@gmail.com"), + person(given = "Christopher T.", + family = "Kenny", + role = c("ctb"), + email = "ctkenny@proton.me", + comment = c(ORCID = "0000-0002-9386-6860"))) Imports: checkmate, curl, diff --git a/NEWS.md b/NEWS.md index 2b70f3b..a938d26 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # dataverse +# CHANGES in dataverse 0.3.17 + +* Update to use `httr2` internally over `httr`. + # CHANGES in dataverse 0.3.16 * Fix API calls to set X-Dataverse-key header correctly (#140, by @konradoberwimmer) From 7c37fbb50d60de281cc79ca9c7dbdebb537a99ac Mon Sep 17 00:00:00 2001 From: Shiro Kuriwaki Date: Fri, 6 Mar 2026 09:13:07 -0500 Subject: [PATCH 3/6] ubuntu to latest (#143) --- .github/workflows/R-CMD-check-dev.yaml | 2 +- .github/workflows/R-CMD-check-thorough.yaml | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/R-CMD-check-dev.yaml b/.github/workflows/R-CMD-check-dev.yaml index 4092fa8..26995a1 100644 --- a/.github/workflows/R-CMD-check-dev.yaml +++ b/.github/workflows/R-CMD-check-dev.yaml @@ -12,7 +12,7 @@ name: R-CMD-check-dev jobs: R-CMD-check-dev: - runs-on: ubuntu-22.04 + runs-on: ubuntu-latest env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: diff --git a/.github/workflows/R-CMD-check-thorough.yaml b/.github/workflows/R-CMD-check-thorough.yaml index 75c1347..2c6315c 100644 --- a/.github/workflows/R-CMD-check-thorough.yaml +++ b/.github/workflows/R-CMD-check-thorough.yaml @@ -25,8 +25,8 @@ jobs: - {os: windows-latest, r: 'devel'} - {os: windows-latest, r: 'release'} # - {os: windows-latest, r: '3.6'} - - {os: ubuntu-20.04, r: 'devel'} - - {os: ubuntu-20.04, r: 'release'} + - {os: ubuntu-latest, r: 'devel'} + - {os: ubuntu-latest, r: 'release'} # - {os: ubuntu-18.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/bionic/latest", http-user-agent: "R/4.0.0 (ubuntu-18.04) R (4.0.0 x86_64-pc-linux-gnu x86_64 linux-gnu) on GitHub Actions" } # - {os: ubuntu-18.04, r: 'oldrel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/bionic/latest"} # - {os: ubuntu-18.04, r: '3.5', rspm: "https://packagemanager.rstudio.com/cran/__linux__/bionic/latest"} From 5aadaf44bf826353863d1e30c5ddf33cdac0805e Mon Sep 17 00:00:00 2001 From: Shiro Kuriwaki Date: Fri, 6 Mar 2026 09:55:57 -0500 Subject: [PATCH 4/6] deprecated sysreq --- .github/workflows/R-CMD-check-thorough.yaml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/R-CMD-check-thorough.yaml b/.github/workflows/R-CMD-check-thorough.yaml index 2c6315c..f5ccff1 100644 --- a/.github/workflows/R-CMD-check-thorough.yaml +++ b/.github/workflows/R-CMD-check-thorough.yaml @@ -61,8 +61,7 @@ jobs: - name: Install system dependencies if: runner.os == 'Linux' run: | - pak::local_system_requirements(execute = TRUE) - pak::pkg_system_requirements("rcmdcheck", execute = TRUE) + pak::pkg_sysreqs(execute = TRUE) shell: Rscript {0} - name: Install dependencies From f7b5819cda2a6eae071d92242cd8ce2d4cfe9912 Mon Sep 17 00:00:00 2001 From: Shiro Kuriwaki Date: Fri, 6 Mar 2026 11:46:01 -0500 Subject: [PATCH 5/6] Wrap up in r-dependencies --- .github/workflows/R-CMD-check-thorough.yaml | 23 ++------------------- 1 file changed, 2 insertions(+), 21 deletions(-) diff --git a/.github/workflows/R-CMD-check-thorough.yaml b/.github/workflows/R-CMD-check-thorough.yaml index f5ccff1..4cc83e3 100644 --- a/.github/workflows/R-CMD-check-thorough.yaml +++ b/.github/workflows/R-CMD-check-thorough.yaml @@ -47,28 +47,9 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: cache: "always" - - uses: r-lib/actions/setup-pandoc@v2 - - - name: Restore R package cache - uses: actions/cache@v3 - with: - path: | - ${{ env.R_LIBS_USER }} - !${{ env.R_LIBS_USER }}/pak - key: ${{ matrix.config.os }}-${{ steps.install-r.outputs.installed-r-version }}-1-${{ hashFiles('.github/r-depends.rds') }} - restore-keys: ${{ matrix.config.os }}-${{ steps.install-r.outputs.installed-r-version }}-1- + extra-packages: any::rcmdcheck - - name: Install system dependencies - if: runner.os == 'Linux' - run: | - pak::pkg_sysreqs(execute = TRUE) - shell: Rscript {0} - - - name: Install dependencies - run: | - pak::local_install_dev_deps(upgrade = TRUE) - pak::pkg_install("rcmdcheck") - shell: Rscript {0} + - uses: r-lib/actions/setup-pandoc@v2 - name: Session info run: | From 83d93a660ecf03689651708940d7a59e3d9f16a9 Mon Sep 17 00:00:00 2001 From: Shiro Kuriwaki Date: Fri, 6 Mar 2026 16:43:35 -0500 Subject: [PATCH 6/6] Simplify issue message --- .github/ISSUE_TEMPLATE.md | 26 +------------------------- 1 file changed, 1 insertion(+), 25 deletions(-) diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md index 4574f97..20cad8b 100644 --- a/.github/ISSUE_TEMPLATE.md +++ b/.github/ISSUE_TEMPLATE.md @@ -1,25 +1 @@ -Please specify whether your issue is about: - - - [ ] a possible bug - - [ ] a question about package functionality - - [ ] a suggested code or documentation change, improvement to the code, or feature request - -If you are reporting (1) a bug or (2) a question about code, please supply: - - - [a fully reproducible example](http://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example) using a publicly available dataset (or provide your data) - - if an error is occurring, include the output of `traceback()` run immediately after the error occurs - - the output of `sessionInfo()` - -Put your code here: - -```R -## load package -library("dataverse") - -## code goes here - - -## session info for your system -sessionInfo() -``` - +If you are reporting a bug, please supply a reproducible dataset using [reprex](https://reprex.tidyverse.org/).