From 7f67eb3a951d5f017207d7ad810c44a56a91e799 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 5 Dec 2024 11:42:32 -0600 Subject: [PATCH 1/4] Needed options for redirect set properly #413 --- R/curl.R | 3 ++- R/makeApiCall.R | 5 +++-- R/unlockREDCap.R | 11 ++++++----- 3 files changed, 11 insertions(+), 8 deletions(-) diff --git a/R/curl.R b/R/curl.R index 080ea506..5f6fcd77 100644 --- a/R/curl.R +++ b/R/curl.R @@ -25,7 +25,8 @@ fields = cfg$fields, options = modifyList(list(timeout_ms = 3e5, useragent = .curlDefaultUa(), - post = TRUE), + post = TRUE, + followlocation = FALSE), cfg$options), auth_token = token, output = structure(list(), class = c("write_memory", "write_function")) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index e3f7cebb..33ba7d62 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -142,6 +142,7 @@ makeApiCall <- function(rcon, body = list(), url = NULL, success_status_codes = 200L, + redirect = TRUE, ...) { # Pull config, api_param from ... @@ -221,7 +222,7 @@ makeApiCall <- function(rcon, message(paste0(">>>\n", as.character(response), "<<<\n")) } - response <- .makeApiCall_handleRedirect(rcon, body, response, ...) + if(redirect) response <- .makeApiCall_handleRedirect(rcon, body, response, ...) is_retry_eligible <- .makeApiCall_isRetryEligible(response) @@ -262,7 +263,7 @@ makeApiCall <- function(rcon, } # Good for a single call - makeApiCall(rcon, body, response$headers$location, ...) + makeApiCall(rcon, body, response$header$location, ...) } else response # The not redirected case } diff --git a/R/unlockREDCap.R b/R/unlockREDCap.R index e9a262f4..377c3002 100644 --- a/R/unlockREDCap.R +++ b/R/unlockREDCap.R @@ -42,8 +42,10 @@ connectAndCheck <- function(key, url, ...) rcon <- redcapConnection(token=key, url=url, ...) version <- list(content = "version", format = "csv") # Test connection by checking version - response <- makeApiCall(rcon, body = version, - success_status_codes=c(200L, 301L, 302L) + response <- makeApiCall(rcon, + body = version, + success_status_codes=c(200L, 301L, 302L), + redirect=FALSE ) # No redirect, this is success @@ -52,17 +54,16 @@ connectAndCheck <- function(key, url, ...) # Handle redirect rcon <- redcapConnection( token = key, - url = paste0(response$header$location, '/api/'), + url = response$header$location, ...) # Test connection by checking version post redirect response <- makeApiCall(rcon, body = version, - success_status_codes=c(200L, 301L, 302L)) + success_status_codes=c(200L, 301L, 302L), redirect=FALSE) if(response$status_code %in% c(301L, 302L)) stop(paste("Too many redirects from", url)) - rcon }, error = function(e) From 7814281d27d44d772715bf81f95d1f6ab0913c42 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 5 Dec 2024 11:47:17 -0600 Subject: [PATCH 2/4] Fixed redirect test #413 --- tests/testthat/test-024-unlockREDCap.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-024-unlockREDCap.R b/tests/testthat/test-024-unlockREDCap.R index 5b0936fa..0b4cece8 100644 --- a/tests/testthat/test-024-unlockREDCap.R +++ b/tests/testthat/test-024-unlockREDCap.R @@ -10,7 +10,7 @@ redirect <- structure( content = "", headers=structure(list( 'content-type'="text/csv; charset=utf-8", - 'location'=gsub('\\/api\\/', '', url) + 'location'=url ), class = c("insensitive", "list")), class = "response") From 49fa823c033cfbc2cfe88f27fcd9f27032853ffc Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 5 Dec 2024 13:39:41 -0600 Subject: [PATCH 3/4] Updates to validate parameter and include coumentation for redirect #413 --- R/makeApiCall.R | 5 +++++ man/makeApiCall.Rd | 11 ++++++++++- tests/testthat/test-050-makeApiCall.R | 18 ++++++++++++++++++ 3 files changed, 33 insertions(+), 1 deletion(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index 33ba7d62..223cb230 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -12,6 +12,7 @@ #' @param url `character(1)` A url string to hit. Defaults to rcon$url. #' @param success_status_codes `integerish` A vector of success codes to ignore #' for error handling. Defaults to c(200L). +#' @param redirect `logical(1)` Is redirection on the request allowed? #' @param ... This will capture `api_param` (if specified) which will modify the body of the #' the specified body of the request. It also captures `config` which will get #' passed to curl::handle_setopt. @@ -177,6 +178,10 @@ makeApiCall <- function(rcon, checkmate::assert_list(x = api_param, names = "named", add = coll) + + checkmate::assert_logical(x = redirect, + len = 1, + add = coll) checkmate::reportAssertions(coll) diff --git a/man/makeApiCall.Rd b/man/makeApiCall.Rd index 307271ab..aaec420c 100644 --- a/man/makeApiCall.Rd +++ b/man/makeApiCall.Rd @@ -4,7 +4,14 @@ \alias{makeApiCall} \title{Make REDCap API Calls} \usage{ -makeApiCall(rcon, body = list(), url = NULL, success_status_codes = 200L, ...) +makeApiCall( + rcon, + body = list(), + url = NULL, + success_status_codes = 200L, + redirect = TRUE, + ... +) } \arguments{ \item{rcon}{A \code{redcapConnection} object.} @@ -17,6 +24,8 @@ makeApiCall(rcon, body = list(), url = NULL, success_status_codes = 200L, ...) \item{success_status_codes}{\code{integerish} A vector of success codes to ignore for error handling. Defaults to c(200L).} +\item{redirect}{\code{logical(1)} Is redirection on the request allowed?} + \item{...}{This will capture \code{api_param} (if specified) which will modify the body of the the specified body of the request. It also captures \code{config} which will get passed to curl::handle_setopt.} diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index b10db39f..230b91d1 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -19,6 +19,24 @@ test_that( } ) +test_that( + "makeApiCall will not allow a non-logical redirect parameter", + { + expect_error( + makeApiCall(rcon, body = list(format = "csv"), url='xyz.com', redirect=23), + "redirect.*Must be of type 'logical'") + } +) + +test_that( + "makeApiCall will not allow more than one redirect parameter", + { + expect_error( + makeApiCall(rcon, body = list(format = "csv"), url='xyz.com', redirect=c(TRUE, TRUE)), + "redirect.*Must have length 1") + } +) + test_that( ".makeApiCall_isRetryEligible returns appropriate logical values", { From cdf5b213864c75df1a24cc4d9e7a87da47d1a057 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 4 Dec 2024 15:50:06 -0600 Subject: [PATCH 4/4] Removed old-rel-3 due to failing Hmisc install #417 --- .github/workflows/r-cmd-check.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/r-cmd-check.yml b/.github/workflows/r-cmd-check.yml index 94f80992..71f39127 100644 --- a/.github/workflows/r-cmd-check.yml +++ b/.github/workflows/r-cmd-check.yml @@ -35,7 +35,6 @@ jobs: - {os: ubuntu-latest, r: 'release'} - {os: ubuntu-latest, r: 'oldrel-1'} - {os: ubuntu-latest, r: 'oldrel-2'} - - {os: ubuntu-latest, r: 'oldrel-3'} env: R_KEEP_PKG_SOURCE: yes