fix: disclosure levels (#76)

* fix: add disclosure mode check

* added disclosure info to readme

* corrected privacy levels

* docs: updated privacy control table

* docs: correct function name

* docs: restructured privacy mode table to be in line with wiki

* docs: tweaked text

* changed privacy level of mutate

* made regex more restrictive on which functions could be used within mutate

* removed functions from regex

* fixed disclosure tests

* added mutate back into banana mode

* updated utils snapshots

* updated tests to accurately represent test scenario

* added disclosure trap to prevent creation of vectors

* try: update version stripping because changed in version 3.0.0 of svu

* try: update version stripping because changed in version 3.0.0 of svu

* try: check syntax

* try: other syntax to strip v

* try: see what version has been set as

* try: correct print syntax

* try: still experimenting wth syntax

* try: get next version not previous

.circleci/config.yml

@@ -36,7 +36,8 @@ jobs:
         command: |
           Rscript -e 'install.packages("git2r")'
           Rscript -e "git2r::config(user.email = '[email protected]', user.name = 'MOLGENIS Jenkins')"
-          export VERSION=`svu --strip-prefix`
+          export VERSION=$(svu next --tag.prefix="")
+          echo "VERSION: $VERSION"
           install2.r --repo https://cloud.r-project.org desc
           Rscript -e "desc::desc_set_version('${VERSION}')"
 

R/caseWhenDS.R

@@ -14,7 +14,7 @@
 #' @return A vector with the same size as the common size computed from the inputs in \code{tidy_expr} and the same type as the common type of the RHS inputs in \code{tidy_expr}.
 #' @export
 caseWhenDS <- function(tidy_expr = NULL, .default = NULL, .ptype = NULL, .size = NULL) {
-  checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'avacado'))
+  checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
   tidy_expr <- .decode_tidy_eval(tidy_expr, .get_encode_dictionary())
   .check_tidy_disclosure(NULL, tidy_expr, check_df = F)
   other_args <- .paste_character_args(.default, .ptype, .size)

R/distinctDS.R

@@ -10,7 +10,6 @@
 #' @return An object of the same type as \code{df.name}, typically a data frame or tibble.
 #' @export
 distinctDS <- function(tidy_expr, df.name, .keep_all) {
-  checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
   tidy_expr <- .decode_tidy_eval(tidy_expr, .get_encode_dictionary())
   other_args <- .paste_character_args(.keep_all)
   call <- .make_tidyverse_call(df.name, "distinct", tidy_expr, other_args)

R/groupByDS.R

@@ -27,6 +27,7 @@ groupByDS <- function(tidy_expr, df.name, .add, .drop) {
 #' @return An ungrouped data frame or tibble.
 #' @export
 ungroupDS <- function(tidy_expr, x) {
+  checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
   .check_data_name_length(x, listDisclosureSettingsDS())
   call <- .make_tidyverse_call(x, "ungroup", tidy_expr = NULL, other_args = NULL)
   out <- .execute_with_error_handling("ungroup", call)

R/ifElseDS.R

@@ -10,7 +10,7 @@
 #' @export
 ifElseDS <- function(condition = NULL, true = NULL, false = NULL, missing = NULL,
                      ptype = NULL, size = NULL) {
-  checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'avacado'))
+  checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
   tidyselect <- .decode_tidy_eval(condition, .get_encode_dictionary())
   .check_tidy_disclosure(NULL, tidyselect, check_df = F)
   other_args <- .paste_character_args(true, false, missing, ptype, size)

R/mutateDS.R

@@ -18,11 +18,33 @@
 #' @return An object of the same type as \code{df.name}, typically a data frame or tibble.
 #' @export
 mutateDS <- function(tidy_expr, df.name, .keep = NULL, .before = NULL, .after = NULL) {
-  checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'avacado'))
+  checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
   tidy_expr <- .decode_tidy_eval(tidy_expr, .get_encode_dictionary())
   .check_tidy_disclosure(df.name, tidy_expr)
+  .check_mutate_disclosure(tidy_expr)
   other_args <- .paste_character_args(.keep, .before, .after)
   call <- .make_tidyverse_call(df.name, "mutate", tidy_expr, other_args)
   out <- .execute_with_error_handling("mutate", call)
   return(out)
 }
+
+#' @title Check for Disallowed Character in ds.mutate
+#' @description This internal function checks whether the provided expression contains a colon (`:`),
+#' which is not permitted in `ds.mutate`. If a colon is found, the function throws an error.
+#' @param tidy_expr A character string representing the expression to be checked.
+#' @return This function does not return a value; it throws an error if `tidy_expr` contains `:`.
+#' @importFrom cli cli_abort
+#' @keywords internal
+#' @noRd
+.check_mutate_disclosure <- function(tidy_expr){
+  if(grepl(":", tidy_expr)){
+    cli_abort(
+      c(
+        "x" = "It is not permitted to use the character ':' within ds.mutate.",
+        "i" = "You passed the expression '{tidy_expr}'.",
+        "i" = "Please remove this character and try again."
+      )
+    )
+  }
+}
+

R/utils.R

@@ -5,9 +5,9 @@
 #' @noRd
 .get_encode_dictionary <- function() {
   encode_list <- list(
-    input = c("(", ")", "\"", ",", " ", ":", "!", "&", "|", "'", "=", "+", "-", "*", "/", "^", ">", "<", "~", "\n"),
+    input = c("(", ")", "\"", ",", " ", "!", "&", "|", "'", "=", "+", "-", "*", "/", "^", ">", "<", "~", "\n"),
     output = c(
-      "$LB$", "$RB$", "$QUOTE$", "$COMMA$", "$SPACE$", "$COLON$", "$EXCL$", "$AND$", "$OR$",
+      "$LB$", "$RB$", "$QUOTE$", "$COMMA$", "$SPACE$", "$EXCL$", "$AND$", "$OR$",
       "$APO$", "$EQU$", "$ADD$", "$SUB$", "$MULT$", "$DIVIDE$", "$POWER$", "$GT$", "$LT$", "$TILDE$", "$LINE$"
     )
   )
@@ -17,7 +17,7 @@
 #' Decode a string using the provided encoding key.
 #'
 #' @param input_string The encoded string passed through the R parser.
-#' @param encode_key The encoding key generated by '.getEncodeKey()'.
+#' @param encode_key The encoding key generated by '.get_encode_dictionary()'.
 #' @return The decoded string.
 #' @noRd
 .decode_tidy_eval <- function(input_string, encode_key) {
@@ -172,11 +172,10 @@ listPermittedTidyverseFunctionsDS <- function() {
   return(
     c(
       "everything", "last_col", "group_cols", "starts_with", "ends_with", "contains",
-      "matches", "num_range", "all_of", "any_of", "where", "c", "rename", "mutate", "if_else",
+      "matches", "num_range", "all_of", "any_of", "where", "rename", "mutate", "if_else",
       "case_when", "mean", "median", "mode", "desc", "last_col", "nth", "where", "num_range",
-      "exp", "sqrt", "scale", "round", "floor", "ceiling", "trunc", "abs", "sign", "sd", "var",
-      "sin", "cos", "tan", "asin", "acos", "atan", "cumsum", "cumprod", "cummin", "cummax",
-      "rank", "diff", "lag"
+      "exp", "sqrt", "scale", "round", "floor", "ceiling", "abs", "sd", "var",
+      "sin", "cos", "tan", "asin", "acos", "atan"
     )
   )
 }

README.md

@@ -34,6 +34,29 @@ Tidyverse packages can be included.
 ### From the `tibble` package:
 - **`as_tibble`**: Convert data to a tibble.
 
+## Privacy control levels
+DataSHIELD implements [privacy control levels](https://wiki.datashield.org/en/opmanag/privacy-control-level), which allows data owners to control which functions can be
+used by researchers. The table below shows which dsTidyverse functions are permitted in which
+privacy mode.
+
+| **Function**       | **Permissive** | **Banana** | **Avocado** | **Non-Permissive** |
+|------------------|-------------|---------|---------|---------------|
+| `arrangeDS` | ✔ | ✔ |  |  |
+| `asTibbleDS` | ✔ | ✔ | ✔  | ✔ |
+| `bindColsDS` | ✔ | ✔ |  |  |
+| `bindRowsDS` | ✔ | ✔ |  |  |
+| `caseWhenDS` | ✔ | ✔ |  |  |
+| `distinctDS` | ✔ | ✔ | ✔  | ✔ |
+| `filterDS` | ✔ | ✔ |  |  |
+| `groupByDS` | ✔ | ✔ |  |  |
+| `groupKeysDS` | ✔ | ✔ |  |  |
+| `mutateDS` | ✔ | ✔  |  |  |
+| `renameDS` | ✔ | ✔ | ✔  | ✔ |
+| `selectDS` | ✔ | ✔ | ✔  | ✔ |
+| `sliceDS` | ✔ | ✔ |  |  |
+| `ungroupDS` | ✔ | ✔ |  |  |
+
+
 ## Contributing
 If there are functions in this list you would like implemented, please either attempt to do so 
 yourself and submit a pull request, or submit a feature request in the `issues` section. See 

docs/pkgdown.yml

@@ -1,6 +1,6 @@
-pandoc: 3.1.1
+pandoc: '3.2'
 pkgdown: 2.0.9
 pkgdown_sha: ~
 articles: {}
-last_built: 2025-02-13T11:14Z
+last_built: 2025-02-17T16:28Z