retrieve_credential_local() can select user

close #364

Author: wibeasley

NEWS.md

@@ -6,6 +6,7 @@ Upcoming Versions
 * `sanitize_token()` now allows lowercase characters --in addition to uppercase characters & digits. (#347, @jmbarbone)
 * `redcap_metadata_read()` now uses json (instead of csv) to transfer the dictionary between server & client.  This accommodates super-wide dictionaries with 35k+ variables.  The user shouldn't notice a difference, and still will receive a data.frame. (#335, @januz & @datalorax)
 * Include a few more `testthat::skip_on_cran()` calls to comply with CRAN's ["fail gracefully"](https://cran.r-project.org/web/packages/policies.html) policy.  Similarly, skip remaining examples that depend on external resources. (#352)
+* `retrieve_credential_local()` can now user `username` to identify the desired credential row (#364)
 
 ### Test Suite 
 

R/helpers-testing.R

@@ -1,8 +1,9 @@
-retrieve_credential_testing <- function(project_id = 153L) {
+retrieve_credential_testing <- function (project_id = 153L, username = NA_character_) {
   checkmate::assert_integer(project_id, lower = 1, len = 1, any.missing = FALSE)
    REDCapR::retrieve_credential_local(
     path_credential = system.file("misc/example.credentials", package="REDCapR"),
-    project_id      = project_id
+    project_id      = project_id,
+    username        = username
   )
 }
 

R/project-dag-write.R

@@ -12,8 +12,7 @@ populate_project_dag_write <- function(batch = FALSE) {
     # nocov end
   }
 
-  credential  <- retrieve_credential_testing(2545L)
-  # credential$token <- "123CA040BDA500E5CADB144D610FA3D0"
+  credential  <- retrieve_credential_testing(2545L, "admin")
 
   project <- REDCapR::redcap_project$new(
     redcap_uri    = credential$redcap_uri,

R/retrieve-credential.R

@@ -12,7 +12,8 @@
 #'   project_id,
 #'   check_url            = TRUE,
 #'   check_username       = FALSE,
-#'   check_token_pattern  = TRUE
+#'   check_token_pattern  = TRUE,
+#'   username             = NA_character_
 #' )
 #'
 #' retrieve_credential_mssql(
@@ -37,6 +38,7 @@
 #' @param check_url A `logical` value indicates if the url in the credential
 #' file should be checked to have approximately the correct form.  Defaults
 #' to TRUE.
+#' [REDCapR::retrieve_credential_local()].
 #' @param check_username A `logical` value indicates if the username in the
 #' credential file should be checked against the username returned by R.
 #' Defaults to FALSE.
@@ -46,6 +48,8 @@
 #' local machine that points to the desired MSSQL database. Required.
 #' @param channel An *optional* connection handle as returned by
 #' [DBI::dbConnect()].  See Details below. Optional.
+#' @param username A character value used to retrieve a credential.
+#' See the Notes below. Optional.
 #'
 #' @return A list of the following elements are returned from
 #' `retrieve_credential_local()` and `retrieve_credential_mssql()`:
@@ -82,13 +86,25 @@
 #' 6. Double-check the file is secured and not accessible by other users.
 #'
 #' @note
+#'
+#' *Storing credentials on a server is preferred*
+#'
 #' Although we strongly encourage storing all the tokens on a central server
 #' (*e.g.*, see the `retrieve_credential_mssql()` function and the
 #' "SecurityDatabase" vignette), there are times when this approach is not
 #' feasible and the token must be stored locally.  Please contact us
 #' if your institution is using something other than SQL Server, and
 #' would like help adapting this approach to your infrastructure.
 #'
+#' *Stored credentials locally*
+#'
+#' When storing credentials locally, typically the credential file
+#' should be dedicated to just one user. Occasionally it makes sense to store
+#' tokens for multiple users --usually it's for the purpose of testing.
+#'
+#' The `username` field is connected only in the local credential file.
+#' It does not need to be the same as the official username in REDCap.
+#'
 #' @author Will Beasley
 #'
 #' @examples
@@ -113,11 +129,13 @@ retrieve_credential_local <- function(
   project_id,
   check_url                = TRUE,
   check_username           = FALSE,
-  check_token_pattern      = TRUE
+  check_token_pattern      = TRUE,
+  username                 = NA_character_
 ) {
 
   checkmate::assert_character(path_credential  , any.missing=FALSE, len=1, pattern="^.{1,}$")
   checkmate::assert_file_exists(path_credential                                         )
+  checkmate::assert_character(username         , any.missing=TRUE, len=1, pattern="^.{1,}$")
 
   col_types <- readr::cols_only(
     redcap_uri    = readr::col_character(),
@@ -154,6 +172,11 @@ retrieve_credential_local <- function(
   # Select only the records with a matching project id.
   ds_credential <- ds_credentials[ds_credentials$project_id == project_id, ]
 
+  # If specified, select only the records with a matching username.
+  if (!is.na(username)) {
+    ds_credential <- ds_credentials[ds_credentials$username == username, ]
+  }
+
   # Check that one and only one record matches the project id.
   if (nrow(ds_credential) == 0L) {
     stop(

inst/misc/example.credentials

@@ -20,7 +20,8 @@ redcap_uri,username,project_id,token,comment
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","1400","F187271FC6FD72C3BFCE37990A6BF6A7","Repeating Instruments"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","1425","221E86DABFEEA233067C6889991B7FBB","Potentially problematic dictionary"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","1490","457C24AB91B7FCF5B1A7DA67E70E24C7","simple write metadata"
-"https://bbmc.ouhsc.edu/redcap/api/","myusername","2545","0BF11B9CB01F0B8F8EE203B7E07DEFD9","DAG Write"
+"https://bbmc.ouhsc.edu/redcap/api/","admin"     ,"2545","0BF11B9CB01F0B8F8EE203B7E07DEFD9","DAG Write -admin"
+"https://bbmc.ouhsc.edu/redcap/api/","user-dag1" ,"2545","C79DB3836373478986928303B52E74DF","DAG Write -group A"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","2593","1C31398F332FCACA4C0A7B93B18D5CD4","super-wide #2--5,785 columns"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","2597","5C1526186C4D04AE0A0630743E69B53C","super-wide #3--35,000 columns"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","2603","56F43A10D01D6578A46393394D76D88F","Repeating Instruments --Sparse"

man/retrieve_credential.Rd

@@ -4,6 +4,7 @@ path               <- system.file("misc/example.credentials", package="REDCapR")
 pid_read           <- 153L # This project is for testing only reading from the server.
 pid_longitudinal   <- 212L # This project is for testing reading longitudinal projects.
 pid_write          <- 213L # This project is for testing reading & writing.
+pid_dag            <- 2545L #This project is for testing DAGs.
 
 test_that("Good Credentials", {
   expected_read_redcap_uri      <- "https://bbmc.ouhsc.edu/redcap/api/"
@@ -46,6 +47,34 @@ test_that("Good Credentials", {
   expect_equal(credential_write$token        , expected_write_token)
   expect_equal(credential_write$comment      , expected_write_comment)
 })
+test_that("Multiple users", {
+  expected_admin_redcap_uri     <- "https://bbmc.ouhsc.edu/redcap/api/"
+  expected_admin_username       <- "admin"
+  expected_admin_project_id     <- pid_dag
+  expected_admin_token          <- "0BF11B9CB01F0B8F8EE203B7E07DEFD9"
+  expected_admin_comment        <- "DAG Write -admin"
+
+  expected_user_redcap_uri      <- "https://bbmc.ouhsc.edu/redcap/api/"
+  expected_user_username        <- "user-dag1"
+  expected_user_project_id      <- pid_dag
+  expected_user_token           <- "C79DB3836373478986928303B52E74DF"
+  expected_user_comment         <- "DAG Write -group A"
+
+  credential_admin        <- retrieve_credential_testing(pid_read, expected_admin_username)
+  credential_user         <- retrieve_credential_testing(pid_read, expected_user_username)
+
+  expect_equal(credential_admin$redcap_uri  , expected_admin_redcap_uri)
+  expect_equal(credential_admin$username    , expected_admin_username)
+  expect_equal(credential_admin$project_id  , expected_admin_project_id)
+  expect_equal(credential_admin$token       , expected_admin_token)
+  expect_equal(credential_admin$comment     , expected_admin_comment)
+
+  expect_equal(credential_user$redcap_uri   , expected_user_redcap_uri)
+  expect_equal(credential_user$username     , expected_user_username)
+  expect_equal(credential_user$project_id   , expected_user_project_id)
+  expect_equal(credential_user$token        , expected_user_token)
+  expect_equal(credential_user$comment      , expected_user_comment)
+})
 
 test_that("Missing file", {
   expected_message <- "Assertion on 'path_credential' failed: File does not exist: 'misc/missing.credentials'."

tests/testthat/test-retrieve-credential-local.R

@@ -1,5 +1,10 @@
 library(testthat)
 update_expectation  <- FALSE
+credential_admin  <- retrieve_credential_testing(2545L, "admin")
+credential_user   <- retrieve_credential_testing(2545L, "user-dag1")
+url               <- credential_admin$redcap_uri
+
+testthat::expect_equal(url,  credential_user$redcap_uri)
 
 test_that("Smoke Test", {
   testthat::skip_on_cran()
@@ -17,11 +22,10 @@ test_that("default", {
   path_expected_after  <- "test-data/specific-redcapr/write-dag/after.R"
   start_clean_result <- REDCapR:::clean_start_dag_write(batch=FALSE)
   project <- start_clean_result$redcap_project
-  token_for_dag_user <- "C79DB3836373478986928303B52E74DF"
 
   expected_outcome_message <- "\\d+ records and \\d+ columns were read from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."
   expect_message(
-    returned_object <- redcap_read_oneshot(redcap_uri=project$redcap_uri, token=token_for_dag_user),
+    returned_object <- redcap_read_oneshot(url, credential_user$token),
     regexp = expected_outcome_message
   )
 
@@ -42,8 +46,8 @@ test_that("default", {
   # ds_updated$record_id <- sub("^\\d+-(\\d+)$", "\\1",  ds_updated$record_id)
   # ds_updated$redcap_data_access_group <- NULL
 
-  redcap_write_oneshot(ds_updated, project$redcap_uri, token_for_dag_user)
-  returned_object <- redcap_read_oneshot(redcap_uri=project$redcap_uri, token=project$token)
+  redcap_write_oneshot(ds_updated, url, credential_user$token)
+  returned_object <- redcap_read_oneshot(url, credential_admin$token)
 
   if (update_expectation) save_expected(returned_object$data, path_expected_after)
   expected_data_frame <- retrieve_expected(path_expected_after)
@@ -63,34 +67,34 @@ test_that("reassign subject to a different dag", {
 
   # Step 1: Initialize the project
   start_clean_result <- REDCapR:::clean_start_dag_write(batch=FALSE)
-  url                <- start_clean_result$redcap_project$redcap_uri
-  token_for_admin    <- start_clean_result$redcap_project$token
-  token_for_dag_user <- "C79DB3836373478986928303B52E74DF"
+  # url                <- start_clean_result$redcap_project$redcap_uri
+  # token_for_admin    <- start_clean_result$redcap_project$token
+  # token_for_dag_user <- "C79DB3836373478986928303B52E74DF"
 
   # Step 2a: Retrieve the dataset as admin.  The 3 subjects' DAGs are 'daga', 'daga', & 'dagb'
-  ds_admin_1  <- redcap_read_oneshot(url, token_for_admin, export_data_access_groups=T)$data
+  ds_admin_1  <- redcap_read_oneshot(url, credential_admin$token, export_data_access_groups=T)$data
   expect_equal(nrow(ds_admin_1), 3L)
   expect_equal(ds_admin_1$record_id               , c("331-1", "331-2", "332-3"))
   expect_equal(ds_admin_1$redcap_data_access_group, c("daga", "daga", "dagb"   ))
 
   # Step 2b: Retrieve the dataset as user. Only the first two subjects are visible to DAG-A users initially.
-  ds_user_1   <- redcap_read_oneshot(url, token_for_dag_user)$data
+  ds_user_1   <- redcap_read_oneshot(url, credential_user$token)$data
   expect_equal(nrow(ds_user_1), 2L)
   expect_equal(ds_user_1$record_id, c("331-1", "331-2"))
 
   #Step 3: Reassign the 2nd subject and upload to server
   ds_admin_1$redcap_data_access_group[2] <- "dagb"
-  redcap_write_oneshot(ds_admin_1, url, token_for_admin)
+  redcap_write_oneshot(ds_admin_1, url, credential_admin$token)
 
   # Step 4a: Retrieve the dataset as admin.  Should the 2nd row automatically change from '331-2' to '332-2'?
-  ds_admin_2  <- redcap_read_oneshot(url, token_for_admin, export_data_access_groups=T)$data
+  ds_admin_2  <- redcap_read_oneshot(url, credential_admin$token, export_data_access_groups=T)$data
   expect_equal(nrow(ds_admin_2), 3L)
   expect_equal(ds_admin_2$record_id               , c("331-1", "331-2", "332-3"))
   # expect_equal(ds_admin_2$record_id               , c("331-1", "332-2", "332-3"))
   expect_equal(ds_admin_2$redcap_data_access_group, c("daga", "dagb", "dagb"   ))
 
   # Step 4b: Retrieve the dataset as user. Now only one subject is visible to DAG-A users.
-  ds_user_2   <- redcap_read_oneshot(url, token_for_dag_user)$data
+  ds_user_2   <- redcap_read_oneshot(url, credential_user$token)$data
   expect_equal(nrow(ds_user_2), 1L)
   expect_equal(ds_user_2$record_id, c("331-1"))
 })

tests/testthat/test-write-dag.R

@@ -32,9 +32,10 @@ pkgdown::build_site()
 
 devtools::run_examples(); #dev.off() #This overwrites the NAMESPACE file too
 # devtools::run_examples(, "redcap_read.Rd")
+# pkgload::load_all()
 test_results_checked <- devtools::test()
 test_results_checked <- devtools::test(filter = "column")
-test_results_checked <- devtools::test(filter = "validate.*$")
+test_results_checked <- devtools::test(filter = "write-dag")
 withr::local_envvar(ONLYREADTESTS = "true")
 test_results_checked <- devtools::test(filter = "write-batch")