#4 more tabular work for privileges and row policies

- example code for passwd table turned into a fxn to do one liner for table setup
- use one liner setup in privileges and row policy fxn docs
- rework rls_run to fetch con from query input if con not passed, also separate file
-

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as_con,PqConnection)
+S3method(as_con,row_policy)
 S3method(as_priv,privilege)
 S3method(as_priv,tbl_sql)
 S3method(as_row_policy,row_policy)
@@ -35,6 +37,7 @@ export(rls_tbl)
 export(row_policy)
 export(rows_existing)
 export(rows_new)
+export(setup_example_table)
 export(to)
 export(translate_privilege)
 import(dbplyr)
@@ -45,10 +48,12 @@ importFrom(cli,ansi_collapse)
 importFrom(cli,cat_line)
 importFrom(cli,cli_abort)
 importFrom(cli,format_error)
+importFrom(dbplyr,copy_inline)
 importFrom(dbplyr,sql)
 importFrom(dbplyr,translate_sql)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,filter)
+importFrom(dplyr,rows_append)
 importFrom(dplyr,tbl)
 importFrom(glue,glue)
 importFrom(glue,glue_safe)
@@ -65,3 +70,4 @@ importFrom(rlang,is_empty)
 importFrom(rlang,is_scalar_character)
 importFrom(rlang,quo_is_null)
 importFrom(tibble,as_tibble)
+importFrom(tibble,tribble)

R/as_priv.R

@@ -1,6 +1,7 @@
 #' As privilege
 #' @param x some input
 #' @export
+#' @return an object of S3 class "privilege"
 as_priv <- function(x) {
   UseMethod("as_priv")
 }

R/as_row_policy.R

@@ -1,6 +1,7 @@
 #' As row policy
 #' @param x some input
 #' @export
+#' @return an object of S3 class "row_policy"
 as_row_policy <- function(x) {
   UseMethod("as_row_policy")
 }

R/examples.R

@@ -1,6 +1,13 @@
 #' Setup for running examples throughout this package
 #'
-#' @name passwd
+#' @aliases passwd
+#' @export
+#' @importFrom tibble tribble
+#' @importFrom dbplyr copy_inline
+#' @importFrom dplyr rows_append
+#' @param con a postgres or redshift connection object
+#' @param which (character) the table to create. only option right
+#' now is "passwd"
 #' @examplesIf interactive() && has_postgres()
 #' library(RPostgres)
 #' library(dplyr)
@@ -41,4 +48,42 @@
 #'
 #' ## Check that the data is in the table
 #' tbl(con, "passwd")
-NULL
+setup_example_table <- function(con, which = "passwd") {
+	options <- c("passwd")
+	if (!which %in% options) {
+		rls_abort(
+			format_error("{.arg {which}} must be one of {clz_col(options)}")
+		)
+	}
+	dbExecute(con, eg_schemas[[which]])
+	rows_append(
+	  tbl(con, which),
+	  copy_inline(con, eg_data[[which]]),
+	  in_place = TRUE
+	)
+	tbl(con, which)
+}
+
+eg_schemas <- list(
+	passwd = "
+	  CREATE TABLE passwd (
+	  user_name             text UNIQUE NOT NULL,
+	  pwhash                text,
+	  uid                   int  PRIMARY KEY,
+	  gid                   int  NOT NULL,
+	  real_name             text NOT NULL,
+	  home_phone            text,
+	  home_dir              text NOT NULL,
+	  shell                 text NOT NULL
+	);
+	"
+)
+
+eg_data <- list(
+	passwd = tribble(
+	  ~user_name, ~pwhash, ~uid, ~gid, ~real_name, ~home_phone, ~home_dir,~shell,
+	  "admin", "xxx", 0, 0, "Admin", "111-222-3333", "/root", "/bin/dash",
+	  "bob", "xxx", 1, 1, "Bob", "123-456-7890", "/home/bob", "/bin/zsh",
+	  "alice", "xxx", 2, 1, "Alice", "098-765-4321", "/home/alice", "/bin/zsh"
+	)
+)

R/pipeline.R

@@ -73,7 +73,13 @@ pipe_autoexec <- function(toggle) {
   info <- pipeline_info()
 
   if (isTRUE(info[["is_piped"]])) {
-    rls_exit <- function(x) if (inherits(x, c("privilege", "row_policy"))) rls_run(x$data$src$con, x) else x
+    rls_exit <- function(x) {
+      if (inherits(x, c("privilege", "row_policy"))) {
+        rls_run(x, x$data$src$con)
+      } else {
+        x
+      }
+    }
     pipeline_on_exit(info$env)
     info$env$.rls_exitfun <- if (toggle) rls_exit else identity
   }

R/privileges.R

@@ -5,8 +5,12 @@
 #' @param ... one of all, select, update, insert, delete
 #' @param cols (character) vector of column names
 #' @examplesIf interactive() && has_postgres()
+#' library(DBI)
 #' library(RPostgres)
 #' con <- dbConnect(Postgres())
+#' if (!dbExistsTable(con, "passwd")) {
+#'    setup_example_table(con, "passwd")
+#' }
 #'
 #' rls_tbl(con, "passwd") %>%
 #'   grant(update) %>%
@@ -37,8 +41,12 @@ grant <- function(.data, ..., cols = NULL) {
 #' @export
 #' @inheritParams grant
 #' @examplesIf interactive() && has_postgres()
+#' library(DBI)
 #' library(RPostgres)
 #' con <- dbConnect(Postgres())
+#' if (!dbExistsTable(con, "passwd")) {
+#'    setup_example_table(con, "passwd")
+#' }
 #'
 #' rls_tbl(con, "passwd") %>%
 #'   revoke(update) %>%
@@ -66,8 +74,13 @@ revoke <- function(.data, ..., cols = NULL) {
 #' @param .data a `privilege` object
 #' @param ... (character) one or more user (or role) names
 #' @examplesIf interactive() && has_postgres()
+#' library(DBI)
 #' library(RPostgres)
 #' con <- dbConnect(Postgres())
+#' if (!dbExistsTable(con, "passwd")) {
+#'    setup_example_table(con, "passwd")
+#' }
+#'
 #' rls_tbl(con, "passwd") %>% to(jane)
 #' rls_tbl(con, "passwd") %>% to(jane, bob, alice)
 to <- function(.data, ...) {
@@ -132,8 +145,6 @@ from <- to
 #' dbExecute(con, sql)
 translate_privilege <- function(priv, con) {
   assert_is(priv, "privilege")
-  # stopifnot("Can not use grant and revoke" =
-  #   xor(!is_empty(priv$grant), !is_empty(priv$revoke)))
 
   template <- priv_templates[[priv$type]]
 
@@ -161,21 +172,6 @@ priv_templates <- list(
   revoke = "REVOKE %s ON %s FROM %s"
 )
 
-#' Run a query
-#'
-#' @export
-#' @param query an s3 object of class `privilege` or `row_policy, required
-#' @param con DBI connection object, required
-rls_run <- function(con, query) {
-  is_conn(con)
-  assert_is(query, c("privilege", "row_policy"))
-  sql <- switch(class(query),
-    privilege = translate_privilege(query, con),
-    row_policy = translate_row_policy(query, con)
-  )
-  dbExecute(con, sql)
-}
-
 rls_grant <- function(commands, cols) {
   x <- list(commands = commands, cols = cols)
   structure(x, class = "rls_grant")

R/row_policy.R

@@ -4,10 +4,15 @@
 #' @inheritParams grant
 #' @param name (character) scalar name for the policy. required
 #' @examplesIf interactive() && has_postgres()
+#' library(DBI)
 #' library(RPostgres)
 #' con <- dbConnect(Postgres())
+#' if (!dbExistsTable(con, "passwd")) {
+#'    setup_example_table(con, "passwd")
+#' }
 #' rls_tbl(con, "passwd") %>%
-#'   row_policy("my_policy")
+#'   row_policy("my_policy") %>%
+#'   rls_run()
 row_policy <- function(.data, name) {
   pipe_autoexec(toggle = rls_env$auto_pipe)
   assert_is(name, "character")
@@ -22,8 +27,12 @@ row_policy <- function(.data, name) {
 #' @export
 #' @inheritParams grant
 #' @examplesIf interactive() && has_postgres()
+#' library(DBI)
 #' library(RPostgres)
 #' con <- dbConnect(Postgres())
+#' if (!dbExistsTable(con, "passwd")) {
+#'    setup_example_table(con, "passwd")
+#' }
 #' rls_tbl(con, "passwd") %>%
 #'   row_policy("my_policy") %>%
 #'   commands(update)
@@ -42,8 +51,12 @@ commands <- function(.data, ...) {
 #' @param sql (character) sql syntax to use for existing rows
 #' @details Use either `using` or `sql`, not both
 #' @examplesIf interactive() && has_postgres()
+#' library(DBI)
 #' library(RPostgres)
 #' con <- dbConnect(Postgres())
+#' if (!dbExistsTable(con, "passwd")) {
+#'    setup_example_table(con, "passwd")
+#' }
 #' rls_tbl(con, "passwd") %>%
 #'   row_policy("my_policy") %>%
 #'   commands(update) %>%
@@ -72,8 +85,12 @@ rows_existing <- function(.data, using = NULL, sql = NULL) {
 #' @param sql (character) sql syntax to use for new rows
 #' @details Use either `check` or `sql`, not both
 #' @examplesIf interactive() && has_postgres()
+#' library(DBI)
 #' library(RPostgres)
 #' con <- dbConnect(Postgres())
+#' if (!dbExistsTable(con, "passwd")) {
+#'    setup_example_table(con, "passwd")
+#' }
 #'
 #' rls_tbl(con, "passwd") %>%
 #'   row_policy("a_policy") %>%
@@ -102,11 +119,22 @@ rows_new <- function(.data, check = NULL, sql = NULL) {
   .data
 }
 
+#' @keywords internal
 as_con <- function(x) {
-  assert_is(x, "row_policy")
-  x$data$src$con
+  UseMethod("as_con")
+}
+#' @export
+as_con.row_policy <- function(x) {
+  return(x$data$src$con)
+}
+#' @export
+as_con.PqConnection <- function(x) {
+  return(x)
 }
 
+#' @note param `fun` takes a function, by default uses a function
+#' that simply returns whatever is passed in to it
+#' @noRd
 combine_if <- function(statement, item, fun = \(x) x) {
   ifelse(!rlang::is_null(item), paste(statement, fun(item)), "")
 }

R/run.R

@@ -0,0 +1,19 @@
+#' Run a query
+#'
+#' @export
+#' @param query an s3 object of class `privilege` or `row_policy, required.
+#' if `con` is not supplied, we attempt to get the connection
+#' from `query`; if it is not found we try to use a value passed to `con`.
+#' @param con DBI connection object, optional, see `query`
+#' @return error from PostgreSQL or Redshift upon error, or an integer
+#' value
+rls_run <- function(query, con = NULL) {
+  assert_is(query, c("privilege", "row_policy"))
+  con <- as_con(query %||% con)
+  is_conn(con)
+  sql <- switch(class(query),
+    privilege = translate_privilege(query, con),
+    row_policy = translate_row_policy(query, con)
+  )
+  dbExecute(con, sql)
+}

R/utils.R

@@ -1,6 +1,8 @@
 is_conn <- function(con) {
-  stopifnot(!inherits(con, "DBIConnection") ==
-    "con must be of class DBIConnection")
+  stopifnot(
+    "con must be of class DBIConnection" =
+    inherits(con, "DBIConnection")
+  )
 }
 
 compact <- function(x) {