Merge pull request #501 from vubiostat/issue-500-dag

handle DAG within importUsers

Author: spgarbet

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
 

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, ...)
   ))

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))

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]])

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",

tests/testthat/test-101-userMethods-Functionality.R

@@ -16,15 +16,24 @@ 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,
                               data = data.frame(username = EXPENDABLE_USER,
                                                 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",