Merge pull request #194 from vubiostat/issue-193-unlock-yaml

Fixed bug from #174 in yaml file reading for unlockREDCap, #193
vubiostat · Jul 14, 2023 · eb312ce · eb312ce
2 parents 3734094 + 082c252
commit eb312ce
Show file tree

Hide file tree

Showing 3 changed files with 44 additions and 10 deletions.
diff --git 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
@@ -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
@@ -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",
   {