Signing for AWS requests (#569)

* Add AWS request signing. Fixes #566
* Generalise OAuth signing to any pre-request signature. Fixes #562

DESCRIPTION

@@ -38,6 +38,7 @@ Suggests:
     jsonlite,
     knitr,
     later,
+    paws.common,
     promises,
     rmarkdown,
     testthat (>= 3.1.8),

NAMESPACE

@@ -50,6 +50,7 @@ export(oauth_token)
 export(oauth_token_cached)
 export(obfuscate)
 export(obfuscated)
+export(req_auth_aws_v4)
 export(req_auth_basic)
 export(req_auth_bearer_token)
 export(req_body_file)

NEWS.md

@@ -2,6 +2,7 @@
 
 # httr2 1.0.5
 
+* New `req_auth_aws_v4()` signs request using AWS's special format (#562, #566).
 * `req_perform_parallel()` and `req_perform_promise()` now correctly set up the method and body (#549).
 
 # httr2 1.0.4

R/multi-req.R

@@ -162,7 +162,7 @@ Performance <- R6Class("Performance", public = list(
     self$progress <- progress
     self$error_call <- error_call
 
-    req <- auth_oauth_sign(req)
+    req <- auth_sign(req)
     req <- cache_pre_fetch(req, path)
     if (is_response(req)) {
       self$resp <- req

R/oauth.R

@@ -20,27 +20,25 @@
 #' @export
 req_oauth <- function(req, flow, flow_params, cache) {
   # Want req object to contain meaningful objects, not just a closure
-  req_policies(req,
-    auth_oauth = list(
+  req <- req_auth_sign(req,
+    fun = auth_oauth_sign,
+    params = list(
       cache = cache,
       flow = flow,
       flow_params = flow_params
     )
   )
+  req <- req_policies(req, auth_oauth = TRUE)
+  req
 }
 
-auth_oauth_sign <- function(req, reauth = FALSE) {
-  if (!req_policy_exists(req, "auth_oauth")) {
-    return(req)
-  }
-
+auth_oauth_sign <- function(req, cache, flow, flow_params, reauth = FALSE) {
   token <- auth_oauth_token_get(
-    cache = req$policies$auth_oauth$cache,
-    flow = req$policies$auth_oauth$flow,
-    flow_params = req$policies$auth_oauth$flow_params,
+    cache = cache,
+    flow = flow,
+    flow_params = flow_params,
     reauth = reauth
   )
-
   req_auth_bearer_token(req, token$access_token)
 }
 

R/req-auth-aws.R

@@ -0,0 +1,217 @@
+#' Sign a request with the AWS SigV4 signing protocol
+#'
+#' This is a custom auth protocol implemented by AWS.
+#'
+#' @inheritParams req_perform
+#' @param aws_access_key_id,aws_secret_access_key AWS key and secret.
+#' @param aws_session_token AWS session token, if required.
+#' @param aws_service,aws_region The AWS service and region to use for the
+#'   request. If not supplied, will be automatically parsed from the URL
+#'   hostname.
+#' @export
+#' @examplesIf httr2:::has_paws_credentials()
+#' creds <- paws.common::locate_credentials()
+#' model_id <- "anthropic.claude-3-5-sonnet-20240620-v1:0"
+#' req <- request("https://bedrock-runtime.us-east-1.amazonaws.com")
+#' # https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_Converse.html
+#' req <- req_url_path_append(req, "model", model_id, "converse")
+#' req <- req_body_json(req, list(
+#'   messages = list(list(
+#'     role = "user",
+#'     content = list(list(text = "What's your name?"))
+#'   ))
+#' ))
+#' req <- req_auth_aws_v4(
+#'   req,
+#'   aws_access_key_id = creds$access_key_id,
+#'   aws_secret_access_key = creds$secret_access_key,
+#'   aws_session_token = creds$session_token
+#' )
+#' resp <- req_perform_connection(req)
+#' str(resp_body_json(resp))
+req_auth_aws_v4 <- function(req,
+                            aws_access_key_id,
+                            aws_secret_access_key,
+                            aws_session_token = NULL,
+                            aws_service = NULL,
+                            aws_region = NULL) {
+
+  check_request(req)
+  check_string(aws_access_key_id)
+  check_string(aws_secret_access_key)
+  check_string(aws_session_token, allow_null = TRUE)
+  check_string(aws_service, allow_null = TRUE)
+  check_string(aws_region, allow_null = TRUE)
+
+  req_auth_sign(req,
+    fun = auth_aws_sign,
+    params = list(
+      aws_access_key_id = aws_access_key_id,
+      aws_secret_access_key = aws_secret_access_key,
+      aws_session_token = aws_session_token,
+      aws_service = aws_service,
+      aws_region = aws_region
+    )
+  )
+}
+
+auth_aws_sign <- function(req,
+                          aws_access_key_id,
+                          aws_secret_access_key,
+                          aws_session_token = NULL,
+                          aws_service = NULL,
+                          aws_region = NULL,
+                          reauth = FALSE) {
+
+  current_time <- Sys.time()
+
+  body_sha256 <- openssl::sha256(req_body_get(req))
+
+  # We begin by adding some necessary headers that must be added before
+  # canoncalization even thought they aren't documented until later
+  req <- req_aws_headers(req,
+    current_time = current_time,
+    aws_session_token = aws_session_token,
+    body_sha256 = body_sha256
+  )
+
+  signature <- aws_v4_signature(
+    method = req_method_get(req),
+    url = url_parse(req$url),
+    headers = req$headers,
+    body_sha256 = body_sha256,
+    current_time = current_time,
+    aws_service = aws_service,
+    aws_region = aws_region,
+    aws_access_key_id = aws_access_key_id,
+    aws_secret_access_key = aws_secret_access_key
+  )
+  req_headers(req, Authorization = signature$Authorization)
+}
+
+
+req_aws_headers <- function(req, current_time, aws_session_token, body_sha256) {
+  RequestDateTime <- format(current_time, "%Y%m%dT%H%M%SZ", tz = "UTC")
+
+  req_headers(
+    req,
+    "x-amz-date" = RequestDateTime,
+    "x-amz-security-token" = aws_session_token,
+    .redact = "x-amz-security-token"
+  )
+}
+
+# https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html
+aws_v4_signature <- function(method,
+                             url,
+                             headers,
+                             body_sha256,
+                             aws_access_key_id,
+                             aws_secret_access_key,
+                             current_time = Sys.time(),
+                             aws_service = NULL,
+                             aws_region = NULL) {
+
+  if (is.null(aws_service) || is.null(aws_region)) {
+    host <- strsplit(url$hostname, ".", fixed = TRUE)[[1]]
+    aws_service <- aws_service %||% strsplit(host[[1]], "-", fixed = TRUE)[[1]][[1]]
+    aws_region <- aws_region %||% host[[2]]
+  }
+
+  # 1. Create a canonical request
+  # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html#create-canonical-request
+  HTTPMethod <- method
+  CanonicalURI <- curl::curl_escape(url$path %||% "/")
+  # AWS does not want / to be encoded here
+  CanonicalURI <- gsub("%2F", "/", CanonicalURI, fixed = TRUE)
+
+  if (is.null(url$query)) {
+    CanonicalQueryString <- ""
+  } else {
+    sorted_query <- url$query[order(names(url$query))]
+    CanonicalQueryString <- query_build(CanonicalQueryString)
+  }
+
+  headers$host <- url$hostname
+  names(headers) <- tolower(names(headers))
+  headers <- headers[order(names(headers))]
+  headers[] <- trimws(headers)
+  headers[] <- gsub(" {2,}", " ", headers)
+  CanonicalHeaders <- paste0(names(headers), ":", headers, "\n", collapse = "")
+  SignedHeaders <- paste0(names(headers), collapse = ";")
+
+  CanonicalRequest <- paste0(
+    HTTPMethod, "\n",
+    CanonicalURI, "\n",
+    CanonicalQueryString, "\n",
+    CanonicalHeaders, "\n",
+    SignedHeaders, "\n",
+    body_sha256
+  )
+  # 2. Create the hash of the canonical request
+  # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html
+  HashedCanonicalRequest <- openssl::sha256(CanonicalRequest)
+
+  # 3. Create the string to sign
+  # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html#create-string-to-sign
+
+  Algorithm <- "AWS4-HMAC-SHA256"
+  RequestDateTime <- format(current_time, "%Y%m%dT%H%M%SZ", tz = "UTC")
+  Date <- format(current_time, "%Y%m%d", tz = "UTC")
+  CredentialScope <- file.path(Date, aws_region, aws_service, "aws4_request")
+
+  string_to_sign <- paste0(
+    Algorithm, "\n",
+    RequestDateTime, "\n",
+    CredentialScope, "\n",
+    HashedCanonicalRequest
+  )
+
+  # 4. Derive a signing key
+  # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html#derive-signing-key
+
+  DateKey <- hmac_sha256(paste0("AWS4", aws_secret_access_key), Date)
+  DateRegionKey <- hmac_sha256(DateKey, aws_region)
+  DateRegionServiceKey <- hmac_sha256(DateRegionKey, aws_service)
+  SigningKey <- hmac_sha256(DateRegionServiceKey, "aws4_request")
+
+  # 5. Calculate signature
+  # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html#calculate-signature
+
+  signature <- hmac_sha256(SigningKey, string_to_sign)
+  signature <- paste0(as.character(signature), collapse = "")
+
+  # 6. Add the signature to the request
+  # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html#calculate-signature
+  credential <-  file.path(aws_access_key_id, CredentialScope)
+
+  Authorization <- paste0(
+    Algorithm, ",",
+    "Credential=",    credential, ",",
+    "SignedHeaders=", SignedHeaders, ",",
+    "Signature=",     signature
+  )
+
+  list(
+    CanonicalRequest = CanonicalRequest,
+    string_to_sign = string_to_sign,
+    SigningKey = SigningKey,
+    Authorization = Authorization
+  )
+}
+
+hmac_sha256 <- function(key, value) {
+  openssl::sha256(charToRaw(value), key)
+}
+
+has_paws_credentials <- function() {
+  tryCatch(
+    {
+      paws.common::locate_credentials()
+      TRUE
+    },
+    error = function(e) {
+      FALSE
+    }
+  )
+}

R/req-auth-sign.R

@@ -0,0 +1,20 @@
+
+req_auth_sign <- function(req, fun, params) {
+  req_policies(req,
+    auth_sign = list(
+      fun = fun,
+      params = params
+    )
+  )
+}
+auth_sign <- function(req, reauth = FALSE) {
+  if (!req_policy_exists(req, "auth_sign")) {
+    return(req)
+  }
+
+  exec(req$policies$auth_sign$fun,
+    req = req,
+    reauth = reauth,
+    !!!req$policies$auth_sign$params
+  )
+}

R/req-body.R

@@ -217,6 +217,22 @@ req_body_info <- function(req) {
   }
 }
 
+req_body_get <- function(req) {
+  if (is.null(req$body)) {
+    return("")
+  }
+  switch(
+    req$body$type,
+    raw = req$body$data,
+    form = {
+      data <- unobfuscate(req$body$data)
+      query_build(data)
+    },
+    json = exec(jsonlite::toJSON, req$body$data, !!!req$body$params),
+    cli::cli_abort("Unsupported request body type {.str {req$body$type}}.")
+  )
+}
+
 req_body_apply <- function(req) {
   if (is.null(req$body)) {
     return(req)
@@ -243,14 +259,12 @@ req_body_apply <- function(req) {
   } else if (type == "raw") {
     req <- req_body_apply_raw(req, data)
   } else if (type == "json") {
-    json <- exec(jsonlite::toJSON, data, !!!req$body$params)
-    req <- req_body_apply_raw(req, json)
+    req <- req_body_apply_raw(req, req_body_get(req))
   } else if (type == "multipart") {
     data <- unobfuscate(data)
     req$fields <- data
   } else if (type == "form") {
-    data <- unobfuscate(data)
-    req <- req_body_apply_raw(req, query_build(data))
+    req <- req_body_apply_raw(req, req_body_get(req))
   } else {
     cli::cli_abort("Unsupported request body {.arg type}.", .internal = TRUE)
   }

R/req-perform-connection.R

@@ -37,6 +37,7 @@ req_perform_connection <- function(req, blocking = TRUE) {
   check_request(req)
   check_bool(blocking)
 
+  req <- auth_sign(req)
   req_prep <- req_prepare(req)
   handle <- req_handle(req_prep)
   the$last_request <- req

R/req-perform.R

@@ -87,7 +87,7 @@ req_perform <- function(
   }
 
   req <- req_verbosity(req, verbosity)
-  req <- auth_oauth_sign(req)
+  req <- auth_sign(req)
 
   req <- cache_pre_fetch(req, path)
   if (is_response(req)) {
@@ -131,7 +131,7 @@ req_perform <- function(
       signal(class = "httr2_retry", tries = tries, delay = delay)
     } else if (!reauth && resp_is_invalid_oauth_token(req, resp)) {
       reauth <- TRUE
-      req <- auth_oauth_sign(req, TRUE)
+      req <- auth_sign(req, TRUE)
       req_prep <- req_prepare(req)
       handle <- req_handle(req_prep)
       delay <- 0