From d59954031ca3bea5af60003062c37026ce9f9f29 Mon Sep 17 00:00:00 2001 From: pepijn-devries Date: Wed, 11 Feb 2026 00:34:21 +0100 Subject: [PATCH 1/3] Switched from httr to httr2 dependency --- DESCRIPTION | 4 +- NAMESPACE | 2 +- R/acl.R | 2 +- R/get_object.R | 34 +++- R/policy.R | 2 +- R/put_object.R | 3 +- R/s3HTTP.R | 177 +++++++------------- inst/experiments/post-experiment.Rmd | 17 +- inst/experiments/post-experiment.md | 15 +- man/acl.Rd | 2 +- man/aws.s3-package.Rd | 8 + man/get_object.Rd | 6 +- man/put_bucket.Rd | 2 +- man/put_object.Rd | 2 +- man/s3HTTP.Rd | 11 +- tests/testthat/test-authenticated-bucket.R | 5 + tests/testthat/test-authenticated-object.R | 9 +- tests/testthat/test-authenticated-s3HTTP.R | 18 +- tests/testthat/test-authenticated-service.R | 2 + 19 files changed, 161 insertions(+), 160 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9c11671..73df0ae 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,7 +29,7 @@ Imports: utils, tools, curl, - httr, + httr2, xml2 (> 1.0.0), base64enc, digest, @@ -37,4 +37,4 @@ Imports: Suggests: testthat, datasets -RoxygenNote: 7.1.0 +RoxygenNote: 7.3.2 diff --git a/NAMESPACE b/NAMESPACE index eaa3a39..716193e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -87,7 +87,7 @@ export(save_object) export(saveobject) export(select_object) import(aws.signature) -import(httr) +import(httr2) importFrom(base64enc,base64encode) importFrom(curl,curl) importFrom(curl,handle_setheaders) diff --git a/R/acl.R b/R/acl.R index 4d31340..351fb2c 100644 --- a/R/acl.R +++ b/R/acl.R @@ -35,7 +35,7 @@ get_acl <- function(object, bucket, ...) { parse_response = FALSE, ...) } - return(content(r, "text", encoding = "UTF-8")) + return(httr2::resp_body_string(r, "UTF-8")) } #' @rdname acl diff --git a/R/get_object.R b/R/get_object.R index ed4f855..46dcba7 100644 --- a/R/get_object.R +++ b/R/get_object.R @@ -7,7 +7,9 @@ #' @param request_body For \code{select_object}, an XML request body as described in the \href{https://docs.aws.amazon.com/AmazonS3/latest/API/API_SelectObjectContent.html}{SELECT API documentation}. #' @param headers List of request headers for the REST call. #' @param parse_response Passed through to \code{\link{s3HTTP}}, as this function requires a non-default setting. There is probably no reason to ever change this. -#' @param as Passed through to \code{httr::content}. +#' @param as Should be one of `"raw"` (returns a vector of `raw` data), +#' `"text"` (returns a `character` string), or `"parsed"`. The latter will +#' attempt to parse the content to an appropriate R object. #' @template dots #' @details \code{get_object} retrieves an object into memory as a raw vector. This page describes \code{get_object} and several wrappers that provide additional useful functionality. #' @@ -92,12 +94,29 @@ function(object, headers = headers, parse_response = parse_response, ...) - cont <- httr::content(r, as = as) + cont <- + switch( + as, + text = { httr2::resp_body_string(r) }, + raw = { httr2::resp_body_raw(r) }, + parsed = { + ctype <- httr2::resp_content_type(r) + switch( + ctype, + `application/json` = { httr2::resp_body_json(r) }, + `text/xml` = { httr2::resp_body_xml() }, + `application/xml` = { httr2::resp_body_xml() }, + `text/html` = { httr2::resp_body_html() }, + { httr2::resp_body_raw() }, + ) + }, + { httr2::resp_body_raw() } + ) return(cont) } #' @rdname get_object -#' @param overwrite A logical indicating whether to overwrite \code{file}. Passed to \code{\link[httr]{write_disk}}. Default is \code{TRUE}. +#' @param overwrite A logical indicating whether to overwrite \code{file}. #' @export save_object <- function(object, @@ -117,12 +136,13 @@ function(object, dir.create(d, recursive = TRUE) } - # use httr::write_disk() to write directly to disk + if (!overwrite && file.exists(file)) + stop(sprintf("File '%s' already exists. Set 'overwrite' to TRUE, to overwrite")) r <- s3HTTP(verb = "GET", bucket = bucket, path = paste0("/", object), headers = headers, - write_disk = httr::write_disk(path = file, overwrite = overwrite), + file = file, ...) return(file) } @@ -151,7 +171,7 @@ function( request_body = request_body, parse_response = parse_response, ...) - cont <- httr::content(r, as = "raw") + cont <- httr2::resp_body_raw(r) return(cont) } @@ -175,7 +195,7 @@ get_torrent <- function(object, bucket, ...) { path = paste0("/", object), query = list(torrent =""), ...) - return(content(r, "raw")) + return(httr2::resp_body_raw(r)) } #' @rdname get_object diff --git a/R/policy.R b/R/policy.R index 921ec9d..d9e5119 100644 --- a/R/policy.R +++ b/R/policy.R @@ -19,7 +19,7 @@ get_bucket_policy <- function(bucket, parse_response = TRUE, ...){ parse_response = FALSE, ...) if (isTRUE(parse_response)) { - r <- httr::content(r, "text", encoding = "UTF-8") + r <- httr2::resp_body_string(r, "UTF-8") } return(r) } diff --git a/R/put_object.R b/R/put_object.R index fdef0fa..76d5fa6 100644 --- a/R/put_object.R +++ b/R/put_object.R @@ -249,7 +249,8 @@ function( if (!is.na(size) && size > partsize) message("File size is ", size, ", consider setting using multipart=TRUE") - ## httr doesn't support connections so we have to read it all into memory first + ## httr2 doesn't support connections as request body, + ## so we have to read it all into memory first if (inherits(what, "connection")) { con <- what if (!isOpen(con, "r")) diff --git a/R/s3HTTP.R b/R/s3HTTP.R index b4e6d0b..096ec1e 100644 --- a/R/s3HTTP.R +++ b/R/s3HTTP.R @@ -7,8 +7,10 @@ #' @param query Any query arguments, passed as a named list of key-value pairs. #' @param headers A list of request headers for the REST call. #' @param request_body A character string containing request body data. -#' @param write_disk If \code{verb = "GET"}, this is, optionally, an argument like \code{\link[httr]{write_disk}} to write the result directly to disk. -#' @param write_fn If set to a function and \code{verb = "GET"} is used then the output is passed in chunks as a raw vector in the first argument to this function, allowing streaming output. Note that \code{write_disk} and \code{write_fn} are mutually exclusive. +#' @param write_disk,write_fn Deprecated. argument not supported by `httr2`. +#' Use `verb="connection"` or `file` instead. +#' @param file File path. If specified and `verb="GET"` the response content +#' will be written to this file. #' @param accelerate A logical indicating whether to use AWS transfer acceleration, which can produce significant speed improvements for cross-country transfers. Acceleration only works with buckets that do not have dots in bucket name. #' @param dualstack A logical indicating whether to use \dQuote{dual stack} requests, which can resolve to either IPv4 or IPv6. See \url{https://docs.aws.amazon.com/AmazonS3/latest/API/dual-stack-endpoints.html}. #' @param parse_response A logical indicating whether to return the response as is, or parse and return as a list. Default is \code{TRUE}. @@ -24,7 +26,7 @@ #' @param use_https Optionally, a logical indicating whether to use HTTPS requests. Default is \code{TRUE}. #' @param ... Additional arguments passed to an HTTP request function. such as \code{\link[httr]{GET}}. #' @return the S3 response, or the relevant error. -#' @import httr +#' @import httr2 #' @importFrom xml2 read_xml as_list #' @importFrom utils URLencode #' @importFrom curl handle_setheaders new_handle curl @@ -37,8 +39,9 @@ function(verb = "GET", query = NULL, headers = list(), request_body = "", - write_disk = NULL, - write_fn = NULL, + file, + write_disk, + write_fn, accelerate = FALSE, dualstack = FALSE, parse_response = TRUE, @@ -53,7 +56,7 @@ function(verb = "GET", session_token = NULL, use_https = TRUE, ...) { - + #TODO test deprecated args # locate and validate credentials credentials <- aws.signature::locate_credentials(key = key, secret = secret, session_token = session_token, region = region, verbose = verbose) key <- credentials[["key"]] @@ -62,17 +65,6 @@ function(verb = "GET", ## allow region="" to override any config - the only way to use 3rd party URLs without region region <- if (length(region) && !nzchar(region)) region else credentials[["region"]] - # handle 'show_progress' argument - if (isTRUE(show_progress)) { - if (verb %in% c("GET")) { - show_progress <- httr::progress(type = "down") - } else { - show_progress <- httr::progress(type = "up") - } - } else { - show_progress <- NULL - } - # validate bucket name and region bucketname <- get_bucketname(bucket) if (isTRUE(check_region) && (bucketname != "")) { @@ -94,21 +86,31 @@ function(verb = "GET", url_style <- match.arg(url_style) url <- setup_s3_url(bucketname, region, path, accelerate, url_style = url_style, base_url = base_url, verbose = verbose, use_https = use_https) - p <- httr::parse_url(url) - action <- if (p$path == "") "/" else paste0("/", p$path) + p <- httr2::url_parse(url) + request <- + httr2::request(url) |> + httr2::req_method(ifelse(verb == "connection", "GET", verb)) + request <- + do.call(httr2::req_url_query, c(list(.req = request), query)) + + if (show_progress) request <- httr2::req_progress(request) + + action <- p$path hostname <- paste(p$hostname, p$port, sep=ifelse(length(p$port), ":", "")) # parse headers - canonical_headers <- c(list(host = hostname, - `x-amz-date` = d_timestamp), headers) - headers[["x-amz-date"]] <- d_timestamp - # parse query arguments - if (is.null(query) && !is.null(p$query)) { - query <- p[["query"]] - } - if (all(sapply(query, is.null))) { - query <- NULL - } + request <- do.call(httr2::req_headers, c( + list(.req = request, + host = hostname, + `x-amz-date` = d_timestamp), headers)) + + # # parse query arguments TODO this is handled by httr2::request + # if (is.null(query) && !is.null(p$query)) { + # query <- p[["query"]] + # } + # if (all(sapply(query, is.null))) { + # query <- NULL + # } # assess whether request is authenticated or not if (is.null(key) || key == "") { if (isTRUE(verbose)) { @@ -128,9 +130,8 @@ function(verb = "GET", body_hash <- tolower(digest::digest(request_body, file = is.character(request_body) && file.exists(request_body), algo = "sha256", serialize = FALSE)) - - canonical_headers[["x-amz-content-sha256"]] <- - headers[["x-amz-content-sha256"]] <- body_hash + request <- request |> + httr2::req_headers(`x-amz-content-sha256` = body_hash) Sig <- aws.signature::signature_v4_auth( datetime = d_timestamp, @@ -140,94 +141,44 @@ function(verb = "GET", verb = if (verb == "connection") "GET" else verb, action = action, query_args = query, - canonical_headers = canonical_headers, + canonical_headers = httr2::req_headers(request), request_body = request_body, key = key, secret = secret, session_token = session_token, verbose = verbose) if (!is.null(session_token) && session_token != "") { - headers[["x-amz-security-token"]] <- session_token + request <- request |> + httr2::req_headers(`x-amz-security-token` = session_token) } - headers[["Authorization"]] <- Sig[["SignatureHeader"]] + request <- request |> + httr2::req_headers(`Authorization` = Sig[["SignatureHeader"]]) } - H <- do.call(httr::add_headers, headers) - # execute request - if (verb == "GET") { - # GET verb - r <- if (is.function(write_fn)) { - if (!is.null(write_disk)) stop("write_stream and write_disk are mutually exclusive.") - httr::GET(url, H, query = query, httr::write_stream(write_fn), show_progress, ...) - } else if (!is.null(write_disk)) { - httr::GET(url, H, query = query, write_disk, show_progress, ...) + if (verb %in% c("POST", "PUT")) { + # POST or PUT verb + if (is.character(request_body) && file.exists(request_body)) { + request <- request |> + httr2::req_body_file(request_body) } else { - httr::GET(url, H, query = query, show_progress, ...) + request <- request |> + httr2::req_body_raw(request_body) } - } else if (verb == "connection") { - # support for a streaming GET connection - stream_handle <- curl::new_handle() - curl::handle_setheaders(stream_handle, .list = headers) - connection <- curl::curl(url, open = "rb", handle = stream_handle) - return(connection) - } else if (verb == "HEAD") { - # HEAD verb - r <- httr::HEAD(url, H, query = query, ...) - s <- httr::http_status(r) - if (tolower(s$category) == "success") { - out <- TRUE - attributes(out) <- c(attributes(out), httr::headers(r)) - return(out) - } else { - message(s$message) - out <- FALSE - attributes(out) <- c(attributes(out), httr::headers(r)) - return(out) - } - } else if (verb == "DELETE") { - # DELETE verb - r <- httr::DELETE(url, H, query = query, ...) - s <- httr::http_status(r) - if (tolower(s$category) == "success") { - out <- TRUE - attributes(out) <- c(attributes(out), httr::headers(r)) - return(out) - } else { - message(s$message) - out <- FALSE - attributes(out) <- c(attributes(out), httr::headers(r)) - return(out) - } - } else if (verb == "POST") { - # POST verb - if (is.character(request_body) && request_body == "") { - r <- httr::POST(url, H, query = query, show_progress, ...) - } else if (is.character(request_body) && file.exists(request_body)) { - r <- httr::POST(url, H, body = httr::upload_file(request_body), query = query, show_progress, ...) - } else { - r <- httr::POST(url, H, body = request_body, query = query, show_progress, ...) - } - } else if (verb == "PUT") { - # PUT verb - if (is.character(request_body) && request_body == "") { - r <- httr::PUT(url, H, query = query, show_progress, ...) - } else if (is.character(request_body) && file.exists(request_body)) { - r <- httr::PUT(url, H, body = httr::upload_file(request_body), query = query, show_progress, ...) - } else { - r <- httr::PUT(url, H, body = request_body, query = query, show_progress, ...) - } - } else if (verb == "OPTIONS") { - # OPTIONS verb - r <- httr::VERB("OPTIONS", url, H, query = query, ...) } + if (verb == "connection") { + return(httr2::req_perform_connection(request)$body) + } else { + r <- httr2::req_perform(request) + } + # handle response, failing if HTTP error occurs if (isTRUE(parse_response)) { out <- parse_aws_s3_response(r, Sig, verbose = verbose) } else { out <- r } - attributes(out) <- c(attributes(out), httr::headers(r)) + attributes(out) <- c(attributes(out), httr2::resp_headers(r)) out } @@ -235,29 +186,19 @@ parse_aws_s3_response <- function(r, Sig, verbose = getOption("verbose")){ if (isTRUE(verbose)) { message("Parsing AWS API response") } - ctype <- httr::headers(r)[["content-type"]] + ctype <- httr2::resp_header(r, "content-type") if (is.null(ctype) || ctype == "application/xml"){ - content <- httr::content(r, as = "text", encoding = "UTF-8") - if (content != "") { - response_contents <- xml2::as_list(xml2::read_xml(content)) - response <- flatten_list(response_contents) - } else { - response <- NULL - } + response <- httr2::resp_body_xml(r) |> + xml2::as_list() |> + flatten_list() } else { response <- r } if (isTRUE(verbose)) { - message(httr::http_status(r)[["message"]]) + message(sprintf("%s: %s", httr2::resp_status(r), httr2::resp_status_desc(r))) } - if (httr::http_error(r) | (httr::http_status(r)[["category"]] == "Redirection")) { - h <- httr::headers(r) - out <- structure(response, headers = h, class = "aws_error") - attr(out, "request_canonical") <- Sig$CanonicalRequest - attr(out, "request_string_to_sign") <- Sig$StringToSign - attr(out, "request_signature") <- Sig$SignatureHeader - print(out) - httr::stop_for_status(r) + if (floor(httr2::resp_status(r)/100) == 3) { + stop("Unexpected redirection") } return(response) } diff --git a/inst/experiments/post-experiment.Rmd b/inst/experiments/post-experiment.Rmd index f432106..9c849a5 100644 --- a/inst/experiments/post-experiment.Rmd +++ b/inst/experiments/post-experiment.Rmd @@ -1,5 +1,5 @@ ```{r} -library("httr") +library("httr2") library("caTools") library("digest") library("aws.signature") @@ -24,7 +24,7 @@ acl = "private" Compute some parameters needed by the API ```{r} - # Same results from each, documentation unclear which is prefered (for non-default (east-us-1) region) + # Same results from each, documentation unclear which is preferred (for non-default (east-us-1) region) url <- paste0("https://s3-", region, ".amazonaws.com/", bucket) url <- paste0("https://", bucket, ".s3-", region, ".amazonaws.com") @@ -86,19 +86,24 @@ In a POST request, it [looks like](https://raam.org/2008/using-curl-to-upload-fi fields$`x-amz-date` <- d_timestamp ``` -Here we add the policy in base64, and then add this to the signature digest. Last, we include the file with `httr::upload_file()` +Here we add the policy in base64, and then add this to the signature digest. Last, we include the file with `curl::form_file()` ```{r} fields$Policy <- caTools::base64encode(as.character(policy)) fields$`x-amz-signature` <- digest::hmac(Sig$Signature, fields$Policy, "sha256") - fields$file <- httr::upload_file(filename) + fields$file <- curl::form_file(filename) ``` Let's give this a try: ```{r} - r <- httr::POST(url, encode="multipart", body = fields) - content(r) + request <- + request(url) |> + req_method("POST") + request <- do.call(req_body_multipart, c(list(.req = request), fields)) + request |> + req_perform() |> + resp_body_raw() ``` diff --git a/inst/experiments/post-experiment.md b/inst/experiments/post-experiment.md index 667ea68..11d2b4a 100644 --- a/inst/experiments/post-experiment.md +++ b/inst/experiments/post-experiment.md @@ -1,6 +1,6 @@ ```r -library("httr") +library("httr2") library("caTools") library("digest") library("aws.signature") @@ -92,21 +92,26 @@ In a POST request, it [looks like](https://raam.org/2008/using-curl-to-upload-fi fields$`x-amz-date` <- d_timestamp ``` -Here we add the policy in base64, and then add this to the signature digest. Last, we include the file with `httr::upload_file()` +Here we add the policy in base64, and then add this to the signature digest. Last, we include the file with `curl::form_file()` ```r fields$Policy <- caTools::base64encode(as.character(policy)) fields$`x-amz-signature` <- digest::hmac(Sig$Signature, fields$Policy, "sha256") - fields$file <- httr::upload_file(filename) + fields$file <- curl::form_file(filename) ``` Let's give this a try: ```r - r <- httr::POST(url, encode="multipart", body = fields) - content(r) + request <- + request(url) |> + req_method("POST") + request <- do.call(req_body_multipart, c(list(.req = request), fields)) + request |> + req_perform() |> + resp_body_raw() ``` diff --git a/man/acl.Rd b/man/acl.Rd index 0d5729c..e53bfe5 100644 --- a/man/acl.Rd +++ b/man/acl.Rd @@ -16,7 +16,7 @@ put_acl(object, bucket, acl = NULL, headers = list(), body = NULL, ...) \item{\dots}{Additional arguments passed to \code{\link{s3HTTP}}.} -\item{acl}{A character string indicating a \href{https://docs.aws.amazon.com/AmazonS3/latest/userguide/acl-overview.html#canned-acl}{\dQuote{canned} access control list}. By default all bucket contents and objects therein are given the ACL \dQuote{private}. This can later be viewed using \code{\link{get_acl}} and modified using \code{\link{put_acl}}.} +\item{acl}{A character string indicating a \href{http://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#canned-acl}{\dQuote{canned} access control list}. By default all bucket contents and objects therein are given the ACL \dQuote{private}. This can later be viewed using \code{\link{get_acl}} and modified using \code{\link{put_acl}}.} \item{headers}{List of request headers for the REST call} diff --git a/man/aws.s3-package.Rd b/man/aws.s3-package.Rd index 86ac359..322e70b 100644 --- a/man/aws.s3-package.Rd +++ b/man/aws.s3-package.Rd @@ -10,6 +10,14 @@ AWS S3 Client Package } \details{ A simple client package for the Amazon Web Services (AWS) Simple Storage Service (S3) REST API. +} +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/cloudyr/aws.s3} + \item Report bugs at \url{https://github.com/cloudyr/aws.s3/issues} +} + } \author{ Thomas J. Leeper diff --git a/man/get_object.Rd b/man/get_object.Rd index 415e231..10963fa 100644 --- a/man/get_object.Rd +++ b/man/get_object.Rd @@ -45,13 +45,15 @@ s3connection(object, bucket, headers = list(), ...) \item{parse_response}{Passed through to \code{\link{s3HTTP}}, as this function requires a non-default setting. There is probably no reason to ever change this.} -\item{as}{Passed through to \code{httr::content}.} +\item{as}{Should be one of `"raw"` (returns a vector of `raw` data), +`"text"` (returns a `character` string), or `"parsed"`. The latter will +attempt to parse the content to an appropriate R object.} \item{\dots}{Additional arguments passed to \code{\link{s3HTTP}}.} \item{file}{An R connection, or file name specifying the local file to save the object into.} -\item{overwrite}{A logical indicating whether to overwrite \code{file}. Passed to \code{\link[httr]{write_disk}}. Default is \code{TRUE}.} +\item{overwrite}{A logical indicating whether to overwrite \code{file}.} \item{request_body}{For \code{select_object}, an XML request body as described in the \href{https://docs.aws.amazon.com/AmazonS3/latest/API/API_SelectObjectContent.html}{SELECT API documentation}.} } diff --git a/man/put_bucket.Rd b/man/put_bucket.Rd index d78c516..f763291 100644 --- a/man/put_bucket.Rd +++ b/man/put_bucket.Rd @@ -19,7 +19,7 @@ put_bucket( \item{region}{A character string containing the AWS region. If missing, defaults to value of environment variable \env{AWS_DEFAULT_REGION}.} -\item{acl}{A character string indicating a \href{https://docs.aws.amazon.com/AmazonS3/latest/userguide/acl-overview.html#canned-acl}{\dQuote{canned} access control list}. By default all bucket contents and objects therein are given the ACL \dQuote{private}. This can later be viewed using \code{\link{get_acl}} and modified using \code{\link{put_acl}}.} +\item{acl}{A character string indicating a \href{http://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#canned-acl}{\dQuote{canned} access control list}. By default all bucket contents and objects therein are given the ACL \dQuote{private}. This can later be viewed using \code{\link{get_acl}} and modified using \code{\link{put_acl}}.} \item{location_constraint}{A character string specifying a location constraint. If \code{NULL} (for example, for S3-compatible storage), no LocationConstraint body is passed.} diff --git a/man/put_object.Rd b/man/put_object.Rd index 49c7ade..2642019 100644 --- a/man/put_object.Rd +++ b/man/put_object.Rd @@ -30,7 +30,7 @@ put_folder(folder, bucket, ...) \item{multipart}{A logical indicating whether to use multipart uploads. See \url{https://docs.aws.amazon.com/AmazonS3/latest/userguide/mpuoverview.html}. If the content is smaller than \code{partsize} it is ignored.} -\item{acl}{A character string indicating a \href{https://docs.aws.amazon.com/AmazonS3/latest/userguide/acl-overview.html#canned-acl}{\dQuote{canned} access control list}. By default all bucket contents and objects therein are given the ACL \dQuote{private}. This can later be viewed using \code{\link{get_acl}} and modified using \code{\link{put_acl}}.} +\item{acl}{A character string indicating a \href{http://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#canned-acl}{\dQuote{canned} access control list}. By default all bucket contents and objects therein are given the ACL \dQuote{private}. This can later be viewed using \code{\link{get_acl}} and modified using \code{\link{put_acl}}.} \item{file}{string, path to a file to store. Mutually exclusive with \code{what}.} diff --git a/man/s3HTTP.Rd b/man/s3HTTP.Rd index 96ffb54..a995fb5 100644 --- a/man/s3HTTP.Rd +++ b/man/s3HTTP.Rd @@ -11,8 +11,9 @@ s3HTTP( query = NULL, headers = list(), request_body = "", - write_disk = NULL, - write_fn = NULL, + file, + write_disk, + write_fn, accelerate = FALSE, dualstack = FALSE, parse_response = TRUE, @@ -42,9 +43,11 @@ s3HTTP( \item{request_body}{A character string containing request body data.} -\item{write_disk}{If \code{verb = "GET"}, this is, optionally, an argument like \code{\link[httr]{write_disk}} to write the result directly to disk.} +\item{file}{File path. If specified and `verb="GET"` the response content +will be written to this file.} -\item{write_fn}{If set to a function and \code{verb = "GET"} is used then the output is passed in chunks as a raw vector in the first argument to this function, allowing streaming output. Note that \code{write_disk} and \code{write_fn} are mutually exclusive.} +\item{write_disk, write_fn}{Deprecated. argument not supported by `httr2`. +Use `verb="connection"` or `file` instead.} \item{accelerate}{A logical indicating whether to use AWS transfer acceleration, which can produce significant speed improvements for cross-country transfers. Acceleration only works with buckets that do not have dots in bucket name.} diff --git a/tests/testthat/test-authenticated-bucket.R b/tests/testthat/test-authenticated-bucket.R index d6166bd..b570418 100644 --- a/tests/testthat/test-authenticated-bucket.R +++ b/tests/testthat/test-authenticated-bucket.R @@ -1,6 +1,7 @@ context("Authenticated bucket tests") test_that("basic usage of getbucket for signed in user", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") ex <- get_bucket( bucket = 'hpk', key = Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID"), @@ -18,6 +19,7 @@ test_that("basic usage of getbucket for signed in user", { test_that("unparsed getbucket", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") ex <- get_bucket( bucket = 'hpk', key = Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID"), @@ -35,6 +37,7 @@ test_that("unparsed getbucket", { test_that("get_cors on a bucket with no cors setup", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") expect_error(get_cors( bucket = 'hpk', key = Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID"), @@ -44,6 +47,7 @@ test_that("get_cors on a bucket with no cors setup", { test_that("putbucket and deletebucket", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") test_name <- paste0('cloudyr_test_', gsub('\\s', '_', gsub('[-:]', '_', Sys.time()))) resp <- put_bucket( @@ -62,6 +66,7 @@ test_that("putbucket and deletebucket", { }) test_that("bucket versioning", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") test_name <- paste0('cloudyr_test_', gsub('\\s', '_', gsub('[-:]', '_', Sys.time()))) resp <- put_bucket( diff --git a/tests/testthat/test-authenticated-object.R b/tests/testthat/test-authenticated-object.R index 4d0902c..1d1c311 100644 --- a/tests/testthat/test-authenticated-object.R +++ b/tests/testthat/test-authenticated-object.R @@ -3,6 +3,7 @@ context("Authenticated object tests") require("datasets") test_that("basic usage of getobject for signed in user", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") ex <- get_object( object = 'robots.txt', bucket = 'hpk', @@ -20,6 +21,7 @@ test_that("basic usage of getobject for signed in user", { }) test_that("basic usage of putobject and deleteobject for signed in user", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") tmp <- tempfile(fileext = ".txt") writeLines(c("cloudyr", "test"), tmp) @@ -44,7 +46,8 @@ test_that("basic usage of putobject and deleteobject for signed in user", { }) test_that("basic usage of s3save and s3load", { - + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") + p <- s3save( iris, object = "iris-dataset", @@ -67,7 +70,8 @@ test_that("basic usage of s3save and s3load", { }) test_that("basic usage of s3saveRDS and s3readRDS", { - + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") + p <- s3saveRDS( iris, object = "iris-dataset", @@ -90,6 +94,7 @@ test_that("basic usage of s3saveRDS and s3readRDS", { }) test_that("putobject and deleteobject handle object names with spaces and special characters", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") tmp <- tempfile(pattern = 'tricky file name &$@=:+,? ', fileext = ".txt") writeLines(c("cloudyr", "test"), tmp) diff --git a/tests/testthat/test-authenticated-s3HTTP.R b/tests/testthat/test-authenticated-s3HTTP.R index 5e09ce3..84a79cd 100644 --- a/tests/testthat/test-authenticated-s3HTTP.R +++ b/tests/testthat/test-authenticated-s3HTTP.R @@ -1,14 +1,15 @@ context("Authenticated s3HTTP tests") -requireNamespace("httr") +requireNamespace("httr2") test_that("Simple GET bucket call to s3HTTP returns status code 200", { +skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") r <- s3HTTP(verb = "GET", bucket = 'hpk', region = "us-east-1", key = Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID"), secret = Sys.getenv("TRAVIS_AWS_SECRET_ACCESS_KEY"), parse_response = FALSE) - expect_equal(httr::status_code(r), 200L) + expect_equal(httr2::resp_status(r), 200L) r2 <- s3HTTP(verb = "GET", bucket = 'hpk', @@ -18,18 +19,20 @@ r <- s3HTTP(verb = "GET", }) test_that("GET bucket call to s3HTTP using query parameters", { +skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") r2 <- s3HTTP(verb = "GET", bucket = 'hpk', query = list("max-keys" = "2", prefix="index"), key = Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID"), secret = Sys.getenv("TRAVIS_AWS_SECRET_ACCESS_KEY"), parse_response = FALSE) -expect_equal(httr::status_code(r2), 200L) +expect_equal(httr2::resp_status(r2), 200L) }) test_that("Simple GET object call to s3HTTP returns code 200", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") r <- s3HTTP(verb = "GET", bucket = 'hpk', path = "/robots.txt", @@ -37,7 +40,7 @@ test_that("Simple GET object call to s3HTTP returns code 200", { key = Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID"), secret = Sys.getenv("TRAVIS_AWS_SECRET_ACCESS_KEY"), parse_response = FALSE) - expect_equal(httr::status_code(r), 200L) + expect_equal(httr2::resp_status(r), 200L) ## Should be response object even if we don't ask for parsing, since we cannot assume how to parse robots.txt r <- s3HTTP(verb = "GET", @@ -46,13 +49,14 @@ test_that("Simple GET object call to s3HTTP returns code 200", { region = "us-east-1", key = Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID"), secret = Sys.getenv("TRAVIS_AWS_SECRET_ACCESS_KEY")) - expect_equal(httr::status_code(r), 200L) + expect_equal(httr2::resp_status(r), 200L) }) test_that("PUT works", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") tmp <- tempfile(fileext = ".txt") writeLines(c("cloudyr", "test"), tmp) @@ -65,7 +69,7 @@ test_that("PUT works", { secret = Sys.getenv("TRAVIS_AWS_SECRET_ACCESS_KEY"), parse_response = FALSE ) - expect_equal(httr::status_code(p), 200L) + expect_equal(httr2::resp_status(p), 200L) p <- s3HTTP(verb = "DELETE", path = paste0("/", basename(tmp)), @@ -74,7 +78,7 @@ test_that("PUT works", { secret = Sys.getenv("TRAVIS_AWS_SECRET_ACCESS_KEY"), parse_response = FALSE ) -# expect_equal(httr::status_code(p), 200L) +# expect_equal(httr2::resp_status(p), 200L) ## Currently doesn't return a response object even when asked not to parse expect_true(p) diff --git a/tests/testthat/test-authenticated-service.R b/tests/testthat/test-authenticated-service.R index e92c7a0..3e9c651 100644 --- a/tests/testthat/test-authenticated-service.R +++ b/tests/testthat/test-authenticated-service.R @@ -1,6 +1,7 @@ context("Authenticated service tests") test_that("basic usage of bucketlist", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") bl <- bucketlist( key = Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID"), secret = Sys.getenv("TRAVIS_AWS_SECRET_ACCESS_KEY") @@ -12,6 +13,7 @@ test_that("basic usage of bucketlist", { test_that("unparsed bucketlist", { + skip_if(Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID") == "") bl <- bucketlist( key = Sys.getenv("TRAVIS_AWS_ACCESS_KEY_ID"), secret = Sys.getenv("TRAVIS_AWS_SECRET_ACCESS_KEY"), From f6ec505794cb1c6e038c10d1309192c72d5dd4c4 Mon Sep 17 00:00:00 2001 From: pepijn-devries Date: Wed, 11 Feb 2026 08:30:18 +0100 Subject: [PATCH 2/3] Throw error with clear message when deprecated arguments are used --- R/s3HTTP.R | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/R/s3HTTP.R b/R/s3HTTP.R index 096ec1e..4a148de 100644 --- a/R/s3HTTP.R +++ b/R/s3HTTP.R @@ -7,7 +7,7 @@ #' @param query Any query arguments, passed as a named list of key-value pairs. #' @param headers A list of request headers for the REST call. #' @param request_body A character string containing request body data. -#' @param write_disk,write_fn Deprecated. argument not supported by `httr2`. +#' @param write_disk,write_fn Deprecated. Argument not supported by `httr2`. #' Use `verb="connection"` or `file` instead. #' @param file File path. If specified and `verb="GET"` the response content #' will be written to this file. @@ -56,7 +56,10 @@ function(verb = "GET", session_token = NULL, use_https = TRUE, ...) { - #TODO test deprecated args + if (!missing(write_disk) || !missing(write_fn)) + stop(paste("Arguments `write_disk` and `write_fn` are deprecated.", + "Use `file` argument instead", sep = "\n")) + # locate and validate credentials credentials <- aws.signature::locate_credentials(key = key, secret = secret, session_token = session_token, region = region, verbose = verbose) key <- credentials[["key"]] @@ -104,13 +107,6 @@ function(verb = "GET", host = hostname, `x-amz-date` = d_timestamp), headers)) - # # parse query arguments TODO this is handled by httr2::request - # if (is.null(query) && !is.null(p$query)) { - # query <- p[["query"]] - # } - # if (all(sapply(query, is.null))) { - # query <- NULL - # } # assess whether request is authenticated or not if (is.null(key) || key == "") { if (isTRUE(verbose)) { From 80f4fedfc2be17b727c5a4e5c771fa7d56563d17 Mon Sep 17 00:00:00 2001 From: pepijn-devries Date: Wed, 11 Feb 2026 10:27:27 +0100 Subject: [PATCH 3/3] The s3 service seems extremely sensitive to header field order during authentication. Switched back to original implementation which seems to work --- R/s3HTTP.R | 53 +++++++++++++++++++++++++-------------------------- man/s3HTTP.Rd | 2 +- 2 files changed, 27 insertions(+), 28 deletions(-) diff --git a/R/s3HTTP.R b/R/s3HTTP.R index 4a148de..c92fb9b 100644 --- a/R/s3HTTP.R +++ b/R/s3HTTP.R @@ -102,22 +102,19 @@ function(verb = "GET", hostname <- paste(p$hostname, p$port, sep=ifelse(length(p$port), ":", "")) # parse headers - request <- do.call(httr2::req_headers, c( - list(.req = request, - host = hostname, - `x-amz-date` = d_timestamp), headers)) - + canonical_headers <- c(list(host = hostname, + `x-amz-date` = d_timestamp), headers) + headers[["x-amz-date"]] <- d_timestamp + # assess whether request is authenticated or not if (is.null(key) || key == "") { if (isTRUE(verbose)) { message("Executing request without AWS credentials") } - Sig <- list() } else { # if authenticated, figure out the request signature if (isTRUE(verbose)) message("Executing request with AWS credentials") - ## we need to augment canonical headers with ## x-amz-content-sha256 since signature_v4_auth() doesn't do it ## the following is what signature_v4_auth() does and it's terribly fragile! @@ -126,30 +123,32 @@ function(verb = "GET", body_hash <- tolower(digest::digest(request_body, file = is.character(request_body) && file.exists(request_body), algo = "sha256", serialize = FALSE)) - request <- request |> - httr2::req_headers(`x-amz-content-sha256` = body_hash) - + + canonical_headers[["x-amz-content-sha256"]] <- + headers[["x-amz-content-sha256"]] <- body_hash + Sig <- aws.signature::signature_v4_auth( - datetime = d_timestamp, - region = region, - service = "s3", - # For s3connection() we hack the 'verb' argument. It's otherwise a GET request. - verb = if (verb == "connection") "GET" else verb, - action = action, - query_args = query, - canonical_headers = httr2::req_headers(request), - request_body = request_body, - key = key, - secret = secret, - session_token = session_token, - verbose = verbose) + datetime = d_timestamp, + region = region, + service = "s3", + # For s3connection() we hack the 'verb' argument. It's otherwise a GET request. + verb = if (verb == "connection") "GET" else verb, + action = action, + query_args = query, + canonical_headers = canonical_headers, + request_body = request_body, + key = key, + secret = secret, + session_token = session_token, + verbose = verbose) if (!is.null(session_token) && session_token != "") { - request <- request |> - httr2::req_headers(`x-amz-security-token` = session_token) + headers[["x-amz-security-token"]] <- session_token } - request <- request |> - httr2::req_headers(`Authorization` = Sig[["SignatureHeader"]]) + headers[["Authorization"]] <- Sig[["SignatureHeader"]] } + request <- + do.call(httr2::req_headers, c(list(.req = request), headers)) + # execute request if (verb %in% c("POST", "PUT")) { # POST or PUT verb diff --git a/man/s3HTTP.Rd b/man/s3HTTP.Rd index a995fb5..38a308c 100644 --- a/man/s3HTTP.Rd +++ b/man/s3HTTP.Rd @@ -46,7 +46,7 @@ s3HTTP( \item{file}{File path. If specified and `verb="GET"` the response content will be written to this file.} -\item{write_disk, write_fn}{Deprecated. argument not supported by `httr2`. +\item{write_disk, write_fn}{Deprecated. Argument not supported by `httr2`. Use `verb="connection"` or `file` instead.} \item{accelerate}{A logical indicating whether to use AWS transfer acceleration, which can produce significant speed improvements for cross-country transfers. Acceleration only works with buckets that do not have dots in bucket name.}