diff --git a/NEWS b/NEWS index 0b0377ff..d14ce72f 100644 --- a/NEWS +++ b/NEWS @@ -2,10 +2,10 @@ * Fixed upper/lower case for AND/OR in parseBranchingLogic * Added a `system` field type for mapping with `castLabel` and `castRaw`. -* Dags are added to connection cache. +* DAGs are added to connection cache. * Timeout on connections defaults to 5m. * Clearer error message on connection closed. -* export/import handles the now and today validation words for dates and date/times. +* export/import handles the 'now' and 'today' validation words for dates and date/times. * unlockREDCap: major refactor / rewrite. Many edges cases handled gracefully with better error messaging. Now with less password requests. ## 2.7.3 diff --git a/R/unlockREDCap.R b/R/unlockREDCap.R index bbb98608..08a6e15f 100644 --- a/R/unlockREDCap.R +++ b/R/unlockREDCap.R @@ -21,7 +21,7 @@ { tryCatch( { - conn <- redcapConnection(key, url=url, ...) + conn <- redcapConnection(token=key, url=url, ...) conn$metadata() # Test connection by reading metadata into cache conn }, @@ -76,16 +76,24 @@ config <- config$redcapAPI if(is.null(config$keys)) stop(paste0("Config file '",config_file,"' does not contain required 'keys' entry under the 'redcapAPI' entry")) keys <- config$keys - if(!is.null(config$args$url)) url <- config$args$url # Override from yml if available - config$args$url <- NULL - args <- c(config$args, url = url, list(...)) - - dest <- lapply(seq_along(connections), function(i) + + dest <- lapply(connections, function(conn) { - args$key <- keys[connections[i]] + key <- keys[[conn]] - if(is.null(args$key)) stop(paste0("Config file '", config_file, "' does not have API_KEY for '",connections[i],"' under redcapAPI: keys: specified.")) + if(is.null(key) || length(key)==0) + stop(paste0("Config file '", config_file, "' does not have API_KEY for '", conn,"' under 'redcapAPI: keys:' specified.")) + if(!is.character(key)) + { + stop(paste0("Config file '", config_file, "' invalid entry for '", conn,"' under 'redcapAPI: keys:'.")) + } + if(length(key) > 1) + stop(paste0("Config file '", config_file, "' has too may key entries for '", conn,"' under 'redcapAPI: keys:' specified.")) + args <- list(...) + args$key <- key + args$url <- url + if(!is.null(config$args)) args <- modifyList(args, config$args) do.call(.connectAndCheck, args) }) names(dest) <- if(is.null(names(connections))) connections else names(connections) diff --git a/tests/testthat/test-unlockREDCap.R b/tests/testthat/test-unlockREDCap.R index 35f0eebd..8ba1efbd 100644 --- a/tests/testthat/test-unlockREDCap.R +++ b/tests/testthat/test-unlockREDCap.R @@ -52,12 +52,38 @@ test_that( { stub(.unlockYamlOverride, "file.exists", TRUE) stub(.unlockYamlOverride, "read_yaml", list(redcapAPI=list())) + stub(.unlockYamlOverride, ".connectAndCheck", TRUE) expect_error(.unlockYamlOverride("TestRedcapAPI", url), "does not contain required 'keys' entry") } ) +test_that( + ".unlockYamlOverride stops if a list redcapAPI$keys entry is found", + { + stub(.unlockYamlOverride, "file.exists", TRUE) + stub(.unlockYamlOverride, "read_yaml", list(redcapAPI=list(keys=list(TestRedcapAPI=list())))) + stub(.unlockYamlOverride, ".connectAndCheck", TRUE) + + expect_error(.unlockYamlOverride("TestRedcapAPI", url), + "does not have API_KEY for") + } +) + +test_that( + ".unlockYamlOverride stops if a non string redcapAPI$keys entry is found", + { + stub(.unlockYamlOverride, "file.exists", TRUE) + stub(.unlockYamlOverride, "read_yaml", list(redcapAPI=list(keys=list(TestRedcapAPI=TRUE)))) + stub(.unlockYamlOverride, ".connectAndCheck", TRUE) + + expect_error(.unlockYamlOverride("TestRedcapAPI", url), + "invalid entry") + } +) + + test_that( ".unlockYamlOverride returns an entry for every connection", {