Added tests and new grant based role functions. Still troubleshooting…

…. Added temp.R tests with some of these cases.

NAMESPACE

@@ -109,6 +109,7 @@ export(addFormField)
 export(addRecord)
 export(addSort)
 export(adjustWindow)
+export(adminPermissions)
 export(allColumnStyle)
 export(attachmentFieldSchema)
 export(barcodeFieldSchema)
@@ -152,7 +153,6 @@ export(grant)
 export(idColumnStyle)
 export(importRecords)
 export(importTable)
-export(managementPermissions)
 export(migrateFieldData)
 export(minimalColumnStyle)
 export(monthFieldSchema)

R/databases.R

@@ -567,38 +567,38 @@ permissions <- function(view = TRUE,
                         discover = FALSE) {
   operations <- setdiff(names(formals()), "reviewer_only")
 
-  permissions <- lapply(operations, function(operation) {
+  permissionList <- lapply(operations, function(operation) {
     v <- eval(as.name(operation))
     if (length(v) != 1 || is.na(v) || !(is.logical(v) || is.character(v))) {
       stop(sprintf("Invalid value for operation '%s': %s", operation, deparse(v)))
     }
     v
   })
-  names(permissions) <- operations
-  granted <- sapply(permissions, function(p) p == TRUE || is.character(p))
+  names(permissionList) <- operations
+  granted <- sapply(permissionList, function(p) p == TRUE || is.character(p))
 
-  result <- lapply(operations[granted], operationList)
+  result <- lapply(operations[granted], function(x) {operationList(x, permissionList, reviewerOnly = reviewer_only)})
 
   class(result) <- c("activityInfoPermissions", class(result))
 
   result
 }
 
-operationList = function(operation, reviewer_only = FALSE) {
+operationList = function(operation, permissionList, reviewerOnly = FALSE) {
   p <- list(operation = toupper(operation))
-  v <- permissions[[operation]]
+  v <- permissionList[[operation]]
   message(deparse(v), "\n")
   if (is.character(v)) {
     p$filter <- as.character(v)
   }
-  if (toupper(operation) %in% c("EDIT_RECORD", "ADD_RECORD") && isTRUE(reviewer_only)) {
+  if (toupper(operation) %in% c("EDIT_RECORD", "ADD_RECORD") && isTRUE(reviewerOnly)) {
     p$securityCategories <- list("reviewer")
   }
   p
 }
 
 #'
-#' managementPermissions
+#' adminPermissions
 #'
 #' Helper method to create a list of database permissions for an administrative role.
 #'
@@ -609,7 +609,7 @@ operationList = function(operation, reviewer_only = FALSE) {
 #' @param manage_roles Assign roles to users.
 #' @export
 #'
-managementPermissions <- function(manage_automations = FALSE, manage_users = FALSE, manage_roles = FALSE) {
+adminPermissions <- function(manage_automations = FALSE, manage_users = FALSE, manage_roles = FALSE) {
   if (manage_automations&&manage_users&&manage_roles==FALSE) {
     result = list()
     class(result) <- c("activityInfoManagementPermissions", class(result))
@@ -735,7 +735,7 @@ updateGrant <- function(databaseId, userId, resourceId, permissions) {
 #'     ),
 #'     parameters = list(
 #'       list(
-#'         parameterId = "partner",
+#'         id = "partner",
 #'         label = "Partner",
 #'         range = "ck5dxt1712"
 #'       )
@@ -755,15 +755,21 @@ updateRole <- function(databaseId, role) {
   stopifnot("databaseId must be a string" = is.character(databaseId)&&length(databaseId)==1)
   stopifnot("The role must be defined" = is.list(role))
   if (
-    !("activityInfoRoleFilter" %in% class(role)) || 
+    !("activityInfoRole" %in% class(role)) || 
     (is.null(role$grantBased)||!role$grantBased)
     ) {
     warning("Old style roles are deprecated. Please update your scripts to use the new grant-based roles.", call. = FALSE, noBreaks. = TRUE)
+    path <- paste("databases", databaseId, sep = "/")
+    request <- databaseUpdates()
+    request$roleUpdates = list(role)
+    x <- postResource(path, request, task = "updateRole")
+    invisible()
+  } else {
+    path <- paste("databases", databaseId, sep = "/")
+    request$roleUpdates = list(role)
+    x <- postResource(path, request, task = "updateRole")
+    invisible()    
   }
-  path <- paste("databases", databaseId, sep = "/")
-  request <- list(roleUpdates = list(role))
-  postResource(path, request, task = "updateRole")
-  invisible()
 }
 
 #' Create a role parameter to add to a user role definition
@@ -904,15 +910,15 @@ roleFilter <- function(id, label, filter) {
 #' resources (database, folder, forms).
 #'  
 #' Some administrative permissions are defined at the level of the role rather 
-#' than within grants. See \link{managementPermissions}.
+#' than within grants. See \link{adminPermissions}.
 #'
 #' @param id the id of the role
 #' @param label the label or name of the role, e.g. "Viewer" or "Administrator" 
 #' @param parameters a list of \link{parameter} items defining role parameters
 #' @param grants a list of \link{grant} items for each resources and their 
 #' respective permissions
 #' @param filters a list of \link{roleFilter} items
-#' @param managementPermissions \link{managementPermissions} under this role
+#' @param managementPermissions \link{adminPermissions} under this role
 #'
 #' @export
 #'
@@ -950,24 +956,25 @@ roleFilter <- function(id, label, filter) {
 #'       )
 #'       
 #' }
-role <- function(id, label, parameters = list(), grants, managementPermissions = managementPermissions(), filters = list()) {
+role <- function(id, label, parameters = list(), grants, managementPermissions = adminPermissions(), filters = list()) {
   stopifnot("The id must be a character string" = is.null(id)||(is.character(id)&&length(id)==1&&nchar(id)>0))
   stopifnot("The id must start with a letter, must be made of letters and underscores _ and cannot be longer than 32 characters" = is.null(id)||grepl("^[A-Za-z][A-Za-z0-9_]{0,31}$", id))
 
   stopifnot("The label is required to be a character string" = (is.character(label)&&length(label)==1&&nchar(label)>0))
 
   stopifnot("parameters must be a list" = is.list(parameters))
   stopifnot("grants must be a list of grants, for example, grants = list(grant(...))" = is.list(grants)&&length(grants)>=1)
-  stopifnot("Define management permissions using the managementPermissions() function" = "activityInfoManagementPermissions" %in% class(param))
+
+  stopifnot("Define management permissions using the adminPermissions() function" = "activityInfoManagementPermissions" %in% class(managementPermissions))
 
   for(grant in grants) {
     stopifnot("Define each grant using the grant() function" = "activityInfoGrant" %in% class(grant))
   }
   for(param in parameters) {
-    stopifnot("Define each parameter using the parameter() function" = "activityInfoParameters" %in% class(param))
+    stopifnot("Define each parameter using the parameter() function" = "activityInfoParameter" %in% class(param))
   }
   for(fltr in filters) {
-    stopifnot("Define each parameter using the roleFilter() function" = "activityInfoRoleFilter" %in% class(param))
+    stopifnot("Define each parameter using the roleFilter() function" = "activityInfoRoleFilter" %in% class(fltr))
   }
 
   result <- list(

tests/temp.R

@@ -0,0 +1,133 @@
+roleId = "rp"
+roleLabel = "Reporting partner"
+
+# create a partner reference form
+partnerForm <- formSchema(
+  databaseId = database$databaseId, 
+  label = "Reporting Partners") |>
+  addFormField(
+    textFieldSchema(
+      code = "name",
+      label = "Partner name", 
+      required = TRUE))
+
+addForm(partnerForm)
+
+# create a reference partner table
+partnerTbl <- tibble(id = paste0("partner",1:3), name = paste0("Partner ",1:3))
+
+# import partner records
+importRecords(partnerForm$id, data = partnerTbl, recordIdColumn = "id")
+
+# create a reporting table with a reporting partner field
+reportingForm <- formSchema(
+  databaseId = database$databaseId, 
+  label = "Reports") |>
+  addFormField(
+    referenceFieldSchema(
+      referencedFormId = partnerForm$id, 
+      code = "rp", 
+      label = "Partner", 
+      required = TRUE)) |>
+  addFormField(
+    textFieldSchema(
+      label = "Report", 
+      required = TRUE))
+
+addForm(reportingForm)
+
+# create a reports table
+reportingTbl <- tibble(Partner = rep(paste0("partner",1:3), 2), Report = rep(paste0("This is a report from Partner ",1:3),2))
+
+# import reports
+importRecords(reportingForm$id, data = reportingTbl)
+
+# create a role
+newRole <- 
+  role(id = roleId,
+       label = roleLabel,
+       parameters = list(
+         parameter(id = "partner", label = "Partner", range = partnerForm$id)),
+       grants = list(
+         grant(resourceId = reportingForm$id,
+               permissions = permissions(
+                 view = sprintf("%s == @user.partner", partnerForm$id),
+                 edit_record = sprintf("%s == @user.partner", partnerForm$id),
+                 discover = TRUE,
+                 export_records = TRUE)),
+         grant(resourceId = partnerForm$id,
+               permissions = permissions(
+                 view = TRUE,
+                 discover = FALSE))),
+       filters = list(
+         roleFilter(
+           id = "partner", 
+           label = "Partner is user's partner", 
+           filter = sprintf("%s == @user.partner", partnerForm$id)))
+  )
+
+
+updateRole(databaseId = database$databaseId, role = newRole)
+
+newRoleAbridged <- 
+  role(id = roleId,
+       label = roleLabel,
+       parameters = list(
+         parameter(id = "partner", label = "Partner", range = partnerForm$id)),
+       grants = list(
+         grant(resourceId = reportingForm$id,
+               permissions = permissions(
+                 view = sprintf("%s == @user.partner", partnerForm$id),
+                 edit_record = sprintf("%s == @user.partner", partnerForm$id),
+                 discover = TRUE,
+                 export_records = TRUE)),
+         grant(resourceId = partnerForm$id,
+               permissions = permissions(
+                 view = TRUE,
+                 discover = FALSE))))
+
+updateRole(databaseId = database$databaseId, role = newRoleAbridged)
+
+deprecatedNonGrantRole <- list(
+  id = "rpold",
+  label = "Reporting partner",
+  permissions = permissions(
+    view = sprintf("%s == @user.partner", partnerForm$id),
+    edit_record = sprintf("%s == @user.partner", partnerForm$id),
+    export_records = TRUE
+  ),
+  parameters = list(
+    list(
+      id = "partner",
+      label = "Partner",
+      range = partnerForm$id
+    )
+  ),
+  filters = list(
+    list(
+      id = "partner",
+      label = "partner is user's partner",
+      filter = sprintf("%s == @user.partner", partnerForm$id)
+    )
+  ))
+
+
+updateRole(databaseId = database$databaseId, role = deprecatedNonGrantRole)
+
+deprecatedNonGrantRoleNoFilter <- list(
+  id = "rpold",
+  label = "Reporting partner",
+  permissions = permissions(
+    view = sprintf("%s == @user.partner", partnerForm$id),
+    edit_record = sprintf("%s == @user.partner", partnerForm$id),
+    export_records = TRUE
+  ),
+  parameters = list(
+    list(
+      id = "partner",
+      label = "Partner",
+      range = partnerForm$id
+    )
+  ), grantBased = FALSE)
+
+updateRole(databaseId = database$databaseId, role = deprecatedNonGrantRoleNoFilter)