add redcap_users_export()

closes #163

NAMESPACE

@@ -11,6 +11,7 @@ export(redcap_project)
 export(redcap_read)
 export(redcap_read_oneshot)
 export(redcap_upload_file_oneshot)
+export(redcap_users_export)
 export(redcap_variables)
 export(redcap_version)
 export(redcap_write)

NEWS

@@ -16,6 +16,7 @@ Minor New Features:
 * `read_metadata()` always returns `character` vectors for all variables.  With readr 1.2.0, some column were returned differently than before.  (#193)
 * 'raw_or_label_headers' now supported (Thanks Hatem Hosny - hatemhosny, #183 & #203)
 * 'export_checkbox_labels' now supported (#186)
+* `redcap_users_export()` now included (#163)
 * 'forms' now supported for `redcap_read()`, `redcap_read_oneshot()`, & `redcap_read_oneshot_eav()`(#206).  It was already implemented for `redcap_metadata_read()`.
 * If no records are affected, a zero-length *character* vector is returned (instead of sometimes a zero-length *numeric* vector)  (#212)
 * New function (called `constants()`) easily exposes REDCap-specific constants.  (#217)
@@ -28,7 +29,7 @@ Minor New Features:
 Modified Internals:
 * All interaction with the REDCap server goes through the new `kernal_api()` function, which uses the 'httr' and 'curl' packages underneath.  Until now, each function called those packages directly. (#213)
 * When converting REDCap's CSV to R's data.frame, `readr::read_csv()` is used instead of `utils::read.csv()` (Issue #127).
-* updated to readr 1.2.0 (#200).  This changed how some data variables were assigned a data types
+* updated to readr 1.2.0 (#200).  This changed how some data variables were assigned a data types.
 * uses `odbc` package to retrieve credentials from the token server.  Remove RODBC and RODBCext (#188).  Thanks to @krlmlr for error checking advice in https://stackoverflow.com/a/50419403/1082435.
 * `data.table::rbindlist()` replaced by `dplyr::bind_rows()`
 * the checkmate package inspects most function parameters now (instead of `testit::assert()` and `base:stop()` ) (#190 & #208).

R/redcap-users-export.R

@@ -0,0 +1,139 @@
+#' @name redcap_users_export
+#' @export
+#' @title List authorized users.
+#'
+#' @description List users authorized for a project.
+#'
+#' @param redcap_uri The URI (uniform resource identifier) of the REDCap project.  Required.
+#' @param token The user-specific string that serves as the password for a project.  Required.
+#' @param verbose A boolean value indicating if `message`s should be printed to the R console during the operation.  The verbose output might contain sensitive information (*e.g.* PHI), so turn this off if the output might be visible somewhere public. Optional.
+#' @param config_options  A list of options to pass to `POST` method in the `httr` package.  See the details below.  Optional.
+#'
+#' @note
+#' *From the REDCap 8.4.0 Documentation*:
+#' This method allows you to export the list of users for a project,
+#' including their user privileges and also email address, first name, and last name.
+#' Note: If the user has been assigned to a user role, it will return the user with
+#' the role's defined privileges.
+#'
+#' @return a \code{\link[utils:packageDescription]{utils::packageVersion}}.
+#' @examples
+#' uri      <- "https://bbmc.ouhsc.edu/redcap/api/"
+#' token    <- "06DEFB601F9B46847DAA9DF0CFA951B4"
+#' result <- REDCapR::redcap_users_export(redcap_uri=uri, token=token)
+#' result$data_user
+#' result$data_user_form
+
+redcap_users_export <- function( redcap_uri, token, verbose=TRUE, config_options=NULL ) {
+  # version_error <- base::package_version("0.0.0")
+
+  checkmate::assert_character(redcap_uri                , any.missing=F, len=1, pattern="^.{1,}$")
+  checkmate::assert_character(token                     , any.missing=F, len=1, pattern="^.{1,}$")
+
+  token   <- sanitize_token(token)
+  verbose <- verbose_prepare(verbose)
+
+  post_body <- list(
+    token                   = token,
+    content                 = 'user',
+    format                  = 'csv'
+  )
+
+  col_types <- readr::cols(
+    username                      = readr::col_character(),
+    email                         = readr::col_character(),
+    firstname                     = readr::col_character(),
+    lastname                      = readr::col_character(),
+    expiration                    = readr::col_date(),
+    data_access_group             = readr::col_character(),
+    data_access_group_id          = readr::col_character(),
+    design                        = readr::col_logical(),
+    user_rights                   = readr::col_logical(),
+    data_access_groups            = readr::col_logical(),
+    data_export                   = readr::col_character(),
+    reports                       = readr::col_logical(),
+    stats_and_charts              = readr::col_logical(),
+    manage_survey_participants    = readr::col_logical(),
+    calendar                      = readr::col_logical(),
+    data_import_tool              = readr::col_logical(),
+    data_comparison_tool          = readr::col_logical(),
+    logging                       = readr::col_logical(),
+    file_repository               = readr::col_logical(),
+    data_quality_create           = readr::col_logical(),
+    data_quality_execute          = readr::col_logical(),
+    api_export                    = readr::col_logical(),
+    api_import                    = readr::col_logical(),
+    mobile_app                    = readr::col_logical(),
+    mobile_app_download_data      = readr::col_logical(),
+    record_create                 = readr::col_logical(),
+    record_rename                 = readr::col_logical(),
+    record_delete                 = readr::col_logical(),
+    lock_records_all_forms        = readr::col_logical(),
+    lock_records                  = readr::col_logical(),
+    lock_records_customization    = readr::col_logical(),
+    forms                         = readr::col_character()
+  )
+
+  # This is the important line that communicates with the REDCap server.
+  kernel <- kernel_api(redcap_uri, post_body, config_options)
+
+  if( kernel$success ) {
+    try (
+      {
+        # readr::spec_csv(kernel$raw_text)
+        ds_combined <- readr::read_csv(file=kernel$raw_text, col_types=col_types)
+
+        # Remove the readr's `spec` attribute about the column names & types.
+        attr(ds_combined, "spec") <- NULL
+
+        ds_user <- ds_combined %>%
+          dplyr::select_("-forms")
+
+        ds_user_form <- ds_combined %>%
+          dplyr::select_("username", "forms") %>%
+          tidyr::separate_rows(.data$forms, sep=",") %>%
+          tidyr::separate_(
+            col     = "forms",
+            into    = c("form_name", "permission"),
+            sep     = ":",
+            convert = FALSE
+          ) %>%
+          dplyr::mutate(
+            permission  = as.logical(as.integer(.data$permission))
+          )
+      },
+      silent = TRUE #Don't print the warning in the try block.  Print it below, where it's under the control of the caller.
+    )
+
+    if( exists("ds_user") & inherits(ds_user, "data.frame") ) {
+      outcome_message <- paste0(
+        "The REDCap users were successfully exported in ",
+        round(kernel$elapsed_seconds, 1), " seconds.  The http status code was ",
+        kernel$status_code, "."
+      )
+      kernel$raw_text   <- "" # If an operation is successful, the `raw_text` is no longer returned to save RAM.  The content is not really necessary with httr's status message exposed.
+    } else {
+      kernel$success   <- FALSE #Override the 'success' determination from the http status code.
+      ds_user          <- data.frame() #Return an empty data.frame
+      ds_user_form     <- data.frame() #Return an empty data.frame
+      outcome_message  <- paste0("The REDCap user export failed.  The http status code was ", kernel$status_code, ".  The 'raw_text' returned was '", kernel$raw_text, "'.")
+    }
+  } else {
+    ds_user          <- data.frame() #Return an empty data.frame
+    ds_user_form     <- data.frame() #Return an empty data.frame
+    outcome_message  <- paste0("The REDCap user export failed.  The error message was:\n",  kernel$raw_text)
+  }
+
+  if( verbose )
+    message(outcome_message)
+
+  return( list(
+    data_user          = ds_user,
+    data_user_form     = ds_user_form,
+    success            = kernel$success,
+    status_code        = kernel$status_code,
+    outcome_message    = outcome_message,
+    elapsed_seconds    = kernel$elapsed_seconds,
+    raw_text           = kernel$raw_text
+  ) )
+}

_pkgdown.yml

@@ -48,6 +48,7 @@ reference:
     contents:
       - redcap_next_free_record_name
       - redcap_metadata_read
+      - redcap_users_export
       - redcap_variables
       - redcap_version
 

inst/misc/example.credentials

@@ -15,4 +15,4 @@ redcap_uri,username,project_id,token,comment
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","977","F304DEC3793FECC3B6DEEFF66302CAD3","Clinical Trial (Fake) --Read-only, contributed by @higgi13425"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","0","---","Clinical Trial (Fake) --read & write, contributed by @higgi13425"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","998","124CA60A870CAA85394FE9E00EB8EFE7","nonnumeric record_id"
-"https://bbmc.ouhsc.edu/redcap/api/","myusername","999","06DEFB601F9B46847DAA9DF0CFA951B4","nonnumeric record_id"
+"https://bbmc.ouhsc.edu/redcap/api/","myusername","999","06DEFB601F9B46847DAA9DF0CFA951B4","DAG"

tests/testthat/test-users-export.R

@@ -0,0 +1,114 @@
+library(testthat)
+context("Users Export")
+
+credential_1 <- REDCapR::retrieve_credential_local(
+  path_credential = system.file("misc/example.credentials", package="REDCapR"),
+  project_id      = 999
+)
+
+credential_2 <- REDCapR::retrieve_credential_local(
+  path_credential = system.file("misc/example.credentials", package="REDCapR"),
+  project_id      = 153
+)
+
+test_that("smoke test", {
+  testthat::skip_on_cran()
+  expect_message({
+    returned_object_1 <- redcap_users_export(redcap_uri=credential_1$redcap_uri, token=credential_1$token, verbose=T)
+    returned_object_2 <- redcap_users_export(redcap_uri=credential_2$redcap_uri, token=credential_2$token, verbose=T)
+  })
+})
+
+test_that("with DAGs", {
+  testthat::skip_on_cran()
+  expected_outcome_message <- "The REDCap users were successfully exported in \\d+(\\.\\d+\\W|\\W)seconds\\.  The http status code was 200\\."
+  expected_data_user <- structure(
+    list(username = c("dwells", "unittestphifree", "wbeasleya"
+    ), email = c("[email protected]", "[email protected]",
+    "[email protected]"), firstname = c("Donna", "Unit Test",
+    "Will"), lastname = c("Wells", "PHI Free", "Beasley_A"), expiration = structure(c(20334,
+    NA, NA), class = "Date"), data_access_group = c("dagb", "daga",
+    NA), data_access_group_id = c("332", "331", NA), design = c(FALSE,
+    FALSE, TRUE), user_rights = c(FALSE, FALSE, TRUE), data_access_groups = c(FALSE,
+    FALSE, TRUE), data_export = c("2", "1", "1"), reports = c(FALSE,
+    FALSE, TRUE), stats_and_charts = c(FALSE, FALSE, TRUE), manage_survey_participants = c(TRUE,
+    TRUE, TRUE), calendar = c(FALSE, FALSE, TRUE), data_import_tool = c(FALSE,
+    FALSE, TRUE), data_comparison_tool = c(FALSE, FALSE, TRUE), logging = c(FALSE,
+    FALSE, TRUE), file_repository = c(FALSE, FALSE, TRUE), data_quality_create = c(FALSE,
+    FALSE, TRUE), data_quality_execute = c(FALSE, FALSE, TRUE), api_export = c(FALSE,
+    TRUE, TRUE), api_import = c(FALSE, FALSE, TRUE), mobile_app = c(FALSE,
+    FALSE, TRUE), mobile_app_download_data = c(FALSE, FALSE, TRUE
+    ), record_create = c(FALSE, FALSE, TRUE), record_rename = c(FALSE,
+    FALSE, FALSE), record_delete = c(FALSE, FALSE, FALSE), lock_records_all_forms = c(FALSE,
+    FALSE, FALSE), lock_records = c(FALSE, FALSE, FALSE), lock_records_customization = c(FALSE,
+    FALSE, FALSE)), row.names = c(NA, -3L), class = c("tbl_df", "tbl",
+    "data.frame")
+  )
+  expected_data_user_form <- structure(
+    list(username = c("dwells", "unittestphifree", "wbeasleya"
+    ), form_name = c("demographics", "demographics", "demographics"
+    ), permission = c(TRUE, TRUE, TRUE)), class = c("tbl_df", "tbl",
+    "data.frame"), row.names = c(NA, -3L)
+  )
+
+  expect_message(
+    regexp           = expected_outcome_message,
+    returned_object <- redcap_users_export(redcap_uri=credential_1$redcap_uri, token=credential_1$token, verbose=T)
+  )
+
+  expect_equivalent(returned_object$data_user     , expected=expected_data_user     , label="The returned data.frame should be correct") # dput(returned_object$data_user);
+  expect_equivalent(returned_object$data_user_form, expected=expected_data_user_form, label="The returned data.frame should be correct") # dput(returned_object$data_user_form)
+  expect_equal(returned_object$status_code, expected=200L)
+  expect_equivalent(returned_object$raw_text, expected="") # dput(returned_object$raw_text)
+  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
+  expect_true(returned_object$success)
+  # system.file("misc/example.credentials", package="REDCapR")
+
+  # expect_equal_to_reference(returned_object$data, file=system.file("test-data/project-simple/variations/default.rds", package="REDCapR"))
+  # expect_equal_to_reference(returned_object$data, file="./test-data/project-simple/variations/default.rds")
+})
+test_that("with DAGs", {
+  testthat::skip_on_cran()
+  expected_outcome_message <- "The REDCap users were successfully exported in \\d+(\\.\\d+\\W|\\W)seconds\\.  The http status code was 200\\."
+  expected_data_user <- structure(
+    list(username = c("unittestphifree", "wbeasleya"),
+    email = c("[email protected]", "[email protected]"
+    ), firstname = c("Unit Test", "Will"), lastname = c("PHI Free",
+    "Beasley_A"), expiration = structure(c(NA_real_, NA_real_
+    ), class = "Date"), data_access_group = c(NA_character_,
+    NA_character_), data_access_group_id = c(NA_character_, NA_character_
+    ), design = c(FALSE, TRUE), user_rights = c(FALSE, TRUE),
+    data_access_groups = c(FALSE, TRUE), data_export = c("1",
+    "1"), reports = c(TRUE, TRUE), stats_and_charts = c(TRUE,
+    TRUE), manage_survey_participants = c(TRUE, TRUE), calendar = c(TRUE,
+    TRUE), data_import_tool = c(FALSE, TRUE), data_comparison_tool = c(FALSE,
+    TRUE), logging = c(FALSE, TRUE), file_repository = c(TRUE,
+    TRUE), data_quality_create = c(FALSE, TRUE), data_quality_execute = c(FALSE,
+    TRUE), api_export = c(TRUE, FALSE), api_import = c(FALSE,
+    FALSE), mobile_app = c(FALSE, FALSE), mobile_app_download_data = c(FALSE,
+    FALSE), record_create = c(TRUE, TRUE), record_rename = c(FALSE,
+    FALSE), record_delete = c(FALSE, FALSE), lock_records_all_forms = c(FALSE,
+    FALSE), lock_records = c(FALSE, FALSE), lock_records_customization = c(FALSE,
+    FALSE)), row.names = c(NA, -2L), class = c("tbl_df", "tbl",
+    "data.frame")
+  )
+  expected_data_user_form <- structure(
+    list(username = c("unittestphifree", "unittestphifree",
+    "unittestphifree", "wbeasleya", "wbeasleya", "wbeasleya"), form_name = c("demographics",
+    "health", "race_and_ethnicity", "demographics", "health", "race_and_ethnicity"
+    ), permission = c(TRUE, TRUE, TRUE, TRUE, TRUE, TRUE)), class = c("tbl_df",
+    "tbl", "data.frame"), row.names = c(NA, -6L)
+  )
+
+  expect_message(
+    regexp           = expected_outcome_message,
+    returned_object <- redcap_users_export(redcap_uri=credential_2$redcap_uri, token=credential_2$token, verbose=T)
+  )
+
+  expect_equivalent(returned_object$data_user     , expected=expected_data_user     , label="The returned data.frame should be correct") # dput(returned_object$data_user);
+  expect_equivalent(returned_object$data_user_form, expected=expected_data_user_form, label="The returned data.frame should be correct") # dput(returned_object$data_user_form)
+  expect_equal(returned_object$status_code, expected=200L)
+  expect_equivalent(returned_object$raw_text, expected="") # dput(returned_object$raw_text)
+  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
+  expect_true(returned_object$success)
+})

utility/refresh.R

@@ -14,11 +14,13 @@ devtools::run_examples(); #dev.off() #This overwrites the NAMESPACE file too
 # devtools::run_examples(, "redcap_read.Rd")
 test_results_checked <- devtools::test()
 test_results_checked <- devtools::test(filter = "read-oneshot-eav")
-test_results_checked <- devtools::test(filter = "next-free.*$")
+test_results_checked <- devtools::test(filter = "users.*$")
 # testthat::test_dir("./tests/")
 test_results_not_checked <- testthat::test_dir("./tests/manual/")
 
 # devtools::check(force_suggests = FALSE)
+devtools::check(cran=T)
+# devtools::check_rhub(email="[email protected]")
 # devtools::build_win(version="R-devel") #CRAN submission policies encourage the development version
 # devtools::revdep_check(pkg="REDCapR", recursive=TRUE)
 # devtools::release(check=FALSE) #Careful, the last question ultimately uploads it to CRAN, where you can't delete/reverse your decision.