How to make admin mode available for Shinymanager with SQL database

Question

I have a working Rshiny app with shinymanager using postgres database hosted on AWS. I wonder if there is any way to make the admin mode available in this app. According to shinymanager documentation, admin mode is available only with sqlite database which has certain limitations for apps hosted on shinyapps.io

secondly, it is possible to add cookie-based authentication with shinymanager so that the users don't have to retype credentials every time the page gets refreshed.

require(RPostgreSQL)
library(shiny)
library(shinymanager)
library(DBI)
library(glue)

dbname = "*****"
host = "localhost"
port = *****
user = "*****"
password = "******"

con <- dbConnect(dbDriver("PostgreSQL"), dbname = dbname , host = host, port = port ,
                 user = user, password = password )


DBI::dbWriteTable(con, "my_table", overwrite = TRUE,
                  data.frame(user = c("shiny", "admin"),
                             password = c("shiny", "admin"),
                             admin = c(FALSE, TRUE),
                             stringsAsFactors = FALSE))

# or a config .yml file or others arguments
my_custom_check_creds <- function(dbname, host, port, db_user, db_password) {
  
 # finally one function of user and password
  function(user, password) {
    
    con <- dbConnect(dbDriver("PostgreSQL"), dbname = dbname, 
                     host = host, port = port,
                     user = db_user, password = db_password)
    
    on.exit(dbDisconnect(con))
    
    req <- glue_sql("SELECT * FROM my_table WHERE \"user\" = ({user}) AND \"password\" = ({password})", 
             user = user, password = password, .con = con
    )
    
    req <- dbSendQuery(con, req)
    res <- dbFetch(req)
    if (nrow(res) > 0) {
      list(result = TRUE, user_info = list(user = user, something = 123))
    } else {
      list(result = FALSE)
    }
  }
}

ui <- fluidPage(
  tags$h2("My secure application"),
  verbatimTextOutput("auth_output")
)
ui <- secure_app(ui)


server <- function(input, output, session) {
  res_auth <- secure_server(
    check_credentials = my_custom_check_creds(
      dbname = "******",
      host = "*****",
      port = ****,
      db_user = "*****",
      db_password = "*******"
    )
  )  
  auth_output <- reactive({
    reactiveValuesToList(res_auth)
  })
  
  # access info
  observe({
    print(auth_output())
  })
}

shinyApp(ui, server)

Answer 1

The current version of the shinymanager package supports the admin page with SQLite only. Making this functionality available in SQL-based databases require a significant amount of work to make this work.

I have updated the shinymanager package with new functions to add admin page capability while using SQL databases like PostgreSQL.

I have added a pull request to add additional updates to the main package. In the meantime, you can install the R-Package from here:

remotes::install_github("devops-qubits/shinymanager")

You would need to add your own DB creds in the conn.

library(RPostgres)
library(shiny)
library(shinymanager)
library(DBI)



conn <- DBI::dbConnect(RPostgres::Postgres(),
                       host   = "localhost",
                       dbname = "postgres_db",
                       user = "postgres_user",
                       password = "postgres_user",
                       port = 5432)

 

## Credentials data.frame
credentials <- data.frame(
   user = c("shiny", "admin"),
   password = c("shiny", "admin"),
   start = c(NA, NA),
   expire = c(NA, NA),
   admin = c(FALSE, TRUE),
   stringsAsFactors = FALSE)

 

## Write SQL tables
create_sql_tables(conn,
                  credentials_data = credentials,
                  passphrase = NULL
)

 

ui <- fluidPage(
  h2("My secure application"),
  verbatimTextOutput("auth_output")
)

 

ui <- secure_app(ui, enable_admin = TRUE)

 


server <- function(input, output, session) {

  res_auth <- secure_server(
    check_credentials = check_credentials(conn, passphrase = NULL, sql = TRUE)
  )

  output$auth_output <- renderPrint({ reactiveValuesToList(res_auth) })

}

 

shinyApp(ui, server)

Answer 2

To enable admin mode with Shiny Manager using a PostgreSQL database, you can create a separate table in your PostgreSQL database to store admin user credentials and implement the necessary logic to check for admin rights in the my_custom_check_creds function. Below are the steps to achieve this:

1. Create a new table in your PostgreSQL database to store admin user credentials. You can call this table "admin_table" or any other name you prefer.

# Create a new table "admin_table" in the PostgreSQL database
DBI::dbWriteTable(con, "admin_table", data.frame(
  user = c("admin"),     # Add the admin username(s)
  password = c("123"),   # Add the admin password(s)
  isAdmin = TRUE,        # Add a column to mark admin users
  stringsAsFactors = FALSE
))

2. Modify the my_custom_check_creds function to check for admin rights.

my_custom_check_creds <- function(dbname, host, port, db_user, db_password) {

  function(user, password) {

    con <- dbConnect(dbDriver("PostgreSQL"), dbname = dbname, 
                     host = host, port = port,
                     user = db_user, password = db_password)

    on.exit(dbDisconnect(con))

    # Check if the user is an admin
    admin_req <- glue_sql("SELECT * FROM admin_table WHERE \"user\" = ({user}) AND \"password\" = ({password})",
                          user = user, password = password, .con = con)

    admin_req <- dbSendQuery(con, admin_req)
    admin_res <- dbFetch(admin_req)
    isAdmin <- nrow(admin_res) > 0

    # Check if the user is a regular user
    req <- glue_sql("SELECT * FROM my_table WHERE \"user\" = ({user}) AND \"password\" = ({password})",
                    user = user, password = password, .con = con)

    req <- dbSendQuery(con, req)
    res <- dbFetch(req)

    if (nrow(res) > 0) {
      list(result = TRUE, user_info = list(user = user, isAdmin = isAdmin))
    } else {
      list(result = FALSE)
    }
  }
}

3. Now, in your server function, you can access the user information and check for admin rights. Based on the user's role (admin or regular user), you can show or hide certain elements in the Shiny app.

server <- function(input, output, session) {
  res_auth <- secure_server(
    check_credentials = my_custom_check_creds(
      dbname = "******",
      host = "*****",
      port = ****,
      db_user = "*****",
      db_password = "*******"
    )
  )

  auth_output <- reactive({
    reactiveValuesToList(res_auth)
  })

  # access info
  observe({
    user_info <- auth_output()$user_info
    if (!is.null(user_info)) {
      user <- user_info$user
      isAdmin <- user_info$isAdmin
      print(paste("User:", user, "isAdmin:", isAdmin))
      # Implement your logic based on isAdmin value (e.g., show/hide certain UI elements)
    }
  })
}

Regarding the second part of your question about adding cookie-based authentication to avoid re-typing credentials, you can use the shinymanager::shinymanager_auth function with the cookie = TRUE argument to enable cookie-based authentication. The shinymanager_auth function can be used before setting up your Shiny app's UI and server.

# Before setting up the UI and server
shinymanager::shinymanager_auth(
  appTitle = "My Secure Application",
  check_credentials = my_custom_check_creds(
    dbname = "******",
    host = "*****",
    port = ****,
    db_user = "*****",
    db_password = "*******"
  ),
  cookie = TRUE  # Enable cookie-based authentication
)

This will allow users to stay authenticated across page refreshes and sessions.

Please make sure to adapt the code according to your specific PostgreSQL setup and requirements.

Answer 3

I think to try this

library(shiny)
library(shinymanager)

# Define credentials (replace these with your actual username and password)
credentials <- data.frame(
  user = c("admin", "user"),
  password = c("adminpass", "userpass"),
  stringsAsFactors = FALSE
)

# Define your Shiny app UI
ui <- fluidPage(
  # Wrap your app UI with secure_app()
  secure_app(
    # Wrap the parts of your app that require authentication with secure_ui()
    secure_ui(
      fluidPage(
        titlePanel("My Shiny App"),
        # Your app content goes here
        # ...
      )
    )
  )
)

# Define your Shiny app server
server <- function(input, output, session) {
  # Wrap your app server with secure_server()
  secure_server(
    function(input, output, session) {
      # Your app server logic goes here
      # ...
    },
    # Pass the credentials to secure_server()
    user_data = credentials
  )`enter code here`
}

# Run the Shiny app
shinyApp(ui, server)