From 0fdb0ca027e023b061f42413ea6b1653302df863 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Mon, 1 Jun 2026 15:13:26 +0100 Subject: [PATCH 01/81] Increment version number to 0.1.0.9000 --- DESCRIPTION | 2 +- NEWS.md | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index dd42b96..3698255 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: dsROCrate Title: 'DataSHIELD' RO-Crate Governance Functions -Version: 0.1.0 +Version: 0.1.0.9000 Authors@R: c( person(given = "Roberto", family = "Villegas-Diaz", diff --git a/NEWS.md b/NEWS.md index a4e189d..f06b381 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,5 @@ +# dsROCrate (development version) + # dsROCrate 0.1.0 ## New Features From 07fa8890bbc8fa14f8b7077ad118df2ecf248f46 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 26 Jun 2026 11:34:14 +0100 Subject: [PATCH 02/81] Update parsing of Armadillo credentials --- R/safe_project.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/safe_project.R b/R/safe_project.R index 760645a..352ab1e 100644 --- a/R/safe_project.R +++ b/R/safe_project.R @@ -267,6 +267,7 @@ safe_project.ArmadilloCredentials <- function( # retrieve details associated to `project` project_details_tbl <- MolgenisArmadillo::armadillo.get_projects_info() |> - purrr::list_c() |> - tibble::as_tibble() + purrr::map(\(x) tibble::tibble(name = x$name, users = unlist(x$users))) |> + purrr::list_c() + project_details_tbl } From 8a5ec3b17ff0ac392b7b60382646e5b26447ac82 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 26 Jun 2026 11:57:26 +0100 Subject: [PATCH 03/81] Minor user message update --- R/audit.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/audit.R b/R/audit.R index fc88fd7..aee6154 100644 --- a/R/audit.R +++ b/R/audit.R @@ -51,7 +51,7 @@ audit <- function(x, ...) { #' @export audit.ArmadilloCredentials <- function(x, ..., intent = NULL) { stop( - "The audit for Armadillo backend is not currently implemented!", + "The audit for the Armadillo backend is not currently implemented!", call. = FALSE ) } From f83de7f916b62c7871a79d64f0c507008d96aece Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 7 Jul 2026 12:49:51 +0100 Subject: [PATCH 04/81] Add placeholders for S3 generic method for *.ArmadilloCredentials class --- R/audit.R | 2 +- R/check_permissions.R | 11 +++++++++++ R/dsROCrate.R | 9 +++++++++ R/report.R | 9 +++++++++ R/safe_data.R | 9 +++++++++ R/safe_output.R | 9 +++++++++ R/safe_people.R | 9 +++++++++ R/safe_setting.R | 9 +++++++++ 8 files changed, 66 insertions(+), 1 deletion(-) diff --git a/R/audit.R b/R/audit.R index aee6154..fa5f78d 100644 --- a/R/audit.R +++ b/R/audit.R @@ -51,7 +51,7 @@ audit <- function(x, ...) { #' @export audit.ArmadilloCredentials <- function(x, ..., intent = NULL) { stop( - "The audit for the Armadillo backend is not currently implemented!", + "The `audit()` for the Armadillo backend is not currently implemented!", call. = FALSE ) } diff --git a/R/check_permissions.R b/R/check_permissions.R index a3eb91b..8769ac0 100644 --- a/R/check_permissions.R +++ b/R/check_permissions.R @@ -33,6 +33,17 @@ check_permissions.default <- function(x, ...) { ) } +#' @export +check_permissions.ArmadilloCredentials <- function(x, ...) { + stop( + paste0( + "`check_permissions()` for the Armadillo backend is ", + "not currently implemented!" + ), + call. = FALSE + ) +} + #' @export check_permissions.opal <- function(x, ...) { is_admin <- FALSE diff --git a/R/dsROCrate.R b/R/dsROCrate.R index c8bcc33..5f98298 100644 --- a/R/dsROCrate.R +++ b/R/dsROCrate.R @@ -41,6 +41,15 @@ init <- function(x, ...) { UseMethod("init") } +#' @rdname init +#' @export +init.ArmadilloCredentials <- function(x, ...) { + stop( + "`init()` for the Armadillo backend is not currently implemented!", + call. = FALSE + ) +} + #' @rdname init #' @export init.opal <- function( diff --git a/R/report.R b/R/report.R index 6f3dfda..8e9df6a 100644 --- a/R/report.R +++ b/R/report.R @@ -11,6 +11,15 @@ report <- function(x, ...) { UseMethod("report") } +#' @rdname report +#' @export +report.ArmadilloCredentials <- function(x, ...) { + stop( + "The `report()` for the Armadillo backend is not currently implemented!", + call. = FALSE + ) +} + #' @rdname report #' @export report.character <- function( diff --git a/R/safe_data.R b/R/safe_data.R index 738f02a..9f3747d 100644 --- a/R/safe_data.R +++ b/R/safe_data.R @@ -48,6 +48,15 @@ safe_data.default <- function(x, ...) { ) } +#' @rdname safe_data +#' @export +safe_data.ArmadilloCredentials <- function(x, ...) { + stop( + "`safe_data()` for the Armadillo backend is not currently implemented!", + call. = FALSE + ) +} + #' @rdname safe_data #' @export safe_data.character <- function( diff --git a/R/safe_output.R b/R/safe_output.R index 112f6bf..e6aebb4 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -41,6 +41,15 @@ safe_output.default <- function(x, ...) { ) } +#' @rdname safe_output +#' @export +safe_output.ArmadilloCredentials <- function(x, ...) { + stop( + "`safe_output()` for the Armadillo backend is not currently implemented!", + call. = FALSE + ) +} + #' @rdname safe_output #' @export safe_output.character <- function( diff --git a/R/safe_people.R b/R/safe_people.R index 6203557..d34d66d 100644 --- a/R/safe_people.R +++ b/R/safe_people.R @@ -38,6 +38,15 @@ safe_people.default <- function(x, ...) { ) } +#' @rdname safe_people +#' @export +safe_people.ArmadilloCredentials <- function(x, ...) { + stop( + "`safe_people()` for the Armadillo backend is not currently implemented!", + call. = FALSE + ) +} + #' @rdname safe_people #' @export safe_people.character <- function( diff --git a/R/safe_setting.R b/R/safe_setting.R index b729044..64432e8 100644 --- a/R/safe_setting.R +++ b/R/safe_setting.R @@ -43,6 +43,15 @@ safe_setting.default <- function(x, ...) { ) } +#' @rdname safe_setting +#' @export +safe_setting.ArmadilloCredentials <- function(x, ...) { + stop( + "`safe_setting()` for the Armadillo backend is not currently implemented!", + call. = FALSE + ) +} + #' @rdname safe_setting #' @export safe_setting.character <- function( From ca1e9cc6415958f04cfc13717144dad43fcfa2e5 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 7 Jul 2026 12:51:30 +0100 Subject: [PATCH 05/81] New build --- NAMESPACE | 7 +++++++ man/init.Rd | 3 +++ man/report.Rd | 3 +++ man/safe_data.Rd | 3 +++ man/safe_output.Rd | 3 +++ man/safe_people.Rd | 3 +++ man/safe_setting.Rd | 3 +++ 7 files changed, 25 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index adeeb38..f16cc8e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ S3method(audit,opal) S3method(audit,rocrate) S3method(audit_engine,cr8tor) S3method(audit_engine,opal) +S3method(check_permissions,ArmadilloCredentials) S3method(check_permissions,default) S3method(check_permissions,opal) S3method(extract_safe_data,opal) @@ -30,6 +31,7 @@ S3method(flatten_safe_project,default) S3method(flatten_safe_project,rocrate) S3method(flatten_safe_setting,default) S3method(flatten_safe_setting,rocrate) +S3method(init,ArmadilloCredentials) S3method(init,opal) S3method(init,rocrate) S3method(parse_user_profiles,ArmadilloCredentials) @@ -37,18 +39,22 @@ S3method(parse_user_profiles,opal) S3method(print,cr8tor_bundle) S3method(project_exists,ArmadilloCredentials) S3method(project_exists,opal) +S3method(report,ArmadilloCredentials) S3method(report,character) S3method(report,default) S3method(report,list) S3method(report,rocrate) +S3method(safe_data,ArmadilloCredentials) S3method(safe_data,character) S3method(safe_data,default) S3method(safe_data,opal) S3method(safe_data,rocrate) +S3method(safe_output,ArmadilloCredentials) S3method(safe_output,character) S3method(safe_output,default) S3method(safe_output,opal) S3method(safe_output,rocrate) +S3method(safe_people,ArmadilloCredentials) S3method(safe_people,character) S3method(safe_people,default) S3method(safe_people,opal) @@ -58,6 +64,7 @@ S3method(safe_project,character) S3method(safe_project,default) S3method(safe_project,opal) S3method(safe_project,rocrate) +S3method(safe_setting,ArmadilloCredentials) S3method(safe_setting,character) S3method(safe_setting,cr8tor) S3method(safe_setting,default) diff --git a/man/init.Rd b/man/init.Rd index 646685f..867e2ed 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -2,12 +2,15 @@ % Please edit documentation in R/dsROCrate.R \name{init} \alias{init} +\alias{init.ArmadilloCredentials} \alias{init.opal} \alias{init.rocrate} \title{Initialise a Five Safes RO-Crate} \usage{ init(x, ...) +\method{init}{ArmadilloCredentials}(x, ...) + \method{init}{opal}( x, ..., diff --git a/man/report.Rd b/man/report.Rd index fcfa194..cbb5c08 100644 --- a/man/report.Rd +++ b/man/report.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/report.R \name{report} \alias{report} +\alias{report.ArmadilloCredentials} \alias{report.character} \alias{report.default} \alias{report.list} @@ -10,6 +11,8 @@ \usage{ report(x, ...) +\method{report}{ArmadilloCredentials}(x, ...) + \method{report}{character}( x, ..., diff --git a/man/safe_data.Rd b/man/safe_data.Rd index b35ab00..a27c1e0 100644 --- a/man/safe_data.Rd +++ b/man/safe_data.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/safe_data.R \name{safe_data} \alias{safe_data} +\alias{safe_data.ArmadilloCredentials} \alias{safe_data.character} \alias{safe_data.opal} \alias{safe_data.rocrate} @@ -15,6 +16,8 @@ \usage{ safe_data(x, ...) +\method{safe_data}{ArmadilloCredentials}(x, ...) + \method{safe_data}{character}( x, ..., diff --git a/man/safe_output.Rd b/man/safe_output.Rd index 91632fb..1d21833 100644 --- a/man/safe_output.Rd +++ b/man/safe_output.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/safe_output.R \name{safe_output} \alias{safe_output} +\alias{safe_output.ArmadilloCredentials} \alias{safe_output.character} \alias{safe_output.opal} \alias{safe_output.rocrate} @@ -15,6 +16,8 @@ \usage{ safe_output(x, ...) +\method{safe_output}{ArmadilloCredentials}(x, ...) + \method{safe_output}{character}( x, ..., diff --git a/man/safe_people.Rd b/man/safe_people.Rd index 651fb83..e7fbeb2 100644 --- a/man/safe_people.Rd +++ b/man/safe_people.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/safe_people.R \name{safe_people} \alias{safe_people} +\alias{safe_people.ArmadilloCredentials} \alias{safe_people.character} \alias{safe_people.opal} \alias{safe_people.rocrate} @@ -15,6 +16,8 @@ \usage{ safe_people(x, ...) +\method{safe_people}{ArmadilloCredentials}(x, ...) + \method{safe_people}{character}( x, ..., diff --git a/man/safe_setting.Rd b/man/safe_setting.Rd index 478d227..a421416 100644 --- a/man/safe_setting.Rd +++ b/man/safe_setting.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/safe_setting.R \name{safe_setting} \alias{safe_setting} +\alias{safe_setting.ArmadilloCredentials} \alias{safe_setting.character} \alias{safe_setting.cr8tor} \alias{safe_setting.opal} @@ -16,6 +17,8 @@ \usage{ safe_setting(x, ...) +\method{safe_setting}{ArmadilloCredentials}(x, ...) + \method{safe_setting}{character}( x, ..., From 0c57f6f07f2c7b70241653adeb331a23d156d8c9 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 7 Jul 2026 16:30:09 +0100 Subject: [PATCH 06/81] Add documentation to internal functions, for future developments --- R/utils-audit.R | 25 +++++++++++++++++++++++ R/utils-cr8tor.R | 52 +++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 76 insertions(+), 1 deletion(-) diff --git a/R/utils-audit.R b/R/utils-audit.R index 5be4ee8..8d21fbc 100644 --- a/R/utils-audit.R +++ b/R/utils-audit.R @@ -1,3 +1,19 @@ +#' Audit intent of study +#' +#' This internal helper is used to audit and object containing details about the +#' 'intent' of a study. Details include server configuration, user credentials, +#' project and associated assets (e.g., tables and resources). +#' +#' @param excluded_args Vector with names of args to be excluded from the main +#' audit call. +#' @param ... Additional args to be used in the audit process. +#' +#' @inheritParams audit intent +#' +#' @returns List with two audit objects, one for the intent and one for the main +#' @keywords internal +#' +#' @noRd audit_intent <- function(intent, excluded_args = c("project", "user"), ...) { # if `intent` is NOT NULL, audit this object intent_audit <- if (!is.null(intent)) { @@ -29,6 +45,15 @@ audit_intent <- function(intent, excluded_args = c("project", "user"), ...) { list(intent_audit = intent_audit, main_audit_args = main_audit_args) } +#' Excluded arguments from a list +#' +#' @param ... List with arguments. +#' @param excluded Vector with names of args to be excluded from the input list. +#' +#' @returns List with arguments after filtering the values in `excluded`. +#' @keywords internal +#' +#' @noRd exclude_args <- function(..., excluded) { # capture additional args args <- list(...) diff --git a/R/utils-cr8tor.R b/R/utils-cr8tor.R index 028cc6f..1ff9c71 100644 --- a/R/utils-cr8tor.R +++ b/R/utils-cr8tor.R @@ -189,6 +189,13 @@ add_permission_entities_cr8tor <- function(rc, perm_expanded_tbl) { rc } +#' Add Safe Setting entities +#' +#' @param rc RO-Crate object, see [rocrateR::rocrate]. +#' @param tbl Tibble with settings details. +#' +#' @return Updated RO-Crate +#' @noRd add_safe_setting_entities_cr8tor <- function(rc, tbl) { for (i in seq_len(nrow(tbl))) { nm <- names(tbl)[i] @@ -207,6 +214,13 @@ add_safe_setting_entities_cr8tor <- function(rc, tbl) { rc } +#' Add Safe Output entities +#' +#' @param rc RO-Crate object, see [rocrateR::rocrate]. +#' @param tbl Tibble with settings details. +#' +#' @return Updated RO-Crate +#' @noRd add_safe_output_entities_cr8tor <- function(rc, tbl) { rc |> rocrateR::add_entity( @@ -292,7 +306,6 @@ as_rocrate_audit <- function(audit) { rc } - #' Keep strongest permission per user-asset pair #' #' @param perm_tbl Tibble with username, asset, permission. @@ -519,6 +532,11 @@ extract_safe_people_cr8tor <- function(bundle) { list(users = users, n_users = nrow(users)) } +#' Extract user's groups +#' +#' @param bundle cr8tor_bundle +#' @return tibble(username, group) +#' @noRd extract_user_groups_cr8tor <- function(bundle) { user_docs <- bundle$resources[ grepl("user-.*\\.ya?ml$", names(bundle$resources)) @@ -543,6 +561,11 @@ extract_user_groups_cr8tor <- function(bundle) { purrr::list_c() } +#' Extract user's projects +#' +#' @param bundle cr8tor_bundle +#' @return tibble(username, project) +#' @noRd extract_user_projects_cr8tor <- function(bundle) { # local bindings description <- group_id <- NULL @@ -581,6 +604,11 @@ extract_user_projects_cr8tor <- function(bundle) { dplyr::distinct() } +#' Extract groups +#' +#' @param bundle cr8tor_bundle +#' @return tibble(group_id, description, project) +#' @noRd extract_groups_cr8tor <- function(bundle) { grp_docs <- bundle$resources[ grepl("group-.*\\.ya?ml$", names(bundle$resources)) @@ -651,6 +679,11 @@ extract_permissions_cr8tor <- function(bundle) { purrr::list_c() } +#' Extract projects +#' +#' @param bundle cr8tor_bundle +#' @return tibble(project, description) +#' @noRd extract_projects_cr8tor <- function(bundle) { prj_docs <- bundle$resources[ grepl("project-.*\\.ya?ml$", names(bundle$resources)) @@ -733,6 +766,14 @@ find_bagit_root <- function(path) { return(NULL) } +#' Link people entities to the RO-Crate root +#' +#' @param rc RO-Crate object, see [rocrateR::rocrate]. +#' @param usernames Vector of strings with usernames. +#' +#' @returns Updated RO-Crate +#' @keywords internal +#' @noRd link_people_to_root <- function(rc, usernames) { authors <- lapply(usernames, \(u) { list(`@id` = id_hash("#person:", u)) @@ -804,6 +845,15 @@ load_cr8tor_bundle <- function(x, ...) { ) } +#' Map project name to ID +#' +#' @param project String with project name. +#' @param proj_tbl Tibble with projects' details. +#' +#' @returns Project ID if one is matched to the given `project` +#' @keywords internal +#' +#' @noRd map_project_name_to_id <- function(project, proj_tbl) { idx <- which(proj_tbl$description == project) if (length(idx) == 0) { From 15a38c4d9f969659ef8447d8cd630922a1421459 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 7 Jul 2026 16:48:03 +0100 Subject: [PATCH 07/81] Restructure internal methods --- R/utils-connection.R | 42 +++++++++++++++++++----------------------- 1 file changed, 19 insertions(+), 23 deletions(-) diff --git a/R/utils-connection.R b/R/utils-connection.R index ea4a579..5671101 100644 --- a/R/utils-connection.R +++ b/R/utils-connection.R @@ -15,7 +15,11 @@ parse_user_profiles <- function(x, ...) { UseMethod("parse_user_profiles") } -# S3 methods ---- +#' @export +parse_user_profiles.ArmadilloCredentials <- function(x, ..., user) { + message("PLACEHOLDER!") +} + #' @export #' @family Opal parse_user_profiles.opal <- function(x, ..., user) { @@ -45,12 +49,6 @@ parse_user_profiles.opal <- function(x, ..., user) { return(user_prof_tbl) } -# S4 methods ---- -#' @export -parse_user_profiles.ArmadilloCredentials <- function(x, ..., user) { - message("PLACEHOLDER!") -} - #' Verify if project exists #' #' Wrapper for the [opalr::opal.project_exists()] and @@ -69,22 +67,6 @@ project_exists <- function(x, ...) { UseMethod("project_exists") } -# S3 methods ---- -#' @export -#' @family Opal -project_exists.opal <- function(x, ..., project) { - if (!opalr::opal.project_exists(x, project)) { - stop( - sprintf( - "The `project = '%s'` was not found in the given Opal connection!", - project - ), - call. = FALSE - ) - } -} - -# S4 methods ---- #' @export #' @family Armadillo project_exists.ArmadilloCredentials <- @@ -104,6 +86,20 @@ project_exists.ArmadilloCredentials <- } } +#' @export +#' @family Opal +project_exists.opal <- function(x, ..., project) { + if (!opalr::opal.project_exists(x, project)) { + stop( + sprintf( + "The `project = '%s'` was not found in the given Opal connection!", + project + ), + call. = FALSE + ) + } +} + #' Validate backend #' #' Validate backend: including connection status, backend version and check the From 39002b8cfab7402896e56abff066ac389988d719 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 8 Jul 2026 11:03:19 +0100 Subject: [PATCH 08/81] Add new arg verbose to notify users about system readiness for auditing --- R/check_permissions.R | 7 ++++++- man/check_permissions.Rd | 3 +++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/R/check_permissions.R b/R/check_permissions.R index 8769ac0..857c543 100644 --- a/R/check_permissions.R +++ b/R/check_permissions.R @@ -7,6 +7,8 @@ #' #' @param x A backend connection object. #' @param ... Additional arguments passed to methods. +#' @param verbose Boolean value used to indicate if a success message should be +#' displayed (default: FALSE) #' #' @returns #' Returns `TRUE` invisibly if the connection has sufficient permissions. @@ -45,7 +47,7 @@ check_permissions.ArmadilloCredentials <- function(x, ...) { } #' @export -check_permissions.opal <- function(x, ...) { +check_permissions.opal <- function(x, ..., verbose = FALSE) { is_admin <- FALSE is_audit <- FALSE @@ -60,6 +62,9 @@ check_permissions.opal <- function(x, ...) { ) if (isTRUE(is_admin) || isTRUE(is_audit)) { + if (verbose) { + message("You are ready to audit this system!") + } return(invisible(TRUE)) } diff --git a/man/check_permissions.Rd b/man/check_permissions.Rd index 52076d7..26feca5 100644 --- a/man/check_permissions.Rd +++ b/man/check_permissions.Rd @@ -10,6 +10,9 @@ check_permissions(x, ...) \item{x}{A backend connection object.} \item{...}{Additional arguments passed to methods.} + +\item{verbose}{Boolean value used to indicate if a success message should be +displayed (default: FALSE)} } \value{ Returns \code{TRUE} invisibly if the connection has sufficient permissions. From ebc18e05da6cb0bcbed2c8d9af7a1199a63e77ac Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 8 Jul 2026 13:42:38 +0100 Subject: [PATCH 09/81] Update internal documentation to include S3 generic methods in the documentation, except those for the default class --- R/check_permissions.R | 3 ++ R/report.R | 2 +- R/safe_data.R | 1 + R/safe_output.R | 1 + R/safe_people.R | 1 + R/safe_project.R | 74 +++++++++++++++---------------------------- R/safe_setting.R | 1 + 7 files changed, 34 insertions(+), 49 deletions(-) diff --git a/R/check_permissions.R b/R/check_permissions.R index 857c543..686cf6a 100644 --- a/R/check_permissions.R +++ b/R/check_permissions.R @@ -21,6 +21,7 @@ check_permissions <- function(x, ...) { UseMethod("check_permissions") } +# @rdname check_permissions #' @export check_permissions.default <- function(x, ...) { stop( @@ -35,6 +36,7 @@ check_permissions.default <- function(x, ...) { ) } +#' @rdname check_permissions #' @export check_permissions.ArmadilloCredentials <- function(x, ...) { stop( @@ -46,6 +48,7 @@ check_permissions.ArmadilloCredentials <- function(x, ...) { ) } +#' @rdname check_permissions #' @export check_permissions.opal <- function(x, ..., verbose = FALSE) { is_admin <- FALSE diff --git a/R/report.R b/R/report.R index 8e9df6a..25d7ea6 100644 --- a/R/report.R +++ b/R/report.R @@ -54,7 +54,7 @@ report.character <- function( ) } -#' @rdname report +# @rdname report #' @export report.default <- function(x, ...) { stop( diff --git a/R/safe_data.R b/R/safe_data.R index 9f3747d..18c2f06 100644 --- a/R/safe_data.R +++ b/R/safe_data.R @@ -40,6 +40,7 @@ safe_data <- function(x, ...) { UseMethod("safe_data") } +# @rdname safe_data #' @export safe_data.default <- function(x, ...) { stop( diff --git a/R/safe_output.R b/R/safe_output.R index e6aebb4..cb84cc1 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -33,6 +33,7 @@ safe_output <- function(x, ...) { UseMethod("safe_output") } +# @rdname safe_output #' @export safe_output.default <- function(x, ...) { stop( diff --git a/R/safe_people.R b/R/safe_people.R index d34d66d..c212541 100644 --- a/R/safe_people.R +++ b/R/safe_people.R @@ -30,6 +30,7 @@ safe_people <- function(x, ...) { UseMethod("safe_people") } +# @rdname safe_people #' @export safe_people.default <- function(x, ...) { stop( diff --git a/R/safe_project.R b/R/safe_project.R index 352ab1e..15fd340 100644 --- a/R/safe_project.R +++ b/R/safe_project.R @@ -22,28 +22,11 @@ #' \item Research Data Scotland, 2025. "What is the Five Safes framework?". #' #' } -#' -#' @aliases safe_project,armadillo-method -#' @usage -#' \S4method{safe_project}{armadillo}( -#' x, -#' ..., -#' profile = "default", -#' project = NULL, -#' rocrate = rocrateR::rocrate_5s(), -#' asset_id_suffix = "#asset:", -#' project_id_suffix = "#project:", -#' path = NULL, -#' resources = NULL, -#' tables = NULL, -#' user = NULL -#' ) safe_project <- function(x, ...) { UseMethod("safe_project") } -# S3 methods ---- -#' @method safe_project default +# @rdname safe_project #' @export safe_project.default <- function(x, ...) { stop( @@ -52,7 +35,31 @@ safe_project.default <- function(x, ...) { ) } -#' @method safe_project character +#' @rdname safe_project +#' @export +safe_project.ArmadilloCredentials <- function( + x, + ..., + profile = "default", + project = NULL, + rocrate = rocrateR::rocrate_5s(), + asset_id_suffix = "#asset:", + project_id_suffix = "#project:", + path = NULL, + resources = NULL, + tables = NULL, + user = NULL +) { + # check if the given `project` exists + project_exists(x, project = project) + + # retrieve details associated to `project` + project_details_tbl <- MolgenisArmadillo::armadillo.get_projects_info() |> + purrr::map(\(x) tibble::tibble(name = x$name, users = unlist(x$users))) |> + purrr::list_c() + project_details_tbl +} + #' @rdname safe_project #' @export safe_project.character <- function( @@ -86,7 +93,6 @@ safe_project.character <- function( ) } -#' @method safe_project opal #' @rdname safe_project #' @export safe_project.opal <- function( @@ -209,7 +215,6 @@ safe_project.opal <- function( return(rocrate) } -#' @method safe_project rocrate #' @rdname safe_project #' @export safe_project.rocrate <- function( @@ -244,30 +249,3 @@ safe_project.rocrate <- function( user = user ) } - -# S4 methods ---- -#' @method safe_project ArmadilloCredentials -#' @rdname safe_project -#' @export -safe_project.ArmadilloCredentials <- function( - x, - ..., - profile = "default", - project = NULL, - rocrate = rocrateR::rocrate_5s(), - asset_id_suffix = "#asset:", - project_id_suffix = "#project:", - path = NULL, - resources = NULL, - tables = NULL, - user = NULL -) { - # check if the given `project` exists - project_exists(x, project = project) - - # retrieve details associated to `project` - project_details_tbl <- MolgenisArmadillo::armadillo.get_projects_info() |> - purrr::map(\(x) tibble::tibble(name = x$name, users = unlist(x$users))) |> - purrr::list_c() - project_details_tbl -} diff --git a/R/safe_setting.R b/R/safe_setting.R index 64432e8..0c3ec52 100644 --- a/R/safe_setting.R +++ b/R/safe_setting.R @@ -35,6 +35,7 @@ safe_setting <- function(x, ...) { UseMethod("safe_setting") } +# @rdname safe_setting #' @export safe_setting.default <- function(x, ...) { stop( From 330a7af552bddccf19279fcf1729dd74b1eebbfa Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 8 Jul 2026 13:42:47 +0100 Subject: [PATCH 10/81] New build --- man/check_permissions.Rd | 6 ++++++ man/report.Rd | 3 --- man/safe_project.Rd | 35 +++++++++++------------------------ 3 files changed, 17 insertions(+), 27 deletions(-) diff --git a/man/check_permissions.Rd b/man/check_permissions.Rd index 26feca5..75bea70 100644 --- a/man/check_permissions.Rd +++ b/man/check_permissions.Rd @@ -2,9 +2,15 @@ % Please edit documentation in R/check_permissions.R \name{check_permissions} \alias{check_permissions} +\alias{check_permissions.ArmadilloCredentials} +\alias{check_permissions.opal} \title{Check backend connection permissions} \usage{ check_permissions(x, ...) + +\method{check_permissions}{ArmadilloCredentials}(x, ...) + +\method{check_permissions}{opal}(x, ..., verbose = FALSE) } \arguments{ \item{x}{A backend connection object.} diff --git a/man/report.Rd b/man/report.Rd index cbb5c08..935952a 100644 --- a/man/report.Rd +++ b/man/report.Rd @@ -4,7 +4,6 @@ \alias{report} \alias{report.ArmadilloCredentials} \alias{report.character} -\alias{report.default} \alias{report.list} \alias{report.rocrate} \title{Create an RO-Crate report} @@ -28,8 +27,6 @@ report(x, ...) max_line_length = 200 ) -\method{report}{default}(x, ...) - \method{report}{list}( x, ..., diff --git a/man/safe_project.Rd b/man/safe_project.Rd index 3321e50..1dd28b8 100644 --- a/man/safe_project.Rd +++ b/man/safe_project.Rd @@ -2,11 +2,10 @@ % Please edit documentation in R/safe_project.R \name{safe_project} \alias{safe_project} -\alias{safe_project,armadillo-method} +\alias{safe_project.ArmadilloCredentials} \alias{safe_project.character} \alias{safe_project.opal} \alias{safe_project.rocrate} -\alias{safe_project.ArmadilloCredentials} \title{Safe Project details} \source{ \itemize{ @@ -15,7 +14,9 @@ } } \usage{ -\S4method{safe_project}{armadillo}( +safe_project(x, ...) + +\method{safe_project}{ArmadilloCredentials}( x, ..., profile = "default", @@ -70,20 +71,6 @@ tables = attr(x, "tables"), user = attr(x, "user") ) - -\method{safe_project}{ArmadilloCredentials}( - x, - ..., - profile = "default", - project = NULL, - rocrate = rocrateR::rocrate_5s(), - asset_id_suffix = "#asset:", - project_id_suffix = "#project:", - path = NULL, - resources = NULL, - tables = NULL, - user = NULL -) } \arguments{ \item{x}{This can be a connection to a 'DataSHIELD' server (e.g., object with @@ -98,16 +85,16 @@ RO-Crate.} \item{project}{String with the name of the \link[=safe_project]{Safe Project}.} +\item{rocrate}{RO-Crate object. Optional, if \code{x} is either an RO-Crate +object or a path to a valid RO-Crate. If so, then \code{connection} is +required (default: \code{rocrateR::rocrate_5s()}).} + \item{asset_id_suffix}{String with ID suffix for the tables/datasets entities in the RO-Crate (default: \code{"#asset:"}).} \item{project_id_suffix}{String with ID suffix for the project entities in the RO-Crate (default: \code{"#project:"}).} -\item{connection}{Connection object for the 'DataSHIELD' server where the -values will be extracted from (e.g., OBiBa's Opal). Optional, if \code{x} is -set to a connection object. If so, then \code{rocrate} is required.} - \item{path}{String with path pointing to the root of the RO-Crate. This will be used to store log files. If not provided, logs will be stored within the RO-Crate returned by this function.} @@ -124,9 +111,9 @@ associated to \code{project} will be included in the RO-Crate.} the Safe People, it must include \verb{@id} and \code{name} entries. Alternatively, this can be a string with the \code{name} of the current user.} -\item{rocrate}{RO-Crate object. Optional, if \code{x} is either an RO-Crate -object or a path to a valid RO-Crate. If so, then \code{connection} is -required (default: \code{rocrateR::rocrate_5s()}).} +\item{connection}{Connection object for the 'DataSHIELD' server where the +values will be extracted from (e.g., OBiBa's Opal). Optional, if \code{x} is +set to a connection object. If so, then \code{rocrate} is required.} } \value{ Updated RO-Crate object with Safe Project information. From 5385d7a69928c653cf7c93395bef4fe6c1bef1d0 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Thu, 9 Jul 2026 14:48:38 +0100 Subject: [PATCH 11/81] Add new module to capture all the calls to functions from opalr in a single place --- R/backend-generic.R | 63 ++++++++++++++++++++++++++++++++++++++ R/backend-opal.R | 74 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 137 insertions(+) create mode 100644 R/backend-generic.R create mode 100644 R/backend-opal.R diff --git a/R/backend-generic.R b/R/backend-generic.R new file mode 100644 index 0000000..1ed7b97 --- /dev/null +++ b/R/backend-generic.R @@ -0,0 +1,63 @@ +backend_groups <- function(x, ...) { + UseMethod("backend_groups") +} + +backend_logs <- function(x, ...) { + UseMethod("backend_logs") +} + +backend_options <- function(x, ...) { + UseMethod("backend_options") +} + +backend_packages <- function(x, ...) { + UseMethod("backend_packages") +} + +backend_profile_exists <- function(x, ...) { + UseMethod("backend_profile_exists") +} + +backend_project <- function(x, ...) { + UseMethod("backend_project") +} + +backend_project_exists <- function(x, ...) { + UseMethod("backend_project_exists") +} + +backend_project_perms <- function(x, ...) { + UseMethod("backend_project_perms") +} + +backend_projects <- function(x, ...) { + UseMethod("backend_projects") +} + +backend_resource_perms <- function(x, ...) { + UseMethod("backend_resource_perms") +} + +backend_resources <- function(x, ...) { + UseMethod("backend_resources") +} + +backend_sys_perms <- function(x, ...) { + UseMethod("backend_sys_perms") +} + +backend_table_perms <- function(x, ...) { + UseMethod("backend_table_perms") +} + +backend_tables <- function(x, ...) { + UseMethod("backend_tables") +} + +backend_user_exists <- function(x, ...) { + UseMethod("backend_user_exists") +} + +backend_users <- function(x, ...) { + UseMethod("backend_users") +} diff --git a/R/backend-opal.R b/R/backend-opal.R new file mode 100644 index 0000000..51921cc --- /dev/null +++ b/R/backend-opal.R @@ -0,0 +1,74 @@ +#' @export +backend_logs.opal <- function(x, ...) { + opalr::dsadmin.log(x, ...) +} + +#' @export +backend_options.opal <- function(x, ...) { + opalr::dsadmin.get_options(x, ...) +} + +#' @export +backend_packages.opal <- function(x, ...) { + opalr::dsadmin.package_descriptions(x, ...) +} + +#' @export +backend_profile_exists.opal <- function(x, ...) { + opalr::dsadmin.profile_exists(x, ...) +} + +#' @export +backend_project.opal <- function(x, ...) { + opalr::opal.project(x, ...) +} + +#' @export +backend_project_exists.opal <- function(x, ...) { + opalr::opal.project_exists(x, ...) +} + +#' @export +backend_project_perms.opal <- function(x, ...) { + opalr::opal.project_perm(x, ...) +} + +#' @export +backend_projects.opal <- function(x, ...) { + opalr::opal.projects(x, ...) +} + +#' @export +backend_resource_perms.opal <- function(x, ...) { + opalr::opal.resource_perm(x, ...) +} + +#' @export +backend_resources.opal <- function(x, ...) { + opalr::opal.resources(x, ...) +} + +#' @export +backend_sys_perms.opal <- function(x, ...) { + opalr::oadmin.system_perm(x, ...) +} + +#' @export +backend_table_perms.opal <- function(x, ...) { + opalr::opal.table_perm(x, ...) +} + +#' @export +backend_tables.opal <- function(x, ...) { + opalr::opal.tables(x, ...) +} + +#' @export +backend_user_exists.opal <- function(x, ...) { + opalr::oadmin.user_exists(x, ...) +} + +#' @export +backend_users.opal <- function(x, ...) { + opalr::oadmin.user_profiles(x, ...) +} From 92e61f0bb70cf767685814ddfcc6ff9723cadf3c Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Thu, 9 Jul 2026 15:01:32 +0100 Subject: [PATCH 12/81] Update calls to opalr functions with backend_* S3 generics --- R/audit_engine.R | 12 +++++------ R/dsROCrate.R | 2 +- R/safe_data.R | 2 +- R/safe_output.R | 2 +- R/safe_project.R | 4 ++-- R/safe_setting.R | 6 +++--- R/utils-connection.R | 7 ++----- R/utils-opal.R | 28 ++++++++++++------------- R/utils-safe_data.R | 2 +- R/utils-safe_people.R | 2 +- R/utils-safe_project.R | 2 +- tests/testthat/test-utils-safe_people.R | 2 +- 12 files changed, 34 insertions(+), 37 deletions(-) diff --git a/R/audit_engine.R b/R/audit_engine.R index f554ffd..7aedf17 100644 --- a/R/audit_engine.R +++ b/R/audit_engine.R @@ -3,9 +3,9 @@ #' Internal function to create audits for various back-ends. #' #' @param x This can be a connection to a 'DataSHIELD' server (e.g., object with -#' the `opal` class, see [opalr::opal.login()]). Alternatively, a governance -#' archive file, representing the intent of a project and associated -#' governance details. +#' the `opal` or `ArmadilloCredentials` classes). Alternatively, a +#' governance archive file, representing the intent of a project and +#' associated governance details. #' @param ... Other optional arguments, see full documentation for details. #' @param project String with project name(s) from which to extra Safe Project #' details. @@ -71,7 +71,7 @@ audit_engine.opal <- function( } # extract list with all projects to verify `project` contains a valid value - ds <- opalr::opal.projects(x) + ds <- backend_projects(x) server_prjs <- ds[, "name"] idx <- project %in% server_prjs if (!all(idx)) { @@ -86,7 +86,7 @@ audit_engine.opal <- function( # Safe People ---- # get users' details - safe_people_tbl <- opalr::oadmin.user_profiles(x, df = FALSE) |> + safe_people_tbl <- backend_users(x, df = FALSE) |> dplyr::bind_rows() |> dplyr::rename(name = principal) |> # exclude system administrators from the report @@ -95,7 +95,7 @@ audit_engine.opal <- function( # if any users were found, then verify if they are admin/auditors and exclude if (nrow(safe_people_tbl)) { # extract system permissions - sys_perms_tbl <- opalr::oadmin.system_perm(x) + sys_perms_tbl <- backend_sys_perms(x) safe_people_tbl <- tryCatch( { safe_people_tbl |> diff --git a/R/dsROCrate.R b/R/dsROCrate.R index 5f98298..cac0320 100644 --- a/R/dsROCrate.R +++ b/R/dsROCrate.R @@ -3,7 +3,7 @@ #' Creates a new RO-Crate configured for Five Safes auditing. #' #' @param x This can be a connection to a 'DataSHIELD' server (e.g., object with -#' the `opal` class, see [opalr::opal.login()]), an RO-Crate +#' the `opal` or `ArmadilloCredentials` classes), an RO-Crate #' ([rocrate][rocrateR::rocrate()] class) or a string with the path to an #' RO-Crate. #' @param ... Other optional arguments. See the full documentation, diff --git a/R/safe_data.R b/R/safe_data.R index 18c2f06..00f185a 100644 --- a/R/safe_data.R +++ b/R/safe_data.R @@ -15,7 +15,7 @@ #' #' #' @param x This can be a connection to a 'DataSHIELD' server (e.g., object with -#' the `opal` class, see [opalr::opal.login()]), an RO-Crate +#' the `opal` or `ArmadilloCredentials` classes), an RO-Crate #' ([rocrate][rocrateR::rocrate()] class) or a string with the path to an #' RO-Crate. #' @param ... Other optional arguments. See the full documentation, diff --git a/R/safe_output.R b/R/safe_output.R index cb84cc1..bd5f209 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -211,7 +211,7 @@ safe_output.opal <- function( } # parse logs - userlogs_tbl <- opalr::dsadmin.log(x) |> + userlogs_tbl <- backend_logs(x) |> tibble::as_tibble() |> dplyr::mutate( `@timestamp` = as.POSIXct(`@timestamp`, format = "%Y-%m-%dT%H:%M:%S") diff --git a/R/safe_project.R b/R/safe_project.R index 15fd340..722ac69 100644 --- a/R/safe_project.R +++ b/R/safe_project.R @@ -128,7 +128,7 @@ safe_project.opal <- function( project_id <- id_hash(project_id_suffix, project) # retrieve details associated to `project` - project_details_tbl <- opalr::opal.project(x, project) + project_details_tbl <- backend_project(x, project) # filter out asset entities associated with the project based on the # value for `asset_id_suffix`. @@ -155,7 +155,7 @@ safe_project.opal <- function( rocrateR::add_entity(project_entity, overwrite = TRUE) # Opal permissions ---- - perms <- opalr::opal.project_perm(x, project) + perms <- backend_project_perms(x, project) project_users <- perms |> dplyr::filter(type == "user") |> diff --git a/R/safe_setting.R b/R/safe_setting.R index 0c3ec52..c13638c 100644 --- a/R/safe_setting.R +++ b/R/safe_setting.R @@ -164,7 +164,7 @@ safe_setting.opal <- function( validate_backend(x, ...) # validate profile ---- - if (!opalr::dsadmin.profile_exists(x, profile)) { + if (!backend_profile_exists(x, profile)) { stop( sprintf("The given profile name, `%s`, does not exist!", profile), call. = FALSE @@ -173,7 +173,7 @@ safe_setting.opal <- function( # statistical disclosure controls ---- # extract disclosure settings and create `PropertyValue` entities - disc_setting_entities <- opalr::dsadmin.get_options(x, profile = profile) |> + disc_setting_entities <- backend_options(x, profile = profile) |> tibble::as_tibble() |> purrr::pmap(function(name, value, ...) { rocrateR::entity( @@ -200,7 +200,7 @@ safe_setting.opal <- function( # computational environment ---- # extract information about R packages installed in the environment - pkg_tbl <- opalr::dsadmin.package_descriptions(x) |> + pkg_tbl <- backend_packages(x) |> tibble::as_tibble() pkg_entities <- pkg_tbl |> purrr::pmap(function(Package, Version, Description, Author, ...) { diff --git a/R/utils-connection.R b/R/utils-connection.R index 5671101..857f688 100644 --- a/R/utils-connection.R +++ b/R/utils-connection.R @@ -27,7 +27,7 @@ parse_user_profiles.opal <- function(x, ..., user) { principal <- userInfo <- NULL # get user profiles and filter by the current user - user_prof_tbl <- opalr::oadmin.user_profiles(x, df = FALSE) |> + user_prof_tbl <- backend_users(x, df = FALSE) |> dplyr::bind_rows() |> dplyr::filter(principal %in% user) # extract (if available) `userInfo` which contains additional details @@ -51,9 +51,6 @@ parse_user_profiles.opal <- function(x, ..., user) { #' Verify if project exists #' -#' Wrapper for the [opalr::opal.project_exists()] and -#' [MolgenisArmadillo::armadillo.list_projects()] functions. -#' #' @param x Connection object to backend for DataSHIELD server (e.g., Opal). #' @param ... Optional arguments, unused. #' @param project String with project name to be verified. @@ -89,7 +86,7 @@ project_exists.ArmadilloCredentials <- #' @export #' @family Opal project_exists.opal <- function(x, ..., project) { - if (!opalr::opal.project_exists(x, project)) { + if (!backend_project_exists(x, project)) { stop( sprintf( "The `project = '%s'` was not found in the given Opal connection!", diff --git a/R/utils-opal.R b/R/utils-opal.R index d049085..7d9788c 100644 --- a/R/utils-opal.R +++ b/R/utils-opal.R @@ -127,7 +127,7 @@ build_asset_entities <- function(assets_tbl, project_id, asset_id_suffix) { #' Get project's asset permissions #' -#' @param x Connection to OBiBa's Opal server (see [opalr::opal.login()]). +#' @param x Connection to DataSHIELD server (e.g., OBiBa's Opal server). #' @param project String with project name. #' @param asset_type String with type of asset, either `tables` or `resources`. #' @param name String with asset name. @@ -136,9 +136,9 @@ build_asset_entities <- function(assets_tbl, project_id, asset_id_suffix) { #' @noRd get_asset_permissions <- function(x, project, asset_type, name) { if (asset_type == "table") { - perms <- opalr::opal.table_perm(x, project, name) + perms <- backend_table_perms(x, project, name) } else { - perms <- opalr::opal.resource_perm(x, project, name) + perms <- backend_resource_perms(x, project, name) } if (is.null(perms) || length(perms$subject) == 0) { @@ -153,7 +153,7 @@ get_asset_permissions <- function(x, project, asset_type, name) { #' Get project assets. #' -#' @param x Connection to OBiBa's Opal server (see [opalr::opal.login()]). +#' @param x Connection to DataSHIELD server (e.g., OBiBa's Opal server). #' @param project String with project name. #' @param type Type of assets to extract, either `tables` or `resources`. #' @@ -166,7 +166,7 @@ get_project_assets <- function(x, project, type = c("tables", "resources")) { project_exists(x, project = project) if (type == "tables") { - prj <- opalr::opal.tables(x, project, df = FALSE) + prj <- backend_tables(x, project, df = FALSE) if (length(prj) == 0) { return(NULL) @@ -187,7 +187,7 @@ get_project_assets <- function(x, project, type = c("tables", "resources")) { meta = vector("list", length(prj)) ) } else if (type == "resources") { - res <- opalr::opal.resources(x, project, df = FALSE) + res <- backend_resources(x, project, df = FALSE) if (length(res) == 0) { return(NULL) @@ -295,10 +295,10 @@ is_opal_admin_con <- function(x) { # local binding aux <- NULL - # condition 1: admin users have access to `opalr::oadmin.user_exists` + # condition 1: admin users have access to `backend_user_exists` cond1 <- tryCatch( { - aux <- opalr::oadmin.user_exists(x, x$username) + aux <- backend_user_exists(x, x$username) TRUE }, error = function(e) { @@ -306,10 +306,10 @@ is_opal_admin_con <- function(x) { } ) - # condition 2: admin users have access to `opalr::dsadmin.profile_exists` + # condition 2: admin users have access to `backend_profile_exists` cond2 <- tryCatch( { - aux <- opalr::dsadmin.profile_exists(x, "default") + aux <- backend_profile_exists(x, "default") TRUE }, error = function(e) { @@ -338,10 +338,10 @@ is_opal_audit_con <- function(x) { # local binding aux <- NULL - # condition 1: auditor users don't have access to `opalr::oadmin.user_exists` + # condition 1: auditor users don't have access to `backend_user_exists` cond1 <- tryCatch( { - aux <- opalr::oadmin.user_exists(x, x$username) + aux <- backend_user_exists(x, x$username) FALSE }, error = function(e) { @@ -349,10 +349,10 @@ is_opal_audit_con <- function(x) { } ) - # condition 2: auditor users have access to `opalr::dsadmin.profile_exists` + # condition 2: auditor users have access to `backend_profile_exists` cond2 <- tryCatch( { - aux <- opalr::dsadmin.profile_exists(x, "default") + aux <- backend_profile_exists(x, "default") TRUE }, error = function(e) { diff --git a/R/utils-safe_data.R b/R/utils-safe_data.R index feb3cd1..34056d0 100644 --- a/R/utils-safe_data.R +++ b/R/utils-safe_data.R @@ -16,7 +16,7 @@ extract_safe_data <- function(x, ...) { #' @export extract_safe_data.opal <- function(x, ..., rocrate = rocrateR::rocrate_5s()) { # extract list with all projects - ds <- opalr::opal.projects(x) + ds <- backend_projects(x) # extract project names and ignore NAs projects <- ds$name[!is.na(ds$name) & !is.null(ds$name)] diff --git a/R/utils-safe_people.R b/R/utils-safe_people.R index b03e172..618b401 100644 --- a/R/utils-safe_people.R +++ b/R/utils-safe_people.R @@ -19,7 +19,7 @@ extract_safe_people.opal <- function(x, ..., rocrate = rocrateR::rocrate_5s()) { name <- principal <- NULL # extract all users - opal_users <- opalr::oadmin.user_profiles(x, df = FALSE) |> + opal_users <- backend_users(x, df = FALSE) |> dplyr::bind_rows() |> dplyr::rename(name = principal) |> # exclude system administrators from the report diff --git a/R/utils-safe_project.R b/R/utils-safe_project.R index 8f58a22..7ecaefc 100644 --- a/R/utils-safe_project.R +++ b/R/utils-safe_project.R @@ -21,7 +21,7 @@ extract_safe_project.opal <- function( rocrate = rocrateR::rocrate_5s() ) { # extract list with all projects - ds <- opalr::opal.projects(x) + ds <- backend_projects(x) # cycle through the data source (x) and extract project details for (i in seq_len(nrow(ds))) { diff --git a/tests/testthat/test-utils-safe_people.R b/tests/testthat/test-utils-safe_people.R index 9a304b2..5b416d6 100644 --- a/tests/testthat/test-utils-safe_people.R +++ b/tests/testthat/test-utils-safe_people.R @@ -61,7 +61,7 @@ test_that("extract_safe_people.opal iterates over all returned subject profiles" # terminate connection when done with tests withr::defer(opalr::opal.logout(opal_con)) - users_raw <- opalr::oadmin.user_profiles(opal_con, df = FALSE) + users_raw <- backend_users(opal_con, df = FALSE) users_tbl <- dplyr::bind_rows(users_raw) expect_true(nrow(users_tbl) >= 1) From 4815cd37ba41b7ada2b384bc1d91ca64d7af8c5e Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Thu, 9 Jul 2026 15:01:45 +0100 Subject: [PATCH 13/81] New build --- NAMESPACE | 15 +++++++++++++++ man/init.Rd | 2 +- man/safe_data.Rd | 2 +- man/safe_output.Rd | 2 +- man/safe_people.Rd | 2 +- man/safe_project.Rd | 2 +- man/safe_setting.Rd | 2 +- 7 files changed, 21 insertions(+), 6 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index f16cc8e..67c9e49 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,21 @@ S3method(audit,opal) S3method(audit,rocrate) S3method(audit_engine,cr8tor) S3method(audit_engine,opal) +S3method(backend_logs,opal) +S3method(backend_options,opal) +S3method(backend_packages,opal) +S3method(backend_profile_exists,opal) +S3method(backend_project,opal) +S3method(backend_project_exists,opal) +S3method(backend_project_perms,opal) +S3method(backend_projects,opal) +S3method(backend_resource_perms,opal) +S3method(backend_resources,opal) +S3method(backend_sys_perms,opal) +S3method(backend_table_perms,opal) +S3method(backend_tables,opal) +S3method(backend_user_exists,opal) +S3method(backend_users,opal) S3method(check_permissions,ArmadilloCredentials) S3method(check_permissions,default) S3method(check_permissions,opal) diff --git a/man/init.Rd b/man/init.Rd index 867e2ed..44302ec 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -37,7 +37,7 @@ init(x, ...) } \arguments{ \item{x}{This can be a connection to a 'DataSHIELD' server (e.g., object with -the \code{opal} class, see \code{\link[opalr:opal.login]{opalr::opal.login()}}), an RO-Crate +the \code{opal} or \code{ArmadilloCredentials} classes), an RO-Crate (\link[rocrateR:rocrate]{rocrate} class) or a string with the path to an RO-Crate.} diff --git a/man/safe_data.Rd b/man/safe_data.Rd index a27c1e0..018277c 100644 --- a/man/safe_data.Rd +++ b/man/safe_data.Rd @@ -63,7 +63,7 @@ safe_data(x, ...) } \arguments{ \item{x}{This can be a connection to a 'DataSHIELD' server (e.g., object with -the \code{opal} class, see \code{\link[opalr:opal.login]{opalr::opal.login()}}), an RO-Crate +the \code{opal} or \code{ArmadilloCredentials} classes), an RO-Crate (\link[rocrateR:rocrate]{rocrate} class) or a string with the path to an RO-Crate.} diff --git a/man/safe_output.Rd b/man/safe_output.Rd index 1d21833..c05404c 100644 --- a/man/safe_output.Rd +++ b/man/safe_output.Rd @@ -62,7 +62,7 @@ safe_output(x, ...) } \arguments{ \item{x}{This can be a connection to a 'DataSHIELD' server (e.g., object with -the \code{opal} class, see \code{\link[opalr:opal.login]{opalr::opal.login()}}), an RO-Crate +the \code{opal} or \code{ArmadilloCredentials} classes), an RO-Crate (\link[rocrateR:rocrate]{rocrate} class) or a string with the path to an RO-Crate.} diff --git a/man/safe_people.Rd b/man/safe_people.Rd index e7fbeb2..c1ca90f 100644 --- a/man/safe_people.Rd +++ b/man/safe_people.Rd @@ -65,7 +65,7 @@ safe_people(x, ...) } \arguments{ \item{x}{This can be a connection to a 'DataSHIELD' server (e.g., object with -the \code{opal} class, see \code{\link[opalr:opal.login]{opalr::opal.login()}}), an RO-Crate +the \code{opal} or \code{ArmadilloCredentials} classes), an RO-Crate (\link[rocrateR:rocrate]{rocrate} class) or a string with the path to an RO-Crate.} diff --git a/man/safe_project.Rd b/man/safe_project.Rd index 1dd28b8..3e17ddb 100644 --- a/man/safe_project.Rd +++ b/man/safe_project.Rd @@ -74,7 +74,7 @@ safe_project(x, ...) } \arguments{ \item{x}{This can be a connection to a 'DataSHIELD' server (e.g., object with -the \code{opal} class, see \code{\link[opalr:opal.login]{opalr::opal.login()}}), an RO-Crate +the \code{opal} or \code{ArmadilloCredentials} classes), an RO-Crate (\link[rocrateR:rocrate]{rocrate} class) or a string with the path to an RO-Crate.} diff --git a/man/safe_setting.Rd b/man/safe_setting.Rd index a421416..c9d5945 100644 --- a/man/safe_setting.Rd +++ b/man/safe_setting.Rd @@ -59,7 +59,7 @@ safe_setting(x, ...) } \arguments{ \item{x}{This can be a connection to a 'DataSHIELD' server (e.g., object with -the \code{opal} class, see \code{\link[opalr:opal.login]{opalr::opal.login()}}), an RO-Crate +the \code{opal} or \code{ArmadilloCredentials} classes), an RO-Crate (\link[rocrateR:rocrate]{rocrate} class) or a string with the path to an RO-Crate.} From faf70ccafc07c400b98bd7b3cfe37d463d3f8acc Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Thu, 9 Jul 2026 15:35:51 +0100 Subject: [PATCH 14/81] Add internal helpers --- R/dsROCrate.R | 4 ++-- R/utils-audit.R | 13 +++++++++++++ 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/R/dsROCrate.R b/R/dsROCrate.R index cac0320..1e0a278 100644 --- a/R/dsROCrate.R +++ b/R/dsROCrate.R @@ -103,5 +103,5 @@ init.rocrate <- function( ) } -# # helper functions ---- -# `%||%` <- function(a, b) if (!is.null(a) && !is.na(a) && a != "") a else b +# helper functions ---- +`%||%` <- function(a, b) if (!is.null(a) && !is.na(a) && a != "") a else b diff --git a/R/utils-audit.R b/R/utils-audit.R index 8d21fbc..cd5b637 100644 --- a/R/utils-audit.R +++ b/R/utils-audit.R @@ -61,3 +61,16 @@ exclude_args <- function(..., excluded) { # exclude args that shouldn't be passed to the next function args[!(arg_names %in% excluded)] } + +#' Wrapper for [tryCatch] +#' +#' @param expr R code to be executed inside `tryCatch`. +#' +#' @returns List with value and any resulting error. +#' @noRd +.try_load <- function(expr) { + tryCatch( + list(value = expr, error = NULL), + error = function(e) list(value = NULL, error = conditionMessage(e)) + ) +} From 88d3ca7ee29c3180ec1be0f987844e07c8e21f4f Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 10 Jul 2026 09:47:02 +0100 Subject: [PATCH 15/81] Update internal helper to include an argument for setting the value to be returned when an error is triggered --- R/utils-audit.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/utils-audit.R b/R/utils-audit.R index cd5b637..9897da6 100644 --- a/R/utils-audit.R +++ b/R/utils-audit.R @@ -65,12 +65,13 @@ exclude_args <- function(..., excluded) { #' Wrapper for [tryCatch] #' #' @param expr R code to be executed inside `tryCatch`. +#' @param error_val Value to be returned on failure. #' #' @returns List with value and any resulting error. #' @noRd -.try_load <- function(expr) { +.try_load <- function(expr, error_val = NULL) { tryCatch( list(value = expr, error = NULL), - error = function(e) list(value = NULL, error = conditionMessage(e)) + error = function(e) list(value = error_val, error = conditionMessage(e)) ) } From 155fdb2448a13d1d81b4dd4551be9f03b499975e Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 10 Jul 2026 09:47:42 +0100 Subject: [PATCH 16/81] Update code to use internal .try_load function --- R/audit.R | 24 +++++++++------ R/utils-opal.R | 79 ++++++++++++++------------------------------------ 2 files changed, 37 insertions(+), 66 deletions(-) diff --git a/R/audit.R b/R/audit.R index fa5f78d..38400ad 100644 --- a/R/audit.R +++ b/R/audit.R @@ -65,21 +65,27 @@ audit.character <- function(x, ..., intent = NULL) { } # attempt loading a `cr8tor` bundle - x_obj <- tryCatch( - load_cr8tor_bundle(x, ...), - error = function(e) NULL - ) + cr8tor_res <- .try_load(load_cr8tor_bundle(x, ...)) + x_obj <- cr8tor_res$value + # alternatively, attempt loading an RO-Crate + rocrate_res <- list(value = NULL, error = NULL) if (is.null(x_obj)) { - x_obj <- tryCatch( - rocrateR::load_rocrate(x, ...), - error = function(e) NULL - ) + rocrate_res <- .try_load(rocrateR::load_rocrate(x, ...)) + x_obj <- rocrate_res$value } if (is.null(x_obj)) { stop( - "The given path does not point to a valid `cr8tor` archive nor an `rocrate", + paste0( + "The given path does not point to a valid `cr8tor` archive nor an ", + "`rocrate`.\n\n", + " cr8tor bundle error: ", + if (is.null(cr8tor_res$error)) "(not attempted)" else cr8tor_res$error, + "\n", + " rocrate error: ", + if (is.null(rocrate_res$error)) "(not attempted)" else rocrate_res$error + ), call. = FALSE ) } diff --git a/R/utils-opal.R b/R/utils-opal.R index 7d9788c..351edfe 100644 --- a/R/utils-opal.R +++ b/R/utils-opal.R @@ -292,37 +292,18 @@ infer_table_resource_lineage <- function(assets_tbl) { #' #' @noRd is_opal_admin_con <- function(x) { - # local binding - aux <- NULL - # condition 1: admin users have access to `backend_user_exists` - cond1 <- tryCatch( - { - aux <- backend_user_exists(x, x$username) - TRUE - }, - error = function(e) { - FALSE - } - ) - + cond1 <- .try_load(backend_user_exists(x, x$username)) # condition 2: admin users have access to `backend_profile_exists` - cond2 <- tryCatch( - { - aux <- backend_profile_exists(x, "default") - TRUE - }, - error = function(e) { - FALSE - } - ) + cond2 <- .try_load(backend_profile_exists(x, "default")) # check all the conditions are met - if (all(cond1, cond2)) { - return(TRUE) - } else { - return(FALSE) - } + result <- all(!is.null(cond1$value), !is.null(cond2$value)) + attr(result, "error") <- list( + user_exists = cond1$error, + profile_exists = cond2$error + ) + result } #' Verify if connection was created by an auditor user @@ -330,42 +311,26 @@ is_opal_admin_con <- function(x) { #' @inheritParams validate_con #' #' @returns Boolean flag to indicate whether the given connection was created -#' by an administrative user. +#' by an auditor user. #' @keywords internal #' #' @noRd is_opal_audit_con <- function(x) { - # local binding - aux <- NULL - - # condition 1: auditor users don't have access to `backend_user_exists` - cond1 <- tryCatch( - { - aux <- backend_user_exists(x, x$username) - FALSE - }, - error = function(e) { - TRUE - } - ) - - # condition 2: auditor users have access to `backend_profile_exists` - cond2 <- tryCatch( - { - aux <- backend_profile_exists(x, "default") - TRUE - }, - error = function(e) { - FALSE - } - ) + # condition 1: admin users have access to `backend_user_exists` + cond1 <- .try_load(backend_user_exists(x, x$username)) + # condition 2: admin users have access to `backend_profile_exists` + cond2 <- .try_load(backend_profile_exists(x, "default")) # check all the conditions are met - if (all(cond1, cond2)) { - return(TRUE) - } else { - return(FALSE) - } + # cond1 is met when the call *errored* (no admin access, as expected of + # a pure auditor); cond2 is met when the call *succeeded* - the returned + # values don't matter either way + result <- all(!is.null(cond1$error), !is.null(cond2$value)) + attr(result, "error") <- list( + user_exists = NULL, # an error here is expected/correct for an auditor, + profile_exists = cond2$error + ) + result } #' @noRd From 01c324d9466c02eb28e66edfd890f0ae7132d8fe Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 10 Jul 2026 09:48:01 +0100 Subject: [PATCH 17/81] Remove internal functions from documentation --- vignettes/audit-permissions.Rmd | 7 ------- 1 file changed, 7 deletions(-) diff --git a/vignettes/audit-permissions.Rmd b/vignettes/audit-permissions.Rmd index fadbe87..6449516 100644 --- a/vignettes/audit-permissions.Rmd +++ b/vignettes/audit-permissions.Rmd @@ -124,10 +124,3 @@ Ensure the connected user has the permissions required for the target backend. See the backend-specific sections in this vignette for details. - -## Testing Opal permissions directly - -```{r eval = FALSE} -dsROCrate::is_opal_admin_con(con) -dsROCrate::is_opal_audit_con(con) -``` From 961cbf38009c5d1a896d52b8be77dc89da9627d7 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 10 Jul 2026 10:08:05 +0100 Subject: [PATCH 18/81] Update code to filter out admin/audit users from report based on the permissions associated to their account, instead of having a specific username like admin or auditor --- R/audit_engine.R | 4 +--- R/utils-safe_people.R | 19 ++++++++++++++++--- 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/R/audit_engine.R b/R/audit_engine.R index 7aedf17..9044f5f 100644 --- a/R/audit_engine.R +++ b/R/audit_engine.R @@ -88,9 +88,7 @@ audit_engine.opal <- function( # get users' details safe_people_tbl <- backend_users(x, df = FALSE) |> dplyr::bind_rows() |> - dplyr::rename(name = principal) |> - # exclude system administrators from the report - dplyr::filter(!(tolower(name) %in% c("admin", "administrator"))) + dplyr::rename(name = principal) # if any users were found, then verify if they are admin/auditors and exclude if (nrow(safe_people_tbl)) { diff --git a/R/utils-safe_people.R b/R/utils-safe_people.R index 618b401..e156b58 100644 --- a/R/utils-safe_people.R +++ b/R/utils-safe_people.R @@ -21,9 +21,22 @@ extract_safe_people.opal <- function(x, ..., rocrate = rocrateR::rocrate_5s()) { # extract all users opal_users <- backend_users(x, df = FALSE) |> dplyr::bind_rows() |> - dplyr::rename(name = principal) |> - # exclude system administrators from the report - dplyr::filter(!(tolower(name) %in% c("admin", "administrator"))) + dplyr::rename(name = principal) + + if (nrow(opal_users)) { + # extract system permissions + sys_perms_tbl <- backend_sys_perms(x) + opal_users <- tryCatch( + { + opal_users |> + dplyr::left_join(sys_perms_tbl, by = c("name" = "subject")) |> + dplyr::filter(!(permission %in% c("administrate", "audit"))) + }, + error = function(e) { + tibble::tibble() + } + ) + } # cycle through the data source (x) and extract project details for (i in seq_len(nrow(opal_users))) { From 3fa60fe89af9e590998c31bad7b9fbed1ed9b69d Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 10 Jul 2026 14:01:10 +0100 Subject: [PATCH 19/81] Add new internal generic function, filter_safe_people to extract and filter users, based on their permissions --- R/utils-safe_people.R | 62 ++++++++++++++++++++++++++++--------------- 1 file changed, 40 insertions(+), 22 deletions(-) diff --git a/R/utils-safe_people.R b/R/utils-safe_people.R index e156b58..b24acfc 100644 --- a/R/utils-safe_people.R +++ b/R/utils-safe_people.R @@ -15,28 +15,8 @@ extract_safe_people <- function(x, ...) { #' @export extract_safe_people.opal <- function(x, ..., rocrate = rocrateR::rocrate_5s()) { - # set local binding - name <- principal <- NULL - - # extract all users - opal_users <- backend_users(x, df = FALSE) |> - dplyr::bind_rows() |> - dplyr::rename(name = principal) - - if (nrow(opal_users)) { - # extract system permissions - sys_perms_tbl <- backend_sys_perms(x) - opal_users <- tryCatch( - { - opal_users |> - dplyr::left_join(sys_perms_tbl, by = c("name" = "subject")) |> - dplyr::filter(!(permission %in% c("administrate", "audit"))) - }, - error = function(e) { - tibble::tibble() - } - ) - } + # extract non-admin and non-auditor users + opal_users <- filter_safe_people(x) # cycle through the data source (x) and extract project details for (i in seq_len(nrow(opal_users))) { @@ -112,6 +92,44 @@ extract_safe_people.rocrate <- function( return(rocrate) } +filter_safe_people <- function(x, ...) { + UseMethod("filter_safe_people") +} + +#' @export +filter_safe_people.opal <- function(x, ...) { + # set local binding + name <- permission <- principal <- type <- NULL + + # extract all users + opal_users <- backend_users(x, df = FALSE) |> + dplyr::bind_rows() |> + dplyr::rename(name = principal) + + # extract system permissions + sys_perms_tbl <- backend_sys_perms(x) + + # user identities + user_identity <- opal_users |> + dplyr::transmute(name, subject = name, type = "user") + + # group identities + group_identity <- data.frame( + name = rep(opal_users$name, lengths(opal_users$groups)), + subject = unlist(opal_users$groups, use.names = FALSE), + type = "group", + stringsAsFactors = FALSE + ) + + identity_tbl <- dplyr::bind_rows(user_identity, group_identity) + + sys_perms_tbl |> + dplyr::right_join(identity_tbl, by = c("subject", "type")) |> + dplyr::right_join(opal_users, by = "name") |> + dplyr::filter(!(permission %in% c("administrate", "audit"))) |> + dplyr::filter(type == "user") +} + #' Flatten object with Safe People details #' #' @param x Object (e.g., RO-Crate) with Safe People details. This can be From 4855c13061b8981fb23aefc2231324205b287e4b Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 10 Jul 2026 14:02:01 +0100 Subject: [PATCH 20/81] Add default S3 generics --- R/audit.R | 11 +++++++++++ R/audit_engine.R | 33 +++++++++++++-------------------- 2 files changed, 24 insertions(+), 20 deletions(-) diff --git a/R/audit.R b/R/audit.R index 38400ad..6aa1852 100644 --- a/R/audit.R +++ b/R/audit.R @@ -47,6 +47,17 @@ audit <- function(x, ...) { UseMethod("audit") } +#' @export +audit.default <- function(x, ...) { + stop( + sprintf( + "No `audit()` method exists for objects of class: %s.", + paste(class(x), collapse = ", ") + ), + call. = FALSE + ) +} + #' @rdname audit #' @export audit.ArmadilloCredentials <- function(x, ..., intent = NULL) { diff --git a/R/audit_engine.R b/R/audit_engine.R index 9044f5f..eb5379a 100644 --- a/R/audit_engine.R +++ b/R/audit_engine.R @@ -26,6 +26,17 @@ audit_engine <- function(x, ...) { UseMethod("audit_engine") } +#' @export +audit_engine.default <- function(x, ...) { + stop( + sprintf( + "No `audit_engine()` method exists for objects of class: %s.", + paste(class(x), collapse = ", ") + ), + call. = FALSE + ) +} + #' @export audit_engine.cr8tor <- function(x, ...) { # extract individual components from cr8tor bundle @@ -57,7 +68,7 @@ audit_engine.opal <- function( path = NULL ) { # local bindings - name <- permission <- principal <- NULL + name <- NULL # create RO-Create with the 5 safes profile crate <- rocrateR::rocrate_5s() @@ -86,25 +97,7 @@ audit_engine.opal <- function( # Safe People ---- # get users' details - safe_people_tbl <- backend_users(x, df = FALSE) |> - dplyr::bind_rows() |> - dplyr::rename(name = principal) - - # if any users were found, then verify if they are admin/auditors and exclude - if (nrow(safe_people_tbl)) { - # extract system permissions - sys_perms_tbl <- backend_sys_perms(x) - safe_people_tbl <- tryCatch( - { - safe_people_tbl |> - dplyr::left_join(sys_perms_tbl, by = c("name" = "subject")) |> - dplyr::filter(!(permission %in% c("administrate", "audit"))) - }, - error = function(e) { - tibble::tibble() - } - ) - } + safe_people_tbl <- filter_safe_people(x) if (!is.null(user)) { safe_people_tbl <- safe_people_tbl |> From 46123d5c2d955244626d178dea09adc1eb34291e Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 10 Jul 2026 14:02:31 +0100 Subject: [PATCH 21/81] Remove unused generic definition --- R/backend-generic.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/R/backend-generic.R b/R/backend-generic.R index 1ed7b97..a84924f 100644 --- a/R/backend-generic.R +++ b/R/backend-generic.R @@ -1,7 +1,3 @@ -backend_groups <- function(x, ...) { - UseMethod("backend_groups") -} - backend_logs <- function(x, ...) { UseMethod("backend_logs") } From ee807ec7f6d2eef4d665ce606266b0ea01b40130 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 10 Jul 2026 14:27:42 +0100 Subject: [PATCH 22/81] Bump minimum version of testthat to use local_mocked_bindings --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3698255..7895dd3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -33,7 +33,7 @@ Suggests: fs, knitr, MolgenisArmadillo, - testthat (>= 3.0.0), + testthat (>= 3.1.4), withr Config/testthat/edition: 3 Encoding: UTF-8 From 64acd9ade9c4c6ecaef3d48a137bef12bbc9ade7 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 10 Jul 2026 17:15:06 +0100 Subject: [PATCH 23/81] Add new unit tests --- tests/testthat/helper-mock-opal.R | 14 ++ tests/testthat/test-audit.R | 97 ++++++++++ tests/testthat/test-audit_engine.R | 225 ++++++++++++++++++++++++ tests/testthat/test-check_permissions.R | 70 ++++++++ 4 files changed, 406 insertions(+) create mode 100644 tests/testthat/helper-mock-opal.R create mode 100644 tests/testthat/test-audit.R create mode 100644 tests/testthat/test-audit_engine.R create mode 100644 tests/testthat/test-check_permissions.R diff --git a/tests/testthat/helper-mock-opal.R b/tests/testthat/helper-mock-opal.R new file mode 100644 index 0000000..4042af1 --- /dev/null +++ b/tests/testthat/helper-mock-opal.R @@ -0,0 +1,14 @@ +#' Build a minimal fake `opal`-classed object for offline/mocked tests +#' +#' Carries just enough shape (a `username` field and the `"opal"` class) for +#' S3 dispatch to resolve to the `.opal` methods. It is never passed to a +#' real network call in these tests: every function that would otherwise +#' talk to a server (`backend_*()`, `validate_backend()`, etc.) is replaced +#' first via `testthat::local_mocked_bindings()`, so no live connection - and +#' therefore no `skip_on_cran()`/`skip_if_offline()` - is required. +fake_opal_con <- function(username = "test_user") { + structure( + list(username = username), + class = "opal" + ) +} diff --git a/tests/testthat/test-audit.R b/tests/testthat/test-audit.R new file mode 100644 index 0000000..e242d58 --- /dev/null +++ b/tests/testthat/test-audit.R @@ -0,0 +1,97 @@ +test_that("audit.default errors for unsupported classes", { + expect_error( + audit(structure(list(), class = "not_a_backend")), + "No `audit\\(\\)` method exists" + ) +}) + +test_that("audit.ArmadilloCredentials errors as not implemented", { + expect_error( + audit(structure(list(), class = "ArmadilloCredentials")), + "not currently implemented" + ) +}) + +test_that("audit.rocrate returns the input unchanged", { + roc <- structure(list(marker = "unchanged"), class = "rocrate") + + expect_identical(audit(roc), roc) +}) + +test_that("audit.list dispatches over every element", { + roc1 <- structure(list(marker = "one"), class = "rocrate") + roc2 <- structure(list(marker = "two"), class = "rocrate") + + result <- audit(list(roc1, roc2)) + + expect_identical(result, list(roc1, roc2)) +}) + +test_that("audit.character errors for a non-existent file", { + expect_error( + audit(file.path(tempdir(), "does-not-exist.yaml")), + "does not exist" + ) +}) + +test_that("audit.character surfaces both loader errors for an invalid file", { + tmp <- withr::local_tempfile(fileext = ".yaml") + writeLines("not: a valid cr8tor bundle or rocrate", tmp) + + err <- tryCatch(audit(tmp), error = function(e) e) + + expect_s3_class(err, "error") + expect_match(conditionMessage(err), "cr8tor bundle error:") + expect_match(conditionMessage(err), "rocrate error:") +}) + +test_that("audit.character dispatches a successfully loaded cr8tor bundle", { + stub_bundle <- structure(list(marker = "cr8tor-stub"), class = "cr8tor") + + local_mocked_bindings( + load_cr8tor_bundle = function(x, ...) stub_bundle, + `audit_engine.cr8tor` = function(x, ...) "AUDITED" + ) + + tmp <- withr::local_tempfile() + file.create(tmp) + + expect_equal(audit(tmp), "AUDITED") +}) + +test_that("audit.opal passes project/user/log args through to audit_engine", { + captured <- new.env() + + local_mocked_bindings( + `audit_engine.opal` = function( + x, + ..., + project = NULL, + user = NULL, + logs_from = -Inf, + logs_to = Inf, + path = NULL + ) { + captured$project <- project + captured$user <- user + captured$logs_from <- logs_from + captured$logs_to <- logs_to + "AUDITED" + } + ) + + con <- fake_opal_con() + result <- audit( + con, + project = "PROJECT1", + user = "alice", + logs_from = 100, + logs_to = 200 + ) + + expect_equal(result, "AUDITED") + expect_equal(captured$project, "PROJECT1") + expect_equal(captured$user, "alice") + expect_equal(captured$logs_from, 100) + expect_equal(captured$logs_to, 200) +}) diff --git a/tests/testthat/test-audit_engine.R b/tests/testthat/test-audit_engine.R new file mode 100644 index 0000000..9a8a0e3 --- /dev/null +++ b/tests/testthat/test-audit_engine.R @@ -0,0 +1,225 @@ +test_that("audit_engine.default errors for unsupported classes", { + expect_error( + audit_engine(structure(list(), class = "not_a_backend")), + "No `audit_engine\\(\\)` method exists" + ) +}) + +test_that("audit_engine.opal requires a `project` argument", { + local_mocked_bindings(validate_backend = function(x, ...) invisible(TRUE)) + + con <- fake_opal_con() + + expect_error(audit_engine(con), "A `project` name is required") +}) + +test_that("audit_engine.opal errors for a project not on the server", { + local_mocked_bindings( + validate_backend = function(x, ...) invisible(TRUE), + backend_projects = function(x, ...) tibble::tibble(name = "REAL_PROJECT") + ) + + con <- fake_opal_con() + + expect_error( + audit_engine(con, project = "MISSING_PROJECT"), + "not valid" + ) +}) + +test_that("audit_engine.opal orchestrates the 5 Safes steps correctly", { + # two users on the server: `alice` (regular user) and `bob_admin` (has + # administrate permission, so should be excluded from Safe People/Output) + local_mocked_bindings( + validate_backend = function(x, ...) invisible(TRUE), + backend_projects = function(x, ...) tibble::tibble(name = "PROJECT1"), + backend_users = function(x, ..., df = FALSE) { + list( + list(principal = "alice", groups = list("auditor")), + list(principal = "bob_admin", groups = list("admin")) + ) + }, + backend_sys_perms = function(x, ...) { + tibble::tibble( + subject = c("alice", "bob_admin", "opal-administrator"), + permission = c("view", "administrate", "administrate"), + type = c("user", "user", "groups") + ) + } + ) + + # records what each Safe * step was called with, without needing `<<-`: + # environments are mutable by reference, so a plain `<-` inside the mock + # closures is enough to record calls in the enclosing test's scope + calls <- new.env() + calls$safe_people <- character() + calls$safe_project <- character() + calls$safe_data <- character() + calls$safe_output <- character() + calls$safe_setting <- FALSE + + local_mocked_bindings( + `safe_people.rocrate` = function( + x, + ..., + connection, + user, + set_author = TRUE, + set_project = TRUE + ) { + calls$safe_people <- c(calls$safe_people, user) + x + }, + `safe_project.rocrate` = function(x, ..., connection, project) { + calls$safe_project <- c(calls$safe_project, project) + x + }, + `safe_data.rocrate` = function(x, ..., connection, project) { + calls$safe_data <- c(calls$safe_data, project) + x + }, + `safe_output.rocrate` = function( + x, + ..., + connection, + user, + logs_from, + logs_to, + path = NULL + ) { + calls$safe_output <- c(calls$safe_output, user) + x + }, + `safe_setting.opal` = function(x, ..., rocrate) { + calls$safe_setting <- TRUE + rocrate + } + ) + + con <- fake_opal_con() + result <- audit_engine(con, project = "PROJECT1") + + # `bob_admin` is excluded because of the "administrate" permission + expect_equal(calls$safe_people, "alice") + expect_equal(calls$safe_output, "alice") + expect_equal(calls$safe_project, "PROJECT1") + expect_equal(calls$safe_data, "PROJECT1") + expect_true(calls$safe_setting) + expect_s3_class(result, "rocrate") +}) + +test_that("audit_engine.opal filters Safe People by the `user` argument", { + local_mocked_bindings( + validate_backend = function(x, ...) invisible(TRUE), + backend_projects = function(x, ...) tibble::tibble(name = "PROJECT1"), + backend_users = function(x, ..., df = FALSE) { + list( + list(principal = "alice", groups = list("standard")), + list(principal = "carol", groups = list("standard")) + ) + }, + backend_sys_perms = function(x, ...) { + tibble::tibble( + subject = c("alice", "carol", "opal-administrator"), + permission = c("view", "view", "administrate"), + type = c("user", "user", "groups") + ) + } + ) + + calls <- new.env() + calls$safe_people <- character() + + local_mocked_bindings( + `safe_people.rocrate` = function( + x, + ..., + connection, + user, + set_author = TRUE, + set_project = TRUE + ) { + calls$safe_people <- c(calls$safe_people, user) + x + }, + `safe_project.rocrate` = function(x, ...) x, + `safe_data.rocrate` = function(x, ...) x, + `safe_output.rocrate` = function(x, ...) x, + `safe_setting.opal` = function(x, ..., rocrate) rocrate + ) + + con <- fake_opal_con() + audit_engine(con, project = "PROJECT1", user = "alice") + + expect_equal(calls$safe_people, "alice") +}) + +test_that("audit_engine.opal errors if the `user` filter matches nobody", { + local_mocked_bindings( + validate_backend = function(x, ...) invisible(TRUE), + backend_projects = function(x, ...) tibble::tibble(name = "PROJECT1"), + backend_users = function(x, ..., df = FALSE) { + list( + list(principal = "alice", groups = list("standard")), + list(principal = "carol", groups = list("standard")) + ) + }, + backend_sys_perms = function(x, ...) { + tibble::tibble( + subject = c("alice", "carol", "opal-administrator"), + permission = c("view", "view", "administrate"), + type = c("user", "user", "groups") + ) + } + ) + + con <- fake_opal_con() + + expect_error( + audit_engine(con, project = "PROJECT1", user = "nobody_here"), + "No Safe People details were found" + ) +}) + +test_that("audit_engine.opal degrades gracefully if system permissions can't be read", { + # simulates e.g. a permissions-lookup failure on the server: the join + # against system permissions should fall back to an empty Safe People + # table rather than propagate the error + local_mocked_bindings( + validate_backend = function(x, ...) invisible(TRUE), + backend_projects = function(x, ...) tibble::tibble(name = "PROJECT1"), + backend_users = function(x, ..., df = FALSE) { + list(list(principal = "alice")) + }, + backend_sys_perms = function(x, ...) stop("500 Internal Server Error") + ) + + calls <- new.env() + calls$safe_people <- character() + + local_mocked_bindings( + `safe_people.rocrate` = function( + x, + ..., + connection, + user, + set_author = TRUE, + set_project = TRUE + ) { + calls$safe_people <- c(calls$safe_people, user) + x + }, + `safe_project.rocrate` = function(x, ...) x, + `safe_data.rocrate` = function(x, ...) x, + `safe_output.rocrate` = function(x, ...) x, + `safe_setting.opal` = function(x, ..., rocrate) rocrate + ) + + con <- fake_opal_con() + result <- audit_engine(con, project = "PROJECT1") + + # no Safe People steps ran (table fell back to empty), but the audit + # still completes rather than erroring + expect_length(calls$safe_people, 0) + expect_s3_class(result, "rocrate") +}) diff --git a/tests/testthat/test-check_permissions.R b/tests/testthat/test-check_permissions.R new file mode 100644 index 0000000..7234a9e --- /dev/null +++ b/tests/testthat/test-check_permissions.R @@ -0,0 +1,70 @@ +test_that("check_permissions.default errors for unsupported classes", { + expect_error( + check_permissions(structure(list(), class = "not_a_backend")), + "No `check_permissions\\(\\)` method exists" + ) +}) + +test_that("check_permissions.ArmadilloCredentials errors as not implemented", { + expect_error( + check_permissions(structure(list(), class = "ArmadilloCredentials")), + "not currently implemented" + ) +}) + +test_that("check_permissions.opal succeeds for an admin connection", { + local_mocked_bindings( + backend_user_exists = function(x, ...) TRUE, + backend_profile_exists = function(x, ...) TRUE + ) + + con <- fake_opal_con() + + expect_true(isTRUE(check_permissions(con))) +}) + +test_that("check_permissions.opal succeeds for an auditor-only connection", { + # a pure auditor lacks admin access, so `backend_user_exists()` should + # error (403-like), while `backend_profile_exists()` still succeeds + local_mocked_bindings( + backend_user_exists = function(x, ...) stop("403 Forbidden"), + backend_profile_exists = function(x, ...) TRUE + ) + + con <- fake_opal_con() + + expect_true(isTRUE(check_permissions(con))) +}) + +test_that("check_permissions.opal errors when neither role is available", { + local_mocked_bindings( + backend_user_exists = function(x, ...) stop("403 Forbidden"), + backend_profile_exists = function(x, ...) stop("404 Not Found") + ) + + con <- fake_opal_con() + + expect_error(check_permissions(con), "does not have sufficient permissions") +}) + +test_that("check_permissions.opal is silent by default on success", { + local_mocked_bindings( + backend_user_exists = function(x, ...) TRUE, + backend_profile_exists = function(x, ...) TRUE + ) + + con <- fake_opal_con() + + expect_silent(check_permissions(con)) +}) + +test_that("check_permissions.opal shows a message when verbose = TRUE", { + local_mocked_bindings( + backend_user_exists = function(x, ...) TRUE, + backend_profile_exists = function(x, ...) TRUE + ) + + con <- fake_opal_con() + + expect_message(check_permissions(con, verbose = TRUE), "ready to audit") +}) From cb5caac6699a0d617699a9b55ba8b793a66a3428 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 10 Jul 2026 17:15:20 +0100 Subject: [PATCH 24/81] New build --- NAMESPACE | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 67c9e49..3111fd6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,10 +3,12 @@ S3method(audit,ArmadilloCredentials) S3method(audit,character) S3method(audit,cr8tor) +S3method(audit,default) S3method(audit,list) S3method(audit,opal) S3method(audit,rocrate) S3method(audit_engine,cr8tor) +S3method(audit_engine,default) S3method(audit_engine,opal) S3method(backend_logs,opal) S3method(backend_options,opal) @@ -36,6 +38,7 @@ S3method(extract_safe_project,opal) S3method(extract_safe_project,rocrate) S3method(extract_safe_setting,opal) S3method(extract_safe_setting,rocrate) +S3method(filter_safe_people,opal) S3method(flatten_safe_data,default) S3method(flatten_safe_data,rocrate) S3method(flatten_safe_output,default) From c701813d929dcfe2c946ef4de6d5920b7c66d7d0 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Mon, 13 Jul 2026 11:50:58 +0100 Subject: [PATCH 25/81] Add function documentation for filter_safe_people and update S3 generic for opal, so it returns an empty tibble if not records are found --- R/utils-safe_people.R | 62 +++++++++++++++++++++++++++++-------------- 1 file changed, 42 insertions(+), 20 deletions(-) diff --git a/R/utils-safe_people.R b/R/utils-safe_people.R index b24acfc..1ccdb94 100644 --- a/R/utils-safe_people.R +++ b/R/utils-safe_people.R @@ -92,6 +92,14 @@ extract_safe_people.rocrate <- function( return(rocrate) } +#' Filter Safe People (excluding admin/auditor accounts) +#' +#' @inheritParams safe_data +#' +#' @returns Tibble with one row per non-admin, non-auditor user account, +#' accounting for permissions granted directly or via group membership. +#' @keywords internal +#' @noRd filter_safe_people <- function(x, ...) { UseMethod("filter_safe_people") } @@ -106,28 +114,42 @@ filter_safe_people.opal <- function(x, ...) { dplyr::bind_rows() |> dplyr::rename(name = principal) - # extract system permissions - sys_perms_tbl <- backend_sys_perms(x) - - # user identities - user_identity <- opal_users |> - dplyr::transmute(name, subject = name, type = "user") + if (nrow(opal_users) == 0) { + return(tibble::tibble()) + } - # group identities - group_identity <- data.frame( - name = rep(opal_users$name, lengths(opal_users$groups)), - subject = unlist(opal_users$groups, use.names = FALSE), - type = "group", - stringsAsFactors = FALSE + # permission lookups can fail independently of the user list (e.g. a + # transient server error) - fall back to an empty Safe People table + # rather than letting the failure propagate and abort the whole audit + tryCatch( + { + # extract system permissions + sys_perms_tbl <- backend_sys_perms(x) + + # user identities + user_identity <- opal_users |> + dplyr::transmute(name, subject = name, type = "user") + + # group identities + group_identity <- data.frame( + name = rep(opal_users$name, lengths(opal_users$groups)), + subject = unlist(opal_users$groups, use.names = FALSE), + type = "group", + stringsAsFactors = FALSE + ) + + identity_tbl <- dplyr::bind_rows(user_identity, group_identity) + + sys_perms_tbl |> + dplyr::right_join(identity_tbl, by = c("subject", "type")) |> + dplyr::right_join(opal_users, by = "name") |> + dplyr::filter(!(permission %in% c("administrate", "audit"))) |> + dplyr::filter(type == "user") + }, + error = function(e) { + tibble::tibble() + } ) - - identity_tbl <- dplyr::bind_rows(user_identity, group_identity) - - sys_perms_tbl |> - dplyr::right_join(identity_tbl, by = c("subject", "type")) |> - dplyr::right_join(opal_users, by = "name") |> - dplyr::filter(!(permission %in% c("administrate", "audit"))) |> - dplyr::filter(type == "user") } #' Flatten object with Safe People details From 9ec4ee291006b76357a4582e3f32a2c792a3ee63 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Mon, 13 Jul 2026 11:51:18 +0100 Subject: [PATCH 26/81] Update documentation and relocate error message --- R/audit_engine.R | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/R/audit_engine.R b/R/audit_engine.R index eb5379a..000cf52 100644 --- a/R/audit_engine.R +++ b/R/audit_engine.R @@ -76,7 +76,7 @@ audit_engine.opal <- function( # validate backend validate_backend(x, ...) - # if `project` is missing, then ~extract all project names~ error + # if `project` is missing, then error if (is.null(project)) { stop("A `project` name is required!", call. = FALSE) } @@ -98,20 +98,29 @@ audit_engine.opal <- function( # Safe People ---- # get users' details safe_people_tbl <- filter_safe_people(x) - if (!is.null(user)) { safe_people_tbl <- safe_people_tbl |> dplyr::filter(tolower(name) %in% user) + } - if (nrow(safe_people_tbl) == 0) { - stop( + # an audit report is not meaningful without Safe People details, whether + # that's because a `user` filter matched nobody, or because the + # permission lookup itself could not be completed + if (nrow(safe_people_tbl) == 0) { + stop( + if (is.null(user)) { + paste( + "No Safe People details could be found for this project - the", + "audit cannot proceed." + ) + } else { sprintf( "No Safe People details were found for the user: %s!", paste0("'", user, "'", collapse = ", ") - ), - call. = FALSE - ) - } + ) + }, + call. = FALSE + ) } crate <- safe_people_tbl$name |> From a490d7ef95700aebaf376c7e3a666172d6e64025 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Mon, 13 Jul 2026 11:52:45 +0100 Subject: [PATCH 27/81] Update test to use local files instead of installed packages --- tests/testthat/test-dsROCrate-package.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-dsROCrate-package.R b/tests/testthat/test-dsROCrate-package.R index 03e64d9..e8f6f34 100644 --- a/tests/testthat/test-dsROCrate-package.R +++ b/tests/testthat/test-dsROCrate-package.R @@ -1,6 +1,6 @@ test_that("All Rd files have a value section", { - db <- tools::Rd_db("dsROCrate") - + man_dir <- testthat::test_path("..", "man") + db <- list.files(man_dir, pattern = "\\.Rd$", full.names = TRUE) # drop the package-level Rd (e.g., "dsROCrate-package") db <- db[!grepl("-package\\.Rd$", names(db))] From 5c8fd9c992b4af62e76ea6bbed5a29b219df6135 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Mon, 13 Jul 2026 11:53:07 +0100 Subject: [PATCH 28/81] Update test to account for when no safe people details are found --- tests/testthat/test-audit_engine.R | 42 ++++++++---------------------- 1 file changed, 11 insertions(+), 31 deletions(-) diff --git a/tests/testthat/test-audit_engine.R b/tests/testthat/test-audit_engine.R index 9a8a0e3..4eb40de 100644 --- a/tests/testthat/test-audit_engine.R +++ b/tests/testthat/test-audit_engine.R @@ -181,45 +181,25 @@ test_that("audit_engine.opal errors if the `user` filter matches nobody", { ) }) -test_that("audit_engine.opal degrades gracefully if system permissions can't be read", { - # simulates e.g. a permissions-lookup failure on the server: the join - # against system permissions should fall back to an empty Safe People - # table rather than propagate the error +test_that("audit_engine.opal aborts if Safe People details cannot be obtained", { + # simulates e.g. a permissions-lookup failure on the server: + # `filter_safe_people()` falls back to an empty table internally, and + # since an audit is not meaningful without Safe People details, + # `audit_engine.opal()` should abort rather than silently producing an + # incomplete audit local_mocked_bindings( validate_backend = function(x, ...) invisible(TRUE), backend_projects = function(x, ...) tibble::tibble(name = "PROJECT1"), backend_users = function(x, ..., df = FALSE) { - list(list(principal = "alice")) + list(list(principal = "alice", groups = list(character(0)))) }, backend_sys_perms = function(x, ...) stop("500 Internal Server Error") ) - calls <- new.env() - calls$safe_people <- character() - - local_mocked_bindings( - `safe_people.rocrate` = function( - x, - ..., - connection, - user, - set_author = TRUE, - set_project = TRUE - ) { - calls$safe_people <- c(calls$safe_people, user) - x - }, - `safe_project.rocrate` = function(x, ...) x, - `safe_data.rocrate` = function(x, ...) x, - `safe_output.rocrate` = function(x, ...) x, - `safe_setting.opal` = function(x, ..., rocrate) rocrate - ) - con <- fake_opal_con() - result <- audit_engine(con, project = "PROJECT1") - # no Safe People steps ran (table fell back to empty), but the audit - # still completes rather than erroring - expect_length(calls$safe_people, 0) - expect_s3_class(result, "rocrate") + expect_error( + audit_engine(con, project = "PROJECT1"), + "No Safe People details could be found" + ) }) From b8941dc89e0fa776eeedb8fd0878c2453f325e77 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Mon, 13 Jul 2026 11:53:53 +0100 Subject: [PATCH 29/81] Update test to mock verification of admin and auditor roles --- tests/testthat/test-utils-safe_people.R | 58 ++++++++++++++++++++----- 1 file changed, 48 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-utils-safe_people.R b/tests/testthat/test-utils-safe_people.R index 5b416d6..eb28f6e 100644 --- a/tests/testthat/test-utils-safe_people.R +++ b/tests/testthat/test-utils-safe_people.R @@ -39,20 +39,58 @@ test_that("extract_safe_people.opal updates an existing RO-Crate", { }) test_that("extract_safe_people.opal excludes admin and administrator accounts", { - # open connection to OBiBa's Opal demo server - opal_con <- opal_demo_con() - # terminate connection when done with tests - withr::defer(opalr::opal.logout(opal_con)) + # the real OBiBa demo server doesn't set the `administrate` permission on + # its `administrator` account, so this can't be exercised against it - + # simulate a server where the exclusion actually has something to catch + local_mocked_bindings( + backend_users = function(x, ..., df = FALSE) { + list( + list(principal = "alice", groups = list("auditor")), + list(principal = "bob_admin", groups = list("admin")) + ) + }, + backend_sys_perms = function(x, ...) { + tibble::tibble( + subject = c("alice", "bob_admin"), + permission = c("view", "administrate"), + type = c("user", "user") + ) + } + ) - roc <- extract_safe_people(opal_con) + # records which users actually got passed into `safe_people()`, without + # needing `<<-` - environments are mutable by reference + calls <- new.env() + calls$safe_people <- character() + + local_mocked_bindings( + `safe_people.rocrate` = function( + x, + ..., + connection, + user, + set_author = TRUE, + set_project = TRUE + ) { + calls$safe_people <- c( + calls$safe_people, + as.character(unlist(user, use.names = FALSE)) + ) + x + } + ) - people <- rocrateR::get_entity(roc, type = "Person") - ids <- vapply(people, function(e) getElement(e, "name")[[1]], character(1)) + con <- fake_opal_con() + roc <- extract_safe_people(con) - expect_false(any(tolower(ids) %in% c("admin", "administrator"))) + print(calls$safe_people) - # close connection to OBiBa's Opal demo server - opalr::opal.logout(opal_con) + # `administrator` never reaches `safe_people()` because it's excluded + # upstream, in `filter_safe_people()`, before the Person entity would + # ever be created + expect_false(any(tolower(calls$safe_people) %in% c("admin", "administrator"))) + expect_equal(calls$safe_people, "alice") + expect_s3_class(roc, "rocrate") }) test_that("extract_safe_people.opal iterates over all returned subject profiles", { From 484ddef31cd14020ff1ab816fb97e36d1a26861c Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Mon, 13 Jul 2026 16:03:59 +0100 Subject: [PATCH 30/81] Add new generic methods for is_admin_con and is_audit_con, plus implementations for the opal class --- NAMESPACE | 2 ++ R/backend-generic.R | 28 ++++++++++++++++++ R/backend-opal.R | 35 ++++++++++++++++++++++ R/check_permissions.R | 4 +-- R/utils-opal.R | 51 -------------------------------- tests/testthat/test-utils-opal.R | 4 +-- 6 files changed, 69 insertions(+), 55 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 3111fd6..e36fce3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -52,6 +52,8 @@ S3method(flatten_safe_setting,rocrate) S3method(init,ArmadilloCredentials) S3method(init,opal) S3method(init,rocrate) +S3method(is_admin_con,opal) +S3method(is_audit_con,opal) S3method(parse_user_profiles,ArmadilloCredentials) S3method(parse_user_profiles,opal) S3method(print,cr8tor_bundle) diff --git a/R/backend-generic.R b/R/backend-generic.R index a84924f..41386b7 100644 --- a/R/backend-generic.R +++ b/R/backend-generic.R @@ -57,3 +57,31 @@ backend_user_exists <- function(x, ...) { backend_users <- function(x, ...) { UseMethod("backend_users") } + +#' Verify if connection was created by an administrator user +#' +#' @inheritParams validate_con +#' @param ... Unused, extra arguments. +#' +#' @returns Boolean flag to indicate whether the given connection was created +#' by an administrator user. +#' @keywords internal +#' +#' @noRd +is_admin_con <- function(x, ...) { + UseMethod("is_admin_con") +} + +#' Verify if connection was created by an auditor user +#' +#' @inheritParams validate_con +#' @param ... Unused, extra arguments. +#' +#' @returns Boolean flag to indicate whether the given connection was created +#' by an auditor user. +#' @keywords internal +#' +#' @noRd +is_audit_con <- function(x, ...) { + UseMethod("is_audit_con") +} diff --git a/R/backend-opal.R b/R/backend-opal.R index 51921cc..7e37355 100644 --- a/R/backend-opal.R +++ b/R/backend-opal.R @@ -72,3 +72,38 @@ backend_user_exists.opal <- function(x, ...) { backend_users.opal <- function(x, ...) { opalr::oadmin.user_profiles(x, ...) } + +#' @export +is_admin_con.opal <- function(x, ...) { + # condition 1: admin users have access to `backend_user_exists` + cond1 <- .try_load(backend_user_exists(x, x$username)) + # condition 2: admin users have access to `backend_profile_exists` + cond2 <- .try_load(backend_profile_exists(x, "default")) + + # check all the conditions are met + result <- all(!is.null(cond1$value), !is.null(cond2$value)) + attr(result, "error") <- list( + user_exists = cond1$error, + profile_exists = cond2$error + ) + result +} + +#' @export +is_audit_con.opal <- function(x, ...) { + # condition 1: admin users have access to `backend_user_exists` + cond1 <- .try_load(backend_user_exists(x, x$username)) + # condition 2: admin users have access to `backend_profile_exists` + cond2 <- .try_load(backend_profile_exists(x, "default")) + + # check all the conditions are met + # cond1 is met when the call *errored* (no admin access, as expected of + # a pure auditor); cond2 is met when the call *succeeded* - the returned + # values don't matter either way + result <- all(!is.null(cond1$error), !is.null(cond2$value)) + attr(result, "error") <- list( + user_exists = NULL, # an error here is expected/correct for an auditor, + profile_exists = cond2$error + ) + result +} diff --git a/R/check_permissions.R b/R/check_permissions.R index 686cf6a..603a70a 100644 --- a/R/check_permissions.R +++ b/R/check_permissions.R @@ -55,12 +55,12 @@ check_permissions.opal <- function(x, ..., verbose = FALSE) { is_audit <- FALSE is_admin <- tryCatch( - is_opal_admin_con(x), + is_admin_con(x), error = function(e) FALSE ) is_audit <- tryCatch( - is_opal_audit_con(x), + is_audit_con(x), error = function(e) FALSE ) diff --git a/R/utils-opal.R b/R/utils-opal.R index 351edfe..287d776 100644 --- a/R/utils-opal.R +++ b/R/utils-opal.R @@ -282,57 +282,6 @@ infer_table_resource_lineage <- function(assets_tbl) { purrr::list_c() } -#' Verify if connection was created by an administrative user -#' -#' @inheritParams validate_con -#' -#' @returns Boolean flag to indicate whether the given connection was created -#' by an administrative user. -#' @keywords internal -#' -#' @noRd -is_opal_admin_con <- function(x) { - # condition 1: admin users have access to `backend_user_exists` - cond1 <- .try_load(backend_user_exists(x, x$username)) - # condition 2: admin users have access to `backend_profile_exists` - cond2 <- .try_load(backend_profile_exists(x, "default")) - - # check all the conditions are met - result <- all(!is.null(cond1$value), !is.null(cond2$value)) - attr(result, "error") <- list( - user_exists = cond1$error, - profile_exists = cond2$error - ) - result -} - -#' Verify if connection was created by an auditor user -#' -#' @inheritParams validate_con -#' -#' @returns Boolean flag to indicate whether the given connection was created -#' by an auditor user. -#' @keywords internal -#' -#' @noRd -is_opal_audit_con <- function(x) { - # condition 1: admin users have access to `backend_user_exists` - cond1 <- .try_load(backend_user_exists(x, x$username)) - # condition 2: admin users have access to `backend_profile_exists` - cond2 <- .try_load(backend_profile_exists(x, "default")) - - # check all the conditions are met - # cond1 is met when the call *errored* (no admin access, as expected of - # a pure auditor); cond2 is met when the call *succeeded* - the returned - # values don't matter either way - result <- all(!is.null(cond1$error), !is.null(cond2$value)) - attr(result, "error") <- list( - user_exists = NULL, # an error here is expected/correct for an auditor, - profile_exists = cond2$error - ) - result -} - #' @noRd link_assets_to_project <- function(rocrate, project_id, asset_ids) { proj_entity <- .get_entity(rocrate, id = project_id)[[1]] diff --git a/tests/testthat/test-utils-opal.R b/tests/testthat/test-utils-opal.R index 678ad46..ab1a03d 100644 --- a/tests/testthat/test-utils-opal.R +++ b/tests/testthat/test-utils-opal.R @@ -8,11 +8,11 @@ test_that("validate_con works with real Opal connection", { opalr::opal.logout(opal_con) }) -test_that("is_opal_admin_con detects admin connection correctly", { +test_that("is_admin_con detects admin connection correctly", { # open connection to OBiBa's Opal demo server opal_con <- opal_demo_con() - res <- is_opal_admin_con(opal_con) + res <- is_admin_con(opal_con) expect_type(res, "logical") expect_true(res) From 4123a79b750aa95eb749f32b1b31af8674fe701c Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Mon, 13 Jul 2026 16:11:08 +0100 Subject: [PATCH 31/81] Relocate generics for validate_backend_version and validate_con --- R/backend-generic.R | 41 +++++++++++++++++++++++++ R/backend-opal.R | 30 +++++++++++++++++++ R/utils-connection.R | 71 -------------------------------------------- 3 files changed, 71 insertions(+), 71 deletions(-) diff --git a/R/backend-generic.R b/R/backend-generic.R index 41386b7..d9873bf 100644 --- a/R/backend-generic.R +++ b/R/backend-generic.R @@ -85,3 +85,44 @@ is_admin_con <- function(x, ...) { is_audit_con <- function(x, ...) { UseMethod("is_audit_con") } + +#' Validate backend version +#' +#' @param x DataSHIELD backend connection object. +#' @param ... Unused. +#' @param minimum String with minimum version. +#' +#' @returns Logical value indicating if backend version is valid. +#' @keywords internal +#' @noRd +validate_backend_version <- function(x, ...) { + UseMethod("validate_backend_version") +} + +#' @export +validate_backend_version.default <- function(x, ...) { + invisible(TRUE) +} + +#' Validate backend connection +#' +#' @param x DataSHIELD backend connection object. +#' @param ... Unused. +#' +#' @returns Nothing, call for its side effect. +#' @keywords internal +#' @noRd +validate_con <- function(x, ...) { + UseMethod("validate_con") +} + +#' @export +validate_con.default <- function(x, ...) { + stop( + sprintf( + "Unsupported connection type: %s", + paste(class(x), collapse = ", ") + ), + call. = FALSE + ) +} diff --git a/R/backend-opal.R b/R/backend-opal.R index 7e37355..1d98694 100644 --- a/R/backend-opal.R +++ b/R/backend-opal.R @@ -107,3 +107,33 @@ is_audit_con.opal <- function(x, ...) { ) result } + +#' @export +validate_backend_version.opal <- function(x, ..., minimum = "5.7.2") { + if (utils::compareVersion(x$version, minimum) < 0) { + stop( + sprintf( + "Opal >= %s is required, but server version is %s.", + minimum, + x$version + ), + call. = FALSE + ) + } + invisible(TRUE) +} + +#' @export +validate_con.opal <- function(x, ...) { + tryCatch( + { + status <- xptr::is_null_xptr(x$handle$handle) + if (status) { + stop("The given connection is not valid!", call. = FALSE) + } + }, + error = function(e) { + stop("The given connection is not valid!", call. = FALSE) + } + ) +} diff --git a/R/utils-connection.R b/R/utils-connection.R index 857f688..c7222e1 100644 --- a/R/utils-connection.R +++ b/R/utils-connection.R @@ -118,74 +118,3 @@ validate_backend <- function(x, ...) { invisible(TRUE) } - -#' Validate backend version -#' -#' @param x DataSHIELD backend connection object. -#' @param ... Unused. -#' @param minimum String with minimum version. -#' -#' @returns Logical value indicating if backend version is valid. -#' @keywords internal -#' @noRd -validate_backend_version <- function(x, ...) { - UseMethod("validate_backend_version") -} - -#' @export -validate_backend_version.default <- function(x, ...) { - invisible(TRUE) -} - -#' @export -validate_backend_version.opal <- function(x, ..., minimum = "5.7.2") { - if (utils::compareVersion(x$version, minimum) < 0) { - stop( - sprintf( - "Opal >= %s is required, but server version is %s.", - minimum, - x$version - ), - call. = FALSE - ) - } - invisible(TRUE) -} - -#' Validate backend connection -#' -#' @param x DataSHIELD backend connection object. -#' @param ... Unused. -#' -#' @returns Nothing, call for its side effect. -#' @keywords internal -#' @noRd -validate_con <- function(x, ...) { - UseMethod("validate_con") -} - -#' @export -validate_con.default <- function(x, ...) { - stop( - sprintf( - "Unsupported connection type: %s", - paste(class(x), collapse = ", ") - ), - call. = FALSE - ) -} - -#' @export -validate_con.opal <- function(x, ...) { - tryCatch( - { - status <- xptr::is_null_xptr(x$handle$handle) - if (status) { - stop("The given connection is not valid!", call. = FALSE) - } - }, - error = function(e) { - stop("The given connection is not valid!", call. = FALSE) - } - ) -} From 7ef7c5fdc2f9a8746c99ca5f56405b2b5a0f7e49 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 14 Jul 2026 10:57:38 +0100 Subject: [PATCH 32/81] Replace T by TRUE --- R/report.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/report.R b/R/report.R index 25d7ea6..1c78f53 100644 --- a/R/report.R +++ b/R/report.R @@ -520,8 +520,8 @@ report.rocrate <- function( ) |> # replace 'NA' in fx & timestamp with empty string dplyr::mutate( - timestamp = dplyr::case_when(is.na(timestamp) ~ "", T ~ timestamp), - fx = dplyr::case_when(is.na(fx) ~ "", T ~ fx) + timestamp = dplyr::case_when(is.na(timestamp) ~ "", TRUE ~ timestamp), + fx = dplyr::case_when(is.na(fx) ~ "", TRUE ~ fx) ) } From 5900b2e2b4d0dcd954d3a355968375b418e21b1a Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 14 Jul 2026 10:58:05 +0100 Subject: [PATCH 33/81] Add tmp directory for test, plust command to delete on.exit --- tests/testthat/test-report.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-report.R b/tests/testthat/test-report.R index 551277f..a2086a8 100644 --- a/tests/testthat/test-report.R +++ b/tests/testthat/test-report.R @@ -398,6 +398,12 @@ test_that("report.list aggregates outputs from a study audit", { }) test_that("report.list handles missing outputs from a study audit", { + # create temporary file + tmp_dir <- file.path(tempdir(), "dsROCRate_tests") + dir.create(tmp_dir, recursive = TRUE) + on.exit(unlink(tmp_dir, recursive = TRUE, force = TRUE)) + out_file <- file.path(tmp_dir, "report.md") + testthat::with_mocked_bindings( report = function(...) list(), code = { @@ -405,7 +411,7 @@ test_that("report.list handles missing outputs from a study audit", { list(server1 = rocrateR::rocrate_5s()), study_name = "StudyX", render = FALSE, - filepath = tempfile(fileext = ".md") + filepath = out_file ) expect_type(result, "list") From 2e574128be31eb02fd8133500eaae3fb3a3f00b5 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 15 Jul 2026 13:28:10 +0100 Subject: [PATCH 34/81] Add new modules to create safe_symbol and symbol_registry objects, plus utilitarian functions --- R/safe-symbol.R | 86 +++++++++++++++++++++++++++++++++++++++++++++ R/symbol-registry.R | 78 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 164 insertions(+) create mode 100644 R/safe-symbol.R create mode 100644 R/symbol-registry.R diff --git a/R/safe-symbol.R b/R/safe-symbol.R new file mode 100644 index 0000000..7ba238a --- /dev/null +++ b/R/safe-symbol.R @@ -0,0 +1,86 @@ +new_safe_symbol <- function( + symbol, + kind = "unknown", + asset = NULL, + column = NULL, + parent = NULL, + created_by = NULL, + created_at = NULL, + metadata = list() +) { + stopifnot(is.character(symbol)) + stopifnot(length(symbol) == 1) + + structure( + list( + symbol = symbol, + kind = kind, + asset = asset, + column = column, + parent = parent, + created_by = created_by, + created_at = created_at, + metadata = metadata + ), + class = "safe_symbol" + ) +} + +safe_symbol <- function(symbol, ...) { + new_safe_symbol(symbol = symbol, ...) +} + +symbol <- function(x, ...) { + UseMethod("symbol") +} + +#' @export +symbol.safe_symbol <- function(x, ...) { + x$symbol +} + + +symbol_asset <- function(x, ...) { + UseMethod("symbol_asset") +} + +#' @export +symbol_asset.safe_symbol <- function(x, ...) { + x$asset +} + +symbol_column <- function(x, ...) { + UseMethod("symbol_column") +} + +#' @export +symbol_column.safe_symbol <- function(x, ...) { + x$column +} + +symbol_kind <- function(x, ...) { + UseMethod("symbol_kind") +} + +#' @export +symbol_kind.safe_symbol <- function(x, ...) { + x$kind +} + +symbol_metadata <- function(x, ...) { + UseMethod("symbol_metadata") +} + +#' @export +symbol_metadata.safe_symbol <- function(x, ...) { + x$metadata +} + +symbol_parent <- function(x, ...) { + UseMethod("symbol_parent") +} + +#' @export +symbol_parent.safe_symbol <- function(x, ...) { + x$parent +} diff --git a/R/symbol-registry.R b/R/symbol-registry.R new file mode 100644 index 0000000..07b39c2 --- /dev/null +++ b/R/symbol-registry.R @@ -0,0 +1,78 @@ +#' @export +as.data.frame.symbol_registry <- function(x, ...) { + do.call( + rbind, + lapply( + x$symbols, + function(sym) { + data.frame( + symbol = sym$symbol, + kind = sym$kind, + asset = sym$asset, + parent = sym$parent, + column = sym$column, + stringsAsFactors = FALSE + ) + } + ) + ) +} + +has_symbol <- function(registry, name) { + UseMethod("has_symbol") +} + +#' @export +has_symbol.symbol_registry <- function(registry, name) { + name %in% names(registry$symbols) +} + +new_symbol_registry <- function(symbols = list()) { + structure( + list( + symbols = symbols + ), + class = "symbol_registry" + ) +} + +lookup_symbol <- function(registry, name) { + UseMethod("lookup_symbol") +} + +#' @export +lookup_symbol.symbol_registry <- function(registry, name) { + registry$symbols[[name]] +} + +register_symbol <- function(registry, symbol) { + UseMethod("register_symbol") +} + +#' @export +register_symbol.symbol_registry <- function(registry, symbol) { + registry$symbols[[symbol$symbol]] <- symbol + registry +} + +resolve_symbol.symbol_registry <- function(registry, symbol) { + current <- lookup_symbol(registry, symbol) + + while ( + !is.null(current) && is.null(current$asset) && !is.null(current$parent) + ) { + current <- lookup_symbol(registry, current$parent) + } + + current +} + +symbol_registry <- function() { + new_symbol_registry() +} + +update_symbol <- function(registry, symbol, ...) { + # TO BE REVIEWED!!!! + registry$symbols[[symbol$symbol]] <- NULL + registry +} From c0a158aa18f18c7b0038abcd197c7fefab76c866 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 15 Jul 2026 13:28:46 +0100 Subject: [PATCH 35/81] Add steps to create symbol registry from ASSIGN operations --- R/safe_output.R | 51 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) diff --git a/R/safe_output.R b/R/safe_output.R index bd5f209..3da74f6 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -210,6 +210,9 @@ safe_output.opal <- function( return(rocrate) } + # start symbol registry + registry <- symbol_registry() + # parse logs userlogs_tbl <- backend_logs(x) |> tibble::as_tibble() |> @@ -220,6 +223,7 @@ safe_output.opal <- function( dplyr::filter(`@timestamp` >= logs_from, `@timestamp` <= logs_to) |> dplyr::filter(logger_name == "datashield.user") |> dplyr::filter(username %in% user) + userlogs <- NULL if (nrow(userlogs_tbl) > 0) { userlogs <- userlogs_tbl |> @@ -275,6 +279,53 @@ safe_output.opal <- function( encodingFormat = "text/plain" ) + # update symbol registry + ## extract 'ASSIGN' operations from the logs + userlogs_assign_tbl <- userlogs_tbl |> + dplyr::filter(ds_action %in% c("ASSIGN")) + + ## reshape the logs into a tible of `symbols` + symbols_tbl <- seq_len(nrow(userlogs_assign_tbl)) |> + purrr::map(function(i) { + # extract log components + ds_eval <- getElement(userlogs_assign_tbl[i, ], "ds_eval") + ds_resource <- getElement(userlogs_assign_tbl[i, ], "ds_resource") + ds_symbol <- getElement(userlogs_assign_tbl[i, ], "ds_symbol") + ds_table <- getElement(userlogs_assign_tbl[i, ], "ds_table") + + # evaluate which fields are populated + is_expr <- !is.null(ds_eval) && !is.na(ds_eval) + is_resource <- !is.null(ds_resource) && !is.na(ds_resource) + is_table <- !is.null(ds_table) && !is.na(ds_table) + + tibble::tibble( + symbol = ds_symbol, + kind = ifelse( + is_expr, + 'expression', + ifelse(is_resource, 'resource', ifelse(is_table, 'table', NA)) + ), + asset = ifelse( + is_expr, + ds_eval, + ifelse(is_resource, ds_resource, ifelse(is_table, ds_table, NA)) + ), + column = ifelse( + is_expr, + 'ds_eval', + ifelse(is_resource, 'ds_resource', ifelse(is_table, 'ds_table', NA)) + ), + created_at = `@timestamp` + ) + }) |> + purrr::list_c() |> + dplyr::distinct() + + ## add symbols to registry + registry <- symbols_tbl |> + purrr::pmap(safe_symbol) |> + purrr::reduce(register_symbol, .init = registry) + # extract list of functions executed ## evaluated functions and tables/symbols mapped userlogs_tbl_maps_evals <- userlogs_tbl |> From 9b04effebf129b761174e4930f55ebcec6112677 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 15 Jul 2026 13:29:13 +0100 Subject: [PATCH 36/81] Add S3 generic print method for safe_symbol --- R/print.R | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/R/print.R b/R/print.R index 931afeb..a2014eb 100644 --- a/R/print.R +++ b/R/print.R @@ -47,3 +47,27 @@ print.cr8tor_bundle <- function(x, ...) { invisible(x) } + +#' @export +print.safe_symbol <- function(x, ...) { + msg <- "" + + msg <- c(msg, paste("Symbol :", x$symbol)) + msg <- c(msg, paste("Kind :", x$kind)) + + if (!is.null(x$asset)) { + msg <- c(msg, paste("Asset :", x$asset)) + } + + if (!is.null(x$column)) { + msg <- c(msg, paste("Column :", x$column)) + } + + if (!is.null(x$parent)) { + msg <- c(msg, paste("Parent :", x$parent)) + } + + message(paste0(msg, collapse = "\n")) + + invisible(x) +} From b0410118796c559810acfcdaad1f484abf1d24b9 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 15 Jul 2026 13:29:27 +0100 Subject: [PATCH 37/81] New build --- NAMESPACE | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index e36fce3..69ac96e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method(as.data.frame,symbol_registry) S3method(audit,ArmadilloCredentials) S3method(audit,character) S3method(audit,cr8tor) @@ -49,16 +50,20 @@ S3method(flatten_safe_project,default) S3method(flatten_safe_project,rocrate) S3method(flatten_safe_setting,default) S3method(flatten_safe_setting,rocrate) +S3method(has_symbol,symbol_registry) S3method(init,ArmadilloCredentials) S3method(init,opal) S3method(init,rocrate) S3method(is_admin_con,opal) S3method(is_audit_con,opal) +S3method(lookup_symbol,symbol_registry) S3method(parse_user_profiles,ArmadilloCredentials) S3method(parse_user_profiles,opal) S3method(print,cr8tor_bundle) +S3method(print,safe_symbol) S3method(project_exists,ArmadilloCredentials) S3method(project_exists,opal) +S3method(register_symbol,symbol_registry) S3method(report,ArmadilloCredentials) S3method(report,character) S3method(report,default) @@ -90,6 +95,12 @@ S3method(safe_setting,cr8tor) S3method(safe_setting,default) S3method(safe_setting,opal) S3method(safe_setting,rocrate) +S3method(symbol,safe_symbol) +S3method(symbol_asset,safe_symbol) +S3method(symbol_column,safe_symbol) +S3method(symbol_kind,safe_symbol) +S3method(symbol_metadata,safe_symbol) +S3method(symbol_parent,safe_symbol) S3method(validate_backend_version,default) S3method(validate_backend_version,opal) S3method(validate_con,default) From 8e32955a188fbd3ea5d285b49f89c881d3195442 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 15 Jul 2026 14:18:58 +0100 Subject: [PATCH 38/81] Add field for unique ID for each symbol, automatically generated by uuid::UUIDgenerate() --- R/safe-symbol.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/R/safe-symbol.R b/R/safe-symbol.R index 7ba238a..5207531 100644 --- a/R/safe-symbol.R +++ b/R/safe-symbol.R @@ -1,5 +1,6 @@ new_safe_symbol <- function( symbol, + id = paste0("symbol-", uuid::UUIDgenerate()), kind = "unknown", asset = NULL, column = NULL, @@ -14,6 +15,7 @@ new_safe_symbol <- function( structure( list( symbol = symbol, + id = id, kind = kind, asset = asset, column = column, @@ -58,6 +60,15 @@ symbol_column.safe_symbol <- function(x, ...) { x$column } +symbol_id <- function(x, ...) { + UseMethod("symbol_id") +} + +#' @export +symbol_id.safe_symbol <- function(x, ...) { + x$id +} + symbol_kind <- function(x, ...) { UseMethod("symbol_kind") } From 7b16c45758387b026d05fd8961fd1be7fb54eb09 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 15 Jul 2026 14:19:28 +0100 Subject: [PATCH 39/81] Update approach to register and update symbols in the registry --- R/symbol-registry.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/symbol-registry.R b/R/symbol-registry.R index 07b39c2..f16ff60 100644 --- a/R/symbol-registry.R +++ b/R/symbol-registry.R @@ -51,7 +51,7 @@ register_symbol <- function(registry, symbol) { #' @export register_symbol.symbol_registry <- function(registry, symbol) { - registry$symbols[[symbol$symbol]] <- symbol + registry$symbols[[symbol$id]] <- symbol registry } @@ -73,6 +73,6 @@ symbol_registry <- function() { update_symbol <- function(registry, symbol, ...) { # TO BE REVIEWED!!!! - registry$symbols[[symbol$symbol]] <- NULL + registry$symbols[[symbol$id]] <- NULL registry } From 4fbec12fff757fba32692a3088879bc9bf4f590c Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 15 Jul 2026 14:19:59 +0100 Subject: [PATCH 40/81] Add new dependency, uuid --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 7895dd3..e6765a5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,6 +50,7 @@ Imports: rmarkdown, rocrateR (>= 0.1.0), tibble, + uuid, vtree, xptr, yaml From 56ddae5ec507761f66f96c6321552db8f8ed6f82 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 15 Jul 2026 17:48:12 +0100 Subject: [PATCH 41/81] Add new module with utilitarian functions for safe_call --- R/safe-symbol-utils.R | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 R/safe-symbol-utils.R diff --git a/R/safe-symbol-utils.R b/R/safe-symbol-utils.R new file mode 100644 index 0000000..bb59145 --- /dev/null +++ b/R/safe-symbol-utils.R @@ -0,0 +1,25 @@ +find_symbols <- function(expr) { + if (is.character(expr)) { + expr <- parse(text = expr)[[1]] + } + + refs <- list() + recurse <- function(x) { + if (is.call(x)) { + ## A$B + if (identical(x[[1]], quote(`$`))) { + refs[[length(refs) + 1]] <<- list( + symbol = as.character(x[[2]]), + column = as.character(x[[3]]) + ) + } + lapply(as.list(x)[-1], recurse) + } + } + recurse(expr) + + if (length(refs) == 0) { + return(NULL) + } + refs +} From a9ff8985b9e51d37376969226a73474bc1842246 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 15 Jul 2026 17:48:38 +0100 Subject: [PATCH 42/81] Update components for safe_symbol --- R/safe-symbol.R | 50 ++++++++++++++++++++++++------------------------- 1 file changed, 24 insertions(+), 26 deletions(-) diff --git a/R/safe-symbol.R b/R/safe-symbol.R index 5207531..c3d299a 100644 --- a/R/safe-symbol.R +++ b/R/safe-symbol.R @@ -3,10 +3,13 @@ new_safe_symbol <- function( id = paste0("symbol-", uuid::UUIDgenerate()), kind = "unknown", asset = NULL, - column = NULL, - parent = NULL, + expr = expr, + parents = NULL, created_by = NULL, created_at = NULL, + user = NULL, + session = NULL, + action = NULL, metadata = list() ) { stopifnot(is.character(symbol)) @@ -18,10 +21,13 @@ new_safe_symbol <- function( id = id, kind = kind, asset = asset, - column = column, - parent = parent, + expr = expr, + parents = parents, created_by = created_by, created_at = created_at, + user = user, + session = session, + action = action, metadata = metadata ), class = "safe_symbol" @@ -51,24 +57,6 @@ symbol_asset.safe_symbol <- function(x, ...) { x$asset } -symbol_column <- function(x, ...) { - UseMethod("symbol_column") -} - -#' @export -symbol_column.safe_symbol <- function(x, ...) { - x$column -} - -symbol_id <- function(x, ...) { - UseMethod("symbol_id") -} - -#' @export -symbol_id.safe_symbol <- function(x, ...) { - x$id -} - symbol_kind <- function(x, ...) { UseMethod("symbol_kind") } @@ -87,11 +75,21 @@ symbol_metadata.safe_symbol <- function(x, ...) { x$metadata } -symbol_parent <- function(x, ...) { - UseMethod("symbol_parent") +symbol_parents <- function(x, ...) { + UseMethod("symbol_parents") +} + +#' @export +symbol_parents.safe_symbol <- function(x, ...) { + x$parents +} + + +symbol_session <- function(x, ...) { + UseMethod("symbol_session") } #' @export -symbol_parent.safe_symbol <- function(x, ...) { - x$parent +symbol_session.safe_symbol <- function(x, ...) { + x$session } From ea0afc6691c35643016fbd112fb6c68526330eeb Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 15 Jul 2026 17:49:07 +0100 Subject: [PATCH 43/81] Update reshaping of log entries with symbols --- R/safe_output.R | 44 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 35 insertions(+), 9 deletions(-) diff --git a/R/safe_output.R b/R/safe_output.R index 3da74f6..67d59b3 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -284,7 +284,7 @@ safe_output.opal <- function( userlogs_assign_tbl <- userlogs_tbl |> dplyr::filter(ds_action %in% c("ASSIGN")) - ## reshape the logs into a tible of `symbols` + ## reshape the logs into a tibble of `symbols` symbols_tbl <- seq_len(nrow(userlogs_assign_tbl)) |> purrr::map(function(i) { # extract log components @@ -303,19 +303,38 @@ safe_output.opal <- function( kind = ifelse( is_expr, 'expression', - ifelse(is_resource, 'resource', ifelse(is_table, 'table', NA)) + ifelse( + is_resource, + 'resource', + ifelse(is_table, 'table', NA_character_) + ) ), asset = ifelse( - is_expr, - ds_eval, - ifelse(is_resource, ds_resource, ifelse(is_table, ds_table, NA)) + is_resource, + ds_resource, + ifelse(is_table, ds_table, NA_character_) ), - column = ifelse( + expr = ifelse(is_expr, ds_eval, NA_character_), + created_by = ifelse( is_expr, - 'ds_eval', - ifelse(is_resource, 'ds_resource', ifelse(is_table, 'ds_table', NA)) + 'DSI::datashield.assign.expr', + ifelse( + is_resource, + 'DSI::datashield.assign.resource', + ifelse(is_table, 'DSI::datashield.assign.table', NA_character_) + ) + ), + parents = find_symbols( + ifelse( + is_expr, + ds_eval, + ifelse(is_resource, ds_resource, ifelse(is_table, ds_table, NA)) + ) ), - created_at = `@timestamp` + created_at = userlogs_assign_tbl$`@timestamp`[[i]], + user = userlogs_assign_tbl$username[[i]], + action = userlogs_assign_tbl$ds_action[[i]], + session = userlogs_assign_tbl$ds_id[[i]] ) }) |> purrr::list_c() |> @@ -326,6 +345,13 @@ safe_output.opal <- function( purrr::pmap(safe_symbol) |> purrr::reduce(register_symbol, .init = registry) + userlogs_tbl |> + dplyr::filter(!(ds_action %in% c("ASSIGN"))) |> + dplyr::filter(!is.na(ds_eval)) |> + purrr::pmap(function(ds_eval, ...) { + safe_call(ds_eval) + }) + # extract list of functions executed ## evaluated functions and tables/symbols mapped userlogs_tbl_maps_evals <- userlogs_tbl |> From dd7fdef918d032c963095c86d9d721450e0fee9c Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 15 Jul 2026 17:49:26 +0100 Subject: [PATCH 44/81] Update symbol registry --- R/symbol-registry.R | 31 +++++++++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/R/symbol-registry.R b/R/symbol-registry.R index f16ff60..7648b7c 100644 --- a/R/symbol-registry.R +++ b/R/symbol-registry.R @@ -49,9 +49,36 @@ register_symbol <- function(registry, symbol) { UseMethod("register_symbol") } +# #' @export +# register_symbol.symbol_registry <- function(registry, symbol) { +# registry$symbols[[symbol$name]] <- symbol +# registry +# } + #' @export register_symbol.symbol_registry <- function(registry, symbol) { - registry$symbols[[symbol$id]] <- symbol + existing <- registry$symbols[[symbol$symbol]] + + if (is.null(existing)) { + registry$symbols[[symbol$symbol]] <- symbol + return(registry) + } + + # merge information + if (is.null(existing$asset)) { + existing$asset <- symbol$asset + } + + if (is.null(existing$kind)) { + existing$kind <- symbol$kind + } + + if (is.null(existing$parent)) { + existing$parent <- symbol$parent + } + + registry$symbols[[symbol$symbol]] <- existing + registry } @@ -73,6 +100,6 @@ symbol_registry <- function() { update_symbol <- function(registry, symbol, ...) { # TO BE REVIEWED!!!! - registry$symbols[[symbol$id]] <- NULL + registry$symbols[[symbol$name]] <- NULL registry } From 549f2d1e0df9cff03e27d7f555780d2c44a830a3 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Thu, 16 Jul 2026 09:47:15 +0100 Subject: [PATCH 45/81] Add new module for safe_call objects, these are used to parse the logs from DataSHIELD function calls --- R/safe-call-utils.R | 157 ++++++++++++++++++++++++++++++++++++++++++++ R/safe-call.R | 44 +++++++++++++ 2 files changed, 201 insertions(+) create mode 100644 R/safe-call-utils.R create mode 100644 R/safe-call.R diff --git a/R/safe-call-utils.R b/R/safe-call-utils.R new file mode 100644 index 0000000..73c1417 --- /dev/null +++ b/R/safe-call-utils.R @@ -0,0 +1,157 @@ +#' @export +as.data.frame.safe_call <- function(x, ...) { + data.frame( + package = x$package, + fx = x$fx, + argument = names(x$args), + value = vapply(x$args, toString, character(1)), + stringsAsFactors = FALSE + ) +} + +call_args <- function(x, ...) { + UseMethod("call_args") +} + +#' @export +call_args.safe_call <- function(x, ...) { + x$args +} + +call_fx <- function(x, ...) { + UseMethod("call_fx") +} + +#' @export +call_fx.safe_call <- function(x, ...) { + x$fx +} + +call_original <- function(x, ...) { + UseMethod("call_original") +} + +#' @export +call_original.safe_call <- function(x, ...) { + x$original +} + +call_package <- function(x, ...) { + UseMethod("call_package") +} + +#' @export +call_package.safe_call <- function(x, ...) { + x$package +} + +enrich_call <- function(call, registry) { + call$args <- lapply(call$args, resolve_argument, registry = registry) + call +} + +get_function <- function(info) { + if (is.null(info$package)) { + return(get(info$fx, mode = "function")) + } + + get(info$fx, envir = asNamespace(info$package), mode = "function") +} + +parse_arguments <- function(fx_call, info, expand.dots = FALSE) { + supplied <- as.list(fx_call[-1]) + supplied_names <- names(supplied) + + # Recover function object + fun_obj <- get_function(info) + + # Expand names + matched <- match.call( + definition = fun_obj, + call = fx_call, + expand.dots = expand.dots + ) + + matched <- as.list(matched[-1]) + + # Evaluate constants only + matched <- lapply(matched, simplify_argument) + + matched +} + +parse_call <- function(fx_call) { + fx <- fx_call[[1]] + + # package + function + info <- parse_function(fx) + + # arguments + args <- parse_arguments(fx_call, info) + + list( + original = paste(deparse(fx_call), collapse = ""), + package = info$package, + namespace = info$namespace, + fx = info$fx, + args = args, + expr = fx_call + ) +} + +parse_function <- function(fx) { + if (is.call(fx) && identical(fx[[1]], as.name("::"))) { + return( + list( + package = as.character(fx[[2]]), + namespace = "::", + fx = as.character(fx[[3]]) + ) + ) + } + + list( + package = NULL, + namespace = NULL, + fx = as.character(fx) + ) +} + +resolve_argument <- function(registry, x) { + if (!is.character(x) || length(x) != 1) { + return(x) + } + + # exact symbol + if (has_symbol(registry, x)) { + return(lookup_symbol(registry, x)) + } + + # symbol$column + if (grepl("\\$", x)) { + pieces <- strsplit(x, "\\$", fixed = FALSE)[[1]] + + if (has_symbol(registry, pieces[1])) { + sym <- lookup_symbol(registry, pieces[1]) + sym$column <- pieces[2] + return(sym) + } + } + x +} + +simplify_argument <- function(x) { + if (is.atomic(x) || is.character(x)) { + return(x) + } + + if (is.name(x)) { + return(as.character(x)) + } + + if (is.call(x)) { + return(paste(deparse(x), collapse = "")) + } + + x +} diff --git a/R/safe-call.R b/R/safe-call.R new file mode 100644 index 0000000..b54d5f6 --- /dev/null +++ b/R/safe-call.R @@ -0,0 +1,44 @@ +#' Construct a safe_call +#' +#' @keywords internal +new_safe_call <- function( + original, + package, + namespace, + fx, + args, + expr = NULL +) { + stopifnot(is.character(original)) + stopifnot(is.character(fx)) + stopifnot(is.list(args)) + + structure( + list( + original = original, + package = package, + namespace = namespace, + fx = fx, + args = args, + expr = expr + ), + class = "safe_call" + ) +} + +safe_call <- function(call) { + UseMethod("safe_call") +} + +#' @export +safe_call.character <- function(call) { + expr <- str2lang(call) + safe_call(expr) +} + +#' @export +safe_call.call <- function(call) { + parsed <- parse_call(call) + + do.call(new_safe_call, parsed) +} From e7aadd0ffb42ff8ba80087ad33af3cfb084ab684 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Thu, 16 Jul 2026 09:47:38 +0100 Subject: [PATCH 46/81] Add new print generic for safe_call --- R/print.R | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/R/print.R b/R/print.R index a2014eb..2c4b8c2 100644 --- a/R/print.R +++ b/R/print.R @@ -48,10 +48,29 @@ print.cr8tor_bundle <- function(x, ...) { invisible(x) } +#' @export +print.safe_call <- function(x, ...) { + msg <- "" + msg <- c(msg, paste("Function:", paste0(x$package, "::", x$fx))) + + if (length(x$args)) { + msg <- c(msg, "Arguments:") + msg <- c( + msg, + paste0(" ", names(x$args), " = ", unlist(x$args), collapse = "\n") + ) + } + + message(paste0(msg, collapse = "\n")) + + invisible(x) +} + #' @export print.safe_symbol <- function(x, ...) { msg <- "" + msg <- c(msg, paste("ID :", x$id)) msg <- c(msg, paste("Symbol :", x$symbol)) msg <- c(msg, paste("Kind :", x$kind)) From fcc5b4bc7e1e6428a9f33c4a00928a0b0dd6d35f Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Thu, 16 Jul 2026 09:48:11 +0100 Subject: [PATCH 47/81] Add step to generate a list of safe_call objects --- R/safe_output.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/safe_output.R b/R/safe_output.R index 67d59b3..1b169ab 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -315,6 +315,7 @@ safe_output.opal <- function( ifelse(is_table, ds_table, NA_character_) ), expr = ifelse(is_expr, ds_eval, NA_character_), + # expr = if (is_expr) str2lang(ds_eval) else NULL, created_by = ifelse( is_expr, 'DSI::datashield.assign.expr', @@ -345,11 +346,12 @@ safe_output.opal <- function( purrr::pmap(safe_symbol) |> purrr::reduce(register_symbol, .init = registry) - userlogs_tbl |> + calls_tbl <- userlogs_tbl |> dplyr::filter(!(ds_action %in% c("ASSIGN"))) |> dplyr::filter(!is.na(ds_eval)) |> purrr::pmap(function(ds_eval, ...) { - safe_call(ds_eval) + safe_call(ds_eval) |> + enrich_call(registry = registry) }) # extract list of functions executed From ebefabd0bc5a28dd9f9cbb4a23841dfe66404235 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Thu, 16 Jul 2026 17:15:06 +0100 Subject: [PATCH 48/81] Fox print.safe_call to handle when args are objects of the class safe_symbol --- R/print.R | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/R/print.R b/R/print.R index 2c4b8c2..bf3bf85 100644 --- a/R/print.R +++ b/R/print.R @@ -57,8 +57,18 @@ print.safe_call <- function(x, ...) { msg <- c(msg, "Arguments:") msg <- c( msg, - paste0(" ", names(x$args), " = ", unlist(x$args), collapse = "\n") + purrr::map2(x$args, names(x$args), function(arg_val, arg_name) { + if ("safe_symbol" %in% class(arg_val)) { + paste0(" ", arg_name, " = ", arg_val$symbol, collapse = "\n") + } else { + paste0(" ", arg_name, " = ", unlist(arg_val), collapse = "\n") + } + }) ) + # msg <- c( + # msg, + # paste0(" ", names(x$args), " = ", unlist(x$args), collapse = "\n") + # ) } message(paste0(msg, collapse = "\n")) From 0dbc52bba8368198279c3519daa9c721314d6291 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Thu, 16 Jul 2026 17:15:27 +0100 Subject: [PATCH 49/81] Update documentation and parsing of calls --- R/safe_output.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/safe_output.R b/R/safe_output.R index 1b169ab..6f779d2 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -210,7 +210,7 @@ safe_output.opal <- function( return(rocrate) } - # start symbol registry + # initialise symbol registry registry <- symbol_registry() # parse logs @@ -346,9 +346,10 @@ safe_output.opal <- function( purrr::pmap(safe_symbol) |> purrr::reduce(register_symbol, .init = registry) - calls_tbl <- userlogs_tbl |> - dplyr::filter(!(ds_action %in% c("ASSIGN"))) |> - dplyr::filter(!is.na(ds_eval)) |> + # parse aggregate function calls into list of safe_call objects + calls_lst <- userlogs_tbl |> + dplyr::filter((ds_action %in% c("AGGREGATE"))) |> + # dplyr::filter(!is.na(ds_eval)) |> purrr::pmap(function(ds_eval, ...) { safe_call(ds_eval) |> enrich_call(registry = registry) From 7bf54ac6d104330e8e8c0329f5d58d0d574e6669 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 17 Jul 2026 13:13:15 +0100 Subject: [PATCH 50/81] Introduce new helper, enrich_argument --- R/safe-call-utils.R | 35 ++++++++++++++++++++++++++++++++--- 1 file changed, 32 insertions(+), 3 deletions(-) diff --git a/R/safe-call-utils.R b/R/safe-call-utils.R index 73c1417..a026431 100644 --- a/R/safe-call-utils.R +++ b/R/safe-call-utils.R @@ -45,8 +45,38 @@ call_package.safe_call <- function(x, ...) { x$package } +enrich_argument <- function(arg, registry, timestamp, session) { + if (!is.character(arg) || length(arg) != 1) { + return(arg) + } + + symbol <- resolve_symbol( + registry, + symbol = arg, + timestamp = timestamp, + session = session + ) + + if (is.null(symbol)) { + return(arg) + } + + safe_reference( + symbol = symbol$symbol, + symbol_id = symbol$id + ) +} + enrich_call <- function(call, registry) { - call$args <- lapply(call$args, resolve_argument, registry = registry) + # call$args <- lapply(call$args, resolve_argument, registry = registry) + call$args <- purrr::map( + call$args, + enrich_argument, + registry = registry, + timestamp = call$created_at, + session = call$session + ) + call } @@ -94,8 +124,7 @@ parse_call <- function(fx_call) { package = info$package, namespace = info$namespace, fx = info$fx, - args = args, - expr = fx_call + args = args ) } From 671824792213299173bffa32caff55c858fa8205 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 17 Jul 2026 13:14:14 +0100 Subject: [PATCH 51/81] Add new S3 generic for as.data.frame.safe_call objects and update the constructor for safe_call, so it captures additional arguments captured in the logs (e.g., session and user) --- R/safe-call.R | 31 ++++++++++++++++++++++++------- 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/R/safe-call.R b/R/safe-call.R index b54d5f6..66adc80 100644 --- a/R/safe-call.R +++ b/R/safe-call.R @@ -1,3 +1,17 @@ +#' @export +as.data.frame.safe_call <- function(x, ...) { + data.frame( + timestamp = format(x$created_at, '%Y-%m-%dT%H:%M:%S'), + user = x$user, + r_cmd = x$original, + fx = paste0(x$package, x$namespace, x$fx), + args = x$args, + session = x$session, + profile = x$profile, + stringsAsFactors = FALSE + ) +} + #' Construct a safe_call #' #' @keywords internal @@ -7,7 +21,7 @@ new_safe_call <- function( namespace, fx, args, - expr = NULL + ... ) { stopifnot(is.character(original)) stopifnot(is.character(fx)) @@ -20,25 +34,28 @@ new_safe_call <- function( namespace = namespace, fx = fx, args = args, - expr = expr + created_at = getElement(list(...), "@timestamp"), + user = getElement(list(...), "username"), + session = getElement(list(...), "ds_id"), + profile = getElement(list(...), "ds_profile") ), class = "safe_call" ) } -safe_call <- function(call) { +safe_call <- function(call, ...) { UseMethod("safe_call") } #' @export -safe_call.character <- function(call) { +safe_call.character <- function(call, ...) { expr <- str2lang(call) - safe_call(expr) + safe_call(expr, ...) } #' @export -safe_call.call <- function(call) { +safe_call.call <- function(call, ...) { parsed <- parse_call(call) - do.call(new_safe_call, parsed) + do.call(new_safe_call, c(parsed, list(...))) } From 2de0aeb56e2cebebd0ab2ac6459df34aab04ab98 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 17 Jul 2026 13:15:58 +0100 Subject: [PATCH 52/81] Add new S3 generic for as.data.frame.safe_symbol objects and redefine the new_safe_symbol internal helper --- R/safe-symbol.R | 41 ++++++++++++++++++++++++++++++----------- 1 file changed, 30 insertions(+), 11 deletions(-) diff --git a/R/safe-symbol.R b/R/safe-symbol.R index c3d299a..eac1e4d 100644 --- a/R/safe-symbol.R +++ b/R/safe-symbol.R @@ -1,24 +1,43 @@ +#' @export +as.data.frame.safe_symbol <- function(x, ...) { + data.frame( + id = x$id, + symbol = x$symbol, + kind = x$kind, + asset = x$asset, + expr = x$expr, + # parents = x$parents, + created_by = x$created_by, + created_at = x$created_at, + user = x$user, + session = x$session, + action = x$action, + # metadata = x$metadata, + stringsAsFactors = FALSE + ) +} + new_safe_symbol <- function( symbol, - id = paste0("symbol-", uuid::UUIDgenerate()), kind = "unknown", - asset = NULL, - expr = expr, - parents = NULL, - created_by = NULL, - created_at = NULL, - user = NULL, - session = NULL, - action = NULL, - metadata = list() + asset = NA_character_, + expr = NA_character_, + parents = list(), + created_by = NA_character_, + created_at = Sys.time(), + user = NA_character_, + session = NA_character_, + action = NA_character_, + metadata = list(), + id = paste0("symbol-", uuid::UUIDgenerate()) ) { stopifnot(is.character(symbol)) stopifnot(length(symbol) == 1) structure( list( - symbol = symbol, id = id, + symbol = symbol, kind = kind, asset = asset, expr = expr, From cc91a95ddd6b3c0fad0951a82729f4f105186a44 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 17 Jul 2026 13:17:14 +0100 Subject: [PATCH 53/81] Update call to safe_call to dispatch the additional values from the logs. Add code to convert list of calls into tibble --- R/safe_output.R | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/R/safe_output.R b/R/safe_output.R index 6f779d2..077befa 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -351,10 +351,25 @@ safe_output.opal <- function( dplyr::filter((ds_action %in% c("AGGREGATE"))) |> # dplyr::filter(!is.na(ds_eval)) |> purrr::pmap(function(ds_eval, ...) { - safe_call(ds_eval) |> + safe_call(ds_eval, ...) |> enrich_call(registry = registry) }) + # convert list of calls into tibble + purrr::map(calls_lst, \(x) { + tibble::tibble( + timestamp = format(x$created_at, '%Y-%m-%dT%H:%M:%S'), + action = "AGGREGATE", + user = x$user, + r_cmd = x$original, + fx = paste0(x$package, x$namespace, x$fx), + args = list(x$args), + session = x$session, + profile = x$profile + ) + }) |> + purrr::list_c() + # extract list of functions executed ## evaluated functions and tables/symbols mapped userlogs_tbl_maps_evals <- userlogs_tbl |> From 3d3366ef610311fea4097d05084acf75de3a5192 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 17 Jul 2026 13:40:42 +0100 Subject: [PATCH 54/81] Update the resolve_symbol function (previously resolve_symbol.symbol_registry), which now takes a timestamp, session and user to match a symbol in a function call. --- R/symbol-registry.R | 77 +++++++++++++++++++++++---------------------- 1 file changed, 39 insertions(+), 38 deletions(-) diff --git a/R/symbol-registry.R b/R/symbol-registry.R index 7648b7c..dbfa783 100644 --- a/R/symbol-registry.R +++ b/R/symbol-registry.R @@ -49,57 +49,58 @@ register_symbol <- function(registry, symbol) { UseMethod("register_symbol") } -# #' @export -# register_symbol.symbol_registry <- function(registry, symbol) { -# registry$symbols[[symbol$name]] <- symbol -# registry -# } - #' @export register_symbol.symbol_registry <- function(registry, symbol) { - existing <- registry$symbols[[symbol$symbol]] - - if (is.null(existing)) { - registry$symbols[[symbol$symbol]] <- symbol - return(registry) - } - - # merge information - if (is.null(existing$asset)) { - existing$asset <- symbol$asset - } - - if (is.null(existing$kind)) { - existing$kind <- symbol$kind - } + stopifnot(inherits(symbol, "safe_symbol")) - if (is.null(existing$parent)) { - existing$parent <- symbol$parent - } + registry$symbols <- dplyr::bind_rows( + registry$symbols, + tibble::as_tibble(symbol) + ) - registry$symbols[[symbol$symbol]] <- existing + # existing <- registry$symbols[[symbol$symbol]] + # + # registry$symbols[[symbol$symbol]] <- existing registry } -resolve_symbol.symbol_registry <- function(registry, symbol) { - current <- lookup_symbol(registry, symbol) +# resolve_symbol.symbol_registry <- function( +resolve_symbol <- function( + registry, + symbol, + timestamp, + session = NULL, + user = NULL +) { + # current <- lookup_symbol(registry, symbol) + # + # while ( + # !is.null(current) && is.null(current$asset) && !is.null(current$parent) + # ) { + # current <- lookup_symbol(registry, current$parent) + # } + # + # current + x <- registry$symbols |> + dplyr::filter(symbol == !!symbol, created_at <= !!timestamp) + + if (!is.null(session)) { + x <- dplyr::filter(x, session == !!session) + } + + if (!is.null(user)) { + x <- dplyr::filter(x, user == !!user) + } - while ( - !is.null(current) && is.null(current$asset) && !is.null(current$parent) - ) { - current <- lookup_symbol(registry, current$parent) + if (nrow(x) == 0) { + return(NULL) } - current + x |> + dplyr::slice_max(created_at, n = 1) } symbol_registry <- function() { new_symbol_registry() } - -update_symbol <- function(registry, symbol, ...) { - # TO BE REVIEWED!!!! - registry$symbols[[symbol$name]] <- NULL - registry -} From 9df8c8633bb069e9373c7e430ca8ddced4f960c5 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 17 Jul 2026 16:05:10 +0100 Subject: [PATCH 55/81] Add new helper to create a safe_reference object --- R/safe-reference.R | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 R/safe-reference.R diff --git a/R/safe-reference.R b/R/safe-reference.R new file mode 100644 index 0000000..ee1aed0 --- /dev/null +++ b/R/safe-reference.R @@ -0,0 +1,10 @@ +safe_reference <- function(symbol, symbol_id, column = NULL) { + structure( + list( + symbol = symbol, + symbol_id = symbol_id, + column = column + ), + class = "safe_reference" + ) +} From 596e8dc0300a94c2ec157e1bc69b9ea806b557a8 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Mon, 20 Jul 2026 13:53:46 +0100 Subject: [PATCH 56/81] Update safe_ouput.opal generic to skip process of updating registry symbols parent's --- R/safe_output.R | 52 +++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 44 insertions(+), 8 deletions(-) diff --git a/R/safe_output.R b/R/safe_output.R index 077befa..a09d626 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -325,13 +325,14 @@ safe_output.opal <- function( ifelse(is_table, 'DSI::datashield.assign.table', NA_character_) ) ), - parents = find_symbols( - ifelse( - is_expr, - ds_eval, - ifelse(is_resource, ds_resource, ifelse(is_table, ds_table, NA)) - ) - ), + parents = NA_character_, + # parents = find_symbols( + # ifelse( + # is_expr, + # ds_eval, + # ifelse(is_resource, ds_resource, ifelse(is_table, ds_table, NA)) + # ) + # ), created_at = userlogs_assign_tbl$`@timestamp`[[i]], user = userlogs_assign_tbl$username[[i]], action = userlogs_assign_tbl$ds_action[[i]], @@ -346,6 +347,22 @@ safe_output.opal <- function( purrr::pmap(safe_symbol) |> purrr::reduce(register_symbol, .init = registry) + # ## update parents + # registry$symbols <- seq_len(nrow(registry$symbols)) |> + # purrr::map(function(r) { + # registry$symbols[r, ] |> + # dplyr::mutate( + # parents = resolve_symbol( + # registry, + # ifelse(kind == "expression", expr, asset), + # created_at, + # session, + # user + # ) + # ) + # }) |> + # purrr::list_c() + # parse aggregate function calls into list of safe_call objects calls_lst <- userlogs_tbl |> dplyr::filter((ds_action %in% c("AGGREGATE"))) |> @@ -356,7 +373,7 @@ safe_output.opal <- function( }) # convert list of calls into tibble - purrr::map(calls_lst, \(x) { + calls_tbl <- purrr::map(calls_lst, \(x) { tibble::tibble( timestamp = format(x$created_at, '%Y-%m-%dT%H:%M:%S'), action = "AGGREGATE", @@ -364,6 +381,25 @@ safe_output.opal <- function( r_cmd = x$original, fx = paste0(x$package, x$namespace, x$fx), args = list(x$args), + symbol = NA, + table = x$args |> + purrr::map(function(x) { + if (is.list(x)) { + aux <- registry$symbols |> + dplyr::filter(id == x$symbol_id) + if (is.null(aux)) { + return(NA_character_) + } + # recursively find root symbol based on the `parents` column + # while (!is.null(aux$parent)) { + # aux <- + # } + if (aux$kind != "expression") { + return(aux$asset) + } + } + NA_character_ + }), session = x$session, profile = x$profile ) From c8249924fcba6061ccdc0d8982c75e5679790222 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 21 Jul 2026 11:59:58 +0100 Subject: [PATCH 57/81] Update output object containing tibble with parsed log function calls --- R/safe_output.R | 199 +++++++++++++++++++++++++++++++++++------------- 1 file changed, 144 insertions(+), 55 deletions(-) diff --git a/R/safe_output.R b/R/safe_output.R index a09d626..8ff8c40 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -406,77 +406,166 @@ safe_output.opal <- function( }) |> purrr::list_c() - # extract list of functions executed - ## evaluated functions and tables/symbols mapped - userlogs_tbl_maps_evals <- userlogs_tbl |> - dplyr::filter(ds_action %in% c("ASSIGN", "AGGREGATE", "OPEN")) |> - # add place-holder column, for when ro records are found - dplyr::bind_rows(tibble::tibble(ds_table = NA, is_placeholder = TRUE)) |> - dplyr::filter(is.na(is_placeholder)) |> - # create derived `ds_eval` when `ds_action` = 'ASSIGN' + # combine function calls with symbol's registry + calls_symbols_tbl <- calls_tbl |> + dplyr::select(-symbol) |> dplyr::mutate( - ds_eval = dplyr::coalesce( - ds_eval, - paste0(ds_symbol, " <- opal[", ds_table, "]") - ), - # attach session ID, `ds_id`, if `ds_eval` if `ds_action == 'OPEN'` - ds_eval = ifelse( - ds_action == "OPEN", - paste0("Open session: ", ds_id), - ds_eval + args = purrr::map( + args, + ~ purrr::imap_dfr(.x, function(arg, nm) { + if (!inherits(arg, "safe_reference")) { + tibble::tibble( + argument = nm, + value = list(arg), + symbol_id = NA_character_, + symbol = NA_character_, + column = NA_character_ + ) + } else { + tibble::tibble( + argument = nm, + value = list(arg), + symbol_id = arg$symbol_id, + symbol = arg$symbol, + column = arg$column + ) + } + }) ) ) |> - dplyr::distinct( - ds_id, - username, - ds_action, - ds_eval, - ds_table, - `@timestamp` - ) |> - # refill values for ds_table, based on ds_id - dplyr::group_by(ds_id) |> - dplyr::mutate( - ds_table = refill_vec(ds_table) + # tidyr::unnest(args) |> + (\(x) { + purrr::map2( + split(x |> dplyr::select(-args), seq_len(nrow(x))), + x$args, + dplyr::bind_cols + ) + })() |> + purrr::list_c() |> + dplyr::left_join( + registry$symbols, + by = c("symbol_id" = "id"), + suffix = c("", "_registry") ) |> - dplyr::ungroup() |> + # add column with backend + dplyr::mutate(backend = "OBiBa's Opal") |> + # subset columns + dplyr::select( + timestamp, + action, + user, + r_cmd, + fx, + symbol, + kind, + asset, + expr, + # table = ds_table, + session, + backend + ) + + # extract session details + session_tbl <- userlogs_tbl |> + dplyr::filter((ds_action %in% c("OPEN"))) |> dplyr::mutate( # format timestamp - `@timestamp` = format(`@timestamp`, '%Y-%m-%dT%H:%M:%S'), - # extract function name from ds_eval - ds_function = ds_eval |> - gsub(pattern = "(?=\\().*$", replacement = "", perl = TRUE), - # extract symbol/object from ds_eval - ds_symbol = ds_eval |> - gsub(pattern = "^.*(?<=\\()", replacement = "", perl = TRUE) |> - gsub(pattern = "(?=\\)).*$", replacement = "", perl = TRUE) |> - gsub(pattern = '"|\'', replacement = "", perl = TRUE) |> - gsub(pattern = "(?=\\$).*", replacement = "", perl = TRUE), - # autofill `ds_function` when `ds_action` = 'ASSIGN' - ds_function = ifelse(ds_symbol == ds_eval, "base::assign", ds_function), - # set `ds_function = 'DSI::datashield.login'` if `ds_action == 'OPEN'` - ds_function = ifelse( - ds_action == "OPEN", - "DSI::datashield.login", - ds_function - ), - ds_symbol = ifelse(ds_symbol == ds_eval, NA, ds_symbol), - # add column with backend - backend = "OBiBa's Opal", - .before = 1 + timestamp = format(`@timestamp`, '%Y-%m-%dT%H:%M:%S'), + # attach session ID, `ds_id`, if `ds_action == 'OPEN'` + ds_eval = paste0("Open session: ", ds_id), + # set `ds_function = 'DSI::datashield.login'` + ds_function = "DSI::datashield.login", + backend = "OBiBa's Opal" ) |> dplyr::select( - timestamp = `@timestamp`, + timestamp, action = ds_action, user = username, r_cmd = ds_eval, fx = ds_function, - symbol = ds_symbol, - table = ds_table, session = ds_id, backend ) + # combine the logs + userlogs_tbl_maps_evals <- calls_symbols_tbl |> + dplyr::distinct() |> + dplyr::mutate(log_id = dplyr::row_number()) |> + dplyr::bind_rows(session_tbl) |> + dplyr::arrange(timestamp, log_id) |> + dplyr::select(-log_id) + + # # extract list of functions executed + # ## evaluated functions and tables/symbols mapped + # userlogs_tbl_maps_evals <- userlogs_tbl |> + # dplyr::filter(ds_action %in% c("ASSIGN", "AGGREGATE", "OPEN")) |> + # # add place-holder column, for when ro records are found + # dplyr::bind_rows(tibble::tibble(ds_table = NA, is_placeholder = TRUE)) |> + # dplyr::filter(is.na(is_placeholder)) |> + # # create derived `ds_eval` when `ds_action` = 'ASSIGN' + # dplyr::mutate( + # ds_eval = dplyr::coalesce( + # ds_eval, + # paste0(ds_symbol, " <- opal[", ds_table, "]") + # ), + # # attach session ID, `ds_id`, if `ds_eval` if `ds_action == 'OPEN'` + # ds_eval = ifelse( + # ds_action == "OPEN", + # paste0("Open session: ", ds_id), + # ds_eval + # ) + # ) |> + # dplyr::distinct( + # ds_id, + # username, + # ds_action, + # ds_eval, + # ds_table, + # `@timestamp` + # ) |> + # # refill values for ds_table, based on ds_id + # dplyr::group_by(ds_id) |> + # dplyr::mutate( + # ds_table = refill_vec(ds_table) + # ) |> + # dplyr::ungroup() |> + # dplyr::mutate( + # # format timestamp + # `@timestamp` = format(`@timestamp`, '%Y-%m-%dT%H:%M:%S'), + # # extract function name from ds_eval + # ds_function = ds_eval |> + # gsub(pattern = "(?=\\().*$", replacement = "", perl = TRUE), + # # extract symbol/object from ds_eval + # ds_symbol = ds_eval |> + # gsub(pattern = "^.*(?<=\\()", replacement = "", perl = TRUE) |> + # gsub(pattern = "(?=\\)).*$", replacement = "", perl = TRUE) |> + # gsub(pattern = '"|\'', replacement = "", perl = TRUE) |> + # gsub(pattern = "(?=\\$).*", replacement = "", perl = TRUE), + # # autofill `ds_function` when `ds_action` = 'ASSIGN' + # ds_function = ifelse(ds_symbol == ds_eval, "base::assign", ds_function), + # # set `ds_function = 'DSI::datashield.login'` if `ds_action == 'OPEN'` + # ds_function = ifelse( + # ds_action == "OPEN", + # "DSI::datashield.login", + # ds_function + # ), + # ds_symbol = ifelse(ds_symbol == ds_eval, NA, ds_symbol), + # # add column with backend + # backend = "OBiBa's Opal", + # .before = 1 + # ) |> + # dplyr::select( + # timestamp = `@timestamp`, + # action = ds_action, + # user = username, + # r_cmd = ds_eval, + # fx = ds_function, + # symbol = ds_symbol, + # table = ds_table, + # session = ds_id, + # backend + # ) + log_maps_filename <- paste0( format(Sys.time(), "%Y%m%dT%H%M%S"), "-dslogs-", From edec42f17cb458f7088ad2f607e72986c96c1a94 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 21 Jul 2026 17:06:11 +0100 Subject: [PATCH 58/81] Remove unused code --- R/safe_output.R | 89 +------------------------------------------------ 1 file changed, 1 insertion(+), 88 deletions(-) diff --git a/R/safe_output.R b/R/safe_output.R index 8ff8c40..a278642 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -325,7 +325,7 @@ safe_output.opal <- function( ifelse(is_table, 'DSI::datashield.assign.table', NA_character_) ) ), - parents = NA_character_, + # parents = NA_character_, # parents = find_symbols( # ifelse( # is_expr, @@ -347,22 +347,6 @@ safe_output.opal <- function( purrr::pmap(safe_symbol) |> purrr::reduce(register_symbol, .init = registry) - # ## update parents - # registry$symbols <- seq_len(nrow(registry$symbols)) |> - # purrr::map(function(r) { - # registry$symbols[r, ] |> - # dplyr::mutate( - # parents = resolve_symbol( - # registry, - # ifelse(kind == "expression", expr, asset), - # created_at, - # session, - # user - # ) - # ) - # }) |> - # purrr::list_c() - # parse aggregate function calls into list of safe_call objects calls_lst <- userlogs_tbl |> dplyr::filter((ds_action %in% c("AGGREGATE"))) |> @@ -495,77 +479,6 @@ safe_output.opal <- function( dplyr::arrange(timestamp, log_id) |> dplyr::select(-log_id) - # # extract list of functions executed - # ## evaluated functions and tables/symbols mapped - # userlogs_tbl_maps_evals <- userlogs_tbl |> - # dplyr::filter(ds_action %in% c("ASSIGN", "AGGREGATE", "OPEN")) |> - # # add place-holder column, for when ro records are found - # dplyr::bind_rows(tibble::tibble(ds_table = NA, is_placeholder = TRUE)) |> - # dplyr::filter(is.na(is_placeholder)) |> - # # create derived `ds_eval` when `ds_action` = 'ASSIGN' - # dplyr::mutate( - # ds_eval = dplyr::coalesce( - # ds_eval, - # paste0(ds_symbol, " <- opal[", ds_table, "]") - # ), - # # attach session ID, `ds_id`, if `ds_eval` if `ds_action == 'OPEN'` - # ds_eval = ifelse( - # ds_action == "OPEN", - # paste0("Open session: ", ds_id), - # ds_eval - # ) - # ) |> - # dplyr::distinct( - # ds_id, - # username, - # ds_action, - # ds_eval, - # ds_table, - # `@timestamp` - # ) |> - # # refill values for ds_table, based on ds_id - # dplyr::group_by(ds_id) |> - # dplyr::mutate( - # ds_table = refill_vec(ds_table) - # ) |> - # dplyr::ungroup() |> - # dplyr::mutate( - # # format timestamp - # `@timestamp` = format(`@timestamp`, '%Y-%m-%dT%H:%M:%S'), - # # extract function name from ds_eval - # ds_function = ds_eval |> - # gsub(pattern = "(?=\\().*$", replacement = "", perl = TRUE), - # # extract symbol/object from ds_eval - # ds_symbol = ds_eval |> - # gsub(pattern = "^.*(?<=\\()", replacement = "", perl = TRUE) |> - # gsub(pattern = "(?=\\)).*$", replacement = "", perl = TRUE) |> - # gsub(pattern = '"|\'', replacement = "", perl = TRUE) |> - # gsub(pattern = "(?=\\$).*", replacement = "", perl = TRUE), - # # autofill `ds_function` when `ds_action` = 'ASSIGN' - # ds_function = ifelse(ds_symbol == ds_eval, "base::assign", ds_function), - # # set `ds_function = 'DSI::datashield.login'` if `ds_action == 'OPEN'` - # ds_function = ifelse( - # ds_action == "OPEN", - # "DSI::datashield.login", - # ds_function - # ), - # ds_symbol = ifelse(ds_symbol == ds_eval, NA, ds_symbol), - # # add column with backend - # backend = "OBiBa's Opal", - # .before = 1 - # ) |> - # dplyr::select( - # timestamp = `@timestamp`, - # action = ds_action, - # user = username, - # r_cmd = ds_eval, - # fx = ds_function, - # symbol = ds_symbol, - # table = ds_table, - # session = ds_id, - # backend - # ) - log_maps_filename <- paste0( format(Sys.time(), "%Y%m%dT%H%M%S"), "-dslogs-", From e438eda662e4469dc91d1f5054a49cae752708ae Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 21 Jul 2026 17:06:41 +0100 Subject: [PATCH 59/81] Redefine as.data.frame.safe_symbol generic to as_tibble.safe_symbol --- R/safe-symbol.R | 40 ++++++++++++++++++++++++++++------------ 1 file changed, 28 insertions(+), 12 deletions(-) diff --git a/R/safe-symbol.R b/R/safe-symbol.R index eac1e4d..5502d24 100644 --- a/R/safe-symbol.R +++ b/R/safe-symbol.R @@ -1,19 +1,19 @@ #' @export -as.data.frame.safe_symbol <- function(x, ...) { - data.frame( +as_tibble.safe_symbol <- function(x, ...) { + tibble::tibble( id = x$id, symbol = x$symbol, kind = x$kind, asset = x$asset, expr = x$expr, - # parents = x$parents, + depends_on = list(x$depends_on), created_by = x$created_by, created_at = x$created_at, user = x$user, session = x$session, - action = x$action, + action = x$action #, # metadata = x$metadata, - stringsAsFactors = FALSE + # stringsAsFactors = FALSE ) } @@ -22,7 +22,7 @@ new_safe_symbol <- function( kind = "unknown", asset = NA_character_, expr = NA_character_, - parents = list(), + depends_on = list(), created_by = NA_character_, created_at = Sys.time(), user = NA_character_, @@ -41,7 +41,7 @@ new_safe_symbol <- function( kind = kind, asset = asset, expr = expr, - parents = parents, + depends_on = depends_on, created_by = created_by, created_at = created_at, user = user, @@ -53,10 +53,27 @@ new_safe_symbol <- function( ) } +new_safe_symbol_reference <- function(symbol, column = NULL) { + stopifnot(is.character(symbol)) + stopifnot(length(symbol) == 1) + + structure( + list( + symbol = symbol, + column = column + ), + class = "safe_symbol_reference" + ) +} + safe_symbol <- function(symbol, ...) { new_safe_symbol(symbol = symbol, ...) } +safe_symbol_reference <- function(symbol, ...) { + new_safe_symbol_reference(symbol = symbol, ...) +} + symbol <- function(x, ...) { UseMethod("symbol") } @@ -94,16 +111,15 @@ symbol_metadata.safe_symbol <- function(x, ...) { x$metadata } -symbol_parents <- function(x, ...) { - UseMethod("symbol_parents") +symbol_depends_on <- function(x, ...) { + UseMethod("symbol_depends_on") } #' @export -symbol_parents.safe_symbol <- function(x, ...) { - x$parents +symbol_depends_on.safe_symbol <- function(x, ...) { + x$depends_on } - symbol_session <- function(x, ...) { UseMethod("symbol_session") } From 0cb321985ab89c490b7627096bfd1bff03c278d2 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 21 Jul 2026 17:07:43 +0100 Subject: [PATCH 60/81] Add new utilitarian function, resolve_dependencies to trace back root/source table/resource when argument is masked by an assignment operation --- R/safe-symbol-utils.R | 112 +++++++++++++++++++++++++++++++++++++----- 1 file changed, 100 insertions(+), 12 deletions(-) diff --git a/R/safe-symbol-utils.R b/R/safe-symbol-utils.R index bb59145..54031c1 100644 --- a/R/safe-symbol-utils.R +++ b/R/safe-symbol-utils.R @@ -3,23 +3,111 @@ find_symbols <- function(expr) { expr <- parse(text = expr)[[1]] } - refs <- list() recurse <- function(x) { - if (is.call(x)) { - ## A$B - if (identical(x[[1]], quote(`$`))) { - refs[[length(refs) + 1]] <<- list( - symbol = as.character(x[[2]]), - column = as.character(x[[3]]) - ) - } - lapply(as.list(x)[-1], recurse) + if (is.symbol(x)) { + return(list(list( + symbol = as.character(x), + column = NA_character_ + ))) } + + if (!is.call(x)) { + return(list()) + } + + if (identical(x[[1]], quote(`$`))) { + lhs <- x[[2]] + out <- list(list( + symbol = as.character(lhs), + column = as.character(x[[3]]) + )) + + return(out) + } + + unlist( + lapply(as.list(x)[-1], recurse), + recursive = FALSE + ) } - recurse(expr) - if (length(refs) == 0) { + refs <- recurse(expr) + refs <- Filter(\(x) !(x$symbol %in% c("base", "stats", "utils")), refs) + if (!length(refs)) { return(NULL) } refs } + +find_symbol_asset <- function(symbol_id, registry) { + sym <- registry$symbols |> + dplyr::filter(id == symbol_id) + + if (!nrow(sym)) { + return(NA_character_) + } + + if (sym$kind == "table") { + return(sym$asset) + } + + deps <- resolve_dependencies(sym$expr, registry) + + if (!nrow(deps)) { + return(NA_character_) + } + + assets <- purrr::map_chr( + deps$symbol_id, + find_symbol_asset, + registry = registry + ) + + unique(stats::na.omit(assets)) +} + +resolve_dependencies <- function(expr, registry, visited = character()) { + if (is.null(expr) || is.na(expr)) { + return(tibble::tibble()) + } + + refs <- find_symbols(expr) + + if (is.null(refs)) { + return(tibble::tibble()) + } + + deps <- purrr::map_dfr(refs, tibble::as_tibble) |> + dplyr::left_join( + registry$symbols |> + dplyr::select(symbol_id = id, symbol, kind, asset, expr), + by = "symbol" + ) + + deps <- deps |> + dplyr::mutate( + parents = purrr::map( + symbol_id, + function(symbol_id) { + if (is.na(symbol_id) || symbol_id %in% visited) { + return(tibble::tibble()) + } + + sym <- registry$symbols |> + dplyr::filter(id == symbol_id) + + if (!nrow(sym) || sym$kind != "expression") { + return(tibble::tibble()) + } + + resolve_dependencies( + expr = sym$expr, + registry = registry, + visited = c(visited, symbol_id) + ) + } + ) + ) + + deps +} From 2adc2577ee65d433b7c3bea0306033152972dd6e Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 21 Jul 2026 17:08:06 +0100 Subject: [PATCH 61/81] Update symbol registry with extra dependencies --- R/symbol-registry.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/symbol-registry.R b/R/symbol-registry.R index dbfa783..5b7cfda 100644 --- a/R/symbol-registry.R +++ b/R/symbol-registry.R @@ -53,6 +53,10 @@ register_symbol <- function(registry, symbol) { register_symbol.symbol_registry <- function(registry, symbol) { stopifnot(inherits(symbol, "safe_symbol")) + # append dependent symbols + symbol$depends_on <- + resolve_dependencies(symbol$expr, registry) + registry$symbols <- dplyr::bind_rows( registry$symbols, tibble::as_tibble(symbol) From 04931c0c286e683fa01c18b36edc7863d80265d5 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Tue, 21 Jul 2026 17:08:19 +0100 Subject: [PATCH 62/81] New build --- NAMESPACE | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 69ac96e..4e5eabf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method(as.data.frame,safe_call) S3method(as.data.frame,symbol_registry) S3method(audit,ArmadilloCredentials) S3method(audit,character) @@ -26,6 +27,10 @@ S3method(backend_table_perms,opal) S3method(backend_tables,opal) S3method(backend_user_exists,opal) S3method(backend_users,opal) +S3method(call_args,safe_call) +S3method(call_fx,safe_call) +S3method(call_original,safe_call) +S3method(call_package,safe_call) S3method(check_permissions,ArmadilloCredentials) S3method(check_permissions,default) S3method(check_permissions,opal) @@ -60,6 +65,7 @@ S3method(lookup_symbol,symbol_registry) S3method(parse_user_profiles,ArmadilloCredentials) S3method(parse_user_profiles,opal) S3method(print,cr8tor_bundle) +S3method(print,safe_call) S3method(print,safe_symbol) S3method(project_exists,ArmadilloCredentials) S3method(project_exists,opal) @@ -69,6 +75,8 @@ S3method(report,character) S3method(report,default) S3method(report,list) S3method(report,rocrate) +S3method(safe_call,call) +S3method(safe_call,character) S3method(safe_data,ArmadilloCredentials) S3method(safe_data,character) S3method(safe_data,default) @@ -97,15 +105,16 @@ S3method(safe_setting,opal) S3method(safe_setting,rocrate) S3method(symbol,safe_symbol) S3method(symbol_asset,safe_symbol) -S3method(symbol_column,safe_symbol) +S3method(symbol_depends_on,safe_symbol) S3method(symbol_kind,safe_symbol) S3method(symbol_metadata,safe_symbol) -S3method(symbol_parent,safe_symbol) +S3method(symbol_session,safe_symbol) S3method(validate_backend_version,default) S3method(validate_backend_version,opal) S3method(validate_con,default) S3method(validate_con,opal) export(armadillo_login) +export(as_tibble.safe_symbol) export(audit) export(check_permissions) export(init) From bff352c79fa7cf591f5ba42ab20373b4b45ab565 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 15:03:36 +0100 Subject: [PATCH 63/81] Remove snippets of unused code and add call to the new internal helper, resolve_symbol_asset --- R/safe_output.R | 37 ++++++++++++++----------------------- 1 file changed, 14 insertions(+), 23 deletions(-) diff --git a/R/safe_output.R b/R/safe_output.R index a278642..0fc04f9 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -325,14 +325,6 @@ safe_output.opal <- function( ifelse(is_table, 'DSI::datashield.assign.table', NA_character_) ) ), - # parents = NA_character_, - # parents = find_symbols( - # ifelse( - # is_expr, - # ds_eval, - # ifelse(is_resource, ds_resource, ifelse(is_table, ds_table, NA)) - # ) - # ), created_at = userlogs_assign_tbl$`@timestamp`[[i]], user = userlogs_assign_tbl$username[[i]], action = userlogs_assign_tbl$ds_action[[i]], @@ -368,21 +360,10 @@ safe_output.opal <- function( symbol = NA, table = x$args |> purrr::map(function(x) { - if (is.list(x)) { - aux <- registry$symbols |> - dplyr::filter(id == x$symbol_id) - if (is.null(aux)) { - return(NA_character_) - } - # recursively find root symbol based on the `parents` column - # while (!is.null(aux$parent)) { - # aux <- - # } - if (aux$kind != "expression") { - return(aux$asset) - } + if (!inherits(x, "safe_reference")) { + return(NA_character_) } - NA_character_ + resolve_symbol_asset(x$symbol_id, registry) }), session = x$session, profile = x$profile @@ -417,7 +398,6 @@ safe_output.opal <- function( }) ) ) |> - # tidyr::unnest(args) |> (\(x) { purrr::map2( split(x |> dplyr::select(-args), seq_len(nrow(x))), @@ -431,6 +411,17 @@ safe_output.opal <- function( by = c("symbol_id" = "id"), suffix = c("", "_registry") ) |> + dplyr::mutate( + asset = dplyr::if_else( + kind == "expression", + purrr::map_chr( + symbol_id, + resolve_symbol_asset, + registry = registry + ), + asset + ) + ) |> # add column with backend dplyr::mutate(backend = "OBiBa's Opal") |> # subset columns From f328c2fbb3e154f65d9f05f4ab02edc48d201036 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 15:04:42 +0100 Subject: [PATCH 64/81] Remove resolve_argument, an unused internal function --- R/safe-call-utils.R | 23 ----------------------- 1 file changed, 23 deletions(-) diff --git a/R/safe-call-utils.R b/R/safe-call-utils.R index a026431..c1f7481 100644 --- a/R/safe-call-utils.R +++ b/R/safe-call-utils.R @@ -146,29 +146,6 @@ parse_function <- function(fx) { ) } -resolve_argument <- function(registry, x) { - if (!is.character(x) || length(x) != 1) { - return(x) - } - - # exact symbol - if (has_symbol(registry, x)) { - return(lookup_symbol(registry, x)) - } - - # symbol$column - if (grepl("\\$", x)) { - pieces <- strsplit(x, "\\$", fixed = FALSE)[[1]] - - if (has_symbol(registry, pieces[1])) { - sym <- lookup_symbol(registry, pieces[1]) - sym$column <- pieces[2] - return(sym) - } - } - x -} - simplify_argument <- function(x) { if (is.atomic(x) || is.character(x)) { return(x) From 99831ce44b2577764de887b07ad10d4c50815ba1 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 15:10:28 +0100 Subject: [PATCH 65/81] Remove find_symbol_asset and add new helper resolve_symbol_asset --- R/safe-symbol-utils.R | 114 +++++++++++++++++++++++------------------- 1 file changed, 62 insertions(+), 52 deletions(-) diff --git a/R/safe-symbol-utils.R b/R/safe-symbol-utils.R index 54031c1..b6d4004 100644 --- a/R/safe-symbol-utils.R +++ b/R/safe-symbol-utils.R @@ -39,75 +39,85 @@ find_symbols <- function(expr) { refs } -find_symbol_asset <- function(symbol_id, registry) { - sym <- registry$symbols |> - dplyr::filter(id == symbol_id) +resolve_dependencies <- function(expr, registry) { + if (is.null(expr) || is.na(expr)) { + return(tibble::tibble()) + } - if (!nrow(sym)) { - return(NA_character_) + refs <- find_symbols(expr) + + if (is.null(refs)) { + return(tibble::tibble()) } - if (sym$kind == "table") { - return(sym$asset) + purrr::map_dfr(refs, function(ref) { + sym <- lookup_symbol(ref$symbol, registry) + + tibble::tibble( + symbol_id = if (nrow(sym)) sym$id else NA_character_, + symbol = ref$symbol, + column = ref$column, + kind = if (nrow(sym)) sym$kind else NA_character_, + asset = if (nrow(sym)) sym$asset else NA_character_ + ) + }) +} + +resolve_provenance <- function(symbol_id, registry, visited = character()) { + if (symbol_id %in% visited) { + return(tibble::tibble()) } - deps <- resolve_dependencies(sym$expr, registry) + sym <- registry$symbols |> + dplyr::filter(id == symbol_id) + + deps <- sym$depends_on[[1]] if (!nrow(deps)) { - return(NA_character_) + return(tibble::tibble()) } - assets <- purrr::map_chr( - deps$symbol_id, - find_symbol_asset, - registry = registry - ) + children <- + purrr::map_dfr( + deps$symbol_id, + resolve_provenance, + registry = registry, + visited = c(visited, symbol_id) + ) - unique(stats::na.omit(assets)) + dplyr::bind_rows(deps, children) } -resolve_dependencies <- function(expr, registry, visited = character()) { - if (is.null(expr) || is.na(expr)) { - return(tibble::tibble()) +resolve_symbol_asset <- function(symbol_id, registry) { + sym <- registry$symbols |> + dplyr::filter(id == !!symbol_id) + + if (!nrow(sym)) { + return(NA_character_) } - refs <- find_symbols(expr) + # direct asset + if (sym$kind %in% c("table", "resource")) { + return(sym$asset) + } - if (is.null(refs)) { - return(tibble::tibble()) + # expression: follow dependencies + deps <- resolve_provenance( + symbol_id, + registry + ) + + if (!nrow(deps)) { + return(NA_character_) } - deps <- purrr::map_dfr(refs, tibble::as_tibble) |> - dplyr::left_join( - registry$symbols |> - dplyr::select(symbol_id = id, symbol, kind, asset, expr), - by = "symbol" - ) + assets <- deps |> + dplyr::filter(kind %in% c("table", "resource")) |> + dplyr::pull(asset) - deps <- deps |> - dplyr::mutate( - parents = purrr::map( - symbol_id, - function(symbol_id) { - if (is.na(symbol_id) || symbol_id %in% visited) { - return(tibble::tibble()) - } - - sym <- registry$symbols |> - dplyr::filter(id == symbol_id) - - if (!nrow(sym) || sym$kind != "expression") { - return(tibble::tibble()) - } - - resolve_dependencies( - expr = sym$expr, - registry = registry, - visited = c(visited, symbol_id) - ) - } - ) - ) + if (!length(assets)) { + return(NA_character_) + } - deps + paste(unique(stats::na.omit(assets)), collapse = ";") } From e6718e27d3e8204893ae68771bd4e7c890fcb4ff Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 15:12:06 +0100 Subject: [PATCH 66/81] Update lookup_symbol and register_symbol --- R/symbol-registry.R | 53 ++++++++++++++++++++++++++++++--------------- 1 file changed, 35 insertions(+), 18 deletions(-) diff --git a/R/symbol-registry.R b/R/symbol-registry.R index 5b7cfda..25284a6 100644 --- a/R/symbol-registry.R +++ b/R/symbol-registry.R @@ -36,36 +36,53 @@ new_symbol_registry <- function(symbols = list()) { ) } -lookup_symbol <- function(registry, name) { - UseMethod("lookup_symbol") -} +lookup_symbol <- function(symbol, registry, session = NULL) { + out <- registry$symbols -#' @export -lookup_symbol.symbol_registry <- function(registry, name) { - registry$symbols[[name]] -} + if (!is.null(session)) { + out <- dplyr::filter(out, session == !!session) + } -register_symbol <- function(registry, symbol) { - UseMethod("register_symbol") + out |> + dplyr::filter(symbol == !!symbol) |> + dplyr::arrange(dplyr::desc(version)) |> + dplyr::slice(1) } -#' @export -register_symbol.symbol_registry <- function(registry, symbol) { +register_symbol <- function(registry, symbol) { + # local bindings + aux <- NULL stopifnot(inherits(symbol, "safe_symbol")) - # append dependent symbols - symbol$depends_on <- - resolve_dependencies(symbol$expr, registry) + # extract current version of symbol + if (nrow(registry$symbols) == 0 || length(registry$symbols) == 0) { + current_version <- 0 + } else { + aux <- registry$symbols |> + dplyr::filter( + session == !!symbol$session, + symbol == !!symbol$symbol + ) + if (nrow(aux)) { + current_version <- aux |> + dplyr::summarise( + version = dplyr::coalesce(max(version), 0L) + ) |> + dplyr::pull(version) + } else { + current_version <- 0 + } + } + + symbol$version <- current_version + 1L + + symbol$depends_on <- list(resolve_dependencies(symbol$expr, registry)) registry$symbols <- dplyr::bind_rows( registry$symbols, tibble::as_tibble(symbol) ) - # existing <- registry$symbols[[symbol$symbol]] - # - # registry$symbols[[symbol$symbol]] <- existing - registry } From 64f16eecf6025f9e85cf8f39b87c941725495983 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 15:12:37 +0100 Subject: [PATCH 67/81] Add new arg for safe_symbol, version --- R/safe-symbol.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/safe-symbol.R b/R/safe-symbol.R index 5502d24..1ca0905 100644 --- a/R/safe-symbol.R +++ b/R/safe-symbol.R @@ -3,10 +3,11 @@ as_tibble.safe_symbol <- function(x, ...) { tibble::tibble( id = x$id, symbol = x$symbol, + version = x$version, kind = x$kind, asset = x$asset, expr = x$expr, - depends_on = list(x$depends_on), + depends_on = x$depends_on, created_by = x$created_by, created_at = x$created_at, user = x$user, @@ -19,6 +20,7 @@ as_tibble.safe_symbol <- function(x, ...) { new_safe_symbol <- function( symbol, + version = -999, kind = "unknown", asset = NA_character_, expr = NA_character_, @@ -38,6 +40,7 @@ new_safe_symbol <- function( list( id = id, symbol = symbol, + version = version, kind = kind, asset = asset, expr = expr, From 11e89d2fe8f02140bf0e01c9ea686567e99253b5 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 16:08:41 +0100 Subject: [PATCH 68/81] Add local bindings and remove commented code --- R/safe-symbol-utils.R | 6 ++++++ R/safe_output.R | 3 ++- R/symbol-registry.R | 15 ++++----------- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/safe-symbol-utils.R b/R/safe-symbol-utils.R index b6d4004..89e05c3 100644 --- a/R/safe-symbol-utils.R +++ b/R/safe-symbol-utils.R @@ -64,6 +64,9 @@ resolve_dependencies <- function(expr, registry) { } resolve_provenance <- function(symbol_id, registry, visited = character()) { + # local bindings + id <- NULL + if (symbol_id %in% visited) { return(tibble::tibble()) } @@ -89,6 +92,9 @@ resolve_provenance <- function(symbol_id, registry, visited = character()) { } resolve_symbol_asset <- function(symbol_id, registry) { + # local binding + asset <- id <- kind <- NULL + sym <- registry$symbols |> dplyr::filter(id == !!symbol_id) diff --git a/R/safe_output.R b/R/safe_output.R index 0fc04f9..155a20f 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -103,7 +103,8 @@ safe_output.opal <- function( # local bindings `@timestamp` <- backend <- logger_name <- safe_people_id <- username <- NULL ds_action <- ds_eval <- ds_id <- ds_function <- ds_symbol <- ds_table <- NULL - is_placeholder <- NULL + asset <- action <- is_placeholder <- kind <- symbol_id <- timestamp <- NULL + expr <- fx <- log_id <- r_cmd <- session <- NULL # create formatted versions of input dates logs_from_is_valid <- FALSE diff --git a/R/symbol-registry.R b/R/symbol-registry.R index 25284a6..b0062ee 100644 --- a/R/symbol-registry.R +++ b/R/symbol-registry.R @@ -51,7 +51,7 @@ lookup_symbol <- function(symbol, registry, session = NULL) { register_symbol <- function(registry, symbol) { # local bindings - aux <- NULL + aux <- session <- NULL stopifnot(inherits(symbol, "safe_symbol")) # extract current version of symbol @@ -86,7 +86,6 @@ register_symbol <- function(registry, symbol) { registry } -# resolve_symbol.symbol_registry <- function( resolve_symbol <- function( registry, symbol, @@ -94,15 +93,9 @@ resolve_symbol <- function( session = NULL, user = NULL ) { - # current <- lookup_symbol(registry, symbol) - # - # while ( - # !is.null(current) && is.null(current$asset) && !is.null(current$parent) - # ) { - # current <- lookup_symbol(registry, current$parent) - # } - # - # current + # local binding + created_at <- NULL + x <- registry$symbols |> dplyr::filter(symbol == !!symbol, created_at <= !!timestamp) From b175f7e6790c95ce09765e2b285863ab41306b73 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 16:09:10 +0100 Subject: [PATCH 69/81] Convert as_tibble.safe_symbol to internal --- R/safe-symbol.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/safe-symbol.R b/R/safe-symbol.R index 1ca0905..d5e6303 100644 --- a/R/safe-symbol.R +++ b/R/safe-symbol.R @@ -1,4 +1,3 @@ -#' @export as_tibble.safe_symbol <- function(x, ...) { tibble::tibble( id = x$id, From f0f173493c8ae0072de90e5db342bc1464d4085a Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 17:00:53 +0100 Subject: [PATCH 70/81] Remove unused internal methods --- R/safe-symbol.R | 55 ------------------------------------------------- 1 file changed, 55 deletions(-) diff --git a/R/safe-symbol.R b/R/safe-symbol.R index d5e6303..efadd04 100644 --- a/R/safe-symbol.R +++ b/R/safe-symbol.R @@ -75,58 +75,3 @@ safe_symbol <- function(symbol, ...) { safe_symbol_reference <- function(symbol, ...) { new_safe_symbol_reference(symbol = symbol, ...) } - -symbol <- function(x, ...) { - UseMethod("symbol") -} - -#' @export -symbol.safe_symbol <- function(x, ...) { - x$symbol -} - - -symbol_asset <- function(x, ...) { - UseMethod("symbol_asset") -} - -#' @export -symbol_asset.safe_symbol <- function(x, ...) { - x$asset -} - -symbol_kind <- function(x, ...) { - UseMethod("symbol_kind") -} - -#' @export -symbol_kind.safe_symbol <- function(x, ...) { - x$kind -} - -symbol_metadata <- function(x, ...) { - UseMethod("symbol_metadata") -} - -#' @export -symbol_metadata.safe_symbol <- function(x, ...) { - x$metadata -} - -symbol_depends_on <- function(x, ...) { - UseMethod("symbol_depends_on") -} - -#' @export -symbol_depends_on.safe_symbol <- function(x, ...) { - x$depends_on -} - -symbol_session <- function(x, ...) { - UseMethod("symbol_session") -} - -#' @export -symbol_session.safe_symbol <- function(x, ...) { - x$session -} From 197de1ffa4c0aa95671752a422767a21753d9c1e Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 17:01:05 +0100 Subject: [PATCH 71/81] Add missing local binding --- R/safe_output.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/safe_output.R b/R/safe_output.R index 155a20f..42055f8 100644 --- a/R/safe_output.R +++ b/R/safe_output.R @@ -104,7 +104,7 @@ safe_output.opal <- function( `@timestamp` <- backend <- logger_name <- safe_people_id <- username <- NULL ds_action <- ds_eval <- ds_id <- ds_function <- ds_symbol <- ds_table <- NULL asset <- action <- is_placeholder <- kind <- symbol_id <- timestamp <- NULL - expr <- fx <- log_id <- r_cmd <- session <- NULL + expr <- fx <- log_id <- r_cmd <- session <- symbol <- NULL # create formatted versions of input dates logs_from_is_valid <- FALSE From 15248326594895e3b75bc88558ee7cfa4591fa2b Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 17:01:18 +0100 Subject: [PATCH 72/81] Update examples --- R/utils-armadillo.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/utils-armadillo.R b/R/utils-armadillo.R index 4f146f1..a9f2068 100644 --- a/R/utils-armadillo.R +++ b/R/utils-armadillo.R @@ -7,6 +7,11 @@ #' #' @returns MOLGENIS' Armadillo connection object. #' @export +#' +#' @examples +#' \dontrun{ +#' armadillo_login("https://armadillo-playground.molgenis.net/") +#' } armadillo_login <- function(server) { conn <- DSMolgenisArmadillo::armadillo.get_credentials(server) ns <- loadNamespace("MolgenisArmadillo") From 4c7f9bfff64958e0bddf777fc94cf38d66a6dbcb Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 17:10:48 +0100 Subject: [PATCH 73/81] Remove unused internal functions --- R/safe-call-utils.R | 36 ------------------------------------ 1 file changed, 36 deletions(-) diff --git a/R/safe-call-utils.R b/R/safe-call-utils.R index c1f7481..3a96ebd 100644 --- a/R/safe-call-utils.R +++ b/R/safe-call-utils.R @@ -9,42 +9,6 @@ as.data.frame.safe_call <- function(x, ...) { ) } -call_args <- function(x, ...) { - UseMethod("call_args") -} - -#' @export -call_args.safe_call <- function(x, ...) { - x$args -} - -call_fx <- function(x, ...) { - UseMethod("call_fx") -} - -#' @export -call_fx.safe_call <- function(x, ...) { - x$fx -} - -call_original <- function(x, ...) { - UseMethod("call_original") -} - -#' @export -call_original.safe_call <- function(x, ...) { - x$original -} - -call_package <- function(x, ...) { - UseMethod("call_package") -} - -#' @export -call_package.safe_call <- function(x, ...) { - x$package -} - enrich_argument <- function(arg, registry, timestamp, session) { if (!is.character(arg) || length(arg) != 1) { return(arg) From eb663a09ab8faddf6edeb1d62ce3252a1942baa3 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 17:11:12 +0100 Subject: [PATCH 74/81] Remove generic documentation --- R/safe-call.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/safe-call.R b/R/safe-call.R index 66adc80..e6d8491 100644 --- a/R/safe-call.R +++ b/R/safe-call.R @@ -12,9 +12,6 @@ as.data.frame.safe_call <- function(x, ...) { ) } -#' Construct a safe_call -#' -#' @keywords internal new_safe_call <- function( original, package, From 3cef69ff4cf87ffbb1fb1e5d0d64c02eca7b087c Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 17:11:24 +0100 Subject: [PATCH 75/81] New build --- NAMESPACE | 13 ------------- man/armadillo_login.Rd | 5 +++++ 2 files changed, 5 insertions(+), 13 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 4e5eabf..3608585 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,10 +27,6 @@ S3method(backend_table_perms,opal) S3method(backend_tables,opal) S3method(backend_user_exists,opal) S3method(backend_users,opal) -S3method(call_args,safe_call) -S3method(call_fx,safe_call) -S3method(call_original,safe_call) -S3method(call_package,safe_call) S3method(check_permissions,ArmadilloCredentials) S3method(check_permissions,default) S3method(check_permissions,opal) @@ -61,7 +57,6 @@ S3method(init,opal) S3method(init,rocrate) S3method(is_admin_con,opal) S3method(is_audit_con,opal) -S3method(lookup_symbol,symbol_registry) S3method(parse_user_profiles,ArmadilloCredentials) S3method(parse_user_profiles,opal) S3method(print,cr8tor_bundle) @@ -69,7 +64,6 @@ S3method(print,safe_call) S3method(print,safe_symbol) S3method(project_exists,ArmadilloCredentials) S3method(project_exists,opal) -S3method(register_symbol,symbol_registry) S3method(report,ArmadilloCredentials) S3method(report,character) S3method(report,default) @@ -103,18 +97,11 @@ S3method(safe_setting,cr8tor) S3method(safe_setting,default) S3method(safe_setting,opal) S3method(safe_setting,rocrate) -S3method(symbol,safe_symbol) -S3method(symbol_asset,safe_symbol) -S3method(symbol_depends_on,safe_symbol) -S3method(symbol_kind,safe_symbol) -S3method(symbol_metadata,safe_symbol) -S3method(symbol_session,safe_symbol) S3method(validate_backend_version,default) S3method(validate_backend_version,opal) S3method(validate_con,default) S3method(validate_con,opal) export(armadillo_login) -export(as_tibble.safe_symbol) export(audit) export(check_permissions) export(init) diff --git a/man/armadillo_login.Rd b/man/armadillo_login.Rd index 8bd8eb0..47c0376 100644 --- a/man/armadillo_login.Rd +++ b/man/armadillo_login.Rd @@ -16,3 +16,8 @@ MOLGENIS' Armadillo connection object. Login to a MOLGENIS' Armadillo server. Wrapper for the function \code{\link[DSMolgenisArmadillo:armadillo.get_credentials]{DSMolgenisArmadillo::armadillo.get_credentials()}}. } +\examples{ +\dontrun{ + armadillo_login("https://armadillo-playground.molgenis.net/") +} +} From af152e9d3d9057baba3f05544189b5a70fe7b78b Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Wed, 22 Jul 2026 17:11:50 +0100 Subject: [PATCH 76/81] Update report to use new 'asset' column, instead of 'table' --- R/report.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/report.R b/R/report.R index 1c78f53..c242b20 100644 --- a/R/report.R +++ b/R/report.R @@ -504,11 +504,11 @@ report.rocrate <- function( safe_output_tbl_v2 <- tibble::tibble() if (!is.null(safe_output_tbl) && nrow(safe_output_tbl) > 0) { - # split `table` into `project` and `table` + # split `asset` into `project` and `asset` safe_output_tbl_v2 <- safe_output_tbl |> dplyr::mutate( - project = gsub("(?=\\.).*$", "", table, perl = TRUE), - asset = gsub("^.*(?<=\\.)", "", table, perl = TRUE) + project = gsub("(?=\\.).*$", "", asset, perl = TRUE), + asset = gsub("^.*(?<=\\.)", "", asset, perl = TRUE) ) |> dplyr::distinct(project, asset, user, fx, timestamp) @@ -544,7 +544,7 @@ report.rocrate <- function( report_contents <- c( .markdown_report_header(title, overview_tbl, overview_lst$diag_path), tidy_overview_tbl |> - # # tidy up duplicated values in `project` and `table` + # # tidy up duplicated values in `project` and `asset` # dplyr::mutate( # Project = unfill_vec(Project), # Data = unfill_vec(Data) From 18c7b9350aed24d2de9a454258ebd68af23164a2 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Thu, 23 Jul 2026 11:33:40 +0100 Subject: [PATCH 77/81] Add additional check when loading cr8tor bundles --- R/utils-cr8tor.R | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/R/utils-cr8tor.R b/R/utils-cr8tor.R index 1ff9c71..05b3b0d 100644 --- a/R/utils-cr8tor.R +++ b/R/utils-cr8tor.R @@ -805,17 +805,31 @@ load_cr8tor_bundle <- function(x, ...) { tmp <- tempfile("cr8tor_") dir.create(tmp, recursive = TRUE, showWarnings = FALSE) - utils::unzip(x, exdir = tmp) + ok <- tryCatch( + { + utils::unzip(x, exdir = tmp) + TRUE + }, + warning = function(w) FALSE, + error = function(e) FALSE + ) + + if (!ok) { + stop("Not a valid cr8tor bundle.", call. = FALSE) + } + + # get root directory for bag + bagit_root <- find_bagit_root(tmp) # load RO-Crate layer rocrate <- rocrateR::load_rocrate( - x, #file.path(tmp, "bagit"), + bagit_root, load_content = TRUE, ... ) - tmp_root <- find_bagit_root(tmp) |> - dirname() + # get base dir + tmp_root <- dirname(bagit_root) # parse resources layer res_dir <- file.path(tmp_root, "resources") From 404d52b5fdee13644d122bbb59ce752c4fd0644b Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Thu, 23 Jul 2026 15:34:18 +0100 Subject: [PATCH 78/81] Update get_function and parse_arguments to handle cases in which the underlying function package is not installed on the audit server --- R/safe-call-utils.R | 46 +++++++++++++++++++++++++++++++++++---------- 1 file changed, 36 insertions(+), 10 deletions(-) diff --git a/R/safe-call-utils.R b/R/safe-call-utils.R index 3a96ebd..bb34048 100644 --- a/R/safe-call-utils.R +++ b/R/safe-call-utils.R @@ -46,29 +46,55 @@ enrich_call <- function(call, registry) { get_function <- function(info) { if (is.null(info$package)) { - return(get(info$fx, mode = "function")) + return( + tryCatch(get(info$fx, mode = "function"), error = function(e) NULL) + ) } - get(info$fx, envir = asNamespace(info$package), mode = "function") + tryCatch( + get(info$fx, envir = asNamespace(info$package), mode = "function"), + error = function(e) NULL + ) } parse_arguments <- function(fx_call, info, expand.dots = FALSE) { supplied <- as.list(fx_call[-1]) supplied_names <- names(supplied) - # Recover function object + # (attempt to) recover function object fun_obj <- get_function(info) - # Expand names - matched <- match.call( - definition = fun_obj, - call = fx_call, - expand.dots = expand.dots + matched <- tryCatch( + if (is.null(fun_obj)) { + NULL + } else { + match.call( + definition = fun_obj, + call = fx_call, + expand.dots = expand.dots + ) + }, + error = function(e) NULL ) - matched <- as.list(matched[-1]) + if (is.null(matched)) { + # fall back to the supplied arguments if matching failed + matched <- supplied + + # attach arg names + if (is.null(supplied_names)) { + supplied_names <- rep("", length(supplied)) + } + missing <- supplied_names == "" + + supplied_names[missing] <- paste0("..", which(missing)) + + names(matched) <- supplied_names + } else { + matched <- as.list(matched[-1]) + } - # Evaluate constants only + # evaluate constants only matched <- lapply(matched, simplify_argument) matched From f3ebc529d1beabbd510a07f581ecaf4c2dccf760 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 24 Jul 2026 11:24:23 +0100 Subject: [PATCH 79/81] Bump version to next minor release --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e6765a5..db4349b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: dsROCrate Title: 'DataSHIELD' RO-Crate Governance Functions -Version: 0.1.0.9000 +Version: 0.2.0 Authors@R: c( person(given = "Roberto", family = "Villegas-Diaz", From 809412c19c0c49dd8cc4a9915dc8e1a25c555945 Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 24 Jul 2026 11:24:57 +0100 Subject: [PATCH 80/81] Update list of word exceptions --- inst/WORDLIST | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/inst/WORDLIST b/inst/WORDLIST index 8540a5d..7b63e69 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -3,36 +3,29 @@ CMD DataSHIELD DataSHIELD’ Dumontier +FederatedMethods Lifecycle MOLGENIS OBiBa OBiBa's ORCID -OllyButters -POSIXct RO +RStudio Rmd SafePods Sci TRE TREs -Tibble -Unfill -bagit -com -cr +backends datashield +datasource doi etc -github -ies -issuecomment +hardcoded md org -pcr +regex sdata -tidyr -tidyverse -toml +tibble ’s -️NOTE +️ From 9640469f04f93fbc70a05c94b98d3b93c47ddf9a Mon Sep 17 00:00:00 2001 From: Roberto Villegas-Diaz Date: Fri, 24 Jul 2026 11:25:32 +0100 Subject: [PATCH 81/81] Update NEWS section for new release --- NEWS.md | 32 +++++++++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index f06b381..26c254a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,34 @@ -# dsROCrate (development version) +# dsROCrate 0.2.0 + +## Breaking Changes + +* The audit log tibble returned via `safe_output()` no longer includes a `table` column. It has been replaced by three more granular columns: `kind` (whether the tracked object is a `table`, `resource` or `expression`), `asset` (the resolved table/resource name) and `expr` (the associated R expression, when applicable). Code that reads the `table` column directly will need to be updated. + +## New Features + +* Added a symbol registry and call-tracking system (`safe_symbol()`, `safe_call()`, `safe_reference()`, `symbol_registry()`) that replaces regex-based parsing of Opal logs, modelling assignments and aggregate function calls as objects and resolving arguments back to the symbols/tables they reference. +* Added a generic backend abstraction layer (`backend_logs()`, `backend_options()`, `backend_users()`, `backend_projects()`, `backend_sys_perms()`, and others) so internal code no longer calls `opalr::` directly, paving the way for additional backends. +* Added early Armadillo backend scaffolding: `check_permissions()`, `init()`, `report()`, `safe_data()`, `safe_output()`, `safe_people()` and `safe_setting()` now all have `ArmadilloCredentials` methods, returning clear "not yet implemented" errors ahead of full support. +* Added `default` S3 methods for `audit()`, `audit_engine()` and `check_permissions()`, giving clearer errors when an unsupported connection object is supplied. +* Added a `verbose` argument to `check_permissions()` (opal method) to optionally print a success message when permissions are sufficient. +* Added `print.safe_call()` and `print.safe_symbol()` methods, plus `as.data.frame()` methods for `safe_call` and `symbol_registry` objects, for readable inspection of the new internal tracking objects. + +## Improvements + +* `safe_people()` now determines admin/auditor status from actual system permissions and group membership, rather than a hardcoded name check against `"admin"`/`"administrator"`, improving compatibility with deployments that use differently named privileged accounts. +* Permission lookup failures during `safe_people()` now fall back gracefully to an empty result instead of aborting the whole audit. +* Consolidated backend-version and connection-validation logic into the new generic backend framework, reducing duplication between Opal-specific code paths. + +## Documentation + +* Removed a vignette section demonstrating direct calls to internal helper functions, which have since been renamed as part of the backend abstraction work. +* Updated documentation to reflect that `init()`, `safe_data()`, `report()` and related functions now accept either `opal` or `ArmadilloCredentials` connections. + +## Internal Changes + +* Added test coverage for `audit()`, `audit_engine()` and `check_permissions()`, along with a mock-connection test helper, reducing reliance on a live demo Opal server. +* Added `uuid` to `Imports`, used to generate unique IDs for tracked symbols. +* Bumped the `testthat` version requirement in `Suggests` from `>= 3.0.0` to `>= 3.1.4`. # dsROCrate 0.1.0