From 289cb23194d38b436db3cd891dbbf1631c5cae6f Mon Sep 17 00:00:00 2001 From: Nicolas Dickinson Date: Fri, 12 Jul 2024 15:06:36 +0200 Subject: [PATCH] checkUserRole, getDatabaseRole, renaming permissions to resourcePermissions, renaming adminPermissions to managementPermissions, various fixes, changing handling of resources in the canonization of AI API objects, fixes and additions to database tests and snapshots --- NAMESPACE | 6 +- R/databases.R | 140 ++++- man/addDatabaseUser.Rd | 2 +- man/getDatabaseRole.Rd | 22 + ...ermissions.Rd => managementPermissions.Rd} | 8 +- ...{permissions.Rd => resourcePermissions.Rd} | 8 +- man/role.Rd | 14 +- man/roleFilter.Rd | 8 +- man/updateRole.Rd | 9 +- tests/temp.R | 60 +- .../databases-getDatabases.RDS | Bin 0 -> 219 bytes tests/testthat/_snaps.old/databases.md | 354 +++++++++++ tests/testthat/_snaps.old/formField.md | 85 +++ tests/testthat/_snaps.old/forms.md | 12 + tests/testthat/_snaps.old/records.md | 554 ++++++++++++++++++ .../_snaps.old/rmdOutput/TestMessages.html | 452 ++++++++++++++ tests/testthat/_snaps/databases.md | 93 ++- tests/testthat/setup.R | 16 +- tests/testthat/test-databases.R | 294 +++++++--- 19 files changed, 1913 insertions(+), 224 deletions(-) create mode 100644 man/getDatabaseRole.Rd rename man/{adminPermissions.Rd => managementPermissions.Rd} (81%) rename man/{permissions.Rd => resourcePermissions.Rd} (95%) create mode 100644 tests/testthat/_activityInfoSnaps/databases-getDatabases.RDS create mode 100644 tests/testthat/_snaps.old/databases.md create mode 100644 tests/testthat/_snaps.old/formField.md create mode 100644 tests/testthat/_snaps.old/forms.md create mode 100644 tests/testthat/_snaps.old/records.md create mode 100644 tests/testthat/_snaps.old/rmdOutput/TestMessages.html diff --git a/NAMESPACE b/NAMESPACE index 2f5d423..7110a36 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,8 @@ S3method(do,tbl_activityInfoRemoteRecords) S3method(do_,tbl_activityInfoRemoteRecords) S3method(filter,tbl_activityInfoRemoteRecords) S3method(filter_,tbl_activityInfoRemoteRecords) +S3method(getDatabaseRole,character) +S3method(getDatabaseRole,databaseTree) S3method(getRecords,activityInfoFormSchema) S3method(getRecords,activityInfoFormTree) S3method(getRecords,activityInfo_tbl_df) @@ -109,7 +111,6 @@ export(addFormField) export(addRecord) export(addSort) export(adjustWindow) -export(adminPermissions) export(allColumnStyle) export(attachmentFieldSchema) export(barcodeFieldSchema) @@ -138,6 +139,7 @@ export(getBillingAccountDomains) export(getBillingAccountUsers) export(getDatabaseBillingAccount) export(getDatabaseResources) +export(getDatabaseRole) export(getDatabaseSchema) export(getDatabaseTree) export(getDatabaseUser) @@ -153,6 +155,7 @@ export(grant) export(idColumnStyle) export(importRecords) export(importTable) +export(managementPermissions) export(migrateFieldData) export(minimalColumnStyle) export(monthFieldSchema) @@ -170,6 +173,7 @@ export(recoverRecord) export(reference) export(referenceFieldSchema) export(relocateForm) +export(resourcePermissions) export(role) export(roleAssignment) export(roleFilter) diff --git a/R/databases.R b/R/databases.R index a296dd9..f2e40a9 100644 --- a/R/databases.R +++ b/R/databases.R @@ -281,6 +281,41 @@ getDatabaseUser2 <- function(databaseId, userId) { getResource(url, task = sprintf("Request for database/user %s/%s", databaseId, userId)) } +checkUserRole <- function(databaseId, newUser, roleId, roleParameters, roleResources) { + userRoleResources <- c(newUser$role$resources, databaseId) + userRoleParameters <- newUser$role$parameters + + if (roleId != newUser$role$id) { + warning(sprintf( + "User roleId '%s' does not match provided '%s'. The role may not have been assigned correctly.", + newUser$role$id, + roleId + )) + } + # remove databaseId during legacy role removal + missingResources <- userRoleResources[!(roleResources %in% userRoleResources)] + if (length(missingResources)>0) { + warning(sprintf( + "User role resource ids (%s) do not included the following provided resource ids (%s)", + paste(userRoleResources, collapse=", "), + paste(missingResources, collapse=", ") + )) + } + for (param in names(roleParameters)) { + if (!(param %in% names(userRoleParameters))) { + warning(sprintf("Provided parameter '%s' not found applied to user.", param)) + } else if (!grepl(roleParameters[[param]],userRoleParameters[[param]])) { + warning(sprintf("Provided '%s' parameter value '%s' for user does not match parameter value returned by server: '%s'", + param, + roleParameters[[param]], + userRoleParameters[[param]] + )) + } + } +} + + + #' addDatabaseUser #' #' Invites a user to a database. @@ -337,7 +372,7 @@ getDatabaseUser2 <- function(databaseId, userId) { #' @export addDatabaseUser <- function(databaseId, email, name, locale = NA_character_, roleId, roleParameters = list(), - roleResources = list(databaseId)) { + roleResources = c(databaseId)) { url <- paste(activityInfoRootUrl(), "resources", "databases", databaseId, "users", sep = "/") @@ -352,15 +387,19 @@ addDatabaseUser <- function(databaseId, email, name, locale = NA_character_, rol ), grants = list() ) + # fix conversion to empty json array by changing it to an empty json object jsonPayload <- stringr::str_replace(string = jsonlite::toJSON(request, auto_unbox = TRUE), pattern = '"parameters":\\[\\]', replacement = '"parameters":{}') response <- POST(url, body = jsonPayload, encode = "raw", activityInfoAuthentication(), accept_json(), httr::content_type_json()) if (response$status_code == 200) { + newUser <- fromActivityInfoJson(response) + checkUserRole(databaseId, newUser, roleId, roleParameters, roleResources) + return(list( added = TRUE, - user = fromActivityInfoJson(response) + user = newUser )) } else if (response$status_code == 400) { return(list( @@ -376,6 +415,41 @@ addDatabaseUser <- function(databaseId, email, name, locale = NA_character_, rol } } +#' getDatabaseRole +#' +#' Helper method to fetch a role based on its id using the database tree or database id. +#' +#' @param database database tree using \link{getDatabaseTree} or the databaseId +#' @param roleId the id of the role. +#' +#' \dontrun{ +#' # Get the reporting partner role +#' dbTree <- getDatabaseTree(databaseId = "ck3pqrp9a1z") # fetch the database tree +#' role <- getDatabaseRole(dbTree, roleId = "rp") # extract the reporting partner role +#' } +#' +#' @export +#' +getDatabaseRole <- function(database, roleId) { + UseMethod("getDatabaseRole") +} + +#' @export +getDatabaseRole.character <- function(database, roleId) { + tree <- getDatabaseTree(databaseId = database) + getDatabaseRole(tree, roleId) +} + +#' @export +getDatabaseRole.databaseTree <- function(database, roleId) { + for (role in database$roles) { + if (role$id == roleId) { + return(role) + } + } + return(NULL) +} + roleParameterList <- function(list) { if(length(list) == 0) { return(structure(list(), names = character(0))) @@ -458,6 +532,10 @@ deleteDatabaseUser <- function(databaseId, userId) { #' @importFrom httr POST #' @export updateUserRole <- function(databaseId, userId, assignment) { + stopifnot("userId must be provided to updateUserRole()" = is.character(userId)&&length(userId)==1) + stopifnot("databaseId must be provided to updateUserRole()" = is.character(databaseId)&&length(databaseId)==1) + stopifnot("assignment must be created with roleAssignment()" = ("activityInfoRoleAssignment" %in% class(assignment))) + url <- paste(activityInfoRootUrl(), "resources", "databases", databaseId, "users", userId, "role", sep = "/") request <- list(assignments = list(assignment)) @@ -468,7 +546,11 @@ updateUserRole <- function(databaseId, userId, assignment) { url, response$status_code, http_status(response$status_code)$message, content(response, as = "text", encoding = "UTF-8") )) + } else { + updatedUser <- fromActivityInfoJson(response) + checkUserRole(databaseId, updatedUser, assignment$id, assignment$parameters, assignment$resources) } + invisible(NULL) } @@ -502,19 +584,22 @@ updateUserRole <- function(databaseId, userId, assignment) { roleAssignment <- function(roleId, roleParameters = list(), roleResources) { stopifnot(is.list(roleParameters)) if (any(is.na(names(roleParameters)))) { - stop("roleParameters must be named.") + stop("roleParameters must be named with each parameter name.") } if (length(roleParameters) == 0) { roleParameters <- NULL } - list(id = roleId, parameters = roleParameters, resources = as.list(roleResources)) + assignment <- list(id = roleId, parameters = roleParameters, resources = as.list(roleResources)) + class(assignment) <- c("activityInfoRoleAssignment", class(assignment)) + + assignment } #' -#' permissions +#' resourcePermissions #' #' Helper method to create a list of permissions for a role or grant. #' @@ -545,7 +630,7 @@ roleAssignment <- function(roleId, roleParameters = list(), roleResources) { #' @param discover Discover and display forms #' @export #' -permissions <- function(view = TRUE, +resourcePermissions <- function(view = TRUE, add_record = FALSE, edit_record = FALSE, delete_record = FALSE, @@ -584,9 +669,14 @@ permissions <- function(view = TRUE, result } +#' @export +permissions <- resourcePermissions + operationList = function(operation, permissionList, reviewerOnly = FALSE) { p <- list(operation = toupper(operation)) v <- permissionList[[operation]] + p$filter <- NULL + p$securityCategories <- list() if (is.character(v)) { p$filter <- as.character(v) } @@ -597,7 +687,7 @@ operationList = function(operation, permissionList, reviewerOnly = FALSE) { } #' -#' adminPermissions +#' managementPermissions #' #' Helper method to create a list of database permissions for an administrative role. #' @@ -608,7 +698,7 @@ operationList = function(operation, permissionList, reviewerOnly = FALSE) { #' @param manage_roles Assign roles to users. #' @export #' -adminPermissions <- function(manage_automations = FALSE, manage_users = FALSE, manage_roles = FALSE) { +managementPermissions <- 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)) @@ -714,12 +804,7 @@ updateGrant <- function(databaseId, userId, resourceId, permissions) { #' view = TRUE, #' discover = TRUE, #' add_record = TRUE), -#' optional = TRUE)), -#' filters = list( -#' roleFilter( -#' id = "partner", -#' label = "Partner is user's partner", -#' filter = "ck5dxt1712 == @user.partner")) +#' optional = TRUE)) #' ) #' updateRole("cxy123", currentGrantBasedRole) #' } else { @@ -740,7 +825,7 @@ updateGrant <- function(databaseId, userId, resourceId, permissions) { #' ) #' ), #' filters = list( -#' list( +#' roleFilter( #' id = "partner", #' label = "partner is user's partner", #' filter = "ck5dxt1712 == @user.partner" @@ -869,10 +954,10 @@ grant <- function(resourceId, permissions = permissions(), optional = FALSE) { #' Create a pre-defined role filter #' #' Pre-defined filters. Role filters allow other users to choose filters for -#' permissions without having to write formulas themselves. +#' permissions without having to write formulas themselves. This is a feature of +#' legacy roles. #' -#' See \link{role} for the creation of roles. See \link{permissions} for the -#' creation of permissions. +#' See \link{permissions} for the creation of permissions. #' #' @param id the id of the pre-defined filter #' @param label A human-readable label @@ -883,7 +968,7 @@ grant <- function(resourceId, permissions = permissions(), optional = FALSE) { #' @examples #' \dontrun{ #' -#' newRoleLevelFilter <- +#' legacyRoleFilter <- #' roleFilter( #' id = "partner", #' label = "Partner is user's partner", @@ -946,16 +1031,11 @@ roleFilter <- function(id, label, filter) { #' view = TRUE, #' discover = TRUE, #' add_record = TRUE), -#' optional = TRUE)), -#' filters = list( -#' roleFilter( -#' id = "partner", -#' label = "Partner is user's partner", -#' filter = "ck5dxt1712 == @user.partner")) +#' optional = TRUE)) #' ) #' #' } -role <- function(id, label, parameters = list(), grants, managementPermissions = adminPermissions(), filters = list()) { +role <- function(id, label, parameters = list(), grants, permissions = managementPermissions()) { 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)) @@ -964,7 +1044,7 @@ role <- function(id, label, parameters = list(), grants, managementPermissions = 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 adminPermissions() function" = "activityInfoManagementPermissions" %in% class(managementPermissions)) + stopifnot("Define management permissions using the managementPermissions() function" = "activityInfoManagementPermissions" %in% class(permissions)) for(grant in grants) { stopifnot("Define each grant using the grant() function" = "activityInfoGrant" %in% class(grant)) @@ -972,17 +1052,13 @@ role <- function(id, label, parameters = list(), grants, managementPermissions = for(param in parameters) { 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(fltr)) - } result <- list( id = id, label = label, parameters = parameters, - permissions = managementPermissions, + permissions = permissions, grants = grants, - filters = filters, grantBased = TRUE ) diff --git a/man/addDatabaseUser.Rd b/man/addDatabaseUser.Rd index 9028435..e0af8c7 100644 --- a/man/addDatabaseUser.Rd +++ b/man/addDatabaseUser.Rd @@ -11,7 +11,7 @@ addDatabaseUser( locale = NA_character_, roleId, roleParameters = list(), - roleResources = list(databaseId) + roleResources = c(databaseId) ) } \arguments{ diff --git a/man/getDatabaseRole.Rd b/man/getDatabaseRole.Rd new file mode 100644 index 0000000..69998f8 --- /dev/null +++ b/man/getDatabaseRole.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/databases.R +\name{getDatabaseRole} +\alias{getDatabaseRole} +\title{getDatabaseRole} +\usage{ +getDatabaseRole(database, roleId) +} +\arguments{ +\item{database}{database tree using \link{getDatabaseTree} or the databaseId} + +\item{roleId}{the id of the role. + +\dontrun{ +# Get the reporting partner role +dbTree <- getDatabaseTree(databaseId = "ck3pqrp9a1z") # fetch the database tree +role <- getDatabaseRole(dbTree, roleId = "rp") # extract the reporting partner role +}} +} +\description{ +Helper method to fetch a role based on its id using the database tree or database id. +} diff --git a/man/adminPermissions.Rd b/man/managementPermissions.Rd similarity index 81% rename from man/adminPermissions.Rd rename to man/managementPermissions.Rd index ced6013..38e2592 100644 --- a/man/adminPermissions.Rd +++ b/man/managementPermissions.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/databases.R -\name{adminPermissions} -\alias{adminPermissions} -\title{adminPermissions} +\name{managementPermissions} +\alias{managementPermissions} +\title{managementPermissions} \usage{ -adminPermissions( +managementPermissions( manage_automations = FALSE, manage_users = FALSE, manage_roles = FALSE diff --git a/man/permissions.Rd b/man/resourcePermissions.Rd similarity index 95% rename from man/permissions.Rd rename to man/resourcePermissions.Rd index 15eb3df..cf26a1e 100644 --- a/man/permissions.Rd +++ b/man/resourcePermissions.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/databases.R -\name{permissions} -\alias{permissions} -\title{permissions} +\name{resourcePermissions} +\alias{resourcePermissions} +\title{resourcePermissions} \usage{ -permissions( +resourcePermissions( view = TRUE, add_record = FALSE, edit_record = FALSE, diff --git a/man/role.Rd b/man/role.Rd index add9f9f..0116c5d 100644 --- a/man/role.Rd +++ b/man/role.Rd @@ -9,8 +9,7 @@ role( label, parameters = list(), grants, - managementPermissions = adminPermissions(), - filters = list() + permissions = managementPermissions() ) } \arguments{ @@ -23,9 +22,9 @@ role( \item{grants}{a list of \link{grant} items for each resources and their respective permissions} -\item{managementPermissions}{\link{adminPermissions} under this role} - \item{filters}{a list of \link{roleFilter} items} + +\item{managementPermissions}{\link{adminPermissions} under this role} } \description{ Returns a role that can be added to a database and assigned to users. @@ -62,12 +61,7 @@ grantBasedRole <- view = TRUE, discover = TRUE, add_record = TRUE), - optional = TRUE)), - filters = list( - roleFilter( - id = "partner", - label = "Partner is user's partner", - filter = "ck5dxt1712 == @user.partner")) + optional = TRUE)) ) } diff --git a/man/roleFilter.Rd b/man/roleFilter.Rd index a066009..497597d 100644 --- a/man/roleFilter.Rd +++ b/man/roleFilter.Rd @@ -15,16 +15,16 @@ roleFilter(id, label, filter) } \description{ Pre-defined filters. Role filters allow other users to choose filters for -permissions without having to write formulas themselves. +permissions without having to write formulas themselves. This is a feature of +legacy roles. } \details{ -See \link{role} for the creation of roles. See \link{permissions} for the -creation of permissions. +See \link{permissions} for the creation of permissions. } \examples{ \dontrun{ -newRoleLevelFilter <- +legacyRoleFilter <- roleFilter( id = "partner", label = "Partner is user's partner", diff --git a/man/updateRole.Rd b/man/updateRole.Rd index 02df62e..ae8029e 100644 --- a/man/updateRole.Rd +++ b/man/updateRole.Rd @@ -45,12 +45,7 @@ if (grantBased) { view = TRUE, discover = TRUE, add_record = TRUE), - optional = TRUE)), - filters = list( - roleFilter( - id = "partner", - label = "Partner is user's partner", - filter = "ck5dxt1712 == @user.partner")) + optional = TRUE)) ) updateRole("cxy123", currentGrantBasedRole) } else { @@ -71,7 +66,7 @@ if (grantBased) { ) ), filters = list( - list( + roleFilter( id = "partner", label = "partner is user's partner", filter = "ck5dxt1712 == @user.partner" diff --git a/tests/temp.R b/tests/temp.R index 19dae5f..0af90c8 100644 --- a/tests/temp.R +++ b/tests/temp.R @@ -69,65 +69,33 @@ newRole <- 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), + view = sprintf("%s == @user.partner2", partnerForm$id), + edit_record = sprintf("%s == @user.partner2", partnerForm$id), + add_record = sprintf("%s == @user.partner2", partnerForm$id), + delete_record = sprintf("%s == @user.partner2", partnerForm$id), export_records = TRUE ), parameters = list( - list( - id = "partner", + parameter( + id = "partner2", label = "Partner", range = partnerForm$id ) ), filters = list( - list( - id = "partner", - label = "partner is user's partner", - filter = sprintf("%s == @user.partner", partnerForm$id) + roleFilter( + id = "partner2", + label = "partner is user's partner2", + filter = sprintf("%s == @user.partner2", 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) + grantBased = FALSE + ) + -updateRole(databaseId = database$databaseId, role = deprecatedNonGrantRoleNoFilter) \ No newline at end of file +updateRole(databaseId = database$databaseId, role = deprecatedNonGrantRole) \ No newline at end of file diff --git a/tests/testthat/_activityInfoSnaps/databases-getDatabases.RDS b/tests/testthat/_activityInfoSnaps/databases-getDatabases.RDS new file mode 100644 index 0000000000000000000000000000000000000000..1f5ba739af85dcde64ec20f055b5c42767f41aa4 GIT binary patch literal 219 zcmV<103`n(iwFP!000002F*~x3W7io9a9nQqV)s*K=%$2bO}0iGw8ayQ!T8kxNFhR zS5v7-hX^8Q*$44e> zoPVsq3y;?4cqb}tV$KXpnZ~zP!9#hT9(D%37p`JC>c+-vhG8nC6l%Z7vZ7XI#asLK z+io)CsIy9xMii=blq^Nr5U)5Xth)86tWzoU0eOOXDVf1W@O7^+YN;Yr1hBs006JCU~K>Z literal 0 HcmV?d00001 diff --git a/tests/testthat/_snaps.old/databases.md b/tests/testthat/_snaps.old/databases.md new file mode 100644 index 0000000..b97b272 --- /dev/null +++ b/tests/testthat/_snaps.old/databases.md @@ -0,0 +1,354 @@ +# getDatabases() works + + Code + databases + Output + # A tibble: 2 x 6 + billingAccountId databaseId description label ownerId suspended + * + 1 My first database My second database + 1 c10000004 Person form c10000002 FORM PRIVATE + 2 c10000005 Children c10000004 SUB_FORM PRIVATE + +# addDatabaseUser() and deleteDatabaseUser() and getDatabaseUsers() and getDatabaseUser() and getDatabaseUser2() work and expected fields are present + + list(list(activationStatus = "PENDING", databaseId = "", + deliveryStatus = "UNKNOWN", email = "", inviteTime = "", + lastLoginTime = "", name = "Test database user", + userId = ""), list(activationStatus = "PENDING", + databaseId = "", deliveryStatus = "UNKNOWN", email = "", + inviteTime = "", lastLoginTime = "", + name = "Test database user", userId = "")) + +--- + + list(list(activationStatus = "PENDING", databaseId = "", + deliveryStatus = "UNKNOWN", email = "", inviteAccepted = FALSE, + inviteDate = "", lastLoginDate = "", + name = "Test database user", userId = "", userLicenseType = "BASIC"), + list(activationStatus = "PENDING", databaseId = "", + deliveryStatus = "UNKNOWN", email = "", inviteAccepted = FALSE, + inviteDate = "", lastLoginDate = "", + name = "Test database user", userId = "", userLicenseType = "BASIC")) + +# permissions() helper works + + Code + defaultPermissions + Output + [[1]] + [[1]]$operation + [1] "VIEW" + + [[1]]$securityCategories + list() + + + attr(,"class") + [1] "activityInfoPermissions" "list" + +--- + + Code + reviewerPermissions + Output + [[1]] + [[1]]$operation + [1] "VIEW" + + [[1]]$securityCategories + list() + + + [[2]] + [[2]]$operation + [1] "ADD_RECORD" + + [[2]]$securityCategories + [[2]]$securityCategories[[1]] + [1] "reviewer" + + + + [[3]] + [[3]]$operation + [1] "DISCOVER" + + [[3]]$securityCategories + list() + + + attr(,"class") + [1] "activityInfoPermissions" "list" + +# parameter() works + + Code + param + Output + $parameterId + [1] "partner" + + $label + [1] "Reporting partner" + + $range + [1] "ck5dxt1712" + + attr(,"class") + [1] "activityInfoParameter" "list" + +# managementPermissions() works + + Code + defaultManagementPermissions + Output + list() + attr(,"class") + [1] "activityInfoManagementPermissions" "list" + +--- + + Code + enhancedManagementPermissions + Output + [[1]] + [[1]]$operation + [1] "MANAGE_AUTOMATIONS" + + [[1]]$securityCategories + list() + + + [[2]] + [[2]]$operation + [1] "MANAGE_USERS" + + [[2]]$securityCategories + list() + + + [[3]] + [[3]]$operation + [1] "MANAGE_ROLES" + + [[3]]$securityCategories + list() + + + attr(,"class") + [1] "activityInfoManagementPermissions" "list" + +# grant() works + + Code + optionalGrant + Output + $resourceId + [1] "ck5dxt1552" + + $operations + [[1]] + [[1]]$operation + [1] "VIEW" + + [[1]]$securityCategories + list() + + + [[2]] + [[2]]$operation + [1] "ADD_RECORD" + + [[2]]$securityCategories + list() + + + [[3]] + [[3]]$operation + [1] "EDIT_RECORD" + + [[3]]$securityCategories + list() + + + attr(,"class") + [1] "activityInfoPermissions" "list" + + $optional + [1] TRUE + + attr(,"class") + [1] "activityInfoGrant" "list" + +# roleFilter() works + + Code + roleLevelFilter + Output + $id + [1] "partner" + + $label + [1] "Partner is user's partner" + + $filter + [1] "ck5dxt1712 == @user.partner" + + attr(,"class") + [1] "activityInfoRoleFilter" "list" + +# role() works + + Code + grantBasedRole + Output + $id + [1] "rp" + + $label + [1] "Reporting Partner" + + $parameters + $parameters[[1]] + $parameterId + [1] "partner" + + $label + [1] "Partner" + + $range + [1] "ck5dxt1712" + + attr(,"class") + [1] "activityInfoParameter" "list" + + + $permissions + list() + attr(,"class") + [1] "activityInfoManagementPermissions" "list" + + $grants + $grants[[1]] + $resourceId + [1] "cq9xyz1552" + + $operations + [[1]] + [[1]]$operation + [1] "VIEW" + + [[1]]$securityCategories + list() + + [[1]]$filter + [1] "ck5dxt1712 == @user.partner" + + + [[2]] + [[2]]$operation + [1] "EDIT_RECORD" + + [[2]]$securityCategories + list() + + [[2]]$filter + [1] "ck5dxt1712 == @user.partner" + + + [[3]] + [[3]]$operation + [1] "EXPORT_RECORDS" + + [[3]]$securityCategories + list() + + + [[4]] + [[4]]$operation + [1] "DISCOVER" + + [[4]]$securityCategories + list() + + + attr(,"class") + [1] "activityInfoPermissions" "list" + + $optional + [1] FALSE + + attr(,"class") + [1] "activityInfoGrant" "list" + + $grants[[2]] + $resourceId + [1] "cz55555555" + + $operations + [[1]] + [[1]]$operation + [1] "VIEW" + + [[1]]$securityCategories + list() + + + [[2]] + [[2]]$operation + [1] "ADD_RECORD" + + [[2]]$securityCategories + list() + + + [[3]] + [[3]]$operation + [1] "DISCOVER" + + [[3]]$securityCategories + list() + + + attr(,"class") + [1] "activityInfoPermissions" "list" + + $optional + [1] TRUE + + attr(,"class") + [1] "activityInfoGrant" "list" + + + $filters + $filters[[1]] + $id + [1] "partner" + + $label + [1] "Partner is user's partner" + + $filter + [1] "ck5dxt1712 == @user.partner" + + attr(,"class") + [1] "activityInfoRoleFilter" "list" + + + $grantBased + [1] TRUE + + attr(,"class") + [1] "activityInfoRole" "list" + diff --git a/tests/testthat/_snaps.old/formField.md b/tests/testthat/_snaps.old/formField.md new file mode 100644 index 0000000..78258be --- /dev/null +++ b/tests/testthat/_snaps.old/formField.md @@ -0,0 +1,85 @@ +# Test deleteFormField() + + structure(list(databaseId = "", elements = list(structure(list( + code = "txt2", description = NULL, id = "", key = FALSE, + label = "Text field 2", relevanceCondition = "", required = FALSE, + tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( + barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + "activityInfoFormFieldSchema", "formField", "list")), structure(list( + code = "txt4", description = NULL, id = "", key = FALSE, + label = "Text field 4", relevanceCondition = "", required = FALSE, + tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( + barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + "activityInfoFormFieldSchema", "formField", "list")), structure(list( + code = "txt5", description = NULL, id = "", key = FALSE, + label = "Text field 5", relevanceCondition = "", required = FALSE, + tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( + barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + "activityInfoFormFieldSchema", "formField", "list"))), id = "", + label = "R form with multiple fields to delete"), class = c("activityInfoFormSchema", + "formSchema", "list")) + +--- + + structure(list(databaseId = "", elements = list(structure(list( + code = "txt1", description = NULL, id = "", key = FALSE, + label = "Text field 1", relevanceCondition = "", required = FALSE, + tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( + barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + "activityInfoFormFieldSchema", "formField", "list")), structure(list( + code = "txt2", description = NULL, id = "", key = FALSE, + label = "Text field 2", relevanceCondition = "", required = FALSE, + tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( + barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + "activityInfoFormFieldSchema", "formField", "list")), structure(list( + code = "txt3", description = NULL, id = "", key = FALSE, + label = "Text field 3", relevanceCondition = "", required = FALSE, + tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( + barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + "activityInfoFormFieldSchema", "formField", "list")), structure(list( + code = "txt5", description = NULL, id = "", key = FALSE, + label = "Text field 5", relevanceCondition = "", required = FALSE, + tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( + barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + "activityInfoFormFieldSchema", "formField", "list"))), id = "", + label = "R form with multiple fields to delete"), class = c("activityInfoFormSchema", + "formSchema", "list")) + +--- + + structure(list(databaseId = "", elements = list(structure(list( + code = "txt2", description = NULL, id = "", key = FALSE, + label = "Text field 2", relevanceCondition = "", required = FALSE, + tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( + barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + "activityInfoFormFieldSchema", "formField", "list")), structure(list( + code = "txt3", description = NULL, id = "", key = FALSE, + label = "Text field 3", relevanceCondition = "", required = FALSE, + tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( + barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + "activityInfoFormFieldSchema", "formField", "list")), structure(list( + code = "txt4", description = NULL, id = "", key = FALSE, + label = "Text field 4", relevanceCondition = "", required = FALSE, + tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( + barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + "activityInfoFormFieldSchema", "formField", "list"))), id = "", + label = "R form with multiple fields to delete"), class = c("activityInfoFormSchema", + "formSchema", "list")) + +# migrateFieldData() works + + Code + recordsMinimal + Output + a b c newA newB newC + 1 1 1 1 2023-03-01 1 a + 2 2 2 2 2023-03-02 2 b + 3 3 3 3 2023-03-03 3 c + 4 4 4 4 2023-03-04 4 d + 5 5 5 5 2023-03-05 5 e + 6 6 6 6 2023-03-06 6 f + 7 7 7 7 2023-03-07 7 g + 8 8 8 8 2023-03-08 8 h + 9 9 9 9 2023-03-09 9 i + 10 10 10 10 2023-03-10 10 j + diff --git a/tests/testthat/_snaps.old/forms.md b/tests/testthat/_snaps.old/forms.md new file mode 100644 index 0000000..db014e3 --- /dev/null +++ b/tests/testthat/_snaps.old/forms.md @@ -0,0 +1,12 @@ +# Creating a form schema with formSchemaFromData() from data works with factor columns using importRecords() + + Code + larlar2 + Output + a b a_logical_column date_col + 1 1 1_stuff 0 2021-07-06 + 2 2 2_stuff 0 2021-07-07 + 3 3 3_stuff 0 2021-07-08 + 4 4 4_stuff 1 2021-07-09 + 5 5 5_stuff 0 2021-07-10 + diff --git a/tests/testthat/_snaps.old/records.md b/tests/testthat/_snaps.old/records.md new file mode 100644 index 0000000..764d051 --- /dev/null +++ b/tests/testthat/_snaps.old/records.md @@ -0,0 +1,554 @@ +# In extractSchemaFromFields(), form with has duplicate labels can be fixed with useColumnNames = TRUE + + Code + caseDf + Output + Case number A single select column District (from form) Name + 1 1 1_stuff District 10 + 2 2 2_stuff District 7 + 3 3 3_stuff District 6 + 4 4 4_stuff District 3 + 5 5 5_stuff District 9 + 6 6 1_stuff District 10 + 7 7 2_stuff District 7 + 8 8 3_stuff District 6 + 9 9 4_stuff District 6 + 10 10 5_stuff District 4 + Country (from Form) Name + 1 Country 1 + 2 Country 2 + 3 Country 1 + 4 Country 2 + 5 Country 2 + 6 Country 1 + 7 Country 2 + 8 Country 1 + 9 Country 1 + 10 Country 2 + +# getRecords() works + + Code + rcrdsMinDf + Output + Identifier number A single select column A logical column A date column + 1 1 1_stuff True 2021-07-06 + 2 2 2_stuff True 2021-07-07 + 3 3 3_stuff False 2021-07-08 + 4 4 4_stuff False 2021-07-09 + 5 5 5_stuff False 2021-07-10 + 6 6 1_stuff False 2021-07-11 + 7 7 2_stuff False 2021-07-12 + 8 8 3_stuff False 2021-07-13 + 9 9 4_stuff False 2021-07-14 + 10 10 5_stuff False 2021-07-15 + 11 11 1_stuff False 2021-07-16 + 12 12 2_stuff False 2021-07-17 + 13 13 3_stuff False 2021-07-18 + 14 14 4_stuff False 2021-07-19 + 15 15 5_stuff False 2021-07-20 + 16 16 1_stuff False 2021-07-21 + 17 17 2_stuff False 2021-07-22 + 18 18 3_stuff False 2021-07-23 + 19 19 4_stuff False 2021-07-24 + 20 20 5_stuff False 2021-07-25 + 21 21 1_stuff True 2021-07-06 + 22 22 2_stuff True 2021-07-07 + 23 23 3_stuff True 2021-07-08 + 24 24 4_stuff False 2021-07-09 + 25 25 5_stuff False 2021-07-10 + 26 26 1_stuff False 2021-07-11 + 27 27 2_stuff False 2021-07-12 + 28 28 3_stuff False 2021-07-13 + 29 29 4_stuff False 2021-07-14 + 30 30 5_stuff False 2021-07-15 + 31 31 1_stuff False 2021-07-16 + 32 32 2_stuff False 2021-07-17 + 33 33 3_stuff False 2021-07-18 + 34 34 4_stuff False 2021-07-19 + 35 35 5_stuff False 2021-07-20 + 36 36 1_stuff False 2021-07-21 + 37 37 2_stuff False 2021-07-22 + 38 38 3_stuff False 2021-07-23 + 39 39 4_stuff False 2021-07-24 + 40 40 5_stuff False 2021-07-25 + 41 41 1_stuff False 2021-07-06 + 42 42 2_stuff True 2021-07-07 + 43 43 3_stuff True 2021-07-08 + 44 44 4_stuff True 2021-07-09 + 45 45 5_stuff False 2021-07-10 + 46 46 1_stuff False 2021-07-11 + 47 47 2_stuff False 2021-07-12 + 48 48 3_stuff False 2021-07-13 + 49 49 4_stuff False 2021-07-14 + 50 50 5_stuff False 2021-07-15 + 51 51 1_stuff False 2021-07-16 + 52 52 2_stuff False 2021-07-17 + 53 53 3_stuff False 2021-07-18 + 54 54 4_stuff False 2021-07-19 + 55 55 5_stuff False 2021-07-20 + 56 56 1_stuff False 2021-07-21 + 57 57 2_stuff False 2021-07-22 + 58 58 3_stuff False 2021-07-23 + 59 59 4_stuff False 2021-07-24 + 60 60 5_stuff False 2021-07-25 + 61 61 1_stuff False 2021-07-06 + 62 62 2_stuff False 2021-07-07 + 63 63 3_stuff True 2021-07-08 + 64 64 4_stuff True 2021-07-09 + 65 65 5_stuff True 2021-07-10 + 66 66 1_stuff False 2021-07-11 + 67 67 2_stuff False 2021-07-12 + 68 68 3_stuff False 2021-07-13 + 69 69 4_stuff False 2021-07-14 + 70 70 5_stuff False 2021-07-15 + 71 71 1_stuff False 2021-07-16 + 72 72 2_stuff False 2021-07-17 + 73 73 3_stuff False 2021-07-18 + 74 74 4_stuff False 2021-07-19 + 75 75 5_stuff False 2021-07-20 + 76 76 1_stuff False 2021-07-21 + 77 77 2_stuff False 2021-07-22 + 78 78 3_stuff False 2021-07-23 + 79 79 4_stuff False 2021-07-24 + 80 80 5_stuff False 2021-07-25 + 81 81 1_stuff False 2021-07-06 + 82 82 2_stuff False 2021-07-07 + 83 83 3_stuff False 2021-07-08 + 84 84 4_stuff True 2021-07-09 + 85 85 5_stuff True 2021-07-10 + 86 86 1_stuff True 2021-07-11 + 87 87 2_stuff False 2021-07-12 + 88 88 3_stuff False 2021-07-13 + 89 89 4_stuff False 2021-07-14 + 90 90 5_stuff False 2021-07-15 + 91 91 1_stuff False 2021-07-16 + 92 92 2_stuff False 2021-07-17 + 93 93 3_stuff False 2021-07-18 + 94 94 4_stuff False 2021-07-19 + 95 95 5_stuff False 2021-07-20 + 96 96 1_stuff False 2021-07-21 + 97 97 2_stuff False 2021-07-22 + 98 98 3_stuff False 2021-07-23 + 99 99 4_stuff False 2021-07-24 + 100 100 5_stuff False 2021-07-25 + 101 101 1_stuff False 2021-07-06 + 102 102 2_stuff False 2021-07-07 + 103 103 3_stuff False 2021-07-08 + 104 104 4_stuff False 2021-07-09 + 105 105 5_stuff True 2021-07-10 + 106 106 1_stuff True 2021-07-11 + 107 107 2_stuff True 2021-07-12 + 108 108 3_stuff False 2021-07-13 + 109 109 4_stuff False 2021-07-14 + 110 110 5_stuff False 2021-07-15 + 111 111 1_stuff False 2021-07-16 + 112 112 2_stuff False 2021-07-17 + 113 113 3_stuff False 2021-07-18 + 114 114 4_stuff False 2021-07-19 + 115 115 5_stuff False 2021-07-20 + 116 116 1_stuff False 2021-07-21 + 117 117 2_stuff False 2021-07-22 + 118 118 3_stuff False 2021-07-23 + 119 119 4_stuff False 2021-07-24 + 120 120 5_stuff False 2021-07-25 + 121 121 1_stuff False 2021-07-06 + 122 122 2_stuff False 2021-07-07 + 123 123 3_stuff False 2021-07-08 + 124 124 4_stuff False 2021-07-09 + 125 125 5_stuff False 2021-07-10 + 126 126 1_stuff True 2021-07-11 + 127 127 2_stuff True 2021-07-12 + 128 128 3_stuff True 2021-07-13 + 129 129 4_stuff False 2021-07-14 + 130 130 5_stuff False 2021-07-15 + 131 131 1_stuff False 2021-07-16 + 132 132 2_stuff False 2021-07-17 + 133 133 3_stuff False 2021-07-18 + 134 134 4_stuff False 2021-07-19 + 135 135 5_stuff False 2021-07-20 + 136 136 1_stuff False 2021-07-21 + 137 137 2_stuff False 2021-07-22 + 138 138 3_stuff False 2021-07-23 + 139 139 4_stuff False 2021-07-24 + 140 140 5_stuff False 2021-07-25 + 141 141 1_stuff False 2021-07-06 + 142 142 2_stuff False 2021-07-07 + 143 143 3_stuff False 2021-07-08 + 144 144 4_stuff False 2021-07-09 + 145 145 5_stuff False 2021-07-10 + 146 146 1_stuff False 2021-07-11 + 147 147 2_stuff True 2021-07-12 + 148 148 3_stuff True 2021-07-13 + 149 149 4_stuff True 2021-07-14 + 150 150 5_stuff False 2021-07-15 + 151 151 1_stuff False 2021-07-16 + 152 152 2_stuff False 2021-07-17 + 153 153 3_stuff False 2021-07-18 + 154 154 4_stuff False 2021-07-19 + 155 155 5_stuff False 2021-07-20 + 156 156 1_stuff False 2021-07-21 + 157 157 2_stuff False 2021-07-22 + 158 158 3_stuff False 2021-07-23 + 159 159 4_stuff False 2021-07-24 + 160 160 5_stuff False 2021-07-25 + 161 161 1_stuff False 2021-07-06 + 162 162 2_stuff False 2021-07-07 + 163 163 3_stuff False 2021-07-08 + 164 164 4_stuff False 2021-07-09 + 165 165 5_stuff False 2021-07-10 + 166 166 1_stuff False 2021-07-11 + 167 167 2_stuff False 2021-07-12 + 168 168 3_stuff True 2021-07-13 + 169 169 4_stuff True 2021-07-14 + 170 170 5_stuff True 2021-07-15 + 171 171 1_stuff False 2021-07-16 + 172 172 2_stuff False 2021-07-17 + 173 173 3_stuff False 2021-07-18 + 174 174 4_stuff False 2021-07-19 + 175 175 5_stuff False 2021-07-20 + 176 176 1_stuff False 2021-07-21 + 177 177 2_stuff False 2021-07-22 + 178 178 3_stuff False 2021-07-23 + 179 179 4_stuff False 2021-07-24 + 180 180 5_stuff False 2021-07-25 + 181 181 1_stuff False 2021-07-06 + 182 182 2_stuff False 2021-07-07 + 183 183 3_stuff False 2021-07-08 + 184 184 4_stuff False 2021-07-09 + 185 185 5_stuff False 2021-07-10 + 186 186 1_stuff False 2021-07-11 + 187 187 2_stuff False 2021-07-12 + 188 188 3_stuff False 2021-07-13 + 189 189 4_stuff True 2021-07-14 + 190 190 5_stuff True 2021-07-15 + 191 191 1_stuff True 2021-07-16 + 192 192 2_stuff False 2021-07-17 + 193 193 3_stuff False 2021-07-18 + 194 194 4_stuff False 2021-07-19 + 195 195 5_stuff False 2021-07-20 + 196 196 1_stuff False 2021-07-21 + 197 197 2_stuff False 2021-07-22 + 198 198 3_stuff False 2021-07-23 + 199 199 4_stuff False 2021-07-24 + 200 200 5_stuff False 2021-07-25 + 201 201 1_stuff False 2021-07-06 + 202 202 2_stuff False 2021-07-07 + 203 203 3_stuff False 2021-07-08 + 204 204 4_stuff False 2021-07-09 + 205 205 5_stuff False 2021-07-10 + 206 206 1_stuff False 2021-07-11 + 207 207 2_stuff False 2021-07-12 + 208 208 3_stuff False 2021-07-13 + 209 209 4_stuff False 2021-07-14 + 210 210 5_stuff True 2021-07-15 + 211 211 1_stuff True 2021-07-16 + 212 212 2_stuff True 2021-07-17 + 213 213 3_stuff False 2021-07-18 + 214 214 4_stuff False 2021-07-19 + 215 215 5_stuff False 2021-07-20 + 216 216 1_stuff False 2021-07-21 + 217 217 2_stuff False 2021-07-22 + 218 218 3_stuff False 2021-07-23 + 219 219 4_stuff False 2021-07-24 + 220 220 5_stuff False 2021-07-25 + 221 221 1_stuff False 2021-07-06 + 222 222 2_stuff False 2021-07-07 + 223 223 3_stuff False 2021-07-08 + 224 224 4_stuff False 2021-07-09 + 225 225 5_stuff False 2021-07-10 + 226 226 1_stuff False 2021-07-11 + 227 227 2_stuff False 2021-07-12 + 228 228 3_stuff False 2021-07-13 + 229 229 4_stuff False 2021-07-14 + 230 230 5_stuff False 2021-07-15 + 231 231 1_stuff True 2021-07-16 + 232 232 2_stuff True 2021-07-17 + 233 233 3_stuff True 2021-07-18 + 234 234 4_stuff False 2021-07-19 + 235 235 5_stuff False 2021-07-20 + 236 236 1_stuff False 2021-07-21 + 237 237 2_stuff False 2021-07-22 + 238 238 3_stuff False 2021-07-23 + 239 239 4_stuff False 2021-07-24 + 240 240 5_stuff False 2021-07-25 + 241 241 1_stuff False 2021-07-06 + 242 242 2_stuff False 2021-07-07 + 243 243 3_stuff False 2021-07-08 + 244 244 4_stuff False 2021-07-09 + 245 245 5_stuff False 2021-07-10 + 246 246 1_stuff False 2021-07-11 + 247 247 2_stuff False 2021-07-12 + 248 248 3_stuff False 2021-07-13 + 249 249 4_stuff False 2021-07-14 + 250 250 5_stuff False 2021-07-15 + 251 251 1_stuff False 2021-07-16 + 252 252 2_stuff True 2021-07-17 + 253 253 3_stuff True 2021-07-18 + 254 254 4_stuff True 2021-07-19 + 255 255 5_stuff False 2021-07-20 + 256 256 1_stuff False 2021-07-21 + 257 257 2_stuff False 2021-07-22 + 258 258 3_stuff False 2021-07-23 + 259 259 4_stuff False 2021-07-24 + 260 260 5_stuff False 2021-07-25 + 261 261 1_stuff False 2021-07-06 + 262 262 2_stuff False 2021-07-07 + 263 263 3_stuff False 2021-07-08 + 264 264 4_stuff False 2021-07-09 + 265 265 5_stuff False 2021-07-10 + 266 266 1_stuff False 2021-07-11 + 267 267 2_stuff False 2021-07-12 + 268 268 3_stuff False 2021-07-13 + 269 269 4_stuff False 2021-07-14 + 270 270 5_stuff False 2021-07-15 + 271 271 1_stuff False 2021-07-16 + 272 272 2_stuff False 2021-07-17 + 273 273 3_stuff True 2021-07-18 + 274 274 4_stuff True 2021-07-19 + 275 275 5_stuff True 2021-07-20 + 276 276 1_stuff False 2021-07-21 + 277 277 2_stuff False 2021-07-22 + 278 278 3_stuff False 2021-07-23 + 279 279 4_stuff False 2021-07-24 + 280 280 5_stuff False 2021-07-25 + 281 281 1_stuff False 2021-07-06 + 282 282 2_stuff False 2021-07-07 + 283 283 3_stuff False 2021-07-08 + 284 284 4_stuff False 2021-07-09 + 285 285 5_stuff False 2021-07-10 + 286 286 1_stuff False 2021-07-11 + 287 287 2_stuff False 2021-07-12 + 288 288 3_stuff False 2021-07-13 + 289 289 4_stuff False 2021-07-14 + 290 290 5_stuff False 2021-07-15 + 291 291 1_stuff False 2021-07-16 + 292 292 2_stuff False 2021-07-17 + 293 293 3_stuff False 2021-07-18 + 294 294 4_stuff True 2021-07-19 + 295 295 5_stuff True 2021-07-20 + 296 296 1_stuff True 2021-07-21 + 297 297 2_stuff False 2021-07-22 + 298 298 3_stuff False 2021-07-23 + 299 299 4_stuff False 2021-07-24 + 300 300 5_stuff False 2021-07-25 + 301 301 1_stuff False 2021-07-06 + 302 302 2_stuff False 2021-07-07 + 303 303 3_stuff False 2021-07-08 + 304 304 4_stuff False 2021-07-09 + 305 305 5_stuff False 2021-07-10 + 306 306 1_stuff False 2021-07-11 + 307 307 2_stuff False 2021-07-12 + 308 308 3_stuff False 2021-07-13 + 309 309 4_stuff False 2021-07-14 + 310 310 5_stuff False 2021-07-15 + 311 311 1_stuff False 2021-07-16 + 312 312 2_stuff False 2021-07-17 + 313 313 3_stuff False 2021-07-18 + 314 314 4_stuff False 2021-07-19 + 315 315 5_stuff True 2021-07-20 + 316 316 1_stuff True 2021-07-21 + 317 317 2_stuff True 2021-07-22 + 318 318 3_stuff False 2021-07-23 + 319 319 4_stuff False 2021-07-24 + 320 320 5_stuff False 2021-07-25 + 321 321 1_stuff False 2021-07-06 + 322 322 2_stuff False 2021-07-07 + 323 323 3_stuff False 2021-07-08 + 324 324 4_stuff False 2021-07-09 + 325 325 5_stuff False 2021-07-10 + 326 326 1_stuff False 2021-07-11 + 327 327 2_stuff False 2021-07-12 + 328 328 3_stuff False 2021-07-13 + 329 329 4_stuff False 2021-07-14 + 330 330 5_stuff False 2021-07-15 + 331 331 1_stuff False 2021-07-16 + 332 332 2_stuff False 2021-07-17 + 333 333 3_stuff False 2021-07-18 + 334 334 4_stuff False 2021-07-19 + 335 335 5_stuff False 2021-07-20 + 336 336 1_stuff True 2021-07-21 + 337 337 2_stuff True 2021-07-22 + 338 338 3_stuff True 2021-07-23 + 339 339 4_stuff False 2021-07-24 + 340 340 5_stuff False 2021-07-25 + 341 341 1_stuff False 2021-07-06 + 342 342 2_stuff False 2021-07-07 + 343 343 3_stuff False 2021-07-08 + 344 344 4_stuff False 2021-07-09 + 345 345 5_stuff False 2021-07-10 + 346 346 1_stuff False 2021-07-11 + 347 347 2_stuff False 2021-07-12 + 348 348 3_stuff False 2021-07-13 + 349 349 4_stuff False 2021-07-14 + 350 350 5_stuff False 2021-07-15 + 351 351 1_stuff False 2021-07-16 + 352 352 2_stuff False 2021-07-17 + 353 353 3_stuff False 2021-07-18 + 354 354 4_stuff False 2021-07-19 + 355 355 5_stuff False 2021-07-20 + 356 356 1_stuff False 2021-07-21 + 357 357 2_stuff True 2021-07-22 + 358 358 3_stuff True 2021-07-23 + 359 359 4_stuff True 2021-07-24 + 360 360 5_stuff False 2021-07-25 + 361 361 1_stuff False 2021-07-06 + 362 362 2_stuff False 2021-07-07 + 363 363 3_stuff False 2021-07-08 + 364 364 4_stuff False 2021-07-09 + 365 365 5_stuff False 2021-07-10 + 366 366 1_stuff False 2021-07-11 + 367 367 2_stuff False 2021-07-12 + 368 368 3_stuff False 2021-07-13 + 369 369 4_stuff False 2021-07-14 + 370 370 5_stuff False 2021-07-15 + 371 371 1_stuff False 2021-07-16 + 372 372 2_stuff False 2021-07-17 + 373 373 3_stuff False 2021-07-18 + 374 374 4_stuff False 2021-07-19 + 375 375 5_stuff False 2021-07-20 + 376 376 1_stuff False 2021-07-21 + 377 377 2_stuff False 2021-07-22 + 378 378 3_stuff True 2021-07-23 + 379 379 4_stuff True 2021-07-24 + 380 380 5_stuff True 2021-07-25 + 381 381 1_stuff False 2021-07-06 + 382 382 2_stuff False 2021-07-07 + 383 383 3_stuff False 2021-07-08 + 384 384 4_stuff False 2021-07-09 + 385 385 5_stuff False 2021-07-10 + 386 386 1_stuff False 2021-07-11 + 387 387 2_stuff False 2021-07-12 + 388 388 3_stuff False 2021-07-13 + 389 389 4_stuff False 2021-07-14 + 390 390 5_stuff False 2021-07-15 + 391 391 1_stuff False 2021-07-16 + 392 392 2_stuff False 2021-07-17 + 393 393 3_stuff False 2021-07-18 + 394 394 4_stuff False 2021-07-19 + 395 395 5_stuff False 2021-07-20 + 396 396 1_stuff False 2021-07-21 + 397 397 2_stuff False 2021-07-22 + 398 398 3_stuff False 2021-07-23 + 399 399 4_stuff True 2021-07-24 + 400 400 5_stuff True 2021-07-25 + 401 401 1_stuff True 2021-07-06 + 402 402 2_stuff False 2021-07-07 + 403 403 3_stuff False 2021-07-08 + 404 404 4_stuff False 2021-07-09 + 405 405 5_stuff False 2021-07-10 + 406 406 1_stuff False 2021-07-11 + 407 407 2_stuff False 2021-07-12 + 408 408 3_stuff False 2021-07-13 + 409 409 4_stuff False 2021-07-14 + 410 410 5_stuff False 2021-07-15 + 411 411 1_stuff False 2021-07-16 + 412 412 2_stuff False 2021-07-17 + 413 413 3_stuff False 2021-07-18 + 414 414 4_stuff False 2021-07-19 + 415 415 5_stuff False 2021-07-20 + 416 416 1_stuff False 2021-07-21 + 417 417 2_stuff False 2021-07-22 + 418 418 3_stuff False 2021-07-23 + 419 419 4_stuff False 2021-07-24 + 420 420 5_stuff True 2021-07-25 + 421 421 1_stuff True 2021-07-06 + 422 422 2_stuff True 2021-07-07 + 423 423 3_stuff False 2021-07-08 + 424 424 4_stuff False 2021-07-09 + 425 425 5_stuff False 2021-07-10 + 426 426 1_stuff False 2021-07-11 + 427 427 2_stuff False 2021-07-12 + 428 428 3_stuff False 2021-07-13 + 429 429 4_stuff False 2021-07-14 + 430 430 5_stuff False 2021-07-15 + 431 431 1_stuff False 2021-07-16 + 432 432 2_stuff False 2021-07-17 + 433 433 3_stuff False 2021-07-18 + 434 434 4_stuff False 2021-07-19 + 435 435 5_stuff False 2021-07-20 + 436 436 1_stuff False 2021-07-21 + 437 437 2_stuff False 2021-07-22 + 438 438 3_stuff False 2021-07-23 + 439 439 4_stuff False 2021-07-24 + 440 440 5_stuff False 2021-07-25 + 441 441 1_stuff True 2021-07-06 + 442 442 2_stuff True 2021-07-07 + 443 443 3_stuff True 2021-07-08 + 444 444 4_stuff False 2021-07-09 + 445 445 5_stuff False 2021-07-10 + 446 446 1_stuff False 2021-07-11 + 447 447 2_stuff False 2021-07-12 + 448 448 3_stuff False 2021-07-13 + 449 449 4_stuff False 2021-07-14 + 450 450 5_stuff False 2021-07-15 + 451 451 1_stuff False 2021-07-16 + 452 452 2_stuff False 2021-07-17 + 453 453 3_stuff False 2021-07-18 + 454 454 4_stuff False 2021-07-19 + 455 455 5_stuff False 2021-07-20 + 456 456 1_stuff False 2021-07-21 + 457 457 2_stuff False 2021-07-22 + 458 458 3_stuff False 2021-07-23 + 459 459 4_stuff False 2021-07-24 + 460 460 5_stuff False 2021-07-25 + 461 461 1_stuff False 2021-07-06 + 462 462 2_stuff True 2021-07-07 + 463 463 3_stuff True 2021-07-08 + 464 464 4_stuff True 2021-07-09 + 465 465 5_stuff False 2021-07-10 + 466 466 1_stuff False 2021-07-11 + 467 467 2_stuff False 2021-07-12 + 468 468 3_stuff False 2021-07-13 + 469 469 4_stuff False 2021-07-14 + 470 470 5_stuff False 2021-07-15 + 471 471 1_stuff False 2021-07-16 + 472 472 2_stuff False 2021-07-17 + 473 473 3_stuff False 2021-07-18 + 474 474 4_stuff False 2021-07-19 + 475 475 5_stuff False 2021-07-20 + 476 476 1_stuff False 2021-07-21 + 477 477 2_stuff False 2021-07-22 + 478 478 3_stuff False 2021-07-23 + 479 479 4_stuff False 2021-07-24 + 480 480 5_stuff False 2021-07-25 + 481 481 1_stuff False 2021-07-06 + 482 482 2_stuff False 2021-07-07 + 483 483 3_stuff True 2021-07-08 + 484 484 4_stuff True 2021-07-09 + 485 485 5_stuff True 2021-07-10 + 486 486 1_stuff False 2021-07-11 + 487 487 2_stuff False 2021-07-12 + 488 488 3_stuff False 2021-07-13 + 489 489 4_stuff False 2021-07-14 + 490 490 5_stuff False 2021-07-15 + 491 491 1_stuff False 2021-07-16 + 492 492 2_stuff False 2021-07-17 + 493 493 3_stuff False 2021-07-18 + 494 494 4_stuff False 2021-07-19 + 495 495 5_stuff False 2021-07-20 + 496 496 1_stuff False 2021-07-21 + 497 497 2_stuff False 2021-07-22 + 498 498 3_stuff False 2021-07-23 + 499 499 4_stuff False 2021-07-24 + 500 500 5_stuff False 2021-07-25 + +# Reference field with shallow reference table should provide field based names + + Code + personMinimalRefDf + Output + Respondent name Children Ref 1 Identifier number + 1 Bob 6 + 2 Alice 6 107 + +# filter on reference field works + + Code + filteredRowDf + Output + Ref 1 Identifier number Ref 2 Identifier number Ref 3 Identifier number + 1 107 NA NA + Respondent name + 1 Alice + diff --git a/tests/testthat/_snaps.old/rmdOutput/TestMessages.html b/tests/testthat/_snaps.old/rmdOutput/TestMessages.html new file mode 100644 index 0000000..cd6002d --- /dev/null +++ b/tests/testthat/_snaps.old/rmdOutput/TestMessages.html @@ -0,0 +1,452 @@ + + + + + + + + + + + + + + + +TestMessages + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + +
+

This is a test of issue #29

+
try({
+  if (grepl(pattern = "activityinfo-R$", rstudioapi::getActiveProject())) {
+    devtools::load_all(".")
+    withr::with_options(new = list(activityinfo.interactive = FALSE), {
+      source(file = testthat::test_path("setup.R"))
+    })
+  }
+}, silent = TRUE)
+
+dt <- as.data.frame(getFormSchema(formId = personFormId))
+
+knitr::kable(dt[,c("fieldCode", "fieldType")])
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
fieldCodefieldType
NAMEFREE_TEXT
CHILDRENsubform
NAreference
NAreference
NAreference
+
+ + + + +
+ + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/databases.md b/tests/testthat/_snaps/databases.md index af00544..6bba98d 100644 --- a/tests/testthat/_snaps/databases.md +++ b/tests/testthat/_snaps/databases.md @@ -1,7 +1,7 @@ # getDatabases() works Code - databases + databasesDf Output # A tibble: 2 x 6 billingAccountId databaseId description label ownerId suspended @@ -50,6 +50,9 @@ [[1]]$operation [1] "VIEW" + [[1]]$securityCategories + list() + attr(,"class") [1] "activityInfoPermissions" "list" @@ -63,6 +66,9 @@ [[1]]$operation [1] "VIEW" + [[1]]$securityCategories + list() + [[2]] [[2]]$operation @@ -78,6 +84,9 @@ [[3]]$operation [1] "DISCOVER" + [[3]]$securityCategories + list() + attr(,"class") [1] "activityInfoPermissions" "list" @@ -99,10 +108,10 @@ attr(,"class") [1] "activityInfoParameter" "list" -# adminPermissions() works +# managementPermissions() works Code - defaultAdminPermissions + defaultManagementPermissions Output list() attr(,"class") @@ -111,22 +120,31 @@ --- Code - enhancedAdminPermissions + enhancedManagementPermissions Output [[1]] [[1]]$operation [1] "MANAGE_AUTOMATIONS" + [[1]]$securityCategories + list() + [[2]] [[2]]$operation [1] "MANAGE_USERS" + [[2]]$securityCategories + list() + [[3]] [[3]]$operation [1] "MANAGE_ROLES" + [[3]]$securityCategories + list() + attr(,"class") [1] "activityInfoManagementPermissions" "list" @@ -144,16 +162,25 @@ [[1]]$operation [1] "VIEW" + [[1]]$securityCategories + list() + [[2]] [[2]]$operation [1] "ADD_RECORD" + [[2]]$securityCategories + list() + [[3]] [[3]]$operation [1] "EDIT_RECORD" + [[3]]$securityCategories + list() + attr(,"class") [1] "activityInfoPermissions" "list" @@ -222,6 +249,9 @@ [[1]]$operation [1] "VIEW" + [[1]]$securityCategories + list() + [[1]]$filter [1] "ck5dxt1712 == @user.partner" @@ -230,6 +260,9 @@ [[2]]$operation [1] "EDIT_RECORD" + [[2]]$securityCategories + list() + [[2]]$filter [1] "ck5dxt1712 == @user.partner" @@ -238,11 +271,17 @@ [[3]]$operation [1] "EXPORT_RECORDS" + [[3]]$securityCategories + list() + [[4]] [[4]]$operation [1] "DISCOVER" + [[4]]$securityCategories + list() + attr(,"class") [1] "activityInfoPermissions" "list" @@ -262,16 +301,25 @@ [[1]]$operation [1] "VIEW" + [[1]]$securityCategories + list() + [[2]] [[2]]$operation [1] "ADD_RECORD" + [[2]]$securityCategories + list() + [[3]] [[3]]$operation [1] "DISCOVER" + [[3]]$securityCategories + list() + attr(,"class") [1] "activityInfoPermissions" "list" @@ -283,24 +331,37 @@ [1] "activityInfoGrant" "list" - $filters - $filters[[1]] + $grantBased + [1] TRUE + + attr(,"class") + [1] "activityInfoRole" "list" + +# roleAssignment() works + + Code + roleAssignment(roleId = "rp", roleParameter = list(partner = "test:test"), + roleResources = list("resource1", "resource2", "resource3")) + Output $id - [1] "partner" + [1] "rp" - $label - [1] "Partner is user's partner" + $parameters + $parameters$partner + [1] "test:test" - $filter - [1] "ck5dxt1712 == @user.partner" - attr(,"class") - [1] "activityInfoRoleFilter" "list" + $resources + $resources[[1]] + [1] "resource1" + $resources[[2]] + [1] "resource2" + + $resources[[3]] + [1] "resource3" - $grantBased - [1] TRUE attr(,"class") - [1] "activityInfoRole" "list" + [1] "activityInfoRoleAssignment" "list" diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 068a939..b07d1d5 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -53,25 +53,27 @@ canonicalizeActivityInfoObject <- function(tree, replaceId = TRUE, replaceDate = } if (replaceResource) { - n <- grepl(pattern = "resources", names(x)) & lengths(x) == 1 - x[n] <- list("Empty resources until we can ensure a sort order in the API.") n <- grepl(pattern = "resources", names(x)) & lengths(x) > 1 - # replace a list or vector of resource ids x[n] <- lapply(x[n], function(y) { if (is.recursive(y)) { # y - list("Empty resources until we can ensure a sort order in the API.") + list(list(id = "", note = "Empty resources until we can ensure a sort order in the API.")) } else if (is.list(y)) { # yReturn <- list(rep("", length(y))) # names(yReturn) <- names(y) - list("Empty resources until we can ensure a sort order in the API.") + list(list(id = "", note = "Empty resources until we can ensure a sort order in the API.")) } else { # rep("", length(y)) - list("Empty resources until we can ensure a sort order in the API.") + list(list(id = "", note = "Empty resources until we can ensure a sort order in the API.")) } }) + + n <- grepl(pattern = "resources", names(x)) & lengths(x) == 1 + x[n] <- list(list(id = "", note = "Empty resources until we can ensure a sort order in the API.")) + + } x <- lapply(x, function(y) { @@ -143,7 +145,7 @@ expectActivityInfoSnapshotCompare <- function(x, snapshotName, replaceId = TRUE, x <- canonicalizeActivityInfoObject(x, replaceId, replaceDate, replaceResource) - path <- sprintf("%s/_activityInfoSnaps/%s.RDS", getwd(), snapshotName) + path <- testthat::test_path("_activityInfoSnaps", sprintf("%s.RDS", snapshotName)) if (file.exists(path)) { y <- readRDS(file = path) diff --git a/tests/testthat/test-databases.R b/tests/testthat/test-databases.R index 9ef5368..6066464 100644 --- a/tests/testthat/test-databases.R +++ b/tests/testthat/test-databases.R @@ -14,14 +14,14 @@ testthat::test_that("addDatabase() and deleteDatabase() works", { }) testthat::test_that("getDatabases() works", { - - # update snapshot; works for now - databases <- getDatabases() %>% + databases <- getDatabases(asDataFrame = FALSE) + expectActivityInfoSnapshotCompare(databases, snapshotName = "databases-getDatabases", allowed_new_fields = TRUE) + + databasesDf <- getDatabases(asDataFrame = TRUE) %>% select("billingAccountId", "databaseId", "description", "label", "ownerId", "suspended") - databases <- canonicalizeActivityInfoObject(databases) - - - testthat::expect_snapshot(databases) + databasesDf <- canonicalizeActivityInfoObject(databasesDf) + testthat::expect_snapshot(databasesDf) + }) testthat::test_that("getDatabaseSchema() and getDatabaseTree() return same value and getDatabaseSchema() provides deprecation warning", { @@ -61,18 +61,29 @@ testthat::test_that("getDatabaseResources() works", { testthat::expect_snapshot(dbResources) }) -addTestUsers <- function(database, tree, nUsers = 1) { +addTestUsers <- function(database, tree, nUsers = 1, roleId, roleParameters = list(), roleResources = list(database$databaseId)) { + if (missing(roleId)) roleId <- tree$roles[[2]]$id lapply(1:nUsers, function(x) { newUserEmail <- sprintf("test%s@example.com", cuid()) - newDatabaseUser <- addDatabaseUser(databaseId = database$databaseId, email = newUserEmail, name = "Test database user", locale = "en", roleId = tree$roles[[2]]$id, roleResources = list(database$databaseId)) - - testthat::expect_true(newDatabaseUser$added) - - testthat::expect_identical(newDatabaseUser$user$email, newUserEmail) - testthat::expect_identical(newDatabaseUser$user$role$id, tree$roles[[2]]$id) - testthat::expect_identical(newDatabaseUser$user$role$resources[[1]], database$databaseId) - - newDatabaseUser + newDatabaseUser <- addDatabaseUser( + databaseId = database$databaseId, + email = newUserEmail, + name = "Test database user", + locale = "en", + roleId = roleId, + roleParameters = roleParameters, + roleResources = roleResources + ) + + if (newDatabaseUser$added) { + testthat::expect_identical(newDatabaseUser$user$email, newUserEmail) + testthat::expect_identical(newDatabaseUser$user$role$id, roleId) + testthat::expect_identical(newDatabaseUser$user$role$resources[[1]], database$databaseId) + newDatabaseUser + } else { + warning("Could not add user.") + NULL + } }) } @@ -171,29 +182,6 @@ testthat::test_that("addDatabaseUser() and deleteDatabaseUser() and getDatabaseU deleteTestUsers(database, returnedUsers) }) - -testthat::test_that("updateUserRole() works", { - # databases <- getDatabases() - # database <- databases[[1]] - # tree <- getDatabaseTree(databaseId = database$databaseId) - # - # returnedUsers <- addTestUsers(database, tree, nUsers = 1) - # - # lapply(returnedUsers, function(newDatabaseUser) { - # - # }) - # - # deleteTestUsers(database, tree, returnedUsers) -}) - -testthat::test_that("roleAssignment() works", { - #old# -}) - -testthat::test_that("updateGrant() works", { - #old# -}) - testthat::test_that("permissions() helper works", { defaultPermissions <- permissions() reviewerPermissions <- permissions( @@ -211,15 +199,15 @@ testthat::test_that("parameter() works", { testthat::expect_snapshot(param) }) -testthat::test_that("adminPermissions() works", { - defaultAdminPermissions <- adminPermissions() - enhancedAdminPermissions <- adminPermissions( +testthat::test_that("managementPermissions() works", { + defaultManagementPermissions <- managementPermissions() + enhancedManagementPermissions <- managementPermissions( manage_automations = TRUE, manage_users = TRUE, manage_roles = TRUE ) - testthat::expect_snapshot(defaultAdminPermissions) - testthat::expect_snapshot(enhancedAdminPermissions) + testthat::expect_snapshot(defaultManagementPermissions) + testthat::expect_snapshot(enhancedManagementPermissions) }) @@ -236,7 +224,6 @@ testthat::test_that("grant() works", { testthat::expect_snapshot(optionalGrant) }) - testthat::test_that("roleFilter() works", { roleLevelFilter <- roleFilter( @@ -247,7 +234,6 @@ testthat::test_that("roleFilter() works", { testthat::expect_snapshot(roleLevelFilter) }) - testthat::test_that("role() works", { grantBasedRole <- role(id = "rp", @@ -266,17 +252,68 @@ testthat::test_that("role() works", { view = TRUE, discover = TRUE, add_record = TRUE), - optional = TRUE)), - filters = list( - roleFilter( - id = "partner", - label = "Partner is user's partner", - filter = "ck5dxt1712 == @user.partner")) + optional = TRUE)) ) testthat::expect_snapshot(grantBasedRole) }) -testthat::test_that("updateRole() works", { +createReportingPartnerGrantBasedRole <- function(roleLabel, partnerForm, reportingForm) { + role(id = "rp", + label = roleLabel, + parameters = list( + parameter(id = "partner", label = "Partner", range = partnerForm$id)), + grants = list( + grant(resourceId = partnerForm$databaseId, + permissions = permissions( + view = TRUE, + edit_record = FALSE + )), + 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 = TRUE, + edit_record = TRUE), + optional = TRUE) + ) + ) +} + +createDeprecatedReportingPartnerRole <- function(roleLabel, partnerForm, reportingForm) { + list( + id = "rpold", + label = "Reporting partner", + permissions = permissions( + view = sprintf("%s == @user.partner2", partnerForm$id), + edit_record = sprintf("%s == @user.partner2", partnerForm$id), + add_record = sprintf("%s == @user.partner2", partnerForm$id), + delete_record = sprintf("%s == @user.partner2", partnerForm$id), + export_records = TRUE + ), + parameters = list( + parameter( + id = "partner2", + label = "Partner", + range = partnerForm$id + ) + ), + filters = list( + roleFilter( + id = "partner2", + label = "partner is user's partner2", + filter = sprintf("%s == @user.partner2", partnerForm$id) + ) + ), + grantBased = FALSE + ) +} + +testthat::test_that("updateRole() works for both legacy and new roles", { roleId = "rp" roleLabel = "Reporting partner" @@ -322,37 +359,15 @@ testthat::test_that("updateRole() works", { 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))) - ) + newReportingPartnerRole <- createReportingPartnerGrantBasedRole(roleLabel, partnerForm, reportingForm) # update the role - updateRole(databaseId = database$databaseId, role = newRole) + updateRole(databaseId = database$databaseId, role = newReportingPartnerRole) # fetch and check that the role matches tree <- getDatabaseTree(databaseId = database$databaseId) - roleIdentical <- sapply(tree$roles, function(x) { + roleIdentical <- any(sapply(tree$roles, function(x) { if (x$id == roleId) { testthat::expect_identical(x$label, roleLabel) testthat::expect_length(object = x$parameters, n = 1) @@ -361,7 +376,7 @@ testthat::test_that("updateRole() works", { testthat::expect_length(object = x$permissions, n = 0) - testthat::expect_length(object = x$grants, n = 2) + testthat::expect_length(object = x$grants, n = 3) grant1 <- x$grants[[which(sapply(x$grants, function(g) g$resourceId == reportingForm$id))]] testthat::expect_identical(grant1$resourceId, reportingForm$id) @@ -375,29 +390,124 @@ testthat::test_that("updateRole() works", { grant2 <- x$grants[[which(sapply(x$grants, function(g) g$resourceId == partnerForm$id))]] testthat::expect_identical(grant2$resourceId, partnerForm$id) - testthat::expect_length(object = grant2$operations, n = 1) + testthat::expect_length(object = grant2$operations, n = 3) testthat::expect_identical(grant2$operations[[1]]$operation, "VIEW") - #testthat::expect_length(object = x$filters, n = 1) - #testthat::expect_identical(x$filters[[1]]$id, "partner") - #testthat::expect_identical(x$filters[[1]]$label, "Partner is user's partner") - #testthat::expect_identical(x$filters[[1]]$filter, "cwjcaculx3axxgxo == @user.partner") - testthat::expect_true(x$grantBased) TRUE } else { FALSE } - }) - testthat::expect_true(any(roleIdentical)) + })) + testthat::expect_true(roleIdentical) + + testthat::test_that("Deprecated roles work and provide deprecation warning", { + deprecatedNonGrantRole <- createDeprecatedReportingPartnerRole(label, partnerForm, reportingForm) + + testthat::expect_warning({ + updateRole(databaseId = database$databaseId, role = deprecatedNonGrantRole) + }, regexp="deprecated") + }) + + testthat::test_that("Grant-based role assignment works with updateUserRole()", { + + tree <- getDatabaseTree(database$databaseId) + + tree$roles + + returnedUsers <- addTestUsers( + database, + tree, + nUsers = 1, + roleId = "readonly" + ) + + user <- returnedUsers[[1]]$user + + userRoleParam <- list( + partner = reference(formId = partnerForm$id, recordId = "partner1") + ) + + updateUserRole( + database$databaseId, + user$userId, + assignment = + roleAssignment( + roleId = "rp", + roleParameters = userRoleParam, + roleResources = list(partnerForm$id) + ) + ) + + userWithRole <- getDatabaseUser(database$databaseId, user$userId) + + userRole = userWithRole$role[[1]] + + testthat::expect_identical(userRole$id, "rp") + testthat::expect_identical(userRole$parameters, userRoleParam) + testthat::expect_identical(userRole$resources, partnerForm$id) + + deleteTestUsers(database, returnedUsers) + }) + }) -testthat::test_that("Grant-based role assignment works", { - # create a test user - # assign a role - # check the user roles and verify they match +testthat::test_that("getDatabaseRole() works", { + dbTree = getDatabaseTree(database$databaseId) + dbId = dbTree$databaseId + + role1 = getDatabaseRole(dbId, roleId = "rp") + role2 = getDatabaseRole(dbTree, roleId = "rp") + + testthat::expect_identical(role1$id, "rp") + testthat::expect_identical(role1, role2) }) +testthat::test_that("Missing role resources and parameters are reported", { + testthat::expect_warning({ + returnedUsers <- addTestUsers(database, tree, nUsers = 1, roleId = "rp2") + }, regexp = "Could not add user") + testthat::expect_warning({ + returnedUsers <- addTestUsers(database, tree, nUsers = 1, roleId = "rp", roleParameters = list(nonexistant = "nonexistant")) + }) + + returnedUsers <- addTestUsers(database, tree, roleId = "rp", roleParameters = list(partner = "partner1")) + + user <- returnedUsers[[1]]$user + + testthat::expect_error({ + updateUserRole( + databaseId = database$databaseId, + userId = user$userId, + assignment = roleAssignment(roleId = "rp2", roleResources = database$databaseId) + ) + }, regexp = "INVALID_ROLE_PARAMETERS") + testthat::expect_error({ + updateUserRole( + databaseId = database$databaseId, + userId = user$userId, + assignment = roleAssignment(roleId = "rp", roleParameters = list(nonexistant = "nonexistant"), roleResources = database$databaseId) + ) + }, regexp = "INVALID_ROLE_PARAMETERS") + + testthat::expect_error({ + updateUserRole( + databaseId = database$databaseId, + userId = user$userId, + assignment = roleAssignment(roleId = "rp", roleResources = list("nonexistant")) + ) + }, regexp = "INVALID_ROLE_PARAMETERS") +}) +testthat::test_that("roleAssignment() works", { + testthat::expect_snapshot(roleAssignment( + roleId = "rp", + roleParameter = list(partner = "test:test"), + roleResources = list("resource1", "resource2", "resource3") + )) +}) +testthat::test_that("updateGrant() works", { + #old method - not tested# +}) \ No newline at end of file