Merge pull request #551 from OuhscBbmc/dev

add tests for `redcap_file_repo_list()`

R/redcap-file-repo-list.R

@@ -31,6 +31,10 @@
 #'
 #' @return
 #' Currently, a list is returned with the following elements,
+#' * `data`: A [tibble::tibble] with the following columns:
+#'   `folder_id`, `doc_id`, and (file) `name`.
+#'   Each sub-folder will have an associated `folder_id` integer,
+#'   and each file will have an associated `doc_id` integer.
 #' * `success`: A boolean value indicating if the operation was apparently
 #' successful.
 #' * `status_code`: The
@@ -39,24 +43,21 @@
 #' * `outcome_message`: A human readable string indicating the operation's
 #' outcome.
 #' * `records_affected_count`: The number of records inserted or updated.
-#' * `affected_ids`: The subject IDs of the inserted or updated records.
 #' * `elapsed_seconds`: The duration of the function.
 #' * `raw_text`: If an operation is NOT successful, the text returned by
 #' REDCap.  If an operation is successful, the `raw_text` is returned as an
 #' empty string to save RAM.
-#' * `file_name`: The name of the file persisted to disk. This is useful if
-#' the name stored in REDCap is used (which is the default).
 #'
 #' @details
-#' For files in a repeating instrument, don't specify `repeating_instrument`.
-#' The server only needs `field` (name) and `repeating_instance`.
+#' This functions requires API Export privileges and File Repository privileges
+#' in the project.
+#' (Note: Until
+#' [v14.7.3 Standard](https://redcap.vumc.org/community/post.php?id=243161),
+#' API *import* privileges too.)
 #'
-#' The function `redcap_download_file_oneshot()` is soft-deprecated
-#' as of REDCapR 1.2.0.
-#' Please rename to [redcap_file_download_oneshot()].
 #'
 #' @author
-#' Will Beasley, John J. Aponte
+#' Will Beasley
 #'
 #' @references
 #' The official documentation can be found on the 'API Help Page'

inst/misc/example.credentials

@@ -35,3 +35,4 @@ redcap_uri,username,project_id,token,comment
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","3003","1F2EC7059AC339DFDCD5800225DC7A95","blank-for-gray-status"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","3074","5007DC786DBE39CE77ED8DD0C68069A6","checkboxes-1"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","3181","22C3FF1C8B08899FB6F86D91D874A159","vignette-repeating"
+"https://bbmc.ouhsc.edu/redcap/api/","myusername","5002","2DEF128C3F55DA719835FEB506FAC2E9","file-repo"

inst/misc/project-redirection.yml

@@ -32,7 +32,7 @@
     - blank-for-gray-status: 3003
     - checkboxes-1: 3074
     - vignette-repeating: 3181
-    # - file-repo: 63
+    - file-repo: 5002
 -
   instance: dev-2
   credential_file: "misc/dev-2.credentials"

inst/test-data/projects/file-repo/README.md

@@ -0,0 +1,16 @@
+file-repo Test Project
+=========
+
+Steps to Recreate:
+
+1.  Create new project, based on project.xml
+1.  Reconstruct the file repository, manually
+    1.  Create top-level directory called "the-state"
+    1.  Drop [levon-and-barry.jpg](../../levon-and-barry.jpg) into this directory
+    1.  Navigate back to the root directory.
+    1.  Drop the following file files into the root directory:
+        1.  [mugshot-1.jpg](../../mugshot-1.jpg)
+        1.  [mugshot-2.jpg](../../mugshot-2.jpg)
+        1.  [mugshot-3.jpg](../../mugshot-3.jpg)
+        1.  [mugshot-4.jpg](../../mugshot-4.jpg)
+        1.  [mugshot-5.jpg](../../mugshot-5.jpg)

inst/test-data/projects/file-repo/data.csv

@@ -0,0 +1,3 @@
+record_id,redcap_survey_identifier,form_1_timestamp,name,date,signature,form_1_complete
+1,,"2024-10-25 10:16:01",Scissors,2024-10-25,signature_2024-10-25_1015.png,2
+2,,"2024-10-25 10:17:24",Paper,2024-10-25,signature_2024-10-25_1017.png,2

inst/test-data/projects/file-repo/dictionary.csv

@@ -0,0 +1,6 @@
+"Variable / Field Name","Form Name","Section Header","Field Type","Field Label","Choices, Calculations, OR Slider Labels","Field Note","Text Validation Type OR Show Slider Number","Text Validation Min","Text Validation Max",Identifier?,"Branching Logic (Show field only if...)","Required Field?","Custom Alignment","Question Number (surveys only)","Matrix Group Name","Matrix Ranking?","Field Annotation"
+record_id,form_1,,text,"Record ID",,,,,,,,,,,,,
+consent_01,form_1,,descriptive,,,,,,,,,,,,,,
+name,form_1,,text,Name,,,,,,,,,,,,,
+date,form_1,,text,Date,,,date_ymd,,,,,,,,,," @TODAY"
+signature,form_1,,file,Signature,,,signature,,,,,,,,,,

inst/test-data/specific-redcapr/file-repo-list-oneshot/bad-folder-id.R

@@ -0,0 +1 @@
+structure(list(), class = c("tbl_df", "tbl", "data.frame"), row.names = integer(0), names = character(0))

inst/test-data/specific-redcapr/file-repo-list-oneshot/default.R

@@ -0,0 +1,10 @@
+structure(list(folder_id = c(1L, NA, NA, NA, NA, NA), doc_id = c(NA, 
+6652L, 6653L, 6654L, 6655L, 6656L), name = c("the-state", "mugshot-1.jpg", 
+"mugshot-2.jpg", "mugshot-3.jpg", "mugshot-4.jpg", "mugshot-5.jpg"
+)), row.names = c(NA, -6L), spec = structure(list(cols = list(
+    folder_id = structure(list(), class = c("collector_integer", 
+    "collector")), doc_id = structure(list(), class = c("collector_integer", 
+    "collector")), name = structure(list(), class = c("collector_character", 
+    "collector"))), default = structure(list(), class = c("collector_guess", 
+"collector")), delim = ","), class = "col_spec"), class = c("spec_tbl_df", 
+"tbl_df", "tbl", "data.frame"))

inst/test-data/specific-redcapr/file-repo-list-oneshot/first-subdirectory.R

@@ -0,0 +1,7 @@
+structure(list(folder_id = NA_integer_, doc_id = 6651L, name = "levon-and-barry.jpg"), row.names = c(NA, 
+-1L), spec = structure(list(cols = list(folder_id = structure(list(), class = c("collector_integer", 
+"collector")), doc_id = structure(list(), class = c("collector_integer", 
+"collector")), name = structure(list(), class = c("collector_character", 
+"collector"))), default = structure(list(), class = c("collector_guess", 
+"collector")), delim = ","), class = "col_spec"), class = c("spec_tbl_df", 
+"tbl_df", "tbl", "data.frame"))

tests/testthat/test-file-repo-list-oneshot.R

@@ -0,0 +1,164 @@
+library(testthat)
+
+credential <- retrieve_credential_testing("file-repo")
+update_expectation  <- FALSE
+
+test_that("smoke test", {
+  testthat::skip_on_cran()
+  expected_message <- "The file repository structure describing 6 elements was read from REDCap in [0-9.]+ seconds\\.  The http status code was 200\\."
+
+  suppressMessages({
+    expect_message(
+      redcap_file_repo_list_oneshot(
+        redcap_uri  = credential$redcap_uri,
+        token       = credential$token
+      ),
+      expected_message
+    )
+  })
+})
+test_that("default", {
+  testthat::skip_on_cran()
+  expected_message <- "The file repository structure describing 6 elements was read from REDCap in [0-9.]+ seconds\\.  The http status code was 200\\."
+
+  path_expected <- "test-data/specific-redcapr/file-repo-list-oneshot/default.R"
+
+  suppressMessages({
+    expect_message(
+      returned_object <-
+        redcap_file_repo_list_oneshot(
+          redcap_uri  = credential$redcap_uri,
+          token       = credential$token
+        ),
+      expected_message
+    )
+  })
+
+  if (update_expectation) save_expected(returned_object$data, path_expected)
+  expected_data_frame <- retrieve_expected(path_expected)
+
+  #Test the values of the returned object.
+  if (credential$redcap_uri == "https://redcap-dev-2.ouhsc.edu/redcap/api/") {
+    expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object$data)
+  }
+
+  expect_equal(nrow(returned_object$data), expected=6L)
+  expect_equal(returned_object$data$name, expected_data_frame$name)
+  expect_equal(class(returned_object$data$folder_id), "integer")
+  expect_equal(class(returned_object$data$doc_id   ), "integer")
+  expect_equal(
+    !is.na(returned_object$data$folder_id),
+    c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE)
+  )
+  expect_equal(
+    !is.na(returned_object$data$doc_id),
+    c(FALSE, TRUE, TRUE, TRUE, TRUE, TRUE)
+  )
+
+  expect_true(returned_object$success)
+  expect_equal(returned_object$status_code, expected=200L)
+  expect_match(returned_object$outcome_message, regexp=expected_message, perl=TRUE)
+  expect_true(returned_object$elapsed_seconds>0, "The `elapsed_seconds` should be a positive number.")
+  expect_equal(returned_object$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object$raw_text)
+})
+test_that("first-subdirectory", {
+  testthat::skip_on_cran()
+
+  if (credential$redcap_uri != "https://redcap-dev-2.ouhsc.edu/redcap/api/") {
+    testthat::skip("The `folder_id` will be different on different servers.")
+  }
+
+  expected_message <- "The file repository structure describing 1 elements was read from REDCap in [0-9.]+ seconds\\.  The http status code was 200\\."
+
+  path_expected <- "test-data/specific-redcapr/file-repo-list-oneshot/first-subdirectory.R"
+
+  suppressMessages({
+    expect_message(
+      returned_object <-
+        redcap_file_repo_list_oneshot(
+          redcap_uri  = credential$redcap_uri,
+          token       = credential$token,
+          folder_id   = 1
+        ),
+      expected_message
+    )
+  })
+
+  if (update_expectation) save_expected(returned_object$data, path_expected)
+  expected_data_frame <- retrieve_expected(path_expected)
+
+  #Test the values of the returned object.
+  expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object$data)
+
+  expect_equal(nrow(returned_object$data), expected=1L)
+  expect_equal(returned_object$data$name, expected_data_frame$name)
+  expect_equal(class(returned_object$data$folder_id), "integer")
+  expect_equal(class(returned_object$data$doc_id   ), "integer")
+  expect_equal(
+    !is.na(returned_object$data$folder_id),
+    c(FALSE)
+  )
+  expect_equal(
+    !is.na(returned_object$data$doc_id),
+    c(TRUE)
+  )
+
+  expect_true(returned_object$success)
+  expect_equal(returned_object$status_code, expected=200L)
+  expect_match(returned_object$outcome_message, regexp=expected_message, perl=TRUE)
+  expect_true(returned_object$elapsed_seconds>0, "The `elapsed_seconds` should be a positive number.")
+  expect_equal(returned_object$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object$raw_text)
+})
+test_that("bad-folder-id", {
+  testthat::skip_on_cran()
+  expected_message <- "ERROR: The File Repository folder folder_id=99 does not exist or else you do not have permission to that folder because it is DAG-restricted or Role-restricted."
+
+  path_expected <- "test-data/specific-redcapr/file-repo-list-oneshot/bad-folder-id.R"
+
+  suppressMessages({
+    expect_message(
+      returned_object <-
+        redcap_file_repo_list_oneshot(
+          redcap_uri  = credential$redcap_uri,
+          token       = credential$token,
+          folder_id   = 99
+        ),
+      expected_message
+    )
+  })
+
+  if (update_expectation) save_expected(returned_object$data, path_expected)
+  expected_data_frame <- retrieve_expected(path_expected)
+
+  #Test the values of the returned object.
+  if (credential$redcap_uri == "https://redcap-dev-2.ouhsc.edu/redcap/api/") {
+    expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object$data)
+  }
+
+  expect_equal(nrow(returned_object$data), expected=0L)
+
+  expect_false(returned_object$success)
+  expect_equal(returned_object$status_code, expected=400L)
+  expect_match(returned_object$outcome_message, regexp=expected_message, perl=TRUE)
+  expect_true(returned_object$elapsed_seconds>0, "The `elapsed_seconds` should be a positive number.")
+  expect_equal(returned_object$raw_text, expected=expected_message, ignore_attr = TRUE) # dput(returned_object$raw_text)
+})
+test_that("download w/ bad token -Error", {
+  testthat::skip_on_cran()
+
+  returned_object <-
+    redcap_file_repo_list_oneshot(
+      redcap_uri  = credential$redcap_uri,
+      token       = "BAD00000000000000000000000000000",
+      verbose     = FALSE
+    )
+
+  expected_data <- structure(list(), class = c("tbl_df", "tbl", "data.frame"), row.names = integer(0), names = character(0))
+  testthat::expect_equal(returned_object$data, expected_data)
+
+  testthat::expect_false(returned_object$success)
+  testthat::expect_equal(returned_object$status_code, 403L)
+  testthat::expect_equal(returned_object$raw_text, "ERROR: You do not have permissions to use the API")
+})
+
+rm(credential)

tests/testthat/test-instruments.R

@@ -5,6 +5,10 @@ delay_after_download_file <- 1.0 # In seconds
 
 test_that("download instrument", {
   testthat::skip_on_cran()
+  expected_file_name <- "instruments.pdf"
+  if (base::file.exists(expected_file_name)) {
+    base::unlink(expected_file_name) # nocov
+  }
   on.exit(base::unlink(returned_object$file_name))
 
   expected_outcome_message <- "Preparing to download the file `.+`."
@@ -29,7 +33,7 @@ test_that("download instrument", {
   expect_equal(length(returned_object$record_id), 0L)
   expect_true(returned_object$elapsed_seconds>0, "The `elapsed_seconds` should be a positive number.")
   expect_equal(returned_object$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object$raw_text)
-  expect_equal(returned_object$file_name, "instruments.pdf", label="The name of the downloaded file should be correct.")
+  expect_equal(returned_object$file_name, expected_file_name, label="The name of the downloaded file should be correct.")
 })
 
 test_that("download instrument conflict -Error", {