fix #15 add restrictive fxn for as part of RLS policy; update vignette

NAMESPACE

@@ -17,6 +17,7 @@ export(commands)
 export(from)
 export(grant)
 export(has_postgres)
+export(restrictive)
 export(revoke)
 export(rls_check_status)
 export(rls_col_policy)

R/as_row_policy.R

@@ -14,6 +14,7 @@ as_row_policy.tbl_sql <- function(x) {
   tmp <- list(
     data = x,
     name = NULL,
+    as = NULL,
     commands = NULL,
     user = NULL,
     existing_rows = NULL,
@@ -25,6 +26,7 @@ as_row_policy.tbl_sql <- function(x) {
 #' @export
 print.row_policy <- function(x, ...) {
   cat_line(glue("<row_policy> {x$name}"))
+  cat_me("as", x$as %||% "PERMISSIVE")
   if (!is_really_empty(x$user)) {
     cat_me("user", x$user)
   }

R/row_policy.R

@@ -1,8 +1,22 @@
 #' Row policy
-#' 
+#'
 #' @export
 #' @inheritParams grant
 #' @param name (character) scalar name for the policy. required
+#' @return an S3 class `row_policy`; see [row_policy()] for its
+#' structure
+#' @details The return object and all functions that build on this
+#' function return an S3 class called `row_policy` which is just
+#' a named list with slots:
+#'
+#' - data
+#' - name
+#' - as
+#' - commands
+#' - user
+#' - existing_rows
+#' - new_rows
+#' - type
 #' @examplesIf has_postgres()
 #' library(DBI)
 #' library(RPostgres)
@@ -14,7 +28,7 @@
 #'   row_policy("my_policy") %>%
 #'   rls_run()
 #' rls_policies(con)
-#' 
+#'
 #' # cleanup
 #' rls_drop_policies(con)
 #' dbDisconnect(con)
@@ -28,9 +42,10 @@ row_policy <- function(.data, name) {
 }
 
 #' Commands
-#' 
+#'
 #' @export
 #' @inheritParams grant
+#' @inherit row_policy return
 #' @examplesIf has_postgres()
 #' library(DBI)
 #' library(RPostgres)
@@ -41,7 +56,7 @@ row_policy <- function(.data, name) {
 #' rls_tbl(con, "passwd") %>%
 #'   row_policy("their_policy") %>%
 #'   commands(update)
-#' 
+#'
 #' # cleanup
 #' dbDisconnect(con)
 commands <- function(.data, ...) {
@@ -52,9 +67,10 @@ commands <- function(.data, ...) {
 }
 
 #' Create rule for existing rows
-#' 
+#'
 #' @export
 #' @inheritParams grant
+#' @inherit row_policy return
 #' @param using an expression to use to check against existing rows
 #' @param sql (character) sql syntax to use for existing rows
 #' @details Use either `using` or `sql`, not both
@@ -70,7 +86,7 @@ commands <- function(.data, ...) {
 #'   row_policy("a_good_policy") %>%
 #'   commands(update) %>%
 #'   rows_existing(sql = 'current_user = "user_name"')
-#' 
+#'
 #' # cleanup
 #' dbDisconnect(con)
 rows_existing <- function(.data, using = NULL, sql = NULL) {
@@ -88,10 +104,11 @@ rows_existing <- function(.data, using = NULL, sql = NULL) {
 }
 
 #' Create rule for new rows
-#' 
+#'
 #' @export
 #' @importFrom dbplyr translate_sql
 #' @inheritParams grant
+#' @inherit row_policy return
 #' @param check an expression to use to check against addition of
 #' new rows or editing of existing rows
 #' @param sql (character) sql syntax to use for new rows
@@ -118,7 +135,7 @@ rows_existing <- function(.data, using = NULL, sql = NULL) {
 #'   rows_existing(sql = 'current_user = "user_name"') %>%
 #'   rows_new(home_phone == "098-765-4321") %>%
 #'   to(jane)
-#' 
+#'
 #' # cleanup
 #' dbDisconnect(con)
 rows_new <- function(.data, check = NULL, sql = NULL) {
@@ -146,27 +163,56 @@ express <- function(x) {
   glue("({ifelse(x == 'TRUE', tolower(x), x)})")
 }
 
+#' Set RLS policy to be restrictive
+#'
+#' @export
+#' @inherit row_policy return
+#' @details By default row level policies are permissive. Permissive policies
+#' are applied using a boolean "OR", so you need permission from only one
+#' policy to be able to query a certain row. Whereas for restrictive policies,
+#' they are applied using a boolean "AND" so you have to pass all restrictive
+#' policies for each row you want to query.
+#' @examples
+#' library(DBI)
+#' library(RPostgres)
+#' con <- dbConnect(Postgres())
+#' if (!dbExistsTable(con, "passwd")) {
+#'    setup_example_table(con, "passwd")
+#' }
+#'
+#' rls_tbl(con, "passwd") %>% row_policy("their_policy")
+#' rls_tbl(con, "passwd") %>% row_policy("their_policy") %>% restrictive()
+restrictive <- function(.data) {
+  pipe_autoexec(toggle = rls_env$auto_pipe)
+  .data <- as_row_policy(.data)
+  .data$as <- "RESTRICTIVE"
+  .data
+}
+
 #' Translate row policy
 #'
 #' @export
 #' @keywords internal
 #' @param policy an S3 object of class `row_policy`, required
 #' @param con DBI connection object, required
 #' @references <https://www.postgresql.org/docs/current/sql-createpolicy.html>
+#' @return an S3 class [dbplyr::sql()]
 #' @examplesIf has_postgres()
 #' library(DBI)
 #' library(RPostgres)
 #' con <- dbConnect(Postgres())
 #' setup_example_table(con)
-#' 
+#'
 #' # create role
 #' dbExecute(con, "CREATE ROLE jane")
 #'
 #' if (rls_policy_exists(con, "blue_policy")) {
 #'   rls_drop_policy(con, name = "blue_policy", table = "passwd")
 #' }
 #'
-#' policy <- rls_tbl(con, "passwd") %>%
+#' policy <-
+#' rls_tbl(con, "passwd") %>%
+#'   restrictive() %>%
 #'   row_policy(name = "blue_policy") %>%
 #'   commands(update) %>%
 #'   rows_existing(TRUE) %>%
@@ -176,7 +222,7 @@ express <- function(x) {
 #' sql <- translate_row_policy(policy, con)
 #' sql
 #' dbExecute(con, sql)
-#' 
+#'
 #' # cleanup
 #' rls_drop_policies(con)
 #' dbExecute(con, "DROP ROLE jane")
@@ -189,10 +235,11 @@ translate_row_policy <- function(policy, con) {
   )
   sql_create_policy <- glue("
     {create_statement} POLICY {policy$name} ON {attr(policy$data, 'table')}
+    {combine_if('AS', policy$as %||% 'PERMISSIVE')}
     {combine_if('FOR', policy$commands)}
     {combine_if('TO', policy$user)}
     {combine_if('USING', policy$existing_rows, express)}
     {combine_if('WITH CHECK', policy$new_rows, express)}
   ")
-  sql(gsub("\n\\s+\n", "\n", sql_create_policy))
+  sql(sub("^\\s+", "", gsub("\n\\s+\n", "\n", sql_create_policy)))
 }

_pkgdown.yml

@@ -25,6 +25,7 @@ reference:
       - row_policy
       - rows_existing
       - rows_new
+      - restrictive
   - title: Privileges (aka column level security)
     contents:
       - as_priv

vignettes/rls.Rmd

@@ -138,6 +138,7 @@ policy1 <- rls_tbl(con, "passwd") %>%
   to(admin)
 policy1
 #> <row_policy> admin_all
+#>   as: PERMISSIVE
 #>   user: admin
 #>   existing rows: TRUE
 #>   new rows: TRUE
@@ -167,6 +168,7 @@ policy2 <- rls_tbl(con, "passwd") %>%
   rows_existing(TRUE)
 policy2
 #> <row_policy> all_view
+#>   as: PERMISSIVE
 #>   commands: select
 #>   existing rows: TRUE
 #> # Source:   SQL [3 x 8]
@@ -201,6 +203,7 @@ policy3 <- rls_tbl(con, "passwd") %>%
   )
 policy3
 #> <row_policy> user_mod
+#>   as: PERMISSIVE
 #>   commands: update
 #>   existing rows: current_user = user_name
 #>   new rows: 

vignettes/rls.Rmd.og

@@ -38,7 +38,12 @@ con <- dbConnect(Postgres())
 ```
 
 ```{r echo=FALSE}
+# get current user
 user <- dbGetQuery(con, "select current_user")$current_user
+# delete passwd table if it exists
+if (dbExistsTable(con, "passwd")) {
+  dbRemoveTable(con, "passwd")
+}
 ```
 
 ## Create roles
@@ -268,4 +273,3 @@ dbExecute(con, "DROP ROLE admin")
 dbExecute(con, "DROP ROLE bob")
 dbExecute(con, "DROP ROLE alice")
 ```
-