Enrich error message

paws.common/DESCRIPTION

@@ -39,7 +39,7 @@ Suggests:
     testthat (>= 3.0.0)
 SystemRequirements: pandoc (>= 1.12.3) - http://pandoc.org
 Roxygen: list(markdown = TRUE, roclets = c("rd", "namespace", "collate"))
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Collate:
     'RcppExports.R'
     'util.R'
@@ -61,11 +61,13 @@ Collate:
     'service.R'
     'custom_dynamodb.R'
     'custom_rds.R'
+    'head_bucket.R'
+    'http_status.R'
+    'error.R'
     'tags.R'
     'xmlutil.R'
     'stream.R'
     'custom_s3.R'
-    'error.R'
     'handlers_core.R'
     'handlers_ec2query.R'
     'handlers_jsonrpc.R'

paws.common/NEWS.md

@@ -2,6 +2,28 @@
 * fix `transpose` to correctly parse lists with empty first elements (#791), thanks to @FMKerckhof for raising issue.
 * support refreshable credentials for `sso` (#793)
 * fix region redirect for aws s3 buckets (#788) thanks to @payam-delfi for identifying issue
+* enrich error messages to align with boto3 error message template:
+```r
+# previous error message format
+svc <- paws.storage::s3()
+response <- svc$get_object(
+  Bucket = "<bucket>",
+  Key = "<key>",
+  IfNoneMatch = "<etag>"
+)
+#> Error: SerializationError (HTTP 304). failed to read from query HTTP response body
+```
+```r
+# new error message format
+client <- paws.storage::s3()
+resp <- client$get_object(
+  Bucket = "<bucket>",
+  Key = "<key>",
+  IfNoneMatch = "<etag>"
+)
+#> Error: SerializationError (HTTP 304). An error occurred (304) when calling the GetObject operation: Not Modified
+```
+* head bucket as final resort when redirecting aws s3 call.
 
 # paws.common 0.7.3
 * fix `xml_parse` to correctly parse empty elements (#783) thanks to @stevepowell99 for raising issue

paws.common/R/custom_s3.R

@@ -1,6 +1,8 @@
 #' @include service.R
 #' @include stream.R
 #' @include util.R
+#' @include error.R
+#' @include head_bucket.R
 NULL
 
 ################################################################################
@@ -279,13 +281,8 @@ s3_unmarshal_error <- function(request) {
     )
     return(request)
   }
-
   if (is.null(data)) {
-    request$error <- Error(
-      "SerializationError",
-      "failed to read from query HTTP response body",
-      request$http_response$status_code
-    )
+    request$error <- serialization_error(request)
     return(request)
   }
 
@@ -294,11 +291,7 @@ s3_unmarshal_error <- function(request) {
   message <- error_response$Message
 
   if (is.null(message) && is.null(code)) {
-    request$error <- Error(
-      "SerializationError",
-      "failed to decode query XML error response",
-      request$http_response$status_code
-    )
+    request$error <- serialization_error(request)
     return(request)
   }
 
@@ -356,7 +349,7 @@ s3_redirect_from_error <- function(request) {
     return(request)
   }
   bucket_name <- request$params[["Bucket"]]
-  new_region <- s3_get_bucket_region(request$http_response, error)
+  new_region <- s3_get_bucket_region(request, error, bucket_name)
   if (is.null(new_region)) {
     log_debug(
       paste(
@@ -437,14 +430,19 @@ can_be_redirected <- function(request, error_code, error) {
 # HEAD on the bucket if all else fails.
 # param response: HttpResponse
 # param error: Error
-s3_get_bucket_region <- function(response, error) {
+s3_get_bucket_region <- function(request, error, bucket) {
   # First try to source the region from the headers.
-  response_headers <- response$header
+  response_headers <- request$http_response$header
   if (!is.null(region <- response_headers[["x-amz-bucket-region"]])) {
     return(unlist(region))
   }
-  # Next, check the error body
-  return(unlist(error$Region))
+  if (!is.null(region <- unlist(error$Region))) {
+    return(region)
+  }
+
+  # Finally, HEAD the bucket. No other choice sadly.
+  resp <- s3(request$config)$head_bucket(Bucket = bucket)
+  return(resp$BucketRegion)
 }
 
 # Splice a new endpoint into an existing URL. Note that some endpoints

paws.common/R/error.R

@@ -1,3 +1,5 @@
+#' @include http_status.R
+
 # Returns an Error object.
 Error <- struct(
   code = "",
@@ -6,6 +8,24 @@ Error <- struct(
   error_response = list()
 )
 
+ERROR_MSG_TEMPLATE <- "An error occurred (%s) when calling the %s operation: %s"
+
+serialization_error <- function(request) {
+  error_message <- http_statuses[
+    as.character(request$http_response$status_code)
+  ]
+  Error(
+    "SerializationError",
+    sprintf(
+      ERROR_MSG_TEMPLATE,
+      request$http_response$status_code,
+      request$operation$name,
+      error_message
+    ),
+    request$http_response$status_code
+  )
+}
+
 #' Generate a classed http error
 #'
 #' This function generates S3 error objects which are passed to

paws.common/R/handlers_query.R

@@ -1,3 +1,5 @@
+#' @include error.R
+
 # Build the request for the Query protocol.
 query_build <- function(request) {
   body <- list(
@@ -45,11 +47,7 @@ query_unmarshal_error <- function(request) {
   )
 
   if (is.null(data)) {
-    request$error <- Error(
-      "SerializationError",
-      "failed to read from query HTTP response body",
-      request$http_response$status_code
-    )
+    request$error <- serialization_error(request)
     return(request)
   }
 
@@ -59,11 +57,7 @@ query_unmarshal_error <- function(request) {
   )
 
   if (is.null(error)) {
-    request$error <- Error(
-      "SerializationError",
-      "failed to decode query XML error response",
-      request$http_response$status_code
-    )
+    request$error <- serialization_error(request)
     return(request)
   }
 

paws.common/R/head_bucket.R

@@ -0,0 +1,53 @@
+s3 <- function(config = list()) {
+  svc <- .s3$operations
+  svc <- set_config(svc, config)
+  return(svc)
+}
+
+.s3 <- list()
+
+.s3$operations <- list()
+
+.s3$metadata <- list(
+  service_name = "s3",
+  endpoints = list("us-gov-west-1" = list(endpoint = "s3.{region}.amazonaws.com", global = FALSE), "us-west-1" = list(endpoint = "s3.{region}.amazonaws.com", global = FALSE), "us-west-2" = list(endpoint = "s3.{region}.amazonaws.com", global = FALSE), "eu-west-1" = list(endpoint = "s3.{region}.amazonaws.com", global = FALSE), "ap-southeast-1" = list(endpoint = "s3.{region}.amazonaws.com", global = FALSE), "ap-southeast-2" = list(endpoint = "s3.{region}.amazonaws.com", global = FALSE), "ap-northeast-1" = list(endpoint = "s3.{region}.amazonaws.com", global = FALSE), "sa-east-1" = list(endpoint = "s3.{region}.amazonaws.com", global = FALSE), "us-east-1" = list(endpoint = "s3.amazonaws.com", global = FALSE), "*" = list(endpoint = "s3.{region}.amazonaws.com", global = FALSE), "cn-*" = list(endpoint = "s3.{region}.amazonaws.com.cn", global = FALSE), "eu-isoe-*" = list(endpoint = "s3.{region}.cloud.adc-e.uk", global = FALSE), "us-iso-*" = list(endpoint = "s3.{region}.c2s.ic.gov", global = FALSE), "us-isob-*" = list(endpoint = "s3.{region}.sc2s.sgov.gov", global = FALSE), "us-isof-*" = list(endpoint = "s3.{region}.csp.hci.ic.gov", global = FALSE)),
+  service_id = "S3",
+  api_version = "2006-03-01",
+  signing_name = "s3",
+  json_version = "",
+  target_prefix = ""
+)
+
+.s3$service <- function(config = list()) {
+  handlers <- new_handlers("restxml", "s3")
+  new_service(.s3$metadata, handlers, config)
+}
+
+.s3$head_bucket_input <- function(...) {
+  args <- c(as.list(environment()), list(...))
+  shape <- structure(list(Bucket = structure(logical(0), tags = list(location = "uri", locationName = "Bucket", type = "string")), ExpectedBucketOwner = structure(logical(0), tags = list(location = "header", locationName = "x-amz-expected-bucket-owner", type = "string"))), tags = list(type = "structure"))
+  return(populate(args, shape))
+}
+
+.s3$head_bucket_output <- function(...) {
+  args <- c(as.list(environment()), list(...))
+  shape <- structure(list(BucketLocationType = structure(logical(0), tags = list(location = "header", locationName = "x-amz-bucket-location-type", type = "string")), BucketLocationName = structure(logical(0), tags = list(location = "header", locationName = "x-amz-bucket-location-name", type = "string")), BucketRegion = structure(logical(0), tags = list(location = "header", locationName = "x-amz-bucket-region", type = "string")), AccessPointAlias = structure(logical(0), tags = list(location = "header", locationName = "x-amz-access-point-alias", type = "boolean", box = TRUE))), tags = list(type = "structure"))
+  return(populate(args, shape))
+}
+
+s3_head_bucket <- function(Bucket, ExpectedBucketOwner = NULL) {
+  op <- new_operation(
+    name = "HeadBucket",
+    http_method = "HEAD",
+    http_path = "/{Bucket}",
+    paginator = list()
+  )
+  input <- .s3$head_bucket_input(Bucket = Bucket, ExpectedBucketOwner = ExpectedBucketOwner)
+  output <- .s3$head_bucket_output()
+  config <- get_config()
+  svc <- .s3$service(config)
+  request <- new_request(svc, op, input, output)
+  response <- send_request(request)
+  return(response)
+}
+.s3$operations$head_bucket <- s3_head_bucket

paws.common/R/http_status.R

@@ -0,0 +1,64 @@
+# https://developer.mozilla.org/en-US/docs/Web/HTTP/Status
+http_statuses <- c(
+  "100" = "Continue",
+  "101" = "Switching Protocols",
+  "102" = "Processing",
+  "103" = "Early Hints",
+  "200" = "OK",
+  "201" = "Created",
+  "202" = "Accepted",
+  "203" = "Non-Authoritative Information",
+  "204" = "No Content",
+  "205" = "Reset Content",
+  "206" = "Partial Content",
+  "207" = "Multi-Status",
+  "208" = "Already Reported",
+  "226" = "IM Used",
+  "300" = "Multiple Choice",
+  "301" = "Moved Permanently",
+  "302" = "Found",
+  "303" = "See Other",
+  "304" = "Not Modified",
+  "305" = "Use Proxy",
+  "307" = "Temporary Redirect",
+  "308" = "Permanent Redirect",
+  "400" = "Bad Request",
+  "401" = "Unauthorized",
+  "402" = "Payment Required",
+  "403" = "Forbidden",
+  "404" = "Not Found",
+  "405" = "Method Not Allowed",
+  "406" = "Not Acceptable",
+  "407" = "Proxy Authentication Required",
+  "408" = "Request Timeout",
+  "409" = "Conflict",
+  "410" = "Gone",
+  "411" = "Length Required",
+  "412" = "Precondition Failed",
+  "413" = "Payload Too Large",
+  "414" = "URI Too Long",
+  "415" = "Unsupported Media Type",
+  "416" = "Range Not Satisfiable",
+  "417" = "Expectation Failed",
+  "418" = "I'm a teapot",
+  "421" = "Misdirected Request",
+  "422" = "Unprocessable Entity",
+  "423" = "Locked",
+  "424" = "Failed Dependency",
+  "425" = "Too Early",
+  "426" = "Upgrade Required",
+  "428" = "Precondition Required",
+  "429" = "Too Many Requests",
+  "451" = "Unavailable For Legal Reasons",
+  "500" = "Internal Server Error",
+  "501" = "Not Implemented",
+  "502" = "Bad Gateway",
+  "503" = "Service Unavailable",
+  "504" = "Gateway Timeout",
+  "505" = "HTTP Version Not Supported",
+  "506" = "Variant Also Negotiates",
+  "507" = "Insufficient Storage",
+  "508" = "Loop Detected",
+  "510" = "Not Extended",
+  "511" = "Network Authentication Required"
+)

paws.common/tests/testthat/test_custom_s3.R

@@ -312,7 +312,7 @@ test_that("ignore redirect if already redirected", {
   expect_equal(actual, req)
 })
 
-test_that("ignore redirect if unable to find S3 region", {
+test_that("default to head_bucket for final region check", {
   raw_error <- charToRaw(paste0(
     "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<Error><Code>PermanentRedirect</Code>",
     "<Message>Dummy Error</Message><Endpoint>foo.s3.us-east-2.amazonaws.com</Endpoint>",
@@ -323,11 +323,18 @@ test_that("ignore redirect if unable to find S3 region", {
     status_code = 301,
     body = raw_error
   )
-  actual <- s3_redirect_from_error(req)
-  expect_equal(actual, req)
-  expect_equal(actual$http_response$body, raw_error)
-})
+  mock_head_bucket <- mock2(list(BucketRegion = "bar"))
+  mock_s3 <- mock2(list(head_bucket = mock_head_bucket))
+  mockery::stub(s3_get_bucket_region, "s3", mock_s3)
 
+  error <- decode_xml(raw_error)$Error
+
+  actual <- s3_get_bucket_region(req, error, "foo")
+
+  head_bucket_args <- mockery::mock_args(mock_head_bucket)[[1]]
+  expect_equal(head_bucket_args, list(Bucket = "foo"))
+  expect_equal(actual, "bar")
+})
 
 test_that("redirect request from http response error", {
   req <- build_request(bucket = "foo", operation = "ListObjects")