fix CopySource encoding

paws.common/NEWS.md

@@ -3,6 +3,37 @@
 * fix `unix_time` ensure seconds is numeric (#804), thanks to @joseale2310 and @lyschoening for raising issue.
 * fix stop anonymous credentials removing `x-amz-*` headers (#815) thanks to @cgostic for raising issue
 * fix s3 redirect for download_file
+* fix encode `CopySource` in operation `CopyObject` (#819)
+* enable lists to be passed to `CopySource` for `CopyObject` operations (#819). This is to align with `boto3` implementation.
+
+```r
+library(paws)
+client <- s3()
+
+bucket = "BUCKET"
+key = "%01file%/output.txt"
+
+resp <- client$put_object(
+  Bucket = bucket,
+  Key = key,
+  Body = charToRaw("helloworld")
+)
+
+client$copy_object(
+  Bucket = bucket,
+  Key = "file_out_1.txt",
+  CopySource = sprintf("/%s/%s", bucket, key)
+)
+
+client$copy_object(
+  Bucket = bucket,
+  Key = "file_out_2.txt",
+  CopySource = list(
+    Bucket = bucket,
+    Key = key
+  )
+)
+```
 
 # paws.common 0.7.4
 * fix `transpose` to correctly parse lists with empty first elements (#791), thanks to @FMKerckhof for raising issue.

paws.common/R/custom_s3.R

@@ -5,6 +5,18 @@
 #' @include head_bucket.R
 NULL
 
+VERSION_ID_SUFFIX <- '?versionId='
+ACCESSPOINT_ARN <- paste0(
+  "^arn:(aws).*:(s3|s3-object-lambda):[a-z\\-0-9]*:[0-9]{12}:accesspoint[/:]",
+  "[a-zA-Z0-9\\-.]{1,63}$"
+)
+OUTPOST_ARN = paste0(
+  '^arn:(aws).*:s3-outposts:[a-z\\-0-9]+:[0-9]{12}:outpost[/:]',
+  '[a-zA-Z0-9\\-]{1,63}[/:]accesspoint[/:][a-zA-Z0-9\\-]{1,63}$'
+)
+
+VALID_S3_ARN <- paste(ACCESSPOINT_ARN, OUTPOST_ARN, sep = "|")
+
 ################################################################################
 
 convert_file_to_raw <- function(request) {
@@ -470,6 +482,48 @@ set_request_url <- function(original_endpoint,
   return(final_endpoint)
 }
 
+################################################################################
+handle_copy_source_param <- function(request) {
+  if (!(request$operation$name %in% c("CopyObject", "CopyPart"))) {
+    return(request)
+  }
+  source <- request$params$CopySource
+  if (is.character(source)) {
+    request$params$CopySource <- quote_source_header(source)
+  } else if (is.list(source)) {
+    request$params$CopySource <- quote_source_header_from_list(source)
+  }
+  return(request)
+}
+
+quote_source_header <- function(source) {
+  result <- strsplit(source, VERSION_ID_SUFFIX, fixed = T)[[1]]
+  if (is.na(result[2])) {
+    return(paws_url_encoder(result[1], '-._~/'))
+  } else {
+    return(paste0(paws_url_encoder(result[1], '-._~/'), VERSION_ID_SUFFIX, result[2]))
+  }
+}
+
+quote_source_header_from_list <- function(source) {
+  if(is.null(bucket <- source[['Bucket']])) {
+    stopf('CopySource list is missing required parameter: Bucket')
+  }
+  if (is.null(key <- source[['Key']])) {
+    stopf('CopySource list is missing required parameter: Key')
+  }
+  if (grepl(VALID_S3_ARN, bucket, perl = T)) {
+    final <- sprintf('%s/object/%s', bucket, key)
+  } else {
+    final <- sprintf('%s/%s', bucket, key)
+  }
+  final <- paws_url_encoder(final, '-._~/')
+  if (!is.null(version_id <- source[['VersionId']])) {
+    final <- paste0(final, VERSION_ID_SUFFIX, version_id)
+  }
+  return(final)
+}
+
 ################################################################################
 
 customizations$s3 <- function(handlers) {
@@ -485,6 +539,10 @@ customizations$s3 <- function(handlers) {
     handlers$build,
     convert_file_to_raw
   )
+  handlers$build <- handlers_add_front(
+    handlers$build,
+    handle_copy_source_param
+  )
   handlers$build <- handlers_add_front(
     handlers$build,
     sse_md5_build

paws.common/tests/testthat/test_custom_s3.R

@@ -404,3 +404,105 @@ test_that("redirect error without region", {
   )
   expect_equal(error$status_code, 301)
 })
+
+
+build_copy_object_request <- function(bucket, key, copy_source, operation) {
+  metadata <- list(
+    endpoints = list("*" = list(endpoint = "s3.amazonaws.com", global = FALSE)),
+    service_name = "s3"
+  )
+  svc <-  new_service(metadata,  new_handlers("restxml", "s3"))
+  op <-  new_operation(
+    name = operation,
+    http_method = "GET",
+    http_path = "/{Bucket}",
+    paginator = list()
+  )
+  input <-  tag_add(list(Bucket = bucket, Key = key, CopySource = copy_source), list(type = "structure"))
+  output <- list()
+  request <-  new_request(svc, op, input, output)
+  return(request)
+}
+
+test_that("check CopySource character encoded", {
+  req <- build_copy_object_request(
+    bucket = "foo",
+    key = "file.txt",
+    copy_source = "/foo/%01file%/output.txt",
+    operation = "CopyObject"
+  )
+
+  req <- handle_copy_source_param(req)
+  expect_equal(req$params$CopySource, "/foo/%2501file%25/output.txt")
+})
+
+test_that("check CopySource character versionId encoded", {
+  req <- build_copy_object_request(
+    bucket = "foo",
+    key = "file.txt",
+    copy_source = "/foo/%01file%/output.txt?versionId=123",
+    operation = "CopyObject"
+  )
+
+  req <- handle_copy_source_param(req)
+  expect_equal(req$params$CopySource, "/foo/%2501file%25/output.txt?versionId=123")
+})
+
+test_that("check CopySource list encoded", {
+  req <- build_copy_object_request(
+    bucket = "foo",
+    key = "file.txt",
+    copy_source = list(
+      Bucket = "foo",
+      Key = "%01file%/output.txt"
+    ),
+    operation = "CopyObject"
+  )
+
+  req <- handle_copy_source_param(req)
+  expect_equal(req$params$CopySource, "foo/%2501file%25/output.txt")
+})
+
+test_that("check CopySource list versionId encoded", {
+  req <- build_copy_object_request(
+    bucket = "foo",
+    key = "file.txt",
+    copy_source = list(
+      Bucket = "foo",
+      Key = "%01file%/output.txt",
+      VersionId = "123"
+    ),
+    operation = "CopyObject"
+  )
+
+  req <- handle_copy_source_param(req)
+  expect_equal(req$params$CopySource, "foo/%2501file%25/output.txt?versionId=123")
+})
+
+test_that("check CopySource list missing params", {
+  req1 <- build_copy_object_request(
+    bucket = "foo",
+    key = "file.txt",
+    copy_source = list(
+      Key = "%01file%/output.txt"
+    ),
+    operation = "CopyObject"
+  )
+  req2 <- build_copy_object_request(
+    bucket = "foo",
+    key = "file.txt",
+    copy_source = list(
+      Bucket = "foo"
+    ),
+    operation = "CopyObject"
+  )
+  expect_error(
+    handle_copy_source_param(req1),
+    "CopySource list is missing required parameter: Bucket"
+  )
+  expect_error(
+    handle_copy_source_param(req2),
+    "CopySource list is missing required parameter: Key"
+  )
+})
+