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 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..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. @@ -142,6 +143,7 @@ makeApiCall <- function(rcon, body = list(), url = NULL, success_status_codes = 200L, + redirect = TRUE, ...) { # Pull config, api_param from ... @@ -176,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) @@ -221,7 +227,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 +268,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) 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-024-unlockREDCap.R b/tests/testthat/test-024-unlockREDCap.R index 7263ee17..f621ca4c 100644 --- a/tests/testthat/test-024-unlockREDCap.R +++ b/tests/testthat/test-024-unlockREDCap.R @@ -13,7 +13,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") diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index d4083140..576c8bf9 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -22,6 +22,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", {