From 4ef3eb80bf738967a5b802c577cac363d0279832 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Mon, 24 Jul 2023 21:47:43 +0100 Subject: [PATCH 01/19] initial paginate function (#30) --- paws.common/DESCRIPTION | 1 + paws.common/NAMESPACE | 1 + paws.common/R/paginate.R | 84 +++++++++++++++++++++++++++++++++++++ paws.common/man/paginate.Rd | 38 +++++++++++++++++ 4 files changed, 124 insertions(+) create mode 100644 paws.common/R/paginate.R create mode 100644 paws.common/man/paginate.Rd diff --git a/paws.common/DESCRIPTION b/paws.common/DESCRIPTION index 6f24aa200..db0bdf1cb 100644 --- a/paws.common/DESCRIPTION +++ b/paws.common/DESCRIPTION @@ -70,6 +70,7 @@ Collate: 'idempotency.R' 'jsonutil.R' 'onLoad.R' + 'paginate.R' 'populate.R' 'populateutil.R' 'tags.R' diff --git a/paws.common/NAMESPACE b/paws.common/NAMESPACE index e965bd4f1..f2cd72e78 100644 --- a/paws.common/NAMESPACE +++ b/paws.common/NAMESPACE @@ -24,6 +24,7 @@ export(new_handlers) export(new_operation) export(new_request) export(new_service) +export(paginate) export(paws_config_log) export(populate) export(send_request) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R new file mode 100644 index 000000000..c07d31c15 --- /dev/null +++ b/paws.common/R/paginate.R @@ -0,0 +1,84 @@ +#' @include logging.R + +#' @title Paginate over an operation. +#' @description +#' Some AWS operations return results that are incomplete and require subsequent +#' requests in order to attain the entire result set. The process of sending subsequent +#' requests to continue where a previous request left off is called pagination. +#' For example, the list_objects operation of Amazon S3 returns up to 1000 objects +#' at a time, and you must send subsequent requests with the appropriate Marker +#' in order to retrieve the next page of results. +#' +#' @param operation The operation +#' @param MaxRetries Max number of retries call AWS API. +#' @param MaxItems Limits the maximum number of total returned items returned while paginating. +#' @param StartingToken Can be used to modify the starting marker or token of a paginator. +#' This argument if useful for resuming pagination from a previous token or starting pagination at a known position. +#' @examples +#' \dontrun{ +#' # The following example retrieves object list. The request specifies max +#' # keys to limit response to include only 2 object keys. +#' paginate( +#' svc$list_objects_v2( +#' Bucket = "DOC-EXAMPLE-BUCKET" +#' ), +#' MaxItems = 50 +#' ) +#' } +#' @export +paginate <- function(operation, MaxRetries = 5, MaxItems = NULL, StartingToken = NULL) { + fn <- substitute(operation) + fn_call <- eval(fn[[1]]) + pkg_name <- environmentName(environment(fn_call)) + fn_body <- body(fn_call) + fn_input <- names(formals(fn_call)) + output_name <- names(eval(fn_body[[4]][[3]], envir = getNamespace(pkg_name))) + + # Get Tokens + # Identify token parameter names + token_nms <- output_name[grep("Token", output_name)] + next_token <- token_nms[grepl("Next.*Token", token_nms)] + continuation_token <- token_nms[token_nms %in% fn_input] + fn[continuation_token] <- StartingToken + + # Identify if MaxKey/MaxItems used + max_items <- c("MaxKeys", "MaxItems") + max_items <- max_items[max_items %in% fn_input] + fn[max_items] <- MaxItems + + result <- list() + while (!identical(fn[[continuation_token]], character(0))) { + resp <- retry_api_call(eval(fn), MaxRetries) + fn[[continuation_token]] <- resp[[next_token]] + result[[length(result) + 1]] <- resp + } + return(result) +} + +retry_api_call <- function(expr, retries){ + for (i in seq_len(retries + 1)){ + tryCatch({ + return(eval.parent(substitute(expr))) + }, http_100 = function(err) { + back_off(err, i, retries) + }, http_200 = function(err) { + back_off(err, i, retries) + }, http_300 = function(err) { + back_off(err, i, retries) + }, http_400 = function(err) { + stop(err) + }, http_500 = function(err) { + back_off(err, i, retries) + }, error = function(err) { + stop(err) + }) + } +} + +back_off <- function(error, i, retries) { + if(i == (retries + 1)) + stop(error) + time = 2**i * 0.1 + log_error("Request failed. Retrying in %s seconds...", time) + Sys.sleep(time) +} diff --git a/paws.common/man/paginate.Rd b/paws.common/man/paginate.Rd new file mode 100644 index 000000000..12a9a14bd --- /dev/null +++ b/paws.common/man/paginate.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/paginate.R +\name{paginate} +\alias{paginate} +\title{Paginate over an operation.} +\usage{ +paginate(operation, MaxRetries = 5, MaxItems = NULL, StartingToken = NULL) +} +\arguments{ +\item{operation}{The operation} + +\item{MaxRetries}{Max number of retries call AWS API.} + +\item{MaxItems}{Limits the maximum number of total returned items returned while paginating.} + +\item{StartingToken}{Can be used to modify the starting marker or token of a paginator. +This argument if useful for resuming pagination from a previous token or starting pagination at a known position.} +} +\description{ +Some AWS operations return results that are incomplete and require subsequent +requests in order to attain the entire result set. The process of sending subsequent +requests to continue where a previous request left off is called pagination. +For example, the list_objects operation of Amazon S3 returns up to 1000 objects +at a time, and you must send subsequent requests with the appropriate Marker +in order to retrieve the next page of results. +} +\examples{ +\dontrun{ +# The following example retrieves object list. The request specifies max +# keys to limit response to include only 2 object keys. +paginate( + svc$list_objects_v2( + Bucket = "DOC-EXAMPLE-BUCKET" + ), + MaxItems = 50 +) +} +} From bbf37f530a6dc98f245b9efceccd577744ee8164 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Mon, 24 Jul 2023 21:48:11 +0100 Subject: [PATCH 02/19] reexport paws.common functions to paws sdk and category packages --- make.paws/R/cran_category.R | 5 ++++- make.paws/R/cran_collection.R | 2 ++ make.paws/R/process_api.R | 13 +++++++++++++ make.paws/inst/templates/reexports_paws.common.R | 15 +++++++++++++++ 4 files changed, 34 insertions(+), 1 deletion(-) create mode 100644 make.paws/inst/templates/reexports_paws.common.R diff --git a/make.paws/R/cran_category.R b/make.paws/R/cran_category.R index 045ac3264..a1d1a9e43 100644 --- a/make.paws/R/cran_category.R +++ b/make.paws/R/cran_category.R @@ -1,6 +1,8 @@ #' @include package.R service.R NULL +.paws.common.import.version <- "paws.common (>= 0.5.9)" + # Make all category-level packages. make_categories <- function(sdk_dir, out_dir, categories, service_names) { for (category in categories) { @@ -14,7 +16,7 @@ make_category <- function(category, service_names, sdk_dir, out_dir) { services <- category$services title <- category$title description <- category$description - imports <- "paws.common (>= 0.5.4)" + imports <- .paws.common.import.version version <- get_version(sdk_dir) if (is.null(name) || is.null(title) || is.null(description)) { @@ -34,6 +36,7 @@ make_category <- function(category, service_names, sdk_dir, out_dir) { for (service in services) { copy_files(service_names[[service]], from = sdk_dir, to = package_dir) } + copy_files("reexports", from = sdk_dir, to = package_dir) write_documentation(package_dir) } diff --git a/make.paws/R/cran_collection.R b/make.paws/R/cran_collection.R index c70858823..f267231ac 100644 --- a/make.paws/R/cran_collection.R +++ b/make.paws/R/cran_collection.R @@ -62,6 +62,7 @@ write_source_collection <- function(sdk_dir, } } write_list(clients, file.path(out_dir, "R", "paws.R")) + write_list(make_reexports(), file.path(out_dir, "R", "reexports_paws.common.R")) } # Add the category packages to the DESCRIPTION file's Imports. @@ -70,6 +71,7 @@ write_source_collection <- function(sdk_dir, # generate the package. write_imports_collection <- function(path, version, imports) { packages <- sprintf("%s (>= %s)", imports, version) + packages <- c(packages, .paws.common.import.version) desc::desc_set( Imports = paste0(packages, collapse = ","), file = file.path(path, "DESCRIPTION"), diff --git a/make.paws/R/process_api.R b/make.paws/R/process_api.R index 4f54585a3..08d744b7a 100644 --- a/make.paws/R/process_api.R +++ b/make.paws/R/process_api.R @@ -27,6 +27,7 @@ make_code_files <- function(api) { result$interfaces <- make_interfaces_files(api) result$service <- make_service_files(api) result$custom <- make_custom_operations_files(api) + result$reexports <- make_reexports() return(result) } @@ -78,11 +79,23 @@ make_custom_operations_files <- function(api) { return(result) } +make_reexports <- function() { + result <- list() + from <- system_file("templates/reexports_paws.common.R", package = methods::getPackageName()) + filename <- "reexports_paws.common.R" + if (from != "" && file.exists(from)) { + contents <- readLines(from) + result[[file.path(CODE_DIR, filename)]] <- paste(contents, collapse = "\n") + } + return(result) +} + make_docs_files <- function(api) { result <- list() result$operations <- make_operations_files(api, doc_maker = make_docs_long) result$service <- make_service_files(api) result$custom <- make_custom_operations_files(api) + result$reexports <- make_reexports() return(result) } diff --git a/make.paws/inst/templates/reexports_paws.common.R b/make.paws/inst/templates/reexports_paws.common.R new file mode 100644 index 000000000..ba7c0f19e --- /dev/null +++ b/make.paws/inst/templates/reexports_paws.common.R @@ -0,0 +1,15 @@ +#' @importFrom paws.common paginate +#' @export +paws.common::paginate + +#' @importFrom paws.common config +#' @export +paws.common::config + +#' @importFrom paws.common credentials +#' @export +paws.common::credentials + +#' @importFrom paws.common creds +#' @export +paws.common::creds From fc2d13fa4452a47d1e6c1b1f7794a5b096111eef Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Tue, 25 Jul 2023 19:58:59 +0100 Subject: [PATCH 03/19] add lapply method for paginate --- .../inst/templates/reexports_paws.common.R | 4 + paws.common/NAMESPACE | 1 + paws.common/R/paginate.R | 96 ++++++++++++++++--- paws.common/man/paginate.Rd | 14 +++ 4 files changed, 103 insertions(+), 12 deletions(-) diff --git a/make.paws/inst/templates/reexports_paws.common.R b/make.paws/inst/templates/reexports_paws.common.R index ba7c0f19e..347ca4325 100644 --- a/make.paws/inst/templates/reexports_paws.common.R +++ b/make.paws/inst/templates/reexports_paws.common.R @@ -2,6 +2,10 @@ #' @export paws.common::paginate +#' @importFrom paws.common paginate_lapply +#' @export +paws.common::paginate_lapply + #' @importFrom paws.common config #' @export paws.common::config diff --git a/paws.common/NAMESPACE b/paws.common/NAMESPACE index f2cd72e78..f815aa0d3 100644 --- a/paws.common/NAMESPACE +++ b/paws.common/NAMESPACE @@ -25,6 +25,7 @@ export(new_operation) export(new_request) export(new_service) export(paginate) +export(paginate_lapply) export(paws_config_log) export(populate) export(send_request) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index c07d31c15..6201d150f 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -1,4 +1,5 @@ #' @include logging.R +#' @include util.R #' @title Paginate over an operation. #' @description @@ -14,6 +15,8 @@ #' @param MaxItems Limits the maximum number of total returned items returned while paginating. #' @param StartingToken Can be used to modify the starting marker or token of a paginator. #' This argument if useful for resuming pagination from a previous token or starting pagination at a known position. +#' @param FUN the function to be applied to each response element of \code{operation}. +#' @param ... optional arguments to \code{FUN}. #' @examples #' \dontrun{ #' # The following example retrieves object list. The request specifies max @@ -25,25 +28,38 @@ #' MaxItems = 50 #' ) #' } +#' @name paginate #' @export -paginate <- function(operation, MaxRetries = 5, MaxItems = NULL, StartingToken = NULL) { +paginate <- function(operation, + MaxRetries = 5, + MaxItems = NULL, + StartingToken = NULL) { fn <- substitute(operation) fn_call <- eval(fn[[1]]) pkg_name <- environmentName(environment(fn_call)) + + # Ensure method can be found. + if (!nzchar(pkg_name)) { + stop(sprintf( + "Unknown method: `%s`. Please check service methods and try again.", + as.character(fn)[1]), + call. = F + ) + } + fn_body <- body(fn_call) fn_input <- names(formals(fn_call)) output_name <- names(eval(fn_body[[4]][[3]], envir = getNamespace(pkg_name))) # Get Tokens # Identify token parameter names - token_nms <- output_name[grep("Token", output_name)] - next_token <- token_nms[grepl("Next.*Token", token_nms)] + token_nms <- output_name[grep("token", output_name, ignore.case = T)] + next_token <- token_nms[grepl("next.*token", token_nms, ignore.case = T)] continuation_token <- token_nms[token_nms %in% fn_input] fn[continuation_token] <- StartingToken - # Identify if MaxKey/MaxItems used - max_items <- c("MaxKeys", "MaxItems") - max_items <- max_items[max_items %in% fn_input] + # Identify if MaxKey/MaxItems/maxResults used + max_items <- fn_input[grep("^max", fn_input, ignore.case = T)] fn[max_items] <- MaxItems result <- list() @@ -55,30 +71,86 @@ paginate <- function(operation, MaxRetries = 5, MaxItems = NULL, StartingToken = return(result) } +#' @rdname paginate +#' @export +paginate_lapply <- function(operation, + FUN, + ..., + MaxRetries = 5, + MaxItems = NULL, + StartingToken = NULL) { + FUN <- match.fun(FUN) + fn <- substitute(operation) + fn_call <- eval(fn[[1]]) + pkg_name <- environmentName(environment(fn_call)) + + # Ensure method can be found. + if (!nzchar(pkg_name)) { + stop(sprintf( + "Unknown method: `%s`. Please check service methods and try again.", + as.character(fn)[1]), + call. = F + ) + } + + fn_body <- body(fn_call) + fn_input <- names(formals(fn_call)) + output_name <- names(eval(fn_body[[4]][[3]], envir = getNamespace(pkg_name))) + + # Get Tokens + # Identify token parameter names + token_nms <- output_name[grep("token", output_name, ignore.case = T)] + next_token <- token_nms[grepl("next.*token", token_nms, ignore.case = T)] + continuation_token <- token_nms[token_nms %in% fn_input] + fn[continuation_token] <- StartingToken + + # Identify if MaxKey/MaxItems/maxResults used + max_items <- fn_input[grep("^max", fn_input, ignore.case = T)] + fn[max_items] <- MaxItems + + result <- list() + while (!identical(fn[[continuation_token]], character(0))) { + resp <- retry_api_call(eval(fn), MaxRetries) + fn[[continuation_token]] <- resp[[next_token]] + result[[length(result) + 1]] <- FUN(resp, ...) + } + return(result) +} + +# See https://docs.aws.amazon.com/sdkref/latest/guide/feature-retry-behavior.html retry_api_call <- function(expr, retries){ for (i in seq_len(retries + 1)){ tryCatch({ return(eval.parent(substitute(expr))) - }, http_100 = function(err) { + }, http_400 = function(err) { back_off(err, i, retries) - }, http_200 = function(err) { + }, http_403 = function(err) { back_off(err, i, retries) - }, http_300 = function(err) { + }, http_408 = function(err) { + back_off(err, i, retries) + }, http_429 = function(err) { back_off(err, i, retries) - }, http_400 = function(err) { - stop(err) }, http_500 = function(err) { back_off(err, i, retries) + }, http_502 = function(err) { + stop(err) + }, http_503 = function(err) { + back_off(err, i, retries) + }, http_504 = function(err) { + back_off(err, i, retries) + }, http_509 = function(err) { + back_off(err, i, retries) }, error = function(err) { stop(err) }) } } +# Retry with exponential backoff. back_off <- function(error, i, retries) { if(i == (retries + 1)) stop(error) - time = 2**i * 0.1 + time = min(runif(1)*2^i, 20) log_error("Request failed. Retrying in %s seconds...", time) Sys.sleep(time) } diff --git a/paws.common/man/paginate.Rd b/paws.common/man/paginate.Rd index 12a9a14bd..e91471244 100644 --- a/paws.common/man/paginate.Rd +++ b/paws.common/man/paginate.Rd @@ -2,9 +2,19 @@ % Please edit documentation in R/paginate.R \name{paginate} \alias{paginate} +\alias{paginate_lapply} \title{Paginate over an operation.} \usage{ paginate(operation, MaxRetries = 5, MaxItems = NULL, StartingToken = NULL) + +paginate_lapply( + operation, + FUN, + ..., + MaxRetries = 5, + MaxItems = NULL, + StartingToken = NULL +) } \arguments{ \item{operation}{The operation} @@ -15,6 +25,10 @@ paginate(operation, MaxRetries = 5, MaxItems = NULL, StartingToken = NULL) \item{StartingToken}{Can be used to modify the starting marker or token of a paginator. This argument if useful for resuming pagination from a previous token or starting pagination at a known position.} + +\item{FUN}{the function to be applied to each response element of \code{operation}.} + +\item{...}{optional arguments to \code{FUN}.} } \description{ Some AWS operations return results that are incomplete and require subsequent From b84fd4b023b03807b4e9900583a6709c82148416 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Wed, 26 Jul 2023 18:08:45 +0100 Subject: [PATCH 04/19] include paginator information to operations --- make.paws/R/operations.R | 21 +++++++++++++++++++-- make.paws/R/read_api.R | 14 ++++++++++++++ make.paws/R/utils.R | 23 ++++++++++++++++------- 3 files changed, 49 insertions(+), 9 deletions(-) diff --git a/make.paws/R/operations.R b/make.paws/R/operations.R index 781fb7461..81fd85607 100644 --- a/make.paws/R/operations.R +++ b/make.paws/R/operations.R @@ -1,4 +1,5 @@ #' @include templates.R +#' @include utils.R NULL operation_file_template <- template( @@ -36,7 +37,7 @@ operation_template <- template( name = ${operation_name}, http_method = ${http_method}, http_path = ${http_path}, - paginator = list() + paginator = ${paginator} ) input <- .${service}$${operation_input} output <- .${service}$${operation_output} @@ -62,10 +63,26 @@ make_operation <- function(operation, api, doc_maker) { operation_input = get_operation_input(operation, api), operation_output = get_operation_output(operation), http_method = quoted(operation$http$method), - http_path = quoted(operation$http$requestUri) + http_path = quoted(operation$http$requestUri), + paginator = set_paginator(operation$paginators) ) } +set_paginator <- function(paginator) { + if (!is.null(paginator)) { + output_token <- paginator$output_token + if (!is.null(output_token)) { + for (i in seq_along(output_token)) { + output_token[[i]] <- strsplit(output_token[[i]], " ")[[1]][[1]] + } + paginator$output_token <- output_token + } + paste(trimws(deparse(paginator)), collapse = " ") + } else { + "list()" + } +} + # Override operation name from extdata/operation_name_override.yml operation_name_override <- function(operation_name) { path <- system_file( diff --git a/make.paws/R/read_api.R b/make.paws/R/read_api.R index ed5d86f08..4e5de4a51 100644 --- a/make.paws/R/read_api.R +++ b/make.paws/R/read_api.R @@ -14,6 +14,10 @@ read_api <- function(api_name, path) { examples <- jsonlite::read_json(files$examples) api <- merge_examples(api, examples$examples) } + if (!is.null(files$paginators)) { + paginators <- jsonlite::read_json(files$paginators) + api <- merge_paginators(api, paginators$pagination) + } region_config <- jsonlite::read_json(region_config_path) api <- merge_region_config(api, region_config) api <- fix_region_config(api) @@ -48,6 +52,16 @@ merge_examples <- function(api, examples) { return(api) } +# Returns an API object with paginators merged into the corresponding operations. +merge_paginators <- function(api, paginators) { + for (name in names(paginators)) { + operation <- api$operations[[name]] + operation[["paginators"]] <- paginators[[name]] + api$operations[[name]] <- operation + } + return(api) +} + # Returns an API object with region config info attached. Region config info # lists endpoints for each service and region, if different from the default. merge_region_config <- function(api, region_config) { diff --git a/make.paws/R/utils.R b/make.paws/R/utils.R index 864604098..417238e6d 100644 --- a/make.paws/R/utils.R +++ b/make.paws/R/utils.R @@ -13,7 +13,7 @@ parse_operations <- function(text) { ids <- rep(NA, length(text)) id <- 1 for (i in seq_along(text)) { - if (i > 1 && startsWith(text[i], "#'") && !startsWith(text[i-1], "#'")) { + if (i > 1 && startsWith(text[i], "#'") && !startsWith(text[i - 1], "#'")) { id <- id + 1 } ids[i] <- id @@ -35,9 +35,11 @@ parse_operation <- function(text) { comment_lines <- startsWith(text, "#'") comment <- text[comment_lines] code <- text[!comment_lines] - if (length(code) == 0 || all(code == "") || code[1] == "NULL") return(NULL) + if (length(code) == 0 || all(code == "") || code[1] == "NULL") { + return(NULL) + } func <- strsplit(code[1], " ")[[1]][1] - name <- substring(func, regexpr("_", func)+1) + name <- substring(func, regexpr("_", func) + 1) operation <- list( name = name, http = list(), @@ -65,14 +67,18 @@ system_file <- function(..., package = "base") { pkg_path <- find.package(package) subfolder <- list(...) if (length(subfolder) > 0) { - if (subfolder[[1]] == "src") + if (subfolder[[1]] == "src") { subfolder[[1]] <- "R" - else + } else { subfolder <- c("inst", subfolder) + } } path <- do.call(file.path, c(pkg_path, subfolder)) - if (file.exists(path)) return(path) - else return("") + if (file.exists(path)) { + return(path) + } else { + return("") + } } } @@ -125,3 +131,6 @@ get_url <- function(url, tries = 3) { return(NULL) }) } + +# helper function to make it easy to replace NULLs with default value +`%||%` <- function(x, y) if (is.null(x)) y else x From debd0ebbe43ccf037e83f1808a15d155b020a909 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Wed, 26 Jul 2023 18:08:59 +0100 Subject: [PATCH 05/19] reexport paginate_sapply --- make.paws/inst/templates/reexports_paws.common.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/make.paws/inst/templates/reexports_paws.common.R b/make.paws/inst/templates/reexports_paws.common.R index 347ca4325..99b43edae 100644 --- a/make.paws/inst/templates/reexports_paws.common.R +++ b/make.paws/inst/templates/reexports_paws.common.R @@ -6,6 +6,10 @@ paws.common::paginate #' @export paws.common::paginate_lapply +#' @importFrom paws.common paginate_sapply +#' @export +paws.common::paginate_sapply + #' @importFrom paws.common config #' @export paws.common::config From 7b479709bfb416c737817b49ece5d8a62aa9f83a Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Wed, 26 Jul 2023 18:10:08 +0100 Subject: [PATCH 06/19] use paginator information from operations to build paginate query, simply retry and only retry rate execeed errors, include *_sapply method --- paws.common/NAMESPACE | 1 + paws.common/R/paginate.R | 218 ++++++++++++++++++++++++++++-------- paws.common/man/paginate.Rd | 13 +++ 3 files changed, 187 insertions(+), 45 deletions(-) diff --git a/paws.common/NAMESPACE b/paws.common/NAMESPACE index f815aa0d3..11fd598c1 100644 --- a/paws.common/NAMESPACE +++ b/paws.common/NAMESPACE @@ -26,6 +26,7 @@ export(new_request) export(new_service) export(paginate) export(paginate_lapply) +export(paginate_sapply) export(paws_config_log) export(populate) export(send_request) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index 6201d150f..8e9696b46 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -16,6 +16,7 @@ #' @param StartingToken Can be used to modify the starting marker or token of a paginator. #' This argument if useful for resuming pagination from a previous token or starting pagination at a known position. #' @param FUN the function to be applied to each response element of \code{operation}. +#' @param simplify See \link[base:sapply]{base::sapply()}. #' @param ... optional arguments to \code{FUN}. #' @examples #' \dontrun{ @@ -48,24 +49,38 @@ paginate <- function(operation, } fn_body <- body(fn_call) - fn_input <- names(formals(fn_call)) - output_name <- names(eval(fn_body[[4]][[3]], envir = getNamespace(pkg_name))) + paginator <- fn_body[[2]][[3]]$paginator - # Get Tokens - # Identify token parameter names - token_nms <- output_name[grep("token", output_name, ignore.case = T)] - next_token <- token_nms[grepl("next.*token", token_nms, ignore.case = T)] - continuation_token <- token_nms[token_nms %in% fn_input] - fn[continuation_token] <- StartingToken + # Check if method can paginate + if (!all(c("input_token","output_token") %in% names(paginator))) { + stop(sprintf( + "Method: `%s` is unable to paginate.", + as.character(fn)[1]), + call. = F + ) + } - # Identify if MaxKey/MaxItems/maxResults used - max_items <- fn_input[grep("^max", fn_input, ignore.case = T)] - fn[max_items] <- MaxItems + # Get input_token/output_token and limit_key from paginator + input_token <- paginator$input_token + output_token <- paginator$output_token + limit_key <- paginator$limit_key + # only update input_token if single token + if (length(input_token) == 1) { + if (is.null(fn[[input_token]])) { + fn[input_token] <- StartingToken + } + } + if(is.null(fn[[limit_key]])) { + fn[limit_key] <- MaxItems + } result <- list() - while (!identical(fn[[continuation_token]], character(0))) { + while (!identical(fn[[input_token[[1]]]], character(0))) { resp <- retry_api_call(eval(fn), MaxRetries) - fn[[continuation_token]] <- resp[[next_token]] + new_tokens <- get_tokens(resp, output_token) + for (i in seq_along(new_tokens)) { + fn[[input_token[[i]]]] <- new_tokens[[i]] + } result[[length(result) + 1]] <- resp } return(result) @@ -94,54 +109,167 @@ paginate_lapply <- function(operation, } fn_body <- body(fn_call) - fn_input <- names(formals(fn_call)) - output_name <- names(eval(fn_body[[4]][[3]], envir = getNamespace(pkg_name))) + paginator <- fn_body[[2]][[3]]$paginator - # Get Tokens - # Identify token parameter names - token_nms <- output_name[grep("token", output_name, ignore.case = T)] - next_token <- token_nms[grepl("next.*token", token_nms, ignore.case = T)] - continuation_token <- token_nms[token_nms %in% fn_input] - fn[continuation_token] <- StartingToken + # Check if method can paginate + if (!all(c("input_token","output_token") %in% names(paginator))) { + stop(sprintf( + "Method: `%s` is unable to paginate.", + as.character(fn)[1]), + call. = F + ) + } - # Identify if MaxKey/MaxItems/maxResults used - max_items <- fn_input[grep("^max", fn_input, ignore.case = T)] - fn[max_items] <- MaxItems + # Get input_token/output_token and limit_key from paginator + input_token <- paginator$input_token + output_token <- paginator$output_token + limit_key <- paginator$limit_key + # only update input_token if single token + if (length(input_token) == 1) { + if (is.null(fn[[input_token]])) { + fn[input_token] <- StartingToken + } + } + if(is.null(fn[[limit_key]])) { + fn[limit_key] <- MaxItems + } result <- list() - while (!identical(fn[[continuation_token]], character(0))) { + while (!identical(fn[[input_token[[1]]]], character(0))) { resp <- retry_api_call(eval(fn), MaxRetries) - fn[[continuation_token]] <- resp[[next_token]] + new_tokens <- get_tokens(resp, output_token) + for (i in seq_along(new_tokens)) { + fn[[input_token[[i]]]] <- new_tokens[[i]] + } result[[length(result) + 1]] <- FUN(resp, ...) } return(result) } +#' @rdname paginate +#' @export +paginate_sapply <- function(operation, + FUN, + ..., + simplify = TRUE, + MaxRetries = 5, + MaxItems = NULL, + StartingToken = NULL) { + FUN <- match.fun(FUN) + fn <- substitute(operation) + fn_call <- eval(fn[[1]]) + pkg_name <- environmentName(environment(fn_call)) + + # Ensure method can be found. + if (!nzchar(pkg_name)) { + stop(sprintf( + "Unknown method: `%s`. Please check service methods and try again.", + as.character(fn)[1]), + call. = F + ) + } + + fn_body <- body(fn_call) + paginator <- fn_body[[2]][[3]]$paginator + + # Check if method can paginate + if (!all(c("input_token","output_token") %in% names(paginator))) { + stop(sprintf( + "Method: `%s` is unable to paginate.", + as.character(fn)[1]), + call. = F + ) + } + + # Get input_token/output_token and limit_key from paginator + input_token <- paginator$input_token + output_token <- paginator$output_token + limit_key <- paginator$limit_key + + # only update input_token if single token + if (length(input_token) == 1) { + if (is.null(fn[[input_token]])) { + fn[input_token] <- StartingToken + } + } + if(is.null(fn[[limit_key]])) { + fn[limit_key] <- MaxItems + } + result <- list() + while (!identical(fn[[input_token[[1]]]], character(0))) { + resp <- retry_api_call(eval(fn), MaxRetries) + new_tokens <- get_tokens(resp, output_token) + for (i in seq_along(new_tokens)) { + fn[[input_token[[i]]]] <- new_tokens[[i]] + } + result[[length(result) + 1]] <- FUN(resp, ...) + } + + if (!isFALSE(simplify)) + simplify2array(result, higher = (simplify == "array")) + else result +} + +# Get all output tokens +get_tokens <- function(resp, output_tokens) { + tokens <- list() + for (token in output_tokens) { + if(grepl("\\[-1\\]", token)) { + tokens[[token]] <- get_token_len(resp, token) + } else { + tokens[[token]] <- get_token_path(resp, token) + } + } + return(tokens) +} + +# Get Token along a response path: i.e. +# Path.To.Token +get_token_path <- function(resp, token) { + token_prts <- strsplit(token, "\\.")[[1]] + build_key <- c() + for (i in seq_along(token_prts)) { + build_key[i] <- token_prts[[i]] + } + location <- paste0('resp[["',paste(build_key, collapse = '"]][["'), '"]]') + return(eval(parse(text = location), envir = environment())) +} + +# Get Token from the last element in a response path: i.e. +# Path.To[-1].Token +get_token_len <- function(resp, token) { + last_element <- function(x) x[[length(x)]] + build_part <- function(x) { + paste0('last_element(resp[["', paste0(x, collapse = '"]][["'), '"]])') + } + token_prts <- strsplit(token, "\\.")[[1]] + + build_key <- c() + for (i in seq_along(token_prts)) { + if(grepl("\\[-1\\]", token_prts[[i]])) { + build_key[length(build_key) +1] <- gsub("\\[-1\\]", "", key) + build_key <- build_part(build_key) + } else { + build_key[length(build_key) +1] <- token_prts[[i]] + } + } + location <- paste0(paste(build_key, collapse = '[["'), '"]]') + return(eval(parse(text = location), envir = environment())) +} + + # See https://docs.aws.amazon.com/sdkref/latest/guide/feature-retry-behavior.html retry_api_call <- function(expr, retries){ for (i in seq_len(retries + 1)){ tryCatch({ return(eval.parent(substitute(expr))) - }, http_400 = function(err) { - back_off(err, i, retries) - }, http_403 = function(err) { - back_off(err, i, retries) - }, http_408 = function(err) { - back_off(err, i, retries) - }, http_429 = function(err) { - back_off(err, i, retries) - }, http_500 = function(err) { - back_off(err, i, retries) - }, http_502 = function(err) { - stop(err) - }, http_503 = function(err) { - back_off(err, i, retries) - }, http_504 = function(err) { - back_off(err, i, retries) - }, http_509 = function(err) { - back_off(err, i, retries) }, error = function(err) { - stop(err) + msg <- err$message + if (grepl("rate exceeded", msg, ignore.case = T)) { + back_off(err, i, retries) + } else { + stop(err) + } }) } } diff --git a/paws.common/man/paginate.Rd b/paws.common/man/paginate.Rd index e91471244..9ecef0343 100644 --- a/paws.common/man/paginate.Rd +++ b/paws.common/man/paginate.Rd @@ -3,6 +3,7 @@ \name{paginate} \alias{paginate} \alias{paginate_lapply} +\alias{paginate_sapply} \title{Paginate over an operation.} \usage{ paginate(operation, MaxRetries = 5, MaxItems = NULL, StartingToken = NULL) @@ -15,6 +16,16 @@ paginate_lapply( MaxItems = NULL, StartingToken = NULL ) + +paginate_sapply( + operation, + FUN, + ..., + simplify = TRUE, + MaxRetries = 5, + MaxItems = NULL, + StartingToken = NULL +) } \arguments{ \item{operation}{The operation} @@ -29,6 +40,8 @@ This argument if useful for resuming pagination from a previous token or startin \item{FUN}{the function to be applied to each response element of \code{operation}.} \item{...}{optional arguments to \code{FUN}.} + +\item{simplify}{See \link[base:sapply]{base::sapply()}.} } \description{ Some AWS operations return results that are incomplete and require subsequent From a3cc82634ef4ec9d99be4d71b5e14ed1a9811d02 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Thu, 27 Jul 2023 17:25:56 +0100 Subject: [PATCH 07/19] add helper function stopf --- paws.common/DESCRIPTION | 2 +- paws.common/R/credential_providers.R | 14 +-- paws.common/R/custom_s3.R | 182 ++++++++++++++++----------- paws.common/R/iniutil.R | 4 +- paws.common/R/net.R | 11 +- paws.common/R/populate.R | 34 +++-- paws.common/R/struct.R | 6 +- paws.common/R/util.R | 31 +++-- 8 files changed, 177 insertions(+), 107 deletions(-) diff --git a/paws.common/DESCRIPTION b/paws.common/DESCRIPTION index db0bdf1cb..20adb95f5 100644 --- a/paws.common/DESCRIPTION +++ b/paws.common/DESCRIPTION @@ -38,6 +38,7 @@ Roxygen: list(markdown = TRUE, roclets = c("rd", "namespace", "collate")) RoxygenNote: 7.2.3 Collate: 'RcppExports.R' + 'util.R' 'struct.R' 'handlers.R' 'logging.R' @@ -55,7 +56,6 @@ Collate: 'service.R' 'custom_dynamodb.R' 'custom_rds.R' - 'util.R' 'xmlutil.R' 'stream.R' 'custom_s3.R' diff --git a/paws.common/R/credential_providers.R b/paws.common/R/credential_providers.R index 7e9adde4f..ca03b0b29 100644 --- a/paws.common/R/credential_providers.R +++ b/paws.common/R/credential_providers.R @@ -4,6 +4,7 @@ #' @include dateutil.R #' @include iniutil.R #' @include logging.R +#' @include util.R NULL Creds <- struct( @@ -236,17 +237,17 @@ sso_credential_process <- function(sso_session, ) sso_cache <- file.path(root, ".aws", "sso", "cache", json_file) if (!file.exists(sso_cache)) { - stop(sprintf( + stopf( "Error loading SSO Token: Token for %s does not exist", input_str - ), call. = F) + ) } cache_creds <- jsonlite::fromJSON(sso_cache) if (!("accessToken" %in% names(cache_creds)) || !("expiresAt" %in% names(cache_creds))) { - stop(sprintf( + stopf( "Error loading SSO Token: Token for %s is invalid.", sso_start_url - ), call. = F) + ) } svc <- sso( config = list( @@ -494,11 +495,10 @@ iam_credentials_provider <- function() { no_credentials <- function() { message <- ( - if (isTRUE(getOption('paws.log_level') <= 2L)) { + if (isTRUE(getOption("paws.log_level") <= 2L)) { 'No compatible credentials provided. Use `options("paws.log_level" = 3L)` for more information.' } else { "No compatible credentials provided." - } - ) + }) stop(message, call. = FALSE) } diff --git a/paws.common/R/custom_s3.R b/paws.common/R/custom_s3.R index 3f372239b..3e8e28da2 100644 --- a/paws.common/R/custom_s3.R +++ b/paws.common/R/custom_s3.R @@ -7,15 +7,19 @@ NULL convert_file_to_raw <- function(request) { operation_name <- request$operation$name - if (operation_name != "PutObject") return(request) + if (operation_name != "PutObject") { + return(request) + } request_params <- request$params content_body <- request_params["Body"][[1]] - if (!is.character(content_body)) return(request) + if (!is.character(content_body)) { + return(request) + } file_name <- content_body[[1]] if (!file.exists(file_name)) { - stop(sprintf("Unable to find file: %s", file_name)) + stopf("Unable to find file: %s", file_name) } file_connection <- file(file_name, "rb") raw_body <- readBin(file_connection, "raw", n = file.size(file_name)) @@ -32,7 +36,9 @@ bucket_name_from_req_params <- function(request) { request_params <- request$params bucket <- request_params["Bucket"] - if (is.null(bucket)) return(NULL) + if (is.null(bucket)) { + return(NULL) + } bucket_name <- bucket[[1]] @@ -40,7 +46,9 @@ bucket_name_from_req_params <- function(request) { } host_compatible_bucket_name <- function(bucket) { - if (grepl(".", bucket, fixed = TRUE)) return(FALSE) + if (grepl(".", bucket, fixed = TRUE)) { + return(FALSE) + } domain <- "^[a-z0-9][a-z0-9\\.\\-]{1,61}[a-z0-9]$" ip_address <- "^(\\d+\\.){3}\\d+$" return(grepl(domain, bucket) && !grepl(ip_address, bucket)) @@ -51,7 +59,7 @@ move_bucket_to_host <- function(url, bucket) { url$path <- gsub("/\\{Bucket\\}", "", url$path) if (url$path == "") { - url$path = "/" + url$path <- "/" } return(url) @@ -89,7 +97,9 @@ remove_bucket_from_url <- function(url) { update_endpoint_for_s3_config <- function(request) { bucket_name <- bucket_name_from_req_params(request) - if (is.null(bucket_name)) return(request) + if (is.null(bucket_name)) { + return(request) + } if (is_access_point(bucket_name)) { request$http_request$url$host <- get_access_point_endpoint(bucket_name) @@ -97,9 +107,13 @@ update_endpoint_for_s3_config <- function(request) { return(request) } - if (!host_compatible_bucket_name(bucket_name)) return(request) + if (!host_compatible_bucket_name(bucket_name)) { + return(request) + } - if (request$operation$name %in% c("GetBucketLocation")) return(request) + if (request$operation$name %in% c("GetBucketLocation")) { + return(request) + } use_virtual_host_style <- TRUE if (request$config$s3_force_path_style) use_virtual_host_style <- FALSE @@ -116,10 +130,11 @@ update_endpoint_for_s3_config <- function(request) { ################################################################################ populate_location_constraint <- function(request) { - operation_name <- request$operation$name - if (operation_name != "CreateBucket") return(request) + if (operation_name != "CreateBucket") { + return(request) + } request_params <- request$params location <- request_params$CreateBucketConfiguration$LocationConstraint @@ -135,12 +150,16 @@ populate_location_constraint <- function(request) { content_md5 <- function(request) { operation_name <- request$operation$name - if (!(operation_name %in% c("PutBucketCors", "PutBucketLifecycle", - "PutBucketPolicy", "PutBucketTagging", - "DeleteObjects", - "PutBucketLifecycleConfiguration", - "PutBucketReplication", "PutObject", - "UploadPart"))) {return(request)} + if (!(operation_name %in% c( + "PutBucketCors", "PutBucketLifecycle", + "PutBucketPolicy", "PutBucketTagging", + "DeleteObjects", + "PutBucketLifecycleConfiguration", + "PutBucketReplication", "PutObject", + "UploadPart" + ))) { + return(request) + } # Create Content-MD5 header if missing. # https://github.com/aws/aws-sdk-go/blob/e2d6cb448883e4f4fcc5246650f89bde349041ec/private/checksum/content_md5.go#L18 if (is.null(request$http_request$header[["Content-MD5"]])) { @@ -156,7 +175,9 @@ content_md5 <- function(request) { ################################################################################ s3_unmarshal_select_object_content <- function(request) { - if (request$operation$name != "SelectObjectContent") return(request) + if (request$operation$name != "SelectObjectContent") { + return(request) + } payload <- stream_decode(request$http_response$body) request$data <- populate(list(Payload = payload), request$data) request$http_response$body <- raw() @@ -166,12 +187,17 @@ s3_unmarshal_select_object_content <- function(request) { ################################################################################ s3_unmarshal_get_bucket_location <- function(request) { - if (request$operation$name != "GetBucketLocation") return(request) + if (request$operation$name != "GetBucketLocation") { + return(request) + } response <- decode_xml(request$http_response$body) data <- request$data location <- response$LocationConstraint - if (length(location) == 0) location <- "us-east-1" - else location <- location[[1]] + if (length(location) == 0) { + location <- "us-east-1" + } else { + location <- location[[1]] + } if (location == "EU") location <- "eu-west-1" data$LocationConstraint <- location request$data <- data @@ -181,7 +207,6 @@ s3_unmarshal_get_bucket_location <- function(request) { ################################################################################ s3_unmarshal_error <- function(request) { - data <- tryCatch( decode_xml(request$http_response$body), error = function(e) NULL @@ -221,9 +246,11 @@ 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 <- Error( + "SerializationError", + "failed to decode query XML error response", + request$http_response$status_code + ) return(request) } @@ -258,13 +285,13 @@ s3_endpoints <- list( # contains the endpoint the request should be sent to. This handler # will add the redirect information to the signing context and then # redirect the request. -s3_redirect_from_error <- function(request){ +s3_redirect_from_error <- function(request) { if (is.null(request$http_response)) { - return(request) + return(request) } if (isTRUE(request$context$s3_redirect)) { log_debug( - 'S3 request was previously redirected, not redirecting.' + "S3 request was previously redirected, not redirecting." ) return(request) } @@ -273,7 +300,7 @@ s3_redirect_from_error <- function(request){ # Exit s3_redirect_from_error function if initial request is successful # https://docs.aws.amazon.com/waf/latest/developerguide/customizing-the-response-status-codes.html http_success_code <- c(200, 201, 202, 204, 206) - if(error_code %in% http_success_code){ + if (error_code %in% http_success_code) { return(request) } error <- decode_xml(request$http_response$body)$Error @@ -283,18 +310,22 @@ s3_redirect_from_error <- function(request){ bucket_name <- bucket_name_from_req_params(request) new_region <- s3_get_bucket_region(request$http_response, error) if (is.null(new_region)) { - log_debug(paste( - "S3 client configured for region %s but the bucket %s is not", - "in that region and the proper region could not be", - "automatically determined."), + log_debug( + paste( + "S3 client configured for region %s but the bucket %s is not", + "in that region and the proper region could not be", + "automatically determined." + ), request$client_info$signing_region, bucket_name ) return(request) } - log_debug(paste( - "S3 client configured for region %s but the bucket %s is in region", - "%s; Please configure the proper region to avoid multiple", - "unnecessary redirects and signing attempts."), + log_debug( + paste( + "S3 client configured for region %s but the bucket %s is in region", + "%s; Please configure the proper region to avoid multiple", + "unnecessary redirects and signing attempts." + ), request$client_info$signing_region, bucket_name, new_region ) # Update client_info for redirect @@ -322,24 +353,24 @@ s3_redirect_from_error <- function(request){ return(request) } -can_be_redirected <- function(request, error_code, error){ +can_be_redirected <- function(request, error_code, error) { # We have to account for 400 responses because # if we sign a Head* request with the wrong region, # we'll get a 400 Bad Request but we won't get a # body saying it's an "AuthorizationHeaderMalformed". is_special_head_object <- ( - error_code %in% c('301', '400') & request$operation$name == 'HeadObject' + error_code %in% c("301", "400") & request$operation$name == "HeadObject" ) is_special_head_bucket <- ( - error_code %in% c('301', '400') - & request$operation$name == 'HeadBucket' - & 'x-amz-bucket-region' %in% names(request$http_response$header) + error_code %in% c("301", "400") & + request$operation$name == "HeadBucket" & + "x-amz-bucket-region" %in% names(request$http_response$header) ) is_wrong_signing_region <- ( - error$Code == 'AuthorizationHeaderMalformed' & 'Region' %in% names(error) + error$Code == "AuthorizationHeaderMalformed" & "Region" %in% names(error) ) is_redirect_status <- request$http_response$status_code %in% c(301, 302, 307) - is_permanent_redirect <- error$Code == 'PermanentRedirect' + is_permanent_redirect <- error$Code == "PermanentRedirect" return(any( c( @@ -348,9 +379,8 @@ can_be_redirected <- function(request, error_code, error){ is_permanent_redirect, is_special_head_bucket, is_redirect_status - ) ) - ) + )) } # There are multiple potential sources for the new region to redirect to, @@ -359,11 +389,11 @@ 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(response, error) { # First try to source the region from the headers. response_headers <- response$header - if ('x-amz-bucket-region' %in% names(response_headers)){ - return(response_headers[['x-amz-bucket-region']]) + if ("x-amz-bucket-region" %in% names(response_headers)) { + return(response_headers[["x-amz-bucket-region"]]) } # Next, check the error body region <- error$Region @@ -375,7 +405,7 @@ s3_get_bucket_region <- function(response, error){ # discarded by this function. set_request_url <- function(original_endpoint, new_endpoint, - use_new_scheme = TRUE){ + use_new_scheme = TRUE) { new_endpoint_components <- httr::parse_url(new_endpoint) original_endpoint_components <- httr::parse_url(original_endpoint) scheme <- original_endpoint_components$scheme @@ -383,14 +413,14 @@ set_request_url <- function(original_endpoint, scheme <- new_endpoint_components$scheme } final_endpoint_components <- structure(list( - scheme = scheme, - hostname = new_endpoint_components$hostname %||% "", - path = original_endpoint_components$path %||% "", - query = original_endpoint_components$query %||% "", - fragment = "", - raw_path = "", - raw_query = ""), class = "url" - ) + scheme = scheme, + hostname = new_endpoint_components$hostname %||% "", + path = original_endpoint_components$path %||% "", + query = original_endpoint_components$query %||% "", + fragment = "", + raw_path = "", + raw_query = "" + ), class = "url") final_endpoint <- build_url(final_endpoint_components) return(final_endpoint) } @@ -398,19 +428,31 @@ set_request_url <- function(original_endpoint, ################################################################################ customizations$s3 <- function(handlers) { - handlers$build <- handlers_add_front(handlers$build, - update_endpoint_for_s3_config) - handlers$build <- handlers_add_front(handlers$build, - populate_location_constraint) - handlers$build <- handlers_add_front(handlers$build, - convert_file_to_raw) - handlers$build <- handlers_add_back(handlers$build, - content_md5) + handlers$build <- handlers_add_front( + handlers$build, + update_endpoint_for_s3_config + ) + handlers$build <- handlers_add_front( + handlers$build, + populate_location_constraint + ) + handlers$build <- handlers_add_front( + handlers$build, + convert_file_to_raw + ) + handlers$build <- handlers_add_back( + handlers$build, + content_md5 + ) handlers$send <- handlers_add_back(handlers$send, s3_redirect_from_error) - handlers$unmarshal <- handlers_add_front(handlers$unmarshal, - s3_unmarshal_select_object_content) - handlers$unmarshal <- handlers_add_back(handlers$unmarshal, - s3_unmarshal_get_bucket_location) + handlers$unmarshal <- handlers_add_front( + handlers$unmarshal, + s3_unmarshal_select_object_content + ) + handlers$unmarshal <- handlers_add_back( + handlers$unmarshal, + s3_unmarshal_get_bucket_location + ) handlers$unmarshal_error <- handlers_set(s3_unmarshal_error) handlers } diff --git a/paws.common/R/iniutil.R b/paws.common/R/iniutil.R index 902bf2ef0..a43748b2e 100644 --- a/paws.common/R/iniutil.R +++ b/paws.common/R/iniutil.R @@ -1,3 +1,5 @@ +#' @include util.R + # Get the profile name from an ini file extract_ini_profile <- function(item) { profile <- gsub("\\[|\\]", "", item) @@ -17,7 +19,7 @@ extract_ini_parameter <- function(item) { # Read in values from an ini file read_ini <- function(file_name) { if (!file.exists(file_name)) { - stop(sprintf("Unable to find file: %s", file_name)) + stopf("Unable to find file: %s", file_name) } content <- scan(file_name, what = "", sep = "\n", quiet = T) profiles <- list() diff --git a/paws.common/R/net.R b/paws.common/R/net.R index 802acc2dc..db32708f9 100644 --- a/paws.common/R/net.R +++ b/paws.common/R/net.R @@ -1,5 +1,6 @@ #' @include struct.R #' @include url.R +#' @include util.R NULL # Construct an HTTP request object. @@ -63,7 +64,7 @@ new_http_request <- function(method, url, body = NULL, close = FALSE, connect_ti method <- "GET" } if (!valid_method(method)) { - stop(sprintf("invalid method: %s", method)) + stopf("invalid method: %s", method) } u <- parse_url(url) req <- HttpRequest( @@ -120,14 +121,14 @@ issue <- function(http_request) { # utilize httr to write to disk dest <- NULL - if(!is.null(http_request$dest)) { + if (!is.null(http_request$dest)) { dest <- httr::write_disk(http_request$dest) } r <- with_paws_verbose( httr::VERB( method, url = url, - config = c(httr::add_headers(.headers=headers), dest), + config = c(httr::add_headers(.headers = headers), dest), body = body, timeout ) @@ -139,7 +140,7 @@ issue <- function(http_request) { content_length = as.integer(httr::headers(r)$`content-length`), # Prevent reading in data when output is set body = ( - if(is.null(http_request$dest)) httr::content(r, as = "raw") else raw() + if (is.null(http_request$dest)) httr::content(r, as = "raw") else raw() ) ) @@ -163,7 +164,7 @@ is_compressed <- function(http_response) { } if (content_encoding == "gzip") { - bits_to_int <- function(x) sum(as.integer(x) * 2^(1:length(x)-1)) + bits_to_int <- function(x) sum(as.integer(x) * 2^(1:length(x) - 1)) cmf <- http_response$body[1] flg <- http_response$body[2] compression_method <- bits_to_int(rawToBits(cmf)[1:4]) diff --git a/paws.common/R/populate.R b/paws.common/R/populate.R index b7a008536..773e7bb0a 100644 --- a/paws.common/R/populate.R +++ b/paws.common/R/populate.R @@ -1,9 +1,13 @@ +#' @include util.R + # Sometimes the locationName is different from the interface name -check_location_name <- function(name, interface){ +check_location_name <- function(name, interface) { location_names <- sapply(interface, function(x) tag_get(x, "locationName")) in_location_names <- name %in% location_names - if (!in_location_names) return(in_location_names) + if (!in_location_names) { + return(in_location_names) + } location_index <- which(name == location_names) @@ -16,15 +20,20 @@ populate_structure <- function(input, interface) { # If interface is empty (input shape is incomplete), return the input data. # Only needed because input shapes have fixed depth, and some services, # e.g. DynamoDB, can accept data of arbitrary depth. - if (length(interface) == 0) return(input) + if (length(interface) == 0) { + return(input) + } for (name in names(input)) { if (!(name) %in% names(interface)) { check_location <- check_location_name(name, interface) - if (!check_location) - stop(sprintf("invalid name: %s", name)) + if (!check_location) { + stopf("invalid name: %s", name) + } - interface[[check_location]] <- populate(input[[name]], - interface[[check_location]]) + interface[[check_location]] <- populate( + input[[name]], + interface[[check_location]] + ) } else { interface[[name]] <- populate(input[[name]], interface[[name]]) } @@ -36,7 +45,9 @@ populate_list <- function(input, interface) { # If interface is empty (input shape is incomplete), return the input data. # Only needed because input shapes have fixed depth, and some services, # e.g. DynamoDB, can accept data of arbitrary depth. - if (length(interface) == 0) return(input) + if (length(interface) == 0) { + return(input) + } attrs <- attributes(interface) interface <- lapply(input, function(x) populate(x, interface[[1]])) attributes(interface) <- attrs @@ -47,7 +58,9 @@ populate_map <- function(input, interface) { # If interface is empty (input shape is incomplete), return the input data. # Only needed because input shapes have fixed depth, and some services, # e.g. DynamoDB, can accept data of arbitrary depth. - if (length(interface) == 0) return(input) + if (length(interface) == 0) { + return(input) + } result <- list() for (name in names(input)) { result[[name]] <- populate(input[[name]], interface[[1]]) @@ -82,8 +95,7 @@ populate_scalar <- function(input, interface) { #' @export populate <- function(input, interface) { t <- tag_get(interface, "type") - populate_fn <- switch( - t, + populate_fn <- switch(t, structure = populate_structure, list = populate_list, map = populate_map, diff --git a/paws.common/R/struct.R b/paws.common/R/struct.R index 68bd002bb..6d735c354 100644 --- a/paws.common/R/struct.R +++ b/paws.common/R/struct.R @@ -1,3 +1,5 @@ +#' @include util.R + # Create a constructor function for a named list data structure, where the # values of its elements be changed but none can be added or deleted. # `MyList <- struct(a = 1, b = 2)` will create a function to construct a @@ -20,7 +22,7 @@ struct <- function(...) { #' @export `[.struct` <- function(x, key) { if (!(key %in% names(x))) { - stop(sprintf("invalid element: %s", key)) + stopf("invalid element: %s", key) } value <- x[[key]] return(value) @@ -35,7 +37,7 @@ struct <- function(...) { #' @export `[<-.struct` <- function(x, key, value) { if (!(key %in% names(x))) { - stop(sprintf("invalid element: %s", key)) + stopf("invalid element: %s", key) } cl <- oldClass(x) class(x) <- NULL diff --git a/paws.common/R/util.R b/paws.common/R/util.R index 718fd5299..8539d45e6 100644 --- a/paws.common/R/util.R +++ b/paws.common/R/util.R @@ -17,7 +17,9 @@ #' #' @export is_empty <- function(x) { - if (is.null(x) || length(x) == 0) return(TRUE) + if (is.null(x) || length(x) == 0) { + return(TRUE) + } UseMethod("is_empty") } @@ -60,7 +62,9 @@ is_empty.default <- function(x) { #' #' @export is_empty_xml <- function(x) { - if (is.null(x) || is_empty_logical(x) || is_empty_character(x)) return(TRUE) + if (is.null(x) || is_empty_logical(x) || is_empty_character(x)) { + return(TRUE) + } UseMethod("is_empty_xml") } @@ -76,7 +80,9 @@ is_empty_xml.raw <- is_empty.raw is_empty_xml.list <- function(x) { # keep empty lists when parsed from parameters # issue: https://github.com/paws-r/paws/issues/537 - if(length(x) == 0) return (FALSE) + if (length(x) == 0) { + return(FALSE) + } return(all(sapply(x, is_empty_xml))) } @@ -109,7 +115,7 @@ call_with_args <- function(f, data) { } # helper function to make it easy to replace NULLs with default value -`%||%` <- function(x,y) if(is.null(x)) y else x +`%||%` <- function(x, y) if (is.null(x)) y else x sort_list <- function(x) { if (length(x) == 0) { @@ -125,7 +131,7 @@ str_match <- function(str, pattern) { # Get parameter names from http_path template: get_template_params <- function(str) { - out <- str_match(str, '\\{(.*?)}') + out <- str_match(str, "\\{(.*?)}") return(out[grep("\\{.*\\}", out, invert = T, perl = T)]) } @@ -137,7 +143,7 @@ sprintf_template <- function(template) { auth_temp <- temp_split[grepl("\\{.*\\}", temp_split)] # set template to sprintf format - m <- gregexpr('\\{(.*?)}', auth_temp, perl = T) + m <- gregexpr("\\{(.*?)}", auth_temp, perl = T) regmatches(auth_temp, m) <- "%s" return(auth_temp) } @@ -148,7 +154,7 @@ sprintf_template <- function(template) { # render params into http_path template # for example: # /{Bucket}/{Key+} -> /demo_bucket/path/to/file -render_template <- function(request){ +render_template <- function(request) { template <- request$operation$http_path template_params <- get_template_params(template) encoded_params <- vector("list", length(template_params)) @@ -156,7 +162,8 @@ render_template <- function(request){ for (p in template_params) { if (grepl("\\+", p, perl = TRUE)) { encoded_params[[p]] <- paws_url_encoder( - request$params[[gsub("\\+", "", p, perl = TRUE)]], safe = "/~" + request$params[[gsub("\\+", "", p, perl = TRUE)]], + safe = "/~" ) } else { encoded_params[[p]] <- paws_url_encoder( @@ -172,8 +179,8 @@ LABEL_RE <- "[a-z0-9][a-z0-9\\-]*[a-z0-9]" # Developed from: # https://github.com/boto/botocore/blob/cc3f1c22f55ba50ca792eb73e7a6f721abdcc5ee/botocore/utils.py#L1275-L1295 -check_dns_name <- function(bucket_name){ - if (grepl("\\.", bucket_name, perl=TRUE)) { +check_dns_name <- function(bucket_name) { + if (grepl("\\.", bucket_name, perl = TRUE)) { return(FALSE) } n <- nchar(bucket_name) @@ -208,3 +215,7 @@ get_auth <- function(request) { } return(auth_path) } + +stopf <- function(fmt, ...) { + stop(sprintf(fmt, ...), call. = FALSE) +} From c16a8fbe92f58f3dafe6b75bdac9a55467ba1f1f Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Thu, 27 Jul 2023 17:26:43 +0100 Subject: [PATCH 08/19] minor formatting tweaks --- paws.common/R/paginate.R | 119 +++++++++++++++++++++------------------ 1 file changed, 63 insertions(+), 56 deletions(-) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index 8e9696b46..6abdc0655 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -38,13 +38,11 @@ paginate <- function(operation, fn <- substitute(operation) fn_call <- eval(fn[[1]]) pkg_name <- environmentName(environment(fn_call)) - # Ensure method can be found. - if (!nzchar(pkg_name)) { - stop(sprintf( + if (!grepl("^paws", pkg_name, perl = T)) { + stopf( "Unknown method: `%s`. Please check service methods and try again.", - as.character(fn)[1]), - call. = F + as.character(fn)[1] ) } @@ -52,11 +50,10 @@ paginate <- function(operation, paginator <- fn_body[[2]][[3]]$paginator # Check if method can paginate - if (!all(c("input_token","output_token") %in% names(paginator))) { - stop(sprintf( + if (!all(c("input_token", "output_token") %in% names(paginator))) { + stopf( "Method: `%s` is unable to paginate.", - as.character(fn)[1]), - call. = F + as.character(fn)[1] ) } @@ -71,12 +68,14 @@ paginate <- function(operation, fn[input_token] <- StartingToken } } - if(is.null(fn[[limit_key]])) { - fn[limit_key] <- MaxItems + if (!is.null(limit_key)) { + if (is.null(fn[[limit_key]])) { + fn[limit_key] <- MaxItems + } } result <- list() while (!identical(fn[[input_token[[1]]]], character(0))) { - resp <- retry_api_call(eval(fn), MaxRetries) + resp <- retry_api_call(eval(fn), retries = MaxRetries) new_tokens <- get_tokens(resp, output_token) for (i in seq_along(new_tokens)) { fn[[input_token[[i]]]] <- new_tokens[[i]] @@ -100,11 +99,10 @@ paginate_lapply <- function(operation, pkg_name <- environmentName(environment(fn_call)) # Ensure method can be found. - if (!nzchar(pkg_name)) { - stop(sprintf( + if (!grepl("^paws", pkg_name, perl = T)) { + stopf( "Unknown method: `%s`. Please check service methods and try again.", - as.character(fn)[1]), - call. = F + as.character(fn)[1] ) } @@ -112,11 +110,10 @@ paginate_lapply <- function(operation, paginator <- fn_body[[2]][[3]]$paginator # Check if method can paginate - if (!all(c("input_token","output_token") %in% names(paginator))) { - stop(sprintf( + if (!all(c("input_token", "output_token") %in% names(paginator))) { + stopf( "Method: `%s` is unable to paginate.", - as.character(fn)[1]), - call. = F + as.character(fn)[1] ) } @@ -131,12 +128,14 @@ paginate_lapply <- function(operation, fn[input_token] <- StartingToken } } - if(is.null(fn[[limit_key]])) { - fn[limit_key] <- MaxItems + if (!is.null(limit_key)) { + if (is.null(fn[[limit_key]])) { + fn[limit_key] <- MaxItems + } } result <- list() while (!identical(fn[[input_token[[1]]]], character(0))) { - resp <- retry_api_call(eval(fn), MaxRetries) + resp <- retry_api_call(eval(fn), retries = MaxRetries) new_tokens <- get_tokens(resp, output_token) for (i in seq_along(new_tokens)) { fn[[input_token[[i]]]] <- new_tokens[[i]] @@ -161,11 +160,10 @@ paginate_sapply <- function(operation, pkg_name <- environmentName(environment(fn_call)) # Ensure method can be found. - if (!nzchar(pkg_name)) { - stop(sprintf( + if (!grepl("^paws", pkg_name, perl = T)) { + stopf( "Unknown method: `%s`. Please check service methods and try again.", - as.character(fn)[1]), - call. = F + as.character(fn)[1] ) } @@ -173,11 +171,10 @@ paginate_sapply <- function(operation, paginator <- fn_body[[2]][[3]]$paginator # Check if method can paginate - if (!all(c("input_token","output_token") %in% names(paginator))) { - stop(sprintf( + if (!all(c("input_token", "output_token") %in% names(paginator))) { + stopf( "Method: `%s` is unable to paginate.", - as.character(fn)[1]), - call. = F + as.character(fn)[1] ) } @@ -192,12 +189,14 @@ paginate_sapply <- function(operation, fn[input_token] <- StartingToken } } - if(is.null(fn[[limit_key]])) { - fn[limit_key] <- MaxItems + if (!is.null(limit_key)) { + if (is.null(fn[[limit_key]])) { + fn[limit_key] <- MaxItems + } } result <- list() while (!identical(fn[[input_token[[1]]]], character(0))) { - resp <- retry_api_call(eval(fn), MaxRetries) + resp <- retry_api_call(eval(fn), retries = MaxRetries) new_tokens <- get_tokens(resp, output_token) for (i in seq_along(new_tokens)) { fn[[input_token[[i]]]] <- new_tokens[[i]] @@ -205,16 +204,18 @@ paginate_sapply <- function(operation, result[[length(result) + 1]] <- FUN(resp, ...) } - if (!isFALSE(simplify)) + if (!isFALSE(simplify)) { simplify2array(result, higher = (simplify == "array")) - else result + } else { + result + } } # Get all output tokens get_tokens <- function(resp, output_tokens) { tokens <- list() for (token in output_tokens) { - if(grepl("\\[-1\\]", token)) { + if (grepl("\\[-1\\]", token)) { tokens[[token]] <- get_token_len(resp, token) } else { tokens[[token]] <- get_token_path(resp, token) @@ -231,7 +232,7 @@ get_token_path <- function(resp, token) { for (i in seq_along(token_prts)) { build_key[i] <- token_prts[[i]] } - location <- paste0('resp[["',paste(build_key, collapse = '"]][["'), '"]]') + location <- paste0('resp[["', paste(build_key, collapse = '"]][["'), '"]]') return(eval(parse(text = location), envir = environment())) } @@ -246,11 +247,11 @@ get_token_len <- function(resp, token) { build_key <- c() for (i in seq_along(token_prts)) { - if(grepl("\\[-1\\]", token_prts[[i]])) { - build_key[length(build_key) +1] <- gsub("\\[-1\\]", "", key) + if (grepl("\\[-1\\]", token_prts[[i]])) { + build_key[length(build_key) + 1] <- gsub("\\[-1\\]", "", token_prts[[i]]) build_key <- build_part(build_key) } else { - build_key[length(build_key) +1] <- token_prts[[i]] + build_key[length(build_key) + 1] <- token_prts[[i]] } } location <- paste0(paste(build_key, collapse = '[["'), '"]]') @@ -259,26 +260,32 @@ get_token_len <- function(resp, token) { # See https://docs.aws.amazon.com/sdkref/latest/guide/feature-retry-behavior.html -retry_api_call <- function(expr, retries){ - for (i in seq_len(retries + 1)){ - tryCatch({ - return(eval.parent(substitute(expr))) - }, error = function(err) { - msg <- err$message - if (grepl("rate exceeded", msg, ignore.case = T)) { - back_off(err, i, retries) - } else { - stop(err) +retry_api_call <- function(expr, retries) { + for (i in seq_len(retries + 1)) { + tryCatch( + { + return(eval.parent(substitute(expr))) + }, + error = function(err) { + msg <- err$message + + # Only Retry rate exceeded errors. + if (grepl("rate exceeded", msg, ignore.case = T)) { + exp_back_off(err, i, retries) + } else { + stop(err) + } } - }) + ) } } -# Retry with exponential backoff. -back_off <- function(error, i, retries) { - if(i == (retries + 1)) +# Retry with exponential backoff with jitter +exp_back_off <- function(error, i, retries) { + if (i == (retries + 1)) { stop(error) - time = min(runif(1)*2^i, 20) + } + time <- min(runif(1) * 2^i, 20) log_error("Request failed. Retrying in %s seconds...", time) Sys.sleep(time) } From bd1750eeeb967087bcaec93f4ba2f5f4928503b9 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Thu, 27 Jul 2023 17:27:03 +0100 Subject: [PATCH 09/19] initial paginate unit tests --- paws.common/tests/testthat/test_paginate.R | 595 +++++++++++++++++++++ 1 file changed, 595 insertions(+) create mode 100644 paws.common/tests/testthat/test_paginate.R diff --git a/paws.common/tests/testthat/test_paginate.R b/paws.common/tests/testthat/test_paginate.R new file mode 100644 index 000000000..ca0f13df2 --- /dev/null +++ b/paws.common/tests/testthat/test_paginate.R @@ -0,0 +1,595 @@ + +test_that("check token is correctly retrieved", { + output_tokens <- list( + "NextToken", + "Contents.Keys[-1].Id", + "Mark.NextToken" + ) + resp <- list( + NextToken = "token1", + Contents = list(Keys = list(list(Id = "wrong_token"), list(Id = "token2"))), + Mark = list(NextToken = "token3") + ) + expected <- setNames(list("token1", "token2", "token3"), output_tokens) + actual <- get_tokens(resp, output_tokens) + expect_equal(actual, expected) +}) + +test_that("check if retry_api_call retries correctly", { + mock_exp_back_off <- mock2(side_effect = exp_back_off) + mockery::stub(retry_api_call, "exp_back_off", mock_exp_back_off) + + expect_error(retry_api_call(stop("rate exceeded"), 2)) + expect_equal(mock_call_no(mock_exp_back_off), 3) +}) + +test_that("check if retry_api_call doesn't retry", { + mock_exp_back_off <- mock2(side_effect = exp_back_off) + mockery::stub(retry_api_call, "exp_back_off", mock_exp_back_off) + + expect_error(retry_api_call(stop("error"), 2)) + expect_equal(mock_call_no(mock_exp_back_off), 0) +}) + +######################################################################## +# paginate +######################################################################## + +test_that("check paginate", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken" + ) + ) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + + mock_environmentName <- mock2("paws.storage") + mock_retry_api_call <- mock2( + list(NextToken = "token1"), + list(NextToken = "token2"), + list(NextToken = character()) + ) + + expected <- list( + list(NextToken = "token1"), + list(NextToken = "token2"), + list(NextToken = character()) + ) + + mockery::stub(paginate, "substitute", mock_substitute) + mockery::stub(paginate, "environmentName", mock_environmentName) + mockery::stub(paginate, "retry_api_call", mock_retry_api_call) + + actual <- paginate("dummy") + + expect_equal(actual, expected) +}) + +test_that("check paginate all parameters and operation", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey" + ) + ) + list(NextToken=NextToken, MaxKey=MaxKey) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi", MaxKey = 100, NextToken = "abc"))) + + mock_environmentName <- mock2("paws.storage") + mock_retry_api_call <- mock2( + list(NextToken = "token1"), + list(NextToken = character()) + ) + + expected <- list( + list(NextToken = "token1"), + list(NextToken = character()) + ) + + mockery::stub(paginate, "substitute", mock_substitute) + mockery::stub(paginate, "environmentName", mock_environmentName) + mockery::stub(paginate, "retry_api_call", mock_retry_api_call) + + actual <- paginate("dummy", MaxItems = 1, StartingToken = "123") + + inputs <- mockery::mock_args(mock_retry_api_call) + + expect_equal(inputs, list( + list( + list( + NextToken = "abc", + MaxKey = 100 + ), + retries = 5 + ), + list( + list( + NextToken = "token1", + MaxKey = 100 + ), + retries = 5 + ) + )) + expect_equal(actual, expected) +}) + +test_that("check paginate all parameters", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey" + ) + ) + list(NextToken=NextToken, MaxKey=MaxKey) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + + mock_environmentName <- mock2("paws.storage") + mock_retry_api_call <- mock2( + list(NextToken = "token1"), + list(NextToken = character()) + ) + + expected <- list( + list(NextToken = "token1"), + list(NextToken = character()) + ) + + mockery::stub(paginate, "substitute", mock_substitute) + mockery::stub(paginate, "environmentName", mock_environmentName) + mockery::stub(paginate, "retry_api_call", mock_retry_api_call) + + actual <- paginate("dummy", MaxItems = 5, StartingToken = "123") + + inputs <- mockery::mock_args(mock_retry_api_call) + + expect_equal(inputs, list( + list( + list( + NextToken = "123", + MaxKey = 5 + ), + retries = 5 + ), + list( + list( + NextToken = "token1", + MaxKey = 5 + ), + retries = 5 + ) + )) + expect_equal(actual, expected) +}) + +test_that("check paginate error if not paws function", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken = NULL) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken" + ) + ) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + mockery::stub(paginate, "substitute", mock_substitute) + expect_error( + paginate("dummy"), + "Unknown method" + ) +}) + +test_that("check paginate error if not paginator", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken = NULL) { + op <- dummy_internal(paginator = list()) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + mock_environmentName <- mock2("paws.storage") + mockery::stub(paginate, "substitute", mock_substitute) + mockery::stub(paginate, "environmentName", mock_environmentName) + + expect_error( + paginate("dummy"), + "unable to paginate" + ) +}) + +######################################################################## +# paginate_lapply +######################################################################## + +test_that("check paginate_lapply", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken" + ) + ) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + + mock_environmentName <- mock2("paws.storage") + mock_retry_api_call <- mock2( + list(NextToken = "token1"), + list(NextToken = "token2"), + list(NextToken = character()) + ) + + expected <- list( + list(NextToken = "token1"), + list(NextToken = "token2"), + list(NextToken = character()) + ) + + mockery::stub(paginate_lapply, "substitute", mock_substitute) + mockery::stub(paginate_lapply, "environmentName", mock_environmentName) + mockery::stub(paginate_lapply, "retry_api_call", mock_retry_api_call) + + actual <- paginate_lapply("dummy", function(resp) resp) + + expect_equal(actual, expected) +}) + +test_that("check paginate_lapply all parameters and operation", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey" + ) + ) + list(NextToken=NextToken, MaxKey=MaxKey) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi", MaxKey = 100, NextToken = "abc"))) + + mock_environmentName <- mock2("paws.storage") + mock_retry_api_call <- mock2( + list(NextToken = "token1"), + list(NextToken = character()) + ) + + expected <- list( + list(NextToken = "token1"), + list(NextToken = character()) + ) + + mockery::stub(paginate_lapply, "substitute", mock_substitute) + mockery::stub(paginate_lapply, "environmentName", mock_environmentName) + mockery::stub(paginate_lapply, "retry_api_call", mock_retry_api_call) + + actual <- paginate_lapply("dummy", function(resp){resp}, MaxItems = 1, StartingToken = "123") + + inputs <- mockery::mock_args(mock_retry_api_call) + + expect_equal(inputs, list( + list( + list( + NextToken = "abc", + MaxKey = 100 + ), + retries = 5 + ), + list( + list( + NextToken = "token1", + MaxKey = 100 + ), + retries = 5 + ) + )) + expect_equal(actual, expected) +}) + +test_that("check paginate_lapply all parameters", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey" + ) + ) + list(NextToken=NextToken, MaxKey=MaxKey) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + + mock_environmentName <- mock2("paws.storage") + mock_retry_api_call <- mock2( + list(NextToken = "token1"), + list(NextToken = character()) + ) + + expected <- list( + list(NextToken = "token1"), + list(NextToken = character()) + ) + + mockery::stub(paginate_lapply, "substitute", mock_substitute) + mockery::stub(paginate_lapply, "environmentName", mock_environmentName) + mockery::stub(paginate_lapply, "retry_api_call", mock_retry_api_call) + + actual <- paginate_lapply("dummy", function(resp){resp}, MaxItems = 5, StartingToken = "123") + + inputs <- mockery::mock_args(mock_retry_api_call) + + expect_equal(inputs, list( + list( + list( + NextToken = "123", + MaxKey = 5 + ), + retries = 5 + ), + list( + list( + NextToken = "token1", + MaxKey = 5 + ), + retries = 5 + ) + )) + expect_equal(actual, expected) +}) + +test_that("check paginate_lapply error if not paws function", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken = NULL) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken" + ) + ) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + mockery::stub(paginate_lapply, "substitute", mock_substitute) + expect_error( + paginate_lapply("dummy", function(resp) {resp}), + "Unknown method" + ) +}) + +test_that("check paginate_lapply error if not paginator", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken = NULL) { + op <- dummy_internal(paginator = list()) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + mock_environmentName <- mock2("paws.storage") + mockery::stub(paginate_lapply, "substitute", mock_substitute) + mockery::stub(paginate_lapply, "environmentName", mock_environmentName) + + expect_error( + paginate_lapply("dummy", function(resp){resp}), + "unable to paginate" + ) +}) + + +######################################################################## +# paginate_sapply +######################################################################## + +test_that("check paginate_sapply", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken" + ) + ) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + + mock_environmentName <- mock2("paws.storage") + mock_retry_api_call <- mock2( + list(NextToken = "token1"), + list(NextToken = "token2"), + list(NextToken = character()) + ) + + expected <- list( + NextToken = "token1", + NextToken = "token2", + NextToken = character() + ) + + mockery::stub(paginate_sapply, "substitute", mock_substitute) + mockery::stub(paginate_sapply, "environmentName", mock_environmentName) + mockery::stub(paginate_sapply, "retry_api_call", mock_retry_api_call) + + actual <- paginate_sapply("dummy", function(resp) resp) + + expect_equal(actual, expected) +}) + +test_that("check paginate_sapply all parameters and operation", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey" + ) + ) + list(NextToken=NextToken, MaxKey=MaxKey) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi", MaxKey = 100, NextToken = "abc"))) + + mock_environmentName <- mock2("paws.storage") + mock_retry_api_call <- mock2( + list(NextToken = "token1"), + list(NextToken = character()) + ) + + expected <- list( + NextToken = "token1", + NextToken = character() + ) + + mockery::stub(paginate_sapply, "substitute", mock_substitute) + mockery::stub(paginate_sapply, "environmentName", mock_environmentName) + mockery::stub(paginate_sapply, "retry_api_call", mock_retry_api_call) + + actual <- paginate_sapply("dummy", function(resp){resp}, MaxItems = 1, StartingToken = "123") + + inputs <- mockery::mock_args(mock_retry_api_call) + + expect_equal(inputs, list( + list( + list( + NextToken = "abc", + MaxKey = 100 + ), + retries = 5 + ), + list( + list( + NextToken = "token1", + MaxKey = 100 + ), + retries = 5 + ) + )) + expect_equal(actual, expected) +}) + +test_that("check paginate_sapply all parameters", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey" + ) + ) + list(NextToken=NextToken, MaxKey=MaxKey) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + + mock_environmentName <- mock2("paws.storage") + mock_retry_api_call <- mock2( + list(NextToken = "token1"), + list(NextToken = character()) + ) + + expected <- list( + NextToken = "token1", + NextToken = character() + ) + + mockery::stub(paginate_sapply, "substitute", mock_substitute) + mockery::stub(paginate_sapply, "environmentName", mock_environmentName) + mockery::stub(paginate_sapply, "retry_api_call", mock_retry_api_call) + + actual <- paginate_sapply("dummy", function(resp){resp}, MaxItems = 5, StartingToken = "123") + + inputs <- mockery::mock_args(mock_retry_api_call) + + expect_equal(inputs, list( + list( + list( + NextToken = "123", + MaxKey = 5 + ), + retries = 5 + ), + list( + list( + NextToken = "token1", + MaxKey = 5 + ), + retries = 5 + ) + )) + expect_equal(actual, expected) +}) + +test_that("check paginate_sapply error if not paws function", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken = NULL) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken" + ) + ) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + mockery::stub(paginate_sapply, "substitute", mock_substitute) + expect_error( + paginate_sapply("dummy", function(resp) {resp}), + "Unknown method" + ) +}) + +test_that("check paginate_sapply error if not paginator", { + + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken = NULL) { + op <- dummy_internal(paginator = list()) + } + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + mock_environmentName <- mock2("paws.storage") + mockery::stub(paginate_sapply, "substitute", mock_substitute) + mockery::stub(paginate_sapply, "environmentName", mock_environmentName) + + expect_error( + paginate_sapply("dummy", function(resp){resp}), + "unable to paginate" + ) +}) + From 048f3426ffda4af3793ba1a53f8003622005efb7 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Fri, 28 Jul 2023 11:31:35 +0100 Subject: [PATCH 10/19] tidy up paginate functions --- paws.common/R/paginate.R | 210 ++++++++++++++++++------------------ paws.common/man/paginate.Rd | 15 ++- 2 files changed, 121 insertions(+), 104 deletions(-) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index 6abdc0655..5265a36c7 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -1,6 +1,8 @@ #' @include logging.R #' @include util.R +.do_call <- as.name("do.call") + #' @title Paginate over an operation. #' @description #' Some AWS operations return results that are incomplete and require subsequent @@ -12,12 +14,14 @@ #' #' @param operation The operation #' @param MaxRetries Max number of retries call AWS API. +#' @param PageSize The size of each page. #' @param MaxItems Limits the maximum number of total returned items returned while paginating. #' @param StartingToken Can be used to modify the starting marker or token of a paginator. #' This argument if useful for resuming pagination from a previous token or starting pagination at a known position. #' @param FUN the function to be applied to each response element of \code{operation}. #' @param simplify See \link[base:sapply]{base::sapply()}. #' @param ... optional arguments to \code{FUN}. +#' @return list of responses from the operation. #' @examples #' \dontrun{ #' # The following example retrieves object list. The request specifies max @@ -33,54 +37,38 @@ #' @export paginate <- function(operation, MaxRetries = 5, + PageSize = NULL, MaxItems = NULL, StartingToken = NULL) { fn <- substitute(operation) - fn_call <- eval(fn[[1]]) - pkg_name <- environmentName(environment(fn_call)) - # Ensure method can be found. - if (!grepl("^paws", pkg_name, perl = T)) { - stopf( - "Unknown method: `%s`. Please check service methods and try again.", - as.character(fn)[1] - ) - } - - fn_body <- body(fn_call) - paginator <- fn_body[[2]][[3]]$paginator - - # Check if method can paginate - if (!all(c("input_token", "output_token") %in% names(paginator))) { - stopf( - "Method: `%s` is unable to paginate.", - as.character(fn)[1] - ) + # rebuild fn for do.call + if(identical(fn[[1]], .do_call)) { + kwargs <- eval(fn[[3]]) + fn <- fn[2] + for (key in names(kwargs)) { + fn[key] <- kwargs[[key]] + } } - # Get input_token/output_token and limit_key from paginator - input_token <- paginator$input_token - output_token <- paginator$output_token - limit_key <- paginator$limit_key + fn_update <- paginate_update_fn(fn, PageSize, StartingToken) + fn <- fn_update$fn + paginator <- fn_update$paginator - # only update input_token if single token - if (length(input_token) == 1) { - if (is.null(fn[[input_token]])) { - fn[input_token] <- StartingToken - } - } - if (!is.null(limit_key)) { - if (is.null(fn[[limit_key]])) { - fn[limit_key] <- MaxItems - } - } + no_items <- 0 result <- list() - while (!identical(fn[[input_token[[1]]]], character(0))) { + while (!identical(fn[[paginator$input_token[[1]]]], character(0))) { resp <- retry_api_call(eval(fn), retries = MaxRetries) - new_tokens <- get_tokens(resp, output_token) + new_tokens <- get_tokens(resp, paginator$output_token) for (i in seq_along(new_tokens)) { - fn[[input_token[[i]]]] <- new_tokens[[i]] + fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] + } + result[[length(result) + 1]] <- resp[paginator$result_key] + if (!is.null(MaxItems)) { + no_items <- no_items + length(resp[[paginator$result_key]]) + if (no_items >= MaxItems) { + break + } } - result[[length(result) + 1]] <- resp } return(result) } @@ -91,57 +79,30 @@ paginate_lapply <- function(operation, FUN, ..., MaxRetries = 5, + PageSize = NULL, MaxItems = NULL, StartingToken = NULL) { FUN <- match.fun(FUN) fn <- substitute(operation) - fn_call <- eval(fn[[1]]) - pkg_name <- environmentName(environment(fn_call)) - - # Ensure method can be found. - if (!grepl("^paws", pkg_name, perl = T)) { - stopf( - "Unknown method: `%s`. Please check service methods and try again.", - as.character(fn)[1] - ) - } - - fn_body <- body(fn_call) - paginator <- fn_body[[2]][[3]]$paginator - - # Check if method can paginate - if (!all(c("input_token", "output_token") %in% names(paginator))) { - stopf( - "Method: `%s` is unable to paginate.", - as.character(fn)[1] - ) - } - - # Get input_token/output_token and limit_key from paginator - input_token <- paginator$input_token - output_token <- paginator$output_token - limit_key <- paginator$limit_key - # only update input_token if single token - if (length(input_token) == 1) { - if (is.null(fn[[input_token]])) { - fn[input_token] <- StartingToken - } - } - if (!is.null(limit_key)) { - if (is.null(fn[[limit_key]])) { - fn[limit_key] <- MaxItems + # rebuild fn for do.call + if(identical(fn[[1]], .do_call)) { + kwargs <- eval(fn[[3]]) + fn <- fn[2] + for (key in names(kwargs)) { + fn[key] <- kwargs[[key]] } } - result <- list() - while (!identical(fn[[input_token[[1]]]], character(0))) { - resp <- retry_api_call(eval(fn), retries = MaxRetries) - new_tokens <- get_tokens(resp, output_token) - for (i in seq_along(new_tokens)) { - fn[[input_token[[i]]]] <- new_tokens[[i]] - } - result[[length(result) + 1]] <- FUN(resp, ...) - } + + fn_update <- paginate_update_fn(fn, PageSize, StartingToken) + result <- paginate_xapply( + fn = fn_update$fn, + paginator = fn_update$paginator, + FUN = FUN, + ..., + MaxRetries = MaxRetries, + MaxItems = MaxItems + ) return(result) } @@ -152,10 +113,42 @@ paginate_sapply <- function(operation, ..., simplify = TRUE, MaxRetries = 5, + PageSize = NULL, MaxItems = NULL, StartingToken = NULL) { FUN <- match.fun(FUN) fn <- substitute(operation) + + # rebuild fn for do.call + if(identical(fn[[1]], .do_call)) { + kwargs <- eval(fn[[3]]) + fn <- fn[2] + for (key in names(kwargs)) { + fn[key] <- kwargs[[key]] + } + } + + fn_update <- paginate_update_fn(fn, PageSize, StartingToken) + result <- paginate_xapply( + fn = fn_update$fn, + paginator = fn_update$paginator, + FUN = FUN, + ..., + MaxRetries = MaxRetries, + MaxItems = MaxItems + ) + + if (!isFALSE(simplify)) { + simplify2array(result, higher = (simplify == "array")) + } else { + result + } +} + +paginate_update_fn <- function( + fn, + PageSize = NULL, + StartingToken = NULL) { fn_call <- eval(fn[[1]]) pkg_name <- environmentName(environment(fn_call)) @@ -178,37 +171,48 @@ paginate_sapply <- function(operation, ) } - # Get input_token/output_token and limit_key from paginator - input_token <- paginator$input_token - output_token <- paginator$output_token - limit_key <- paginator$limit_key - # only update input_token if single token - if (length(input_token) == 1) { - if (is.null(fn[[input_token]])) { - fn[input_token] <- StartingToken + if (length(paginator$input_token) == 1) { + if (is.null(fn[[paginator$input_token]])) { + fn[paginator$input_token] <- StartingToken } } - if (!is.null(limit_key)) { - if (is.null(fn[[limit_key]])) { - fn[limit_key] <- MaxItems + if (!is.null(paginator$limit_key)) { + if (is.null(fn[[paginator$limit_key]])) { + fn[paginator$limit_key] <- PageSize } } + + return(list( + fn = fn, + paginator = paginator + )) +} + +paginate_xapply <- function( + fn, + paginator, + FUN, + ..., + MaxRetries = 5, + MaxItems = NULL) { + no_items <- 0 result <- list() - while (!identical(fn[[input_token[[1]]]], character(0))) { + while (!identical(fn[[paginator$input_token[[1]]]], character(0))) { resp <- retry_api_call(eval(fn), retries = MaxRetries) - new_tokens <- get_tokens(resp, output_token) + new_tokens <- get_tokens(resp, paginator$output_token) for (i in seq_along(new_tokens)) { - fn[[input_token[[i]]]] <- new_tokens[[i]] + fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] + } + result[[length(result) + 1]] <- FUN(resp[paginator$result_key], ...) + if (!is.null(MaxItems)) { + no_items <- no_items + length(resp[[paginator$result_key]]) + if (no_items >= MaxItems) { + break + } } - result[[length(result) + 1]] <- FUN(resp, ...) - } - - if (!isFALSE(simplify)) { - simplify2array(result, higher = (simplify == "array")) - } else { - result } + return(result) } # Get all output tokens diff --git a/paws.common/man/paginate.Rd b/paws.common/man/paginate.Rd index 9ecef0343..0ed13ba0a 100644 --- a/paws.common/man/paginate.Rd +++ b/paws.common/man/paginate.Rd @@ -6,13 +6,20 @@ \alias{paginate_sapply} \title{Paginate over an operation.} \usage{ -paginate(operation, MaxRetries = 5, MaxItems = NULL, StartingToken = NULL) +paginate( + operation, + MaxRetries = 5, + PageSize = NULL, + MaxItems = NULL, + StartingToken = NULL +) paginate_lapply( operation, FUN, ..., MaxRetries = 5, + PageSize = NULL, MaxItems = NULL, StartingToken = NULL ) @@ -23,6 +30,7 @@ paginate_sapply( ..., simplify = TRUE, MaxRetries = 5, + PageSize = NULL, MaxItems = NULL, StartingToken = NULL ) @@ -32,6 +40,8 @@ paginate_sapply( \item{MaxRetries}{Max number of retries call AWS API.} +\item{PageSize}{The size of each page.} + \item{MaxItems}{Limits the maximum number of total returned items returned while paginating.} \item{StartingToken}{Can be used to modify the starting marker or token of a paginator. @@ -43,6 +53,9 @@ This argument if useful for resuming pagination from a previous token or startin \item{simplify}{See \link[base:sapply]{base::sapply()}.} } +\value{ +list of responses from the operation. +} \description{ Some AWS operations return results that are incomplete and require subsequent requests in order to attain the entire result set. The process of sending subsequent From 5fe868d26c3d8b3f57d7d2113898cd59510651cc Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Fri, 28 Jul 2023 14:52:31 +0100 Subject: [PATCH 11/19] update parameter names --- paws.common/R/paginate.R | 30 +++++++++++++++--------------- paws.common/man/paginate.Rd | 8 ++++---- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index 5265a36c7..0fe1a8384 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -12,7 +12,7 @@ #' at a time, and you must send subsequent requests with the appropriate Marker #' in order to retrieve the next page of results. #' -#' @param operation The operation +#' @param Operation The operation for example an s3 operation: \code{svc$list_buckets()} #' @param MaxRetries Max number of retries call AWS API. #' @param PageSize The size of each page. #' @param MaxItems Limits the maximum number of total returned items returned while paginating. @@ -35,21 +35,21 @@ #' } #' @name paginate #' @export -paginate <- function(operation, +paginate <- function(Operation, MaxRetries = 5, PageSize = NULL, MaxItems = NULL, StartingToken = NULL) { - fn <- substitute(operation) + fn <- substitute(Operation) # rebuild fn for do.call - if(identical(fn[[1]], .do_call)) { + if (identical(fn[[1]], .do_call)) { kwargs <- eval(fn[[3]]) fn <- fn[2] for (key in names(kwargs)) { fn[key] <- kwargs[[key]] } } - + # update fn with pagesize and starting token fn_update <- paginate_update_fn(fn, PageSize, StartingToken) fn <- fn_update$fn paginator <- fn_update$paginator @@ -75,7 +75,7 @@ paginate <- function(operation, #' @rdname paginate #' @export -paginate_lapply <- function(operation, +paginate_lapply <- function(Operation, FUN, ..., MaxRetries = 5, @@ -83,17 +83,17 @@ paginate_lapply <- function(operation, MaxItems = NULL, StartingToken = NULL) { FUN <- match.fun(FUN) - fn <- substitute(operation) + fn <- substitute(Operation) # rebuild fn for do.call - if(identical(fn[[1]], .do_call)) { + if (identical(fn[[1]], .do_call)) { kwargs <- eval(fn[[3]]) fn <- fn[2] for (key in names(kwargs)) { fn[key] <- kwargs[[key]] } } - + # update fn with pagesize and starting token fn_update <- paginate_update_fn(fn, PageSize, StartingToken) result <- paginate_xapply( fn = fn_update$fn, @@ -108,7 +108,7 @@ paginate_lapply <- function(operation, #' @rdname paginate #' @export -paginate_sapply <- function(operation, +paginate_sapply <- function(Operation, FUN, ..., simplify = TRUE, @@ -117,17 +117,17 @@ paginate_sapply <- function(operation, MaxItems = NULL, StartingToken = NULL) { FUN <- match.fun(FUN) - fn <- substitute(operation) + fn <- substitute(Operation) # rebuild fn for do.call - if(identical(fn[[1]], .do_call)) { + if (identical(fn[[1]], .do_call)) { kwargs <- eval(fn[[3]]) fn <- fn[2] for (key in names(kwargs)) { fn[key] <- kwargs[[key]] } } - + # update fn with pagesize and starting token fn_update <- paginate_update_fn(fn, PageSize, StartingToken) result <- paginate_xapply( fn = fn_update$fn, @@ -232,7 +232,7 @@ get_tokens <- function(resp, output_tokens) { # Path.To.Token get_token_path <- function(resp, token) { token_prts <- strsplit(token, "\\.")[[1]] - build_key <- c() + build_key <- character(length(token_prts)) for (i in seq_along(token_prts)) { build_key[i] <- token_prts[[i]] } @@ -249,7 +249,7 @@ get_token_len <- function(resp, token) { } token_prts <- strsplit(token, "\\.")[[1]] - build_key <- c() + build_key <- character(0) for (i in seq_along(token_prts)) { if (grepl("\\[-1\\]", token_prts[[i]])) { build_key[length(build_key) + 1] <- gsub("\\[-1\\]", "", token_prts[[i]]) diff --git a/paws.common/man/paginate.Rd b/paws.common/man/paginate.Rd index 0ed13ba0a..51113743c 100644 --- a/paws.common/man/paginate.Rd +++ b/paws.common/man/paginate.Rd @@ -7,7 +7,7 @@ \title{Paginate over an operation.} \usage{ paginate( - operation, + Operation, MaxRetries = 5, PageSize = NULL, MaxItems = NULL, @@ -15,7 +15,7 @@ paginate( ) paginate_lapply( - operation, + Operation, FUN, ..., MaxRetries = 5, @@ -25,7 +25,7 @@ paginate_lapply( ) paginate_sapply( - operation, + Operation, FUN, ..., simplify = TRUE, @@ -36,7 +36,7 @@ paginate_sapply( ) } \arguments{ -\item{operation}{The operation} +\item{Operation}{The operation for example an s3 operation: \code{svc$list_buckets()}} \item{MaxRetries}{Max number of retries call AWS API.} From 7ec324d2ac49a63857e3e08d6917506f39ae51de Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Fri, 28 Jul 2023 14:52:55 +0100 Subject: [PATCH 12/19] update unit tests to align with paginate updates --- paws.common/tests/testthat/test_paginate.R | 662 ++++++++++----------- 1 file changed, 312 insertions(+), 350 deletions(-) diff --git a/paws.common/tests/testthat/test_paginate.R b/paws.common/tests/testthat/test_paginate.R index ca0f13df2..697e49910 100644 --- a/paws.common/tests/testthat/test_paginate.R +++ b/paws.common/tests/testthat/test_paginate.R @@ -1,3 +1,6 @@ +######################################################################## +# get_tokens +######################################################################## test_that("check token is correctly retrieved", { output_tokens <- list( @@ -15,6 +18,10 @@ test_that("check token is correctly retrieved", { expect_equal(actual, expected) }) +######################################################################## +# retry_api_call +######################################################################## + test_that("check if retry_api_call retries correctly", { mock_exp_back_off <- mock2(side_effect = exp_back_off) mockery::stub(retry_api_call, "exp_back_off", mock_exp_back_off) @@ -32,100 +39,143 @@ test_that("check if retry_api_call doesn't retry", { }) ######################################################################## -# paginate +# paginate_update_fn ######################################################################## -test_that("check paginate", { +test_that("check paginate_update_fn", { + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { + op <- dummy_internal(paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" + ) + ) + list(NextToken=NextToken, MaxKey=MaxKey) + } + + mock_environmentName <- mock2("paws.storage") + mockery::stub(paginate_update_fn, "environmentName", mock_environmentName) + actual <- paginate_update_fn(substitute(dummy_op(x = "hi")), PageSize = 10, StartingToken = "token1") + expect_fn <- substitute(dummy_op(x = "hi", NextToken = "token1", MaxKey = 10)) + expect_paginator <- substitute(list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" + )) + + expect_equal(actual$fn, expect_fn) + expect_equal(actual$paginator, expect_paginator) +}) +test_that("check paginate_update_fn non paws operation", { dummy_internal <- function(paginator) { paginator } - dummy_op <- function(x, NextToken) { + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { op <- dummy_internal(paginator = list( input_token = "NextToken", - output_token = "NextToken" + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" ) ) + list(NextToken=NextToken, MaxKey=MaxKey) } - mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - mock_environmentName <- mock2("paws.storage") - mock_retry_api_call <- mock2( - list(NextToken = "token1"), - list(NextToken = "token2"), - list(NextToken = character()) + expect_error( + paginate_update_fn( + substitute(dummy_op(x = "hi")), PageSize = 10, StartingToken = "token1" + ), + "Unknown method:.*. Please check service methods and try again." ) +}) - expected <- list( - list(NextToken = "token1"), - list(NextToken = "token2"), - list(NextToken = character()) - ) +test_that("check paginate_update_fn unable to paginate", { + dummy_internal <- function(paginator) { + paginator + } + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { + op <- dummy_internal(paginator = list()) + list(NextToken=NextToken, MaxKey=MaxKey) + } - mockery::stub(paginate, "substitute", mock_substitute) - mockery::stub(paginate, "environmentName", mock_environmentName) - mockery::stub(paginate, "retry_api_call", mock_retry_api_call) + mock_environmentName <- mock2("paws.storage") + mockery::stub(paginate_update_fn, "environmentName", mock_environmentName) + expect_error( + paginate_update_fn( + substitute(dummy_op(x = "hi")), PageSize = 10, StartingToken = "token1" + ), + "Method:.*is unable to paginate" + ) +}) - actual <- paginate("dummy") - expect_equal(actual, expected) -}) +######################################################################## +# paginate +######################################################################## -test_that("check paginate all parameters and operation", { +test_that("check paginate", { dummy_internal <- function(paginator) { paginator } dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { op <- dummy_internal(paginator = list( - input_token = "NextToken", - output_token = "NextToken", - limit_key = "MaxKey" + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" ) ) list(NextToken=NextToken, MaxKey=MaxKey) } - mock_substitute <- mock2(substitute(dummy_op(x = "hi", MaxKey = 100, NextToken = "abc"))) + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - mock_environmentName <- mock2("paws.storage") + mock_paginate_update_fn <- mock2( + list( + fn = substitute(dummy_op(x = "hi")), + paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" + ) + ) + ) mock_retry_api_call <- mock2( - list(NextToken = "token1"), - list(NextToken = character()) + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2"), + list(Contents = list("zoo"), NextToken = character()) ) expected <- list( - list(NextToken = "token1"), - list(NextToken = character()) + list(Contents = list("foo")), + list(Contents = list("bar")), + list(Contents = list("zoo")) ) mockery::stub(paginate, "substitute", mock_substitute) - mockery::stub(paginate, "environmentName", mock_environmentName) + mockery::stub(paginate, "paginate_update_fn", mock_paginate_update_fn) mockery::stub(paginate, "retry_api_call", mock_retry_api_call) - actual <- paginate("dummy", MaxItems = 1, StartingToken = "123") - - inputs <- mockery::mock_args(mock_retry_api_call) + actual <- paginate("dummy") + actual_args <- mockery::mock_args(mock_retry_api_call) - expect_equal(inputs, list( - list( - list( - NextToken = "abc", - MaxKey = 100 - ), - retries = 5 - ), - list( - list( - NextToken = "token1", - MaxKey = 100 - ), - retries = 5 - ) + expect_equal(actual_args, list( + list(list(NextToken = NULL, MaxKey = NULL), retries = 5), + list(list(NextToken = "token1", MaxKey = NULL), retries = 5), + list(list(NextToken = "token2", MaxKey = NULL), retries = 5) )) expect_equal(actual, expected) }) -test_that("check paginate all parameters", { + +test_that("check paginate do.call", { dummy_internal <- function(paginator) { paginator @@ -134,131 +184,162 @@ test_that("check paginate all parameters", { op <- dummy_internal(paginator = list( input_token = "NextToken", output_token = "NextToken", - limit_key = "MaxKey" + limit_key = "MaxKey", + result_key = "Contents" ) ) list(NextToken=NextToken, MaxKey=MaxKey) } - mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) + mock_substitute <- mock2(substitute(do.call(dummy_op, list(x = "hi")))) - mock_environmentName <- mock2("paws.storage") + mock_paginate_update_fn <- mock2( + list( + fn = substitute(dummy_op(x = "hi")), + paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" + ) + ) + ) mock_retry_api_call <- mock2( - list(NextToken = "token1"), - list(NextToken = character()) + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2"), + list(Contents = list("zoo"), NextToken = character()) ) expected <- list( - list(NextToken = "token1"), - list(NextToken = character()) + list(Contents = list("foo")), + list(Contents = list("bar")), + list(Contents = list("zoo")) ) mockery::stub(paginate, "substitute", mock_substitute) - mockery::stub(paginate, "environmentName", mock_environmentName) + mockery::stub(paginate, "paginate_update_fn", mock_paginate_update_fn) mockery::stub(paginate, "retry_api_call", mock_retry_api_call) - actual <- paginate("dummy", MaxItems = 5, StartingToken = "123") - - inputs <- mockery::mock_args(mock_retry_api_call) + actual <- paginate("dummy") + actual_args <- mockery::mock_args(mock_retry_api_call) - expect_equal(inputs, list( - list( - list( - NextToken = "123", - MaxKey = 5 - ), - retries = 5 - ), - list( - list( - NextToken = "token1", - MaxKey = 5 - ), - retries = 5 - ) + expect_equal(actual_args, list( + list(list(NextToken = NULL, MaxKey = NULL), retries = 5), + list(list(NextToken = "token1", MaxKey = NULL), retries = 5), + list(list(NextToken = "token2", MaxKey = NULL), retries = 5) )) expect_equal(actual, expected) }) -test_that("check paginate error if not paws function", { +test_that("check paginate restrict MaxItems", { dummy_internal <- function(paginator) { paginator } - dummy_op <- function(x, NextToken = NULL) { + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { op <- dummy_internal(paginator = list( input_token = "NextToken", - output_token = "NextToken" + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" ) ) + list(NextToken=NextToken, MaxKey=MaxKey) } - mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - mockery::stub(paginate, "substitute", mock_substitute) - expect_error( - paginate("dummy"), - "Unknown method" + mock_substitute <- mock2(substitute(do.call(dummy_op, list(x = "hi")))) + + mock_paginate_update_fn <- mock2( + list( + fn = substitute(dummy_op(x = "hi")), + paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" + ) + ) + ) + mock_retry_api_call <- mock2( + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2"), + list(Contents = list("zoo"), NextToken = character()) ) -}) -test_that("check paginate error if not paginator", { + expected <- list( + list(Contents = list("foo")), + list(Contents = list("bar")) + ) - dummy_internal <- function(paginator) { - paginator - } - dummy_op <- function(x, NextToken = NULL) { - op <- dummy_internal(paginator = list()) - } - mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - mock_environmentName <- mock2("paws.storage") mockery::stub(paginate, "substitute", mock_substitute) - mockery::stub(paginate, "environmentName", mock_environmentName) + mockery::stub(paginate, "paginate_update_fn", mock_paginate_update_fn) + mockery::stub(paginate, "retry_api_call", mock_retry_api_call) - expect_error( - paginate("dummy"), - "unable to paginate" - ) + actual <- paginate("dummy", MaxItems = 2) + actual_args <- mockery::mock_args(mock_retry_api_call) + + expect_equal(actual_args, list( + list(list(NextToken = NULL, MaxKey = NULL), retries = 5), + list(list(NextToken = "token1", MaxKey = NULL), retries = 5) + )) + expect_equal(actual, expected) }) ######################################################################## -# paginate_lapply +# paginate_xapply ######################################################################## -test_that("check paginate_lapply", { +test_that("check paginate_xapply", { dummy_internal <- function(paginator) { paginator } - dummy_op <- function(x, NextToken) { + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { op <- dummy_internal(paginator = list( input_token = "NextToken", - output_token = "NextToken" + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" ) ) + list(NextToken=NextToken, MaxKey=MaxKey) } - mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - mock_environmentName <- mock2("paws.storage") mock_retry_api_call <- mock2( - list(NextToken = "token1"), - list(NextToken = "token2"), - list(NextToken = character()) + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2"), + list(Contents = list("zoo"), NextToken = character()) ) expected <- list( - list(NextToken = "token1"), - list(NextToken = "token2"), - list(NextToken = character()) + list(Contents = list("foo")), + list(Contents = list("bar")), + list(Contents = list("zoo")) ) - mockery::stub(paginate_lapply, "substitute", mock_substitute) - mockery::stub(paginate_lapply, "environmentName", mock_environmentName) - mockery::stub(paginate_lapply, "retry_api_call", mock_retry_api_call) + mockery::stub(paginate_xapply, "retry_api_call", mock_retry_api_call) - actual <- paginate_lapply("dummy", function(resp) resp) + actual <- paginate_xapply( + substitute(dummy_op(x = "hi")), + paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" + ), + FUN = function(resp) {resp}, + MaxRetries = 5, + MaxItems = NULL + ) + actual_args <- mockery::mock_args(mock_retry_api_call) + expect_equal(actual_args, list( + list(list(NextToken = NULL, MaxKey = NULL), retries = 5), + list(list(NextToken = "token1", MaxKey = NULL), retries = 5), + list(list(NextToken = "token2", MaxKey = NULL), retries = 5) + )) expect_equal(actual, expected) }) -test_that("check paginate_lapply all parameters and operation", { +test_that("check paginate_xapply restrict MaxItems", { dummy_internal <- function(paginator) { paginator @@ -267,52 +348,52 @@ test_that("check paginate_lapply all parameters and operation", { op <- dummy_internal(paginator = list( input_token = "NextToken", output_token = "NextToken", - limit_key = "MaxKey" + limit_key = "MaxKey", + result_key = "Contents" ) ) list(NextToken=NextToken, MaxKey=MaxKey) } - mock_substitute <- mock2(substitute(dummy_op(x = "hi", MaxKey = 100, NextToken = "abc"))) - mock_environmentName <- mock2("paws.storage") mock_retry_api_call <- mock2( - list(NextToken = "token1"), - list(NextToken = character()) + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2"), + list(Contents = list("zoo"), NextToken = character()) ) expected <- list( - list(NextToken = "token1"), - list(NextToken = character()) + list(Contents = list("foo")), + list(Contents = list("bar")) ) - mockery::stub(paginate_lapply, "substitute", mock_substitute) - mockery::stub(paginate_lapply, "environmentName", mock_environmentName) - mockery::stub(paginate_lapply, "retry_api_call", mock_retry_api_call) - - actual <- paginate_lapply("dummy", function(resp){resp}, MaxItems = 1, StartingToken = "123") - - inputs <- mockery::mock_args(mock_retry_api_call) + mockery::stub(paginate_xapply, "retry_api_call", mock_retry_api_call) - expect_equal(inputs, list( - list( - list( - NextToken = "abc", - MaxKey = 100 - ), - retries = 5 + actual <- paginate_xapply( + substitute(dummy_op(x = "hi")), + paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" ), - list( - list( - NextToken = "token1", - MaxKey = 100 - ), - retries = 5 - ) + FUN = function(resp) {resp}, + MaxRetries = 5, + MaxItems = 2 + ) + actual_args <- mockery::mock_args(mock_retry_api_call) + + expect_equal(actual_args, list( + list(list(NextToken = NULL, MaxKey = NULL), retries = 5), + list(list(NextToken = "token1", MaxKey = NULL), retries = 5) )) expect_equal(actual, expected) }) -test_that("check paginate_lapply all parameters", { + +######################################################################## +# paginate_lapply +######################################################################## +test_that("check paginate_lapply", { dummy_internal <- function(paginator) { paginator @@ -321,133 +402,82 @@ test_that("check paginate_lapply all parameters", { op <- dummy_internal(paginator = list( input_token = "NextToken", output_token = "NextToken", - limit_key = "MaxKey" + limit_key = "MaxKey", + result_key = "Contents" ) ) list(NextToken=NextToken, MaxKey=MaxKey) } mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - mock_environmentName <- mock2("paws.storage") - mock_retry_api_call <- mock2( - list(NextToken = "token1"), - list(NextToken = character()) - ) - - expected <- list( - list(NextToken = "token1"), - list(NextToken = character()) - ) + mock_paginate_update_fn <- mock2(side_effect = function(fn, ...) { + list( + fn = fn, + paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" + ) + ) + }) + mock_paginate_xapply <- mock2() mockery::stub(paginate_lapply, "substitute", mock_substitute) - mockery::stub(paginate_lapply, "environmentName", mock_environmentName) - mockery::stub(paginate_lapply, "retry_api_call", mock_retry_api_call) - - actual <- paginate_lapply("dummy", function(resp){resp}, MaxItems = 5, StartingToken = "123") + mockery::stub(paginate_lapply, "paginate_update_fn", mock_paginate_update_fn) + mockery::stub(paginate_lapply, "paginate_xapply", mock_paginate_xapply) - inputs <- mockery::mock_args(mock_retry_api_call) + actual <- paginate_lapply("dummy", \(resp) {resp}) + actual_fn <- mock_arg(mock_paginate_update_fn)[[1]] - expect_equal(inputs, list( - list( - list( - NextToken = "123", - MaxKey = 5 - ), - retries = 5 - ), - list( - list( - NextToken = "token1", - MaxKey = 5 - ), - retries = 5 - ) - )) - expect_equal(actual, expected) + expect_equal(actual_fn, substitute(dummy_op(x = "hi"))) }) -test_that("check paginate_lapply error if not paws function", { +test_that("check paginate_lapply do.call modified operation", { dummy_internal <- function(paginator) { paginator } - dummy_op <- function(x, NextToken = NULL) { + dummy_op <- function(x, NextToken=NULL, MaxKey=NULL) { op <- dummy_internal(paginator = list( - input_token = "NextToken", - output_token = "NextToken" - ) + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" + ) ) + list(NextToken=NextToken, MaxKey=MaxKey) } - mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - mockery::stub(paginate_lapply, "substitute", mock_substitute) - expect_error( - paginate_lapply("dummy", function(resp) {resp}), - "Unknown method" - ) -}) + mock_substitute <- mock2(substitute(do.call(dummy_op, list(x = "hi")))) -test_that("check paginate_lapply error if not paginator", { + mock_paginate_update_fn <- mock2(side_effect = function(fn, ...) { + list( + fn = fn, + paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" + ) + ) + }) + mock_paginate_xapply <- mock2() - dummy_internal <- function(paginator) { - paginator - } - dummy_op <- function(x, NextToken = NULL) { - op <- dummy_internal(paginator = list()) - } - mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - mock_environmentName <- mock2("paws.storage") mockery::stub(paginate_lapply, "substitute", mock_substitute) - mockery::stub(paginate_lapply, "environmentName", mock_environmentName) + mockery::stub(paginate_lapply, "paginate_update_fn", mock_paginate_update_fn) + mockery::stub(paginate_lapply, "paginate_xapply", mock_paginate_xapply) - expect_error( - paginate_lapply("dummy", function(resp){resp}), - "unable to paginate" - ) -}) + actual <- paginate_lapply("dummy", \(resp) {resp}) + actual_fn <- mock_arg(mock_paginate_update_fn)[[1]] + expect_equal(actual_fn, substitute(dummy_op(x = "hi"))) +}) ######################################################################## # paginate_sapply ######################################################################## - test_that("check paginate_sapply", { - dummy_internal <- function(paginator) { - paginator - } - dummy_op <- function(x, NextToken) { - op <- dummy_internal(paginator = list( - input_token = "NextToken", - output_token = "NextToken" - ) - ) - } - mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - - mock_environmentName <- mock2("paws.storage") - mock_retry_api_call <- mock2( - list(NextToken = "token1"), - list(NextToken = "token2"), - list(NextToken = character()) - ) - - expected <- list( - NextToken = "token1", - NextToken = "token2", - NextToken = character() - ) - - mockery::stub(paginate_sapply, "substitute", mock_substitute) - mockery::stub(paginate_sapply, "environmentName", mock_environmentName) - mockery::stub(paginate_sapply, "retry_api_call", mock_retry_api_call) - - actual <- paginate_sapply("dummy", function(resp) resp) - - expect_equal(actual, expected) -}) - -test_that("check paginate_sapply all parameters and operation", { - dummy_internal <- function(paginator) { paginator } @@ -455,52 +485,38 @@ test_that("check paginate_sapply all parameters and operation", { op <- dummy_internal(paginator = list( input_token = "NextToken", output_token = "NextToken", - limit_key = "MaxKey" + limit_key = "MaxKey", + result_key = "Contents" ) ) list(NextToken=NextToken, MaxKey=MaxKey) } - mock_substitute <- mock2(substitute(dummy_op(x = "hi", MaxKey = 100, NextToken = "abc"))) - - mock_environmentName <- mock2("paws.storage") - mock_retry_api_call <- mock2( - list(NextToken = "token1"), - list(NextToken = character()) - ) + mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - expected <- list( - NextToken = "token1", - NextToken = character() - ) + mock_paginate_update_fn <- mock2(side_effect = function(fn, ...) { + list( + fn = fn, + paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" + ) + ) + }) + mock_paginate_xapply <- mock2() mockery::stub(paginate_sapply, "substitute", mock_substitute) - mockery::stub(paginate_sapply, "environmentName", mock_environmentName) - mockery::stub(paginate_sapply, "retry_api_call", mock_retry_api_call) - - actual <- paginate_sapply("dummy", function(resp){resp}, MaxItems = 1, StartingToken = "123") + mockery::stub(paginate_sapply, "paginate_update_fn", mock_paginate_update_fn) + mockery::stub(paginate_sapply, "paginate_xapply", mock_paginate_xapply) - inputs <- mockery::mock_args(mock_retry_api_call) + actual <- paginate_sapply("dummy", \(resp) {resp}) + actual_fn <- mock_arg(mock_paginate_update_fn)[[1]] - expect_equal(inputs, list( - list( - list( - NextToken = "abc", - MaxKey = 100 - ), - retries = 5 - ), - list( - list( - NextToken = "token1", - MaxKey = 100 - ), - retries = 5 - ) - )) - expect_equal(actual, expected) + expect_equal(actual_fn, substitute(dummy_op(x = "hi"))) }) -test_that("check paginate_sapply all parameters", { +test_that("check paginate_sapply do.call modified operation", { dummy_internal <- function(paginator) { paginator @@ -509,87 +525,33 @@ test_that("check paginate_sapply all parameters", { op <- dummy_internal(paginator = list( input_token = "NextToken", output_token = "NextToken", - limit_key = "MaxKey" + limit_key = "MaxKey", + result_key = "Contents" ) ) list(NextToken=NextToken, MaxKey=MaxKey) } - mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - - mock_environmentName <- mock2("paws.storage") - mock_retry_api_call <- mock2( - list(NextToken = "token1"), - list(NextToken = character()) - ) - - expected <- list( - NextToken = "token1", - NextToken = character() - ) - - mockery::stub(paginate_sapply, "substitute", mock_substitute) - mockery::stub(paginate_sapply, "environmentName", mock_environmentName) - mockery::stub(paginate_sapply, "retry_api_call", mock_retry_api_call) - - actual <- paginate_sapply("dummy", function(resp){resp}, MaxItems = 5, StartingToken = "123") + mock_substitute <- mock2(substitute(do.call(dummy_op, list(x = "hi")))) - inputs <- mockery::mock_args(mock_retry_api_call) - - expect_equal(inputs, list( - list( - list( - NextToken = "123", - MaxKey = 5 - ), - retries = 5 - ), + mock_paginate_update_fn <- mock2(side_effect = function(fn, ...) { list( - list( - NextToken = "token1", - MaxKey = 5 - ), - retries = 5 + fn = fn, + paginator = list( + input_token = "NextToken", + output_token = "NextToken", + limit_key = "MaxKey", + result_key = "Contents" + ) ) - )) - expect_equal(actual, expected) -}) - -test_that("check paginate_sapply error if not paws function", { + }) + mock_paginate_xapply <- mock2() - dummy_internal <- function(paginator) { - paginator - } - dummy_op <- function(x, NextToken = NULL) { - op <- dummy_internal(paginator = list( - input_token = "NextToken", - output_token = "NextToken" - ) - ) - } - mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) mockery::stub(paginate_sapply, "substitute", mock_substitute) - expect_error( - paginate_sapply("dummy", function(resp) {resp}), - "Unknown method" - ) -}) + mockery::stub(paginate_sapply, "paginate_update_fn", mock_paginate_update_fn) + mockery::stub(paginate_sapply, "paginate_xapply", mock_paginate_xapply) -test_that("check paginate_sapply error if not paginator", { - - dummy_internal <- function(paginator) { - paginator - } - dummy_op <- function(x, NextToken = NULL) { - op <- dummy_internal(paginator = list()) - } - mock_substitute <- mock2(substitute(dummy_op(x = "hi"))) - mock_environmentName <- mock2("paws.storage") - mockery::stub(paginate_sapply, "substitute", mock_substitute) - mockery::stub(paginate_sapply, "environmentName", mock_environmentName) + actual <- paginate_sapply("dummy", \(resp) {resp}) + actual_fn <- mock_arg(mock_paginate_update_fn)[[1]] - expect_error( - paginate_sapply("dummy", function(resp){resp}), - "unable to paginate" - ) + expect_equal(actual_fn, substitute(dummy_op(x = "hi"))) }) - From 31670b02603812119061259ffba31fe3cc0cbea3 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Fri, 28 Jul 2023 15:32:42 +0100 Subject: [PATCH 13/19] correctly count number of responses --- paws.common/NEWS.md | 1 + paws.common/R/paginate.R | 12 ++++++---- paws.common/tests/testthat/test_paginate.R | 26 +++++++++++----------- 3 files changed, 22 insertions(+), 17 deletions(-) diff --git a/paws.common/NEWS.md b/paws.common/NEWS.md index 14b5679fc..442caca95 100644 --- a/paws.common/NEWS.md +++ b/paws.common/NEWS.md @@ -1,6 +1,7 @@ # paws.common 0.5.9 * add expiration parameter to creds * add signature_version to config +* add the ability to paginate paws methods (#30) # paws.common 0.5.8 * fix mismatch apparent method as.list.struct (#634) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index 0fe1a8384..f015ed019 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -54,6 +54,8 @@ paginate <- function(Operation, fn <- fn_update$fn paginator <- fn_update$paginator + + primary_result_key <- paginator$result_key[[1]] no_items <- 0 result <- list() while (!identical(fn[[paginator$input_token[[1]]]], character(0))) { @@ -62,9 +64,9 @@ paginate <- function(Operation, for (i in seq_along(new_tokens)) { fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] } - result[[length(result) + 1]] <- resp[paginator$result_key] + result[[length(result) + 1]] <- resp if (!is.null(MaxItems)) { - no_items <- no_items + length(resp[[paginator$result_key]]) + no_items <- no_items + length(resp[[primary_result_key]]) if (no_items >= MaxItems) { break } @@ -196,6 +198,8 @@ paginate_xapply <- function( ..., MaxRetries = 5, MaxItems = NULL) { + + primary_result_key <- paginator$result_key[[1]] no_items <- 0 result <- list() while (!identical(fn[[paginator$input_token[[1]]]], character(0))) { @@ -204,9 +208,9 @@ paginate_xapply <- function( for (i in seq_along(new_tokens)) { fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] } - result[[length(result) + 1]] <- FUN(resp[paginator$result_key], ...) + result[[length(result) + 1]] <- FUN(resp, ...) if (!is.null(MaxItems)) { - no_items <- no_items + length(resp[[paginator$result_key]]) + no_items <- no_items + length(resp[[primary_result_key]]) if (no_items >= MaxItems) { break } diff --git a/paws.common/tests/testthat/test_paginate.R b/paws.common/tests/testthat/test_paginate.R index 697e49910..e26c47117 100644 --- a/paws.common/tests/testthat/test_paginate.R +++ b/paws.common/tests/testthat/test_paginate.R @@ -154,9 +154,9 @@ test_that("check paginate", { ) expected <- list( - list(Contents = list("foo")), - list(Contents = list("bar")), - list(Contents = list("zoo")) + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2"), + list(Contents = list("zoo"), NextToken = character()) ) mockery::stub(paginate, "substitute", mock_substitute) @@ -210,9 +210,9 @@ test_that("check paginate do.call", { ) expected <- list( - list(Contents = list("foo")), - list(Contents = list("bar")), - list(Contents = list("zoo")) + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2"), + list(Contents = list("zoo"), NextToken = character()) ) mockery::stub(paginate, "substitute", mock_substitute) @@ -265,8 +265,8 @@ test_that("check paginate restrict MaxItems", { ) expected <- list( - list(Contents = list("foo")), - list(Contents = list("bar")) + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2") ) mockery::stub(paginate, "substitute", mock_substitute) @@ -310,9 +310,9 @@ test_that("check paginate_xapply", { ) expected <- list( - list(Contents = list("foo")), - list(Contents = list("bar")), - list(Contents = list("zoo")) + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2"), + list(Contents = list("zoo"), NextToken = character()) ) mockery::stub(paginate_xapply, "retry_api_call", mock_retry_api_call) @@ -362,8 +362,8 @@ test_that("check paginate_xapply restrict MaxItems", { ) expected <- list( - list(Contents = list("foo")), - list(Contents = list("bar")) + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2") ) mockery::stub(paginate_xapply, "retry_api_call", mock_retry_api_call) From 2285214b697f8e03560fb84ed0af38a883e57124 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Fri, 28 Jul 2023 21:54:18 +0100 Subject: [PATCH 14/19] ensure option output_token is kept --- make.paws/R/operations.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/make.paws/R/operations.R b/make.paws/R/operations.R index 81fd85607..640fbc980 100644 --- a/make.paws/R/operations.R +++ b/make.paws/R/operations.R @@ -68,14 +68,20 @@ make_operation <- function(operation, api, doc_maker) { ) } + set_paginator <- function(paginator) { if (!is.null(paginator)) { output_token <- paginator$output_token if (!is.null(output_token)) { for (i in seq_along(output_token)) { - output_token[[i]] <- strsplit(output_token[[i]], " ")[[1]][[1]] + # output_token[[i]] <- strsplit(output_token[[i]], " ")[[1]][[1]] + output_token[i] <- list(trimws(strsplit(output_token[[i]], split = "||", fixed = T)[[1]])) } - paginator$output_token <- output_token + paginator$output_token <- unlist(output_token, use.names = FALSE) + paginator$input_token <- rep_len( + paginator$input_token, + length(paginator$output_token) + ) } paste(trimws(deparse(paginator)), collapse = " ") } else { From d347ac667b88cf0c8b99bcf2d5a3475a037fc884 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Fri, 28 Jul 2023 21:54:50 +0100 Subject: [PATCH 15/19] exist if no more results can be found --- paws.common/R/paginate.R | 41 +++++++++++++++++++++++++++++++++------- 1 file changed, 34 insertions(+), 7 deletions(-) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index f015ed019..0d8e2734e 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -53,8 +53,6 @@ paginate <- function(Operation, fn_update <- paginate_update_fn(fn, PageSize, StartingToken) fn <- fn_update$fn paginator <- fn_update$paginator - - primary_result_key <- paginator$result_key[[1]] no_items <- 0 result <- list() @@ -64,6 +62,12 @@ paginate <- function(Operation, for (i in seq_along(new_tokens)) { fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] } + # exit if no more results + if (!is.null(paginator$more_results)) { + if (isFALSE(resp[[paginator$more_results]])) { + break + } + } result[[length(result) + 1]] <- resp if (!is.null(MaxItems)) { no_items <- no_items + length(resp[[primary_result_key]]) @@ -187,7 +191,7 @@ paginate_update_fn <- function( return(list( fn = fn, - paginator = paginator + paginator = eval(paginator) )) } @@ -198,7 +202,6 @@ paginate_xapply <- function( ..., MaxRetries = 5, MaxItems = NULL) { - primary_result_key <- paginator$result_key[[1]] no_items <- 0 result <- list() @@ -208,6 +211,13 @@ paginate_xapply <- function( for (i in seq_along(new_tokens)) { fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] } + # exit if no more results + if (!is.null(paginator$more_results)) { + if (isFALSE(resp[[paginator$more_results]])) { + break + } + } + # Need to double check this is correct result[[length(result) + 1]] <- FUN(resp, ...) if (!is.null(MaxItems)) { no_items <- no_items + length(resp[[primary_result_key]]) @@ -247,7 +257,9 @@ get_token_path <- function(resp, token) { # Get Token from the last element in a response path: i.e. # Path.To[-1].Token get_token_len <- function(resp, token) { - last_element <- function(x) x[[length(x)]] + last_element <- function(x) { + x[[length(x)]] + } build_part <- function(x) { paste0('last_element(resp[["', paste0(x, collapse = '"]][["'), '"]])') } @@ -263,10 +275,25 @@ get_token_len <- function(resp, token) { } } location <- paste0(paste(build_key, collapse = '[["'), '"]]') - return(eval(parse(text = location), envir = environment())) + tryCatch( + { + return(eval(parse(text = location), envir = environment())) + }, + error = function(e) { + # Return default character(0) for empty lists + if (grepl( + "attempt to select less than one element in integerOneIndex", + e$message, + perl = T + )) { + character(0) + } else { + stop(e) + } + } + ) } - # See https://docs.aws.amazon.com/sdkref/latest/guide/feature-retry-behavior.html retry_api_call <- function(expr, retries) { for (i in seq_len(retries + 1)) { From 84c307142837a4c1358693cfc78bbe760ef9bc8c Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Fri, 28 Jul 2023 21:55:23 +0100 Subject: [PATCH 16/19] remove substitute --- paws.common/tests/testthat/test_paginate.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/paws.common/tests/testthat/test_paginate.R b/paws.common/tests/testthat/test_paginate.R index e26c47117..e87fce200 100644 --- a/paws.common/tests/testthat/test_paginate.R +++ b/paws.common/tests/testthat/test_paginate.R @@ -61,12 +61,12 @@ test_that("check paginate_update_fn", { mockery::stub(paginate_update_fn, "environmentName", mock_environmentName) actual <- paginate_update_fn(substitute(dummy_op(x = "hi")), PageSize = 10, StartingToken = "token1") expect_fn <- substitute(dummy_op(x = "hi", NextToken = "token1", MaxKey = 10)) - expect_paginator <- substitute(list( + expect_paginator <- list( input_token = "NextToken", output_token = "NextToken", limit_key = "MaxKey", result_key = "Contents" - )) + ) expect_equal(actual$fn, expect_fn) expect_equal(actual$paginator, expect_paginator) @@ -174,7 +174,6 @@ test_that("check paginate", { expect_equal(actual, expected) }) - test_that("check paginate do.call", { dummy_internal <- function(paginator) { From 4e71b8486e665f2a65bd7bdd9166e222af4b6a82 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Fri, 28 Jul 2023 21:55:36 +0100 Subject: [PATCH 17/19] initial paginate documentation --- docs/paginators.md | 119 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 119 insertions(+) create mode 100644 docs/paginators.md diff --git a/docs/paginators.md b/docs/paginators.md new file mode 100644 index 000000000..d4a80a222 --- /dev/null +++ b/docs/paginators.md @@ -0,0 +1,119 @@ +# Paginators + +> Some AWS operations return results that are incomplete and require subsequent requests in order to attain the entire result set. The process of sending subsequent requests to continue where a previous request left off is called pagination. For example, the list_objects operation of Amazon S3 returns up to 1000 objects at a time, and you must send subsequent requests with the appropriate Marker in order to retrieve the next page of results. +(https://boto3.amazonaws.com/v1/documentation/api/latest/guide/paginators.html#paginators) + + +As of `paws v0.4.0+` paginators are supported within `paws`. + +## Basic Usage + +A paginator can be applied to a `paws` operation. `paws` support 3 different methods of paginator (`paginate`, `paginate_lapply`, `paginate_sapply`). + +### `paginate`: +Return all response from the `paws` operation. + +```r +library(paws) + +svc <- s3(region = "us-west-2") + +results <- paginate(svc$list_objects(Bucket = "my-bucket")) +``` + +### `paginate_lapply`: +Allows you to apply a function on each returning response. +```r +library(paws) + +svc <- s3(region = "us-west-2") + +results <- paginate_lapply(svc$list_objects(Bucket = "my-bucket"), \(resp) resp$Contents) +``` + +### `paginate_sapply`: +Allows you to apply a function on each returning response, however the final result is simplified similar to `base::sapply`. +```r +library(paws) + +svc <- s3(region = "us-west-2") + +results <- paginate_sapply( + svc$list_objects(Bucket = "my-bucket"), + \(resp) resp$Contents, + simplify = T +) +``` + +## Customizing page Iterators + +You can modify the operation by + +* `MaxItems:` + Limits the maximum number of total returned items returned while paginating. +* `StartingToken:` + Can be used to modify the starting marker or token of a paginator. This argument if useful for resuming pagination from a previous token or starting pagination at a known position. +* `PageSize:` + Controls the number of items returned per page of each result. + + +### `paginate` +```r +library(paws) + +svc <- s3(region = "us-west-2") + +results <- paginate(svc$list_objects(Bucket = "my-bucket"), MaxItems = 10) +``` + +#### `paginate_lapply` +```r +library(paws) + +svc <- s3(region = "us-west-2") + +results <- paginate_lapply(svc$list_objects(Bucket = "my-bucket"), \(page) page$Contents) +``` + +#### `paginate_sapply` +```r +library(paws) + +svc <- s3(region = "us-west-2") + +results <- paginate_lapply(svc$list_objects(Bucket = "my-bucket"), \(page) page$Contents) +``` + +## Piping: + +`paws` paginator support R native piping `|>`. However we currently don't support magrittr piping `%>%`. + +```r +library(paws) +library(magrittr) + +svc <- s3(region = "us-west-2") + +# Will Work +results <- svc$list_objects(Bucket = "my-bucket") |> paginate(MaxItems = 10) + +# Will error: +results <- svc$list_objects(Bucket = "my-bucket") %>% paginate(MaxItems = 10) +``` + + +## Filtering results: + +You can filter the paginator results by limiting the response for the paws operation. For example `list_objects` accepts `Prefix` parameter to filter page server-side before returning to `R`. + +```r +library(paws) + +svc <- s3(region = "us-west-2") + +kwargs <- list( + Bucket='my-bucket', + Prefix='foo/baz' +) +result <- do.call(svc$list_objects, kwargs) |> paginate_lapply(\(page) page$Contents) +``` From d1cd102296a3a88ac24551ef39a9fdb928078f30 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Fri, 28 Jul 2023 22:02:46 +0100 Subject: [PATCH 18/19] exit after response is appended --- paws.common/R/paginate.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index 0d8e2734e..80e4106c2 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -62,13 +62,14 @@ paginate <- function(Operation, for (i in seq_along(new_tokens)) { fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] } + result[[length(result) + 1]] <- resp + # exit if no more results if (!is.null(paginator$more_results)) { if (isFALSE(resp[[paginator$more_results]])) { break } } - result[[length(result) + 1]] <- resp if (!is.null(MaxItems)) { no_items <- no_items + length(resp[[primary_result_key]]) if (no_items >= MaxItems) { @@ -211,14 +212,14 @@ paginate_xapply <- function( for (i in seq_along(new_tokens)) { fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] } + result[[length(result) + 1]] <- FUN(resp, ...) + # exit if no more results if (!is.null(paginator$more_results)) { if (isFALSE(resp[[paginator$more_results]])) { break } } - # Need to double check this is correct - result[[length(result) + 1]] <- FUN(resp, ...) if (!is.null(MaxItems)) { no_items <- no_items + length(resp[[primary_result_key]]) if (no_items >= MaxItems) { From 504e7db466867d2e2349b37169107d6b3281624f Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Mon, 31 Jul 2023 16:22:57 +0100 Subject: [PATCH 19/19] return empty token when not found --- paws.common/tests/testthat/test_paginate.R | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/paws.common/tests/testthat/test_paginate.R b/paws.common/tests/testthat/test_paginate.R index e87fce200..15194cae3 100644 --- a/paws.common/tests/testthat/test_paginate.R +++ b/paws.common/tests/testthat/test_paginate.R @@ -18,6 +18,20 @@ test_that("check token is correctly retrieved", { expect_equal(actual, expected) }) +test_that("check empty token is returned", { + output_tokens <- list( + "NextToken", + "Contents[-1].Id" + ) + resp <- list( + NextToken = character(0), + Contents = list() + ) + expected <- setNames(list(character(0), character(0)), output_tokens) + actual <- get_tokens(resp, output_tokens) + expect_equal(actual, expected) +}) + ######################################################################## # retry_api_call ########################################################################