Merge pull request #876 from DyfanJones/main

allow paws.common 0.8.0 support vendor boto and vendor aws js sdk

paws.common/R/RcppExports.R

@@ -43,12 +43,24 @@ endpoint_unescape <- function(endpoint, region) {
     .Call('_paws_common_endpoint_unescape', PACKAGE = 'paws.common', endpoint, region)
 }
 
+#' @useDynLib paws.common _paws_common_endpoint_unescape_js
+#' @importFrom Rcpp evalCpp
+endpoint_unescape_js <- function(endpoint, service, region) {
+    .Call('_paws_common_endpoint_unescape_js', PACKAGE = 'paws.common', endpoint, service, region)
+}
+
 #' @useDynLib paws.common _paws_common_get_region_pattern
 #' @importFrom Rcpp evalCpp
 get_region_pattern <- function(region_pattern, region) {
     .Call('_paws_common_get_region_pattern', PACKAGE = 'paws.common', region_pattern, region)
 }
 
+#' @useDynLib paws.common _paws_common_get_region_pattern_js
+#' @importFrom Rcpp evalCpp
+get_region_pattern_js <- function(region_pattern, region) {
+    .Call('_paws_common_get_region_pattern_js', PACKAGE = 'paws.common', region_pattern, region)
+}
+
 #' @useDynLib paws.common _paws_common_parse_query_string
 #' @importFrom Rcpp evalCpp
 parse_query_string <- function(query) {

paws.common/R/cache.R

@@ -4,6 +4,8 @@ ini_cache <- new.env(parent = emptyenv())
 
 os_env_cache <- new.env(parent = emptyenv())
 
+vendor_cache <- list2env(list(vendor = "boto"), parent = emptyenv())
+
 set_os_env_cache <- function() {
   env_vars <- system("printenv", intern = TRUE)
 

paws.common/R/client.R

@@ -85,6 +85,13 @@ HOST_PREFIX_RE <- "^[A-Za-z0-9\\.\\-]+$"
 # resolver_endpoint returns the endpoint for a given service.
 # e.g. "https://ec2.us-east-1.amazonaws.com"
 resolver_endpoint <- function(service, region, endpoints, sts_regional_endpoint = "", scheme = "https", host_prefix = "") {
+  switch(vendor_cache[["vendor"]],
+    "boto" = resolver_endpoint_boto(service, region, endpoints, sts_regional_endpoint, scheme, host_prefix),
+    "js" = resolver_endpoint_js(service, region, endpoints, sts_regional_endpoint, scheme, host_prefix)
+  )
+}
+
+resolver_endpoint_boto <- function(service, region, endpoints, sts_regional_endpoint, scheme, host_prefix) {
   # locate global endpoint
   global_found <- check_global(endpoints)
   global_region <- region == "aws-global"
@@ -114,6 +121,45 @@ resolver_endpoint <- function(service, region, endpoints, sts_regional_endpoint
   ))
 }
 
+# Support paws < 0.8.0
+resolver_endpoint_js <- function(service, region, endpoints, sts_regional_endpoint, scheme, host_prefix) {
+  # Set default region for s3:
+  # https://github.com/boto/botocore/blob/develop/botocore/regions.py#L189-L220
+  if (service == "s3" & (region == "aws-global")) {
+    region <- "us-east-1"
+  }
+  # locate global endpoint
+  global_found <- check_global(endpoints)
+  global_region <- (region == "aws-global")
+  if (!any(global_found) & global_region) {
+    stop("No region provided and no global region found.")
+  }
+  search_region <- (
+    if (any(global_found) & global_region) names(global_found[global_found][1]) else region
+  )
+  e <- endpoints[[get_region_pattern_js(names(endpoints), search_region)]]
+  if (is.character(e)) {
+    e <- list(endpoint = e, global = FALSE)
+  }
+  if (service == "sts" & nzchar(sts_regional_endpoint)) {
+    e$endpoint <- set_sts_regional_endpoint(
+      sts_regional_endpoint, e
+    )
+    region <- set_sts_region(sts_regional_endpoint, region)
+  }
+  signing_region <- if (e[["global"]]) "us-east-1" else region
+  endpoint <- endpoint_unescape_js(e[["endpoint"]], service, signing_region)
+  if (grepl(HOST_PREFIX_RE, host_prefix)) {
+    endpoint <- sprintf("%s%s", host_prefix, endpoint)
+  }
+  endpoint <- gsub("^(.+://)?", sprintf("%s://", scheme), endpoint)
+
+  return(list(
+    endpoint = endpoint,
+    signing_region = signing_region
+  ))
+}
+
 set_sts_regional_endpoint <- function(sts_regional_endpoint, endpoint) {
   switch(sts_regional_endpoint,
     "legacy" = "sts.amazonaws.com",
@@ -129,45 +175,47 @@ set_sts_region <- function(sts_regional_endpoint, region) {
   )
 }
 
+# client_config returns a ClientConfig configured for the service.
 # client_config returns a ClientConfig configured for the service.
 client_config <- function(service_name, endpoints, cfgs, service_id, operation = Operation()) {
-  s <- new_session()
+  sess <- new_session()
   if (!is.null(cfgs)) {
-    s$config <- cfgs
+    sess$config <- cfgs
   }
   custom_endpoint <- FALSE
   # If region not defined, set it
-  if (nchar(s$config$region) == 0) {
-    s$config$region <- get_region(cfgs[["credentials"]][["profile"]])
+  if (nchar(sess$config$region) == 0) {
+    sess$config$region <- get_region(sess$config[["credentials"]][["profile"]])
   }
-  region <- s$config$region
-  if (s$config$endpoint != "") {
-    endpoint <- s$config$endpoint
-    signing_region <- region
+  signing_region <- sess$config$region
+  if (sess$config$endpoint != "") {
+    endpoint <- sess$config$endpoint
   } else {
-    endpoint <- get_service_endpoint(cfgs[["credentials"]][["profile"]], service_id)
+    endpoint <- get_service_endpoint(sess$config[["credentials"]][["profile"]], service_id)
     if (!is.null(endpoint)) {
-      signing_region <- region
       custom_endpoint <- TRUE
     } else {
-      sts_regional_endpoint <- s$config$sts_regional_endpoint
-      e <- resolver_endpoint(
+      sts_regional_endpoint <- sess$config$sts_regional_endpoint
+      re <- resolver_endpoint(
         service_name,
-        region, endpoints,
+        signing_region,
+        endpoints,
         sts_regional_endpoint,
         host_prefix = operation$host_prefix
       )
-      endpoint <- e$endpoint
-      signing_region <- e$signing_region
+      endpoint <- re$endpoint
+      signing_region <- re$signing_region
     }
+    # sess$config$endpoint <- endpoint
+    # sess$config$region <- signing_region
   }
-  c <- ClientConfig(
-    config = s$config,
-    handlers = s$handlers,
+  cc <- ClientConfig(
+    config = sess$config,
+    handlers = sess$handlers,
     endpoint = endpoint,
     custom_endpoint = custom_endpoint,
     signing_region = signing_region,
     signing_name = service_name
   )
-  return(c)
+  return(cc)
 }

paws.common/R/config.R

@@ -95,9 +95,19 @@ set_config <- function(svc, cfgs = list()) {
   config <- populate(cfgs, shape)
   config$credentials <- as.environment(config$credentials)
   svc$.internal <- list(config = config)
+  set_paws_vendor()
   return(svc)
 }
 
+set_paws_vendor <- function() {
+  where <- topenv(parent.frame(n = 2))
+  pkg_name <- get0(".packageName", where, inherits = FALSE)
+  if (!is.null(pkg_name) && startsWith(pkg_name, "paws.")) {
+    vendor <- (if (packageVersion(pkg_name) >= numeric_version("0.8.0")) "boto" else "js")
+    vendor_cache[["vendor"]] <- vendor
+  }
+}
+
 update_optional_config_parameter <- function(cfgs, profile) {
   for (cfg_param in names(.optional_config_parameter)) {
     if (is.null(cfgs[[cfg_param]])) {

paws.common/R/mock_bindings.R

@@ -4,3 +4,5 @@
 ################################################################
 
 Sys.time <- NULL
+
+get0 <- NULL

paws.common/src/RcppExports.cpp

@@ -89,6 +89,19 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// endpoint_unescape_js
+std::string endpoint_unescape_js(std::string endpoint, const std::string& service, const std::string& region);
+RcppExport SEXP _paws_common_endpoint_unescape_js(SEXP endpointSEXP, SEXP serviceSEXP, SEXP regionSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< std::string >::type endpoint(endpointSEXP);
+    Rcpp::traits::input_parameter< const std::string& >::type service(serviceSEXP);
+    Rcpp::traits::input_parameter< const std::string& >::type region(regionSEXP);
+    rcpp_result_gen = Rcpp::wrap(endpoint_unescape_js(endpoint, service, region));
+    return rcpp_result_gen;
+END_RCPP
+}
 // get_region_pattern
 std::string get_region_pattern(CharacterVector region_pattern, const std::string& region);
 RcppExport SEXP _paws_common_get_region_pattern(SEXP region_patternSEXP, SEXP regionSEXP) {
@@ -101,6 +114,18 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// get_region_pattern_js
+CharacterVector get_region_pattern_js(CharacterVector region_pattern, const std::string& region);
+RcppExport SEXP _paws_common_get_region_pattern_js(SEXP region_patternSEXP, SEXP regionSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< CharacterVector >::type region_pattern(region_patternSEXP);
+    Rcpp::traits::input_parameter< const std::string& >::type region(regionSEXP);
+    rcpp_result_gen = Rcpp::wrap(get_region_pattern_js(region_pattern, region));
+    return rcpp_result_gen;
+END_RCPP
+}
 // parse_query_string
 List parse_query_string(std::string query);
 RcppExport SEXP _paws_common_parse_query_string(SEXP querySEXP) {
@@ -165,7 +190,9 @@ static const R_CallMethodDef CallEntries[] = {
     {"_paws_common_json_convert_string", (DL_FUNC) &_paws_common_json_convert_string, 1},
     {"_paws_common_check_global", (DL_FUNC) &_paws_common_check_global, 1},
     {"_paws_common_endpoint_unescape", (DL_FUNC) &_paws_common_endpoint_unescape, 2},
+    {"_paws_common_endpoint_unescape_js", (DL_FUNC) &_paws_common_endpoint_unescape_js, 3},
     {"_paws_common_get_region_pattern", (DL_FUNC) &_paws_common_get_region_pattern, 2},
+    {"_paws_common_get_region_pattern_js", (DL_FUNC) &_paws_common_get_region_pattern_js, 2},
     {"_paws_common_parse_query_string", (DL_FUNC) &_paws_common_parse_query_string, 1},
     {"_paws_common_parse_url", (DL_FUNC) &_paws_common_parse_url, 1},
     {"_paws_common_build_url", (DL_FUNC) &_paws_common_build_url, 1},

paws.common/src/resolve_endpoint.cpp

@@ -35,7 +35,7 @@ LogicalVector check_global(List endpoint)
 /**
  * @brief Unescape endpoint
  *
- * @param endpoint AWS escaped endpoint
+ * @param endpoint AWS escaped endpoint vendor aws botocore
  * @param service AWS service
  * @param region AWS region
  */
@@ -52,8 +52,35 @@ std::string endpoint_unescape(std::string endpoint, const std::string &region)
   return endpoint;
 }
 
+// Unescape endpoint
+// param endpoint AWS escaped endpoint
+// param service AWS service
+// param region AWS region
+
+/**
+ * @brief Unescape endpoint using vendor aws js sdk
+ *
+ * @param endpoint AWS escaped endpoint
+ * @param service AWS service
+ * @param region AWS region
+ */
+//' @useDynLib paws.common _paws_common_endpoint_unescape_js
+//' @importFrom Rcpp evalCpp
+// [[Rcpp::export]]
+std::string endpoint_unescape_js(std::string endpoint, const std::string& service, const std::string& region) {
+ size_t pos = 0;
+ if ((pos = endpoint.find("{service}", pos)) != std::string::npos) {
+   endpoint.replace(pos, 9, service);
+ };
+
+ if ((pos = endpoint.find("{region}", 0)) != std::string::npos) {
+   endpoint.replace(pos, 8, region);
+ };
+ return endpoint;
+}
+
 /**
- * @brief Get region pattern based on region
+ * @brief Get region pattern based on region using aws botocore vendor
  *
  * @param region_pattern AWS escaped endpoint
  * @param region AWS region
@@ -78,3 +105,47 @@ std::string get_region_pattern(CharacterVector region_pattern, const std::string
   };
   return safe_pattern;
 }
+
+/**
+ * @brief Get region pattern based on region using aws js sdk vendor
+ *
+ * @param region_pattern AWS escaped endpoint
+ * @param region AWS region
+ */
+//' @useDynLib paws.common _paws_common_get_region_pattern_js
+//' @importFrom Rcpp evalCpp
+// [[Rcpp::export]]
+CharacterVector get_region_pattern_js(CharacterVector region_pattern, const std::string& region) {
+ int n = region_pattern.size();
+ CharacterVector region_match;
+ NumericVector pattern_lens;
+
+ size_t pos = 0;
+ for(int i=0; i<n; ++i){
+   String cur = region_pattern[i];
+   std::string safe_pattern = cur;
+   // convert region pattern to regex pattern i.e.
+   // "*" -> ".*",  "cn-*" -> "cn-.*"
+   if ((pos = safe_pattern.find("*", 0)) != std::string::npos) {
+     safe_pattern.replace(pos, 1, ".*");
+   };
+   const std::regex re(safe_pattern);
+   if (std::regex_search(region, re)) {
+     region_match.push_back(region_pattern[i]);
+     pattern_lens.push_back(region_pattern[i].size());
+   };
+ };
+ NumericVector pattern_sort = clone(pattern_lens);
+ pattern_lens.sort(true);
+ CharacterVector output;
+
+ // return longest region pattern
+ for (int i=0; i<region_match.length(); ++i){
+   if (pattern_sort[0] == pattern_lens[i]) {
+     output.push_back(region_match[i]);
+     break;
+   };
+ };
+ return output;
+}
+

paws.common/tests/testthat/test_custom_rds.R

@@ -1,5 +1,5 @@
 test_that("check rds_build_auth_token", {
-  testthat::local_mocked_bindings(
+  local_mocked_bindings(
     Sys.time = function() as.POSIXct("2025/01/01 00:00:01 UTC"),
     get_config = function() list(credentials = list(creds = list(
       access_key_id = "AKIA",
@@ -11,8 +11,8 @@ test_that("check rds_build_auth_token", {
   expected <- "prod-instance.us-east-1.rds.amazonaws.com:3306/?Action=connect&DBUser=mysqlUser&X-Amz-Algorithm=AWS4-HMAC-SHA256&X-Amz-Credential=AKIA%2F20250101%2Fus-west-2%2Frds-db%2Faws4_request&X-Amz-Date=20250101T000001Z&X-Amz-Expires=900&X-Amz-Security-Token=SESSION&X-Amz-SignedHeaders=host&X-Amz-Signature=4e4ce10c7b3710decae757df60ba2519348dcb4db802f15646dce1bf5e17c3ed"
 
   client <- list(
-    build_auth_token = paws.common:::rds_build_auth_token,
-    build_auth_token_v2 = paws.common:::rds_build_auth_token_v2
+    build_auth_token = rds_build_auth_token,
+    build_auth_token_v2 = rds_build_auth_token_v2
   )
   actual_v1 <- client$build_auth_token(
     endpoint = "prod-instance.us-east-1.rds.amazonaws.com:3306",
@@ -49,8 +49,8 @@ test_that("check rds_build_auth_token upper case host", {
   expected <- "XXXXX.US-EAST-2.RDS.AMAZONAWS.COM:3306/?Action=connect&DBUser=user1&X-Amz-Algorithm=AWS4-HMAC-SHA256&X-Amz-Credential=AKIA%2F20250101%2Fus-east-2%2Frds-db%2Faws4_request&X-Amz-Date=20250101T000001Z&X-Amz-Expires=900&X-Amz-Security-Token=SESSION&X-Amz-SignedHeaders=host&X-Amz-Signature=c57093ec8c5c9a668ceab511fe2d72df1794936673fec2418744f71496eed913"
 
   client <- list(
-    build_auth_token = paws.common:::rds_build_auth_token,
-    build_auth_token_v2 = paws.common:::rds_build_auth_token_v2
+    build_auth_token = rds_build_auth_token,
+    build_auth_token_v2 = rds_build_auth_token_v2
   )
 
   actual_v1 <- client$build_auth_token(