diff --git a/NEWS.md b/NEWS.md index eceebd7b..49ade1e7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ * `importMetaData` bug fix when given duplicate names to exit and warn user properly. * `redcapUserRoleStructure` allows new `alerts`, `api_modules`, and `data_quality_resolution` attributes. * `exportUsers` properly handles the columns random_setup, random_dashboard and random_perform. +* `importUsers` and `exportUsers` weren't handling data_access_group assignment properly. ## DEPRECATION NOTICES diff --git a/R/importUserDagAssignments.R b/R/importUserDagAssignments.R index ee717c34..dd3e47b9 100644 --- a/R/importUserDagAssignments.R +++ b/R/importUserDagAssignments.R @@ -75,6 +75,7 @@ importUserDagAssignments.redcapApiConnection <- function(rcon, ################################################################### # Make the API Call #### + rcon$flush_dag_assignment() invisible(as.character( makeApiCall(rcon, body, ...) )) diff --git a/R/importUsers.R b/R/importUsers.R index e22322b1..82a2ad41 100644 --- a/R/importUsers.R +++ b/R/importUsers.R @@ -44,12 +44,12 @@ importUsers.redcapApiConnection <- function(rcon, if(length(extra_access) > 0L) { m <- sprintf('Form Access variables [%s] should generally not be set when consolidate = FALSE', paste(extra_access, collapse = ',')) - warning(m) + logWarning(m) } if(length(extra_export) > 0L) { m <- sprintf('Form Export variables [%s] should generally not be set when consolidate = FALSE', paste(extra_export, collapse = ',')) - warning(m) + logWarning(m) } } @@ -65,8 +65,24 @@ importUsers.redcapApiConnection <- function(rcon, data <- prepUserImportData(data, rcon = rcon, consolidate = consolidate) - - + + ################################################################### + # Check prior user DAG if blank #### + DagAsgmt <- rcon$dag_assignment() + UsersWithDags <- DagAsgmt[!is.na(DagAsgmt[,'redcap_data_access_group']), 'username'] + if('data_access_group' %in% names(data)) { + UsersNoDag <- data[is.na(data[,'data_access_group']), 'username'] + } else { + # if no DAG column, everyone is set to blank + UsersNoDag <- data[,'username'] + } + WarnUserDag <- intersect(UsersNoDag, UsersWithDags) + if(length(WarnUserDag) > 0L) { + m <- sprintf('Users with previous data access group (DAG) assignments will no longer be assigned a DAG. They will now be able to view all records: [%s]', + paste(WarnUserDag, collapse = ',')) + logWarning(m) + } + ################################################################### # Check for Users Assigned to User Role #### @@ -100,6 +116,7 @@ importUsers.redcapApiConnection <- function(rcon, ################################################################### # Make the API Call #### rcon$flush_users() + rcon$flush_dag_assignment() response <- makeApiCall(rcon, body, ...) invisible(as.character(response)) diff --git a/R/prepUserImportData.R b/R/prepUserImportData.R index e6b6e6b1..0c2d99d3 100644 --- a/R/prepUserImportData.R +++ b/R/prepUserImportData.R @@ -90,6 +90,12 @@ prepUserImportData <- function(data, "data_export"), add = coll) + if('data_access_group' %in% all_fields) { + checkmate::assert_subset(x = data$data_access_group, + choices = c(rcon$dags()$unique_group_name, NA_character_), + add = coll) + } + checkmate::reportAssertions(coll) # Prior to redcapAPI version 2.11.5, functionality surrounding form validation @@ -114,24 +120,17 @@ prepUserImportData <- function(data, # Remove fields that cannot be updated + # while "data_access_group_id" and "data_access_group_label" are available from exportUsers + # the DAG is set with "data_access_group" fields_to_remove <- c("email", "lastname", "firstname", - "data_access_group_id", "data_access_group") #?, "data_access_groups") + "data_access_group_id", "data_access_group_label") data <- data[!names(data) %in% fields_to_remove] # Convert values to numeric for (nm in names(data)){ data[[nm]] <- - if (nm == 'data_access_group'){ - # as of version 2.11.5, DAG is in "fields_to_remove" - # this chunk will never be run - # in the future we may handle it, so leaving the information below - - # don't convert DAG into numeric - # it qualifies as REDCAP_USER_TABLE_ACCESS_VARIABLES - # possibly convert to numeric but leave NA? - data[[nm]] - } else if (nm %in% REDCAP_USER_TABLE_ACCESS_VARIABLES){ + if (nm %in% REDCAP_USER_TABLE_ACCESS_VARIABLES){ prepUserImportData_castAccessVariable(data[[nm]]) } else if (nm %in% form_access_field){ prepUserImportData_castFormAccess(rcon, data[[nm]]) diff --git a/R/redcapDataStructure.R b/R/redcapDataStructure.R index 69bd4fda..3be89824 100644 --- a/R/redcapDataStructure.R +++ b/R/redcapDataStructure.R @@ -365,7 +365,7 @@ REDCAP_USER_TABLE_ACCESS_VARIABLES <- c("design", "alerts", "user_rights", - "data_access_group", + "data_access_groups", "reports", "stats_and_charts", "manage_survey_participants", diff --git a/tests/testthat/test-101-userMethods-Functionality.R b/tests/testthat/test-101-userMethods-Functionality.R index 1e205450..260c415c 100644 --- a/tests/testthat/test-101-userMethods-Functionality.R +++ b/tests/testthat/test-101-userMethods-Functionality.R @@ -16,6 +16,15 @@ test_that( # Verify the user was added expect_true(EXPENDABLE_USER %in% rcon$users()$username) + # ensure export > import > export equality + # initial import fixes the state + importUsers(rcon, rcon$users()) + Users <- exportUsers(rcon) + importUsers(rcon, Users) + # cache should be correct + expect_equal(rcon$users(), exportUsers(rcon)) + expect_equal(rcon$users(), Users) + # Modify the user permissions n_imported <- importUsers(rcon, @@ -23,8 +32,8 @@ test_that( alerts = 1)) expect_equal(n_imported, "1") - Users <- exportUsers(rcon) - Users <- Users[rcon$users()$username %in% EXPENDABLE_USER, ] + Users <- rcon$users() + Users <- Users[Users$username %in% EXPENDABLE_USER, ] expect_true(Users$alerts %in% "Access") } ) @@ -82,7 +91,7 @@ test_that( data = data.frame(username = EXPENDABLE_USER, data_export = 1, forms = c("record_id:0"), - # leaving an instrument off implicitly sets permission to 0 + # leaving an instrument off implicitly sets permission to 0 forms_export = ""), consolidate = FALSE) @@ -97,20 +106,60 @@ test_that( record_id_form_access = 1, forms = 'record_id:0', forms_export = ''), - consolidate = FALSE)) + consolidate = FALSE)) Users <- exportUsers(rcon) Users <- Users[Users$username %in% EXPENDABLE_USER, ] expect_true(grepl("record_id:0",Users$forms)) - - # NEED TO ADD TWO TESTS - # Update data_access_group to "No Assignment" - # functionality not supported as of version 2.11.5 - # Update data_access_group to a legitimate DAG - # functionality not supported as of version 2.11.5 } ) +test_that( + "Import User DAG Assignments", + { + skip_if(!RUN_USER_TESTS, + "User tests without an expendable user could have negative consequences and are not run.") + + if (EXPENDABLE_USER %in% rcon$users()$username){ + deleteUsers(rcon, + users = EXPENDABLE_USER) + } + + importUsers(rcon, + data = data.frame(username = EXPENDABLE_USER)) + + # create temporary DAG; it probably already exists at this point + TmpDag <- !'test_dag_1' %in% exportDags(rcon)$unique_group_name + if(TmpDag) { + NewDag <- data.frame(data_access_group_name = 'test_dag_1', + unique_group_name = NA_character_) + importDags(rcon, data = NewDag) + } + # Update data_access_group to a legitimate DAG + Users <- exportUsers(rcon) + Users <- Users[Users$username %in% EXPENDABLE_USER, ] + Users[,'data_access_group'] <- 'test_dag_1' + importUsers(rcon, data = Users) + DagAsgmt <- exportUserDagAssignments(rcon) + expect_equal('test_dag_1', + DagAsgmt[DagAsgmt[,'username'] == EXPENDABLE_USER, 'redcap_data_access_group']) + + # Update data_access_group to "No Assignment" + Users[,'data_access_group'] <- NA_character_ + # warning indicates this gives view access to all records + expect_warning(importUsers(rcon, data = Users), 'view all records') + DagAsgmt <- exportUserDagAssignments(rcon) + expect_true(is.na(DagAsgmt[DagAsgmt[,'username'] == EXPENDABLE_USER, 'redcap_data_access_group'])) + + # Try a bad DAG + Users[,'data_access_group'] <- 'uncouth_dag' + expect_error(importUsers(rcon, data = Users)) + + if(TmpDag) { + deleteDags(rcon, 'test_dag_1') + } + } +) test_that( "Export User Options",