From 175733ec516ec92dc8c64c67f9ea3e9a65140f1e Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Tue, 12 Dec 2023 18:33:44 +0000 Subject: [PATCH 1/6] stop paginating when no results are returned --- paws.common/R/paginate.R | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index 0ddd4443d..b00f77b1a 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -62,16 +62,22 @@ paginate <- function(Operation, for (i in seq_along(new_tokens)) { fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] } + + resp_len <- length(resp[[primary_result_key]]) + if (resp_len == 0) { + break + } + result[[length(result) + 1]] <- resp # exit if no more results - if (!is.null(paginator$more_results)) { - if (isFALSE(resp[[paginator$more_results]])) { + if (!is.null(paginator[["more_results"]])) { + if (isFALSE(resp[[paginator[["more_results"]]]])) { break } } if (!is.null(MaxItems)) { - no_items <- no_items + length(resp[[primary_result_key]]) + no_items <- no_items + resp_len if (no_items >= MaxItems) { break } @@ -244,16 +250,22 @@ paginate_xapply <- function( for (i in seq_along(new_tokens)) { fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] } + + resp_len <- length(resp[[primary_result_key]]) + if (resp_len == 0) { + break + } + result[[length(result) + 1]] <- FUN(resp, ...) # exit if no more results - if (!is.null(paginator$more_results)) { - if (isFALSE(resp[[paginator$more_results]])) { + if (!is.null(paginator[["more_results"]])) { + if (isFALSE(resp[[paginator[["more_results"]]]])) { break } } if (!is.null(MaxItems)) { - no_items <- no_items + length(resp[[primary_result_key]]) + no_items <- no_items + resp_len if (no_items >= MaxItems) { break } From f2154904a5a5eec5773ff1045f43c2816649ba9e Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Tue, 19 Dec 2023 16:59:52 +0000 Subject: [PATCH 2/6] Exit paginator when previous token matches current token (https://github.com/aws/aws-sdk-js-v3/releases/tag/v3.78.0) --- paws.common/R/paginate.R | 56 +++++++++++++++++++++++++------------ paws.common/man/paginate.Rd | 16 +++++++++-- 2 files changed, 51 insertions(+), 21 deletions(-) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index b00f77b1a..13174cd29 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -19,6 +19,7 @@ #' @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 StopOnSameToken Exist paginator if previous token matches current token. #' @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}. @@ -39,7 +40,8 @@ paginate <- function(Operation, PageSize = NULL, MaxItems = NULL, - StartingToken = NULL) { + StartingToken = NULL, + StopOnSameToken = FALSE) { fn <- substitute(Operation) # rebuild fn for do.call if (identical(fn[[1]], .do_call)) { @@ -59,13 +61,19 @@ paginate <- function(Operation, while (!identical(fn[[paginator$input_token[[1]]]], character(0))) { resp <- eval(fn, envir = parent.frame()) new_tokens <- get_tokens(resp, paginator$output_token) - for (i in seq_along(new_tokens)) { - fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] + + # Exit paginator if previous token matches current token + # https://github.com/aws/aws-sdk-js-v3/releases/tag/v3.78.0 + if (isTRUE(StopOnSameToken)) { + previous_token <- unlist(fn[[paginator$input_token]], use.names = F) + if (identical(previous_token, unlist(new_tokens, use.names = F))) { + break + } } - resp_len <- length(resp[[primary_result_key]]) - if (resp_len == 0) { - break + # Update tokens + for (i in seq_along(new_tokens)) { + fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] } result[[length(result) + 1]] <- resp @@ -77,7 +85,7 @@ paginate <- function(Operation, } } if (!is.null(MaxItems)) { - no_items <- no_items + resp_len + no_items <- no_items + length(resp[[primary_result_key]]) if (no_items >= MaxItems) { break } @@ -93,7 +101,8 @@ paginate_lapply <- function(Operation, ..., PageSize = NULL, MaxItems = NULL, - StartingToken = NULL) { + StartingToken = NULL, + StopOnSameToken = FALSE) { FUN <- match.fun(FUN) fn <- substitute(Operation) @@ -112,7 +121,8 @@ paginate_lapply <- function(Operation, paginator = fn_update$paginator, FUN = FUN, ..., - MaxItems = MaxItems + MaxItems = MaxItems, + StopOnSameToken = StopOnSameToken ) return(result) } @@ -125,7 +135,8 @@ paginate_sapply <- function(Operation, simplify = TRUE, PageSize = NULL, MaxItems = NULL, - StartingToken = NULL) { + StartingToken = NULL, + StopOnSameToken = FALSE) { FUN <- match.fun(FUN) fn <- substitute(Operation) @@ -144,7 +155,8 @@ paginate_sapply <- function(Operation, paginator = fn_update$paginator, FUN = FUN, ..., - MaxItems = MaxItems + MaxItems = MaxItems, + StopOnSameToken = StopOnSameToken ) if (!isFALSE(simplify)) { @@ -240,20 +252,28 @@ paginate_xapply <- function( paginator, FUN, ..., - MaxItems = NULL) { + MaxItems = NULL, + StopOnSameToken = FALSE) { primary_result_key <- paginator$result_key[[1]] no_items <- 0 result <- list() while (!identical(fn[[paginator$input_token[[1]]]], character(0))) { resp <- eval(fn, envir = parent.frame(n = 2)) new_tokens <- get_tokens(resp, paginator$output_token) - for (i in seq_along(new_tokens)) { - fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] + previous_token <- unlist(fn[[paginator$input_token]], use.names = F) + + # Exit paginator if previous token matches current token + # https://github.com/aws/aws-sdk-js-v3/releases/tag/v3.78.0 + if (isTRUE(StopOnSameToken)) { + previous_token <- unlist(fn[[paginator$input_token]], use.names = F) + if (identical(previous_token, unlist(new_tokens, use.names = F))) { + break + } } - resp_len <- length(resp[[primary_result_key]]) - if (resp_len == 0) { - break + # Update tokens + for (i in seq_along(new_tokens)) { + fn[[paginator$input_token[[i]]]] <- new_tokens[[i]] } result[[length(result) + 1]] <- FUN(resp, ...) @@ -265,7 +285,7 @@ paginate_xapply <- function( } } if (!is.null(MaxItems)) { - no_items <- no_items + resp_len + no_items <- no_items + length(resp[[primary_result_key]]) if (no_items >= MaxItems) { break } diff --git a/paws.common/man/paginate.Rd b/paws.common/man/paginate.Rd index b095c63a9..9185f2468 100644 --- a/paws.common/man/paginate.Rd +++ b/paws.common/man/paginate.Rd @@ -6,7 +6,13 @@ \alias{paginate_sapply} \title{Paginate over an operation.} \usage{ -paginate(Operation, PageSize = NULL, MaxItems = NULL, StartingToken = NULL) +paginate( + Operation, + PageSize = NULL, + MaxItems = NULL, + StartingToken = NULL, + StopOnSameToken = FALSE +) paginate_lapply( Operation, @@ -14,7 +20,8 @@ paginate_lapply( ..., PageSize = NULL, MaxItems = NULL, - StartingToken = NULL + StartingToken = NULL, + StopOnSameToken = FALSE ) paginate_sapply( @@ -24,7 +31,8 @@ paginate_sapply( simplify = TRUE, PageSize = NULL, MaxItems = NULL, - StartingToken = NULL + StartingToken = NULL, + StopOnSameToken = FALSE ) } \arguments{ @@ -37,6 +45,8 @@ paginate_sapply( \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{StopOnSameToken}{Exist paginator if previous token matches current token.} + \item{FUN}{the function to be applied to each response element of \code{operation}.} \item{...}{optional arguments to \code{FUN}.} From d5a357eb95cd4b60ca0479daf90b9c4d4f003858 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Tue, 19 Dec 2023 17:54:59 +0000 Subject: [PATCH 3/6] exit if StopOnSameToken is True --- paws.common/tests/testthat/test_paginate.R | 100 +++++++++++++++++++++ 1 file changed, 100 insertions(+) diff --git a/paws.common/tests/testthat/test_paginate.R b/paws.common/tests/testthat/test_paginate.R index 670fbde98..9f4de5e55 100644 --- a/paws.common/tests/testthat/test_paginate.R +++ b/paws.common/tests/testthat/test_paginate.R @@ -164,6 +164,57 @@ test_that("check paginate", { expect_equal(actual, expected) }) +test_that("check paginate stop on same token", { + 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_substitute <- mock2(substitute(dummy_op(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_eval <- mock2( + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2"), + list(Contents = list(), NextToken = "token2") + ) + + expected <- list( + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2") + ) + + mockery::stub(paginate, "substitute", mock_substitute) + mockery::stub(paginate, "paginate_update_fn", mock_paginate_update_fn) + mockery::stub(paginate, "eval", mock_eval) + + actual <- paginate("dummy", StopOnSameToken = TRUE) + actual_args <- mockery::mock_args(mock_eval) + expect_equal(lapply(actual_args, function(x) as.list(x[[1]][-1])), list( + list(x = "hi"), + list(x = "hi", NextToken = "token1"), + list(x = "hi", NextToken = "token2") + )) + expect_equal(actual, expected) +}) + ######################################################################## # paginate_xapply ######################################################################## @@ -267,6 +318,55 @@ test_that("check paginate_xapply restrict MaxItems", { expect_equal(actual, expected) }) +test_that("check paginate stop on same token", { + 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_eval <- mock2( + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2"), + list(Contents = list(), NextToken = "token2") + ) + + expected <- list( + list(Contents = list("foo"), NextToken = "token1"), + list(Contents = list("bar"), NextToken = "token2") + ) + + mockery::stub(paginate_xapply, "eval", mock_eval) + + 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 + }, + MaxItems = NULL, + StopOnSameToken = TRUE + ) + actual_args <- mockery::mock_args(mock_eval) + expect_equal(lapply(actual_args, function(x) as.list(x[[1]][-1])), list( + list(x = "hi"), + list(x = "hi", NextToken = "token1"), + list(x = "hi", NextToken = "token2") + )) + expect_equal(actual, expected) +}) ######################################################################## # paginate_lapply From 7a61e04c4d34617849d935a869717a59207c46e0 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Tue, 19 Dec 2023 17:57:36 +0000 Subject: [PATCH 4/6] tidy up code --- paws.common/R/paginate.R | 1 - 1 file changed, 1 deletion(-) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index 13174cd29..65e1ab278 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -260,7 +260,6 @@ paginate_xapply <- function( while (!identical(fn[[paginator$input_token[[1]]]], character(0))) { resp <- eval(fn, envir = parent.frame(n = 2)) new_tokens <- get_tokens(resp, paginator$output_token) - previous_token <- unlist(fn[[paginator$input_token]], use.names = F) # Exit paginator if previous token matches current token # https://github.com/aws/aws-sdk-js-v3/releases/tag/v3.78.0 From 4b54eeaa8ce25d461db18501bf05ca280aca6a42 Mon Sep 17 00:00:00 2001 From: "dyfan.jones" Date: Wed, 20 Dec 2023 17:30:32 +0000 Subject: [PATCH 5/6] update typescript reference --- paws.common/R/paginate.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/paws.common/R/paginate.R b/paws.common/R/paginate.R index 65e1ab278..69cefd8fb 100644 --- a/paws.common/R/paginate.R +++ b/paws.common/R/paginate.R @@ -63,7 +63,7 @@ paginate <- function(Operation, new_tokens <- get_tokens(resp, paginator$output_token) # Exit paginator if previous token matches current token - # https://github.com/aws/aws-sdk-js-v3/releases/tag/v3.78.0 + # https://github.com/smithy-lang/smithy-typescript/blob/main/packages/core/src/pagination/createPaginator.ts#L53 if (isTRUE(StopOnSameToken)) { previous_token <- unlist(fn[[paginator$input_token]], use.names = F) if (identical(previous_token, unlist(new_tokens, use.names = F))) { @@ -262,7 +262,7 @@ paginate_xapply <- function( new_tokens <- get_tokens(resp, paginator$output_token) # Exit paginator if previous token matches current token - # https://github.com/aws/aws-sdk-js-v3/releases/tag/v3.78.0 + # https://github.com/smithy-lang/smithy-typescript/blob/main/packages/core/src/pagination/createPaginator.ts#L53 if (isTRUE(StopOnSameToken)) { previous_token <- unlist(fn[[paginator$input_token]], use.names = F) if (identical(previous_token, unlist(new_tokens, use.names = F))) { From 496faaa793c60b93e39c6775263b9df7f07b49ac Mon Sep 17 00:00:00 2001 From: DyfanJones Date: Wed, 20 Dec 2023 17:39:03 +0000 Subject: [PATCH 6/6] Style --- paws.common/R/custom_s3.R | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/paws.common/R/custom_s3.R b/paws.common/R/custom_s3.R index 977f68569..6220bdc00 100644 --- a/paws.common/R/custom_s3.R +++ b/paws.common/R/custom_s3.R @@ -161,7 +161,7 @@ sse_md5_build <- function(request) { # encryption key. This handler does both if the MD5 has not been set by # the caller. sse_md5 <- function(params) { - return(.sse_md5(params, 'SSECustomer')) + return(.sse_md5(params, "SSECustomer")) } # S3 server-side encryption requires the encryption key to be sent to the @@ -169,14 +169,15 @@ sse_md5 <- function(params) { # encryption key. This handler does both if the MD5 has not been set by # the caller specifically if the parameter is for the copy-source sse-c key. copy_source_sse_md5 <- function(params) { - return(.sse_md5(params, 'CopySourceSSECustomer')) + return(.sse_md5(params, "CopySourceSSECustomer")) } -.sse_md5 <- function(params, sse_member_prefix='SSECustomer') { - if (!.needs_s3_sse_customization(params, sse_member_prefix)) +.sse_md5 <- function(params, sse_member_prefix = "SSECustomer") { + if (!.needs_s3_sse_customization(params, sse_member_prefix)) { return(params) - sse_key_member <- paste0(sse_member_prefix, 'Key') - sse_md5_member <- paste0(sse_member_prefix, 'KeyMD5') + } + sse_key_member <- paste0(sse_member_prefix, "Key") + sse_md5_member <- paste0(sse_member_prefix, "KeyMD5") key_md5_str <- base64enc::base64encode( digest::digest(params[[sse_key_member]], serialize = FALSE, raw = TRUE) ) @@ -186,9 +187,9 @@ copy_source_sse_md5 <- function(params) { } .needs_s3_sse_customization <- function(params, sse_member_prefix) { - return ( - !is_empty(params[[paste0(sse_member_prefix, 'Key')]]) & - is_empty(params[[paste0(sse_member_prefix, 'KeyMD5')]]) + return( + !is_empty(params[[paste0(sse_member_prefix, "Key")]]) & + is_empty(params[[paste0(sse_member_prefix, "KeyMD5")]]) ) }