2

I want to use the shinymanager package to secure my Rshiny application but I want to use it with a PostgreSQL database...

I checked the example provided in the documentation and the github of the package to eventually create this code that is not working but I don't know why:

library(RPostgreSQL)
library(shiny)
library(shinymanager)
library(DBI)
library(pool)
library(sodium)


dbname = ***********
host =  ***********
user =  ***********
password =  ***********

con <- dbPool(
  drv = dbDriver("PostgreSQL"),
  dbname = dbname , 
  host = host,
  user = user, 
  password = password )

DBI::dbWriteTable(con, c("test", "test2"), data.frame(
  user = c("David"),
  password = sodium::password_store("123"),
  stringsAsFactors = FALSE
))

my_custom_check_creds <- function(dbname, host, user, password) {
  function(user, password) {
    
    con <- dbConnect(drv = dbDriver("PostgreSQL"),  
                     dbname = dbname,
                     host = host,
                     user = user, 
                     password = password)

    req <- sqlInterpolate(con, sql = "SELECT * FROM test.test2 WHERE test2.user = ({user}) AND test2.password = ({password})",
                    user = user, password = password)
    
    res <- dbGetQuery(con, statement = req)
    
    if (nrow(res) > 0) {

  hashed_password <- res$password

  if (sodium::password_verify(hashed_password, password)) {
    list(user = user, password = password, result = TRUE)
    } else {
    list(result = FALSE)
  }
} 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
    )  
    output$auth_output <- renderPrint({
      reactiveValuesToList(res_auth)
    })
    
  }
  
  shinyApp(ui, server)

The app is launched but after pressing the log in button the app disconnect and I get a not very informating warning message:

��m)
  [No stack trace available]
zakros
  • 119
  • 9
  • Is there a reason why you are building a custom authentication system rather than using a pre-existing system? There are several R/shiny packages that provide this functionality out of the box, and third party platforms as well. Depending on how sensitive your shiny app/data is, it might be worth considering. – Sam Rogers Apr 06 '23 at 23:47
  • 1
    Hi Sam ! What do you mean by a custom authentification system ? I'm using the shinymanager package to do so but I just want to make it more secured by reading hashed password stored in postgresql... I thought it would be very simple but it is not... Do you have a solution or another suggestion ? I tried the shinyauthr but I have another issue with this package ! – zakros Apr 07 '23 at 08:49
  • Shinyproxy (https://www.shinyproxy.io/) has a way to connect to other sign in systems either via LDAP or SSO which is more for corporate systems I believe, or something like googleAuthR (https://cran.r-project.org/web/packages/googleAuthR/index.html) can mostly outsource auth to Google IDs. I've not personally used either of them, but they're just a couple that I know of. Another option I have used is Auth0 (https://auth0.com/). They have a free plan for up to 7000 users (logins). Hopefully one of those night help? Please comment again if you still need help with this question though – Sam Rogers Apr 07 '23 at 18:32
  • 1
    Unfortunately I'm looking for an easy and quick way to secure my little application. Those solutions sounds good but are defintely overkill solutions for my case. – zakros Apr 08 '23 at 06:39
  • 1
    Fair enough. If you're content with the security of your solution, then there's nothing wrong with that. If you are protecting something very sensitive, then you take appropriate mitigation steps. – Sam Rogers Apr 09 '23 at 07:06
  • 1
    I will see if I can post a solution when I get some time, but from a very brief glance, it looks like you need to be calling my_custom_check_creds as a function, rather than a variable as you are currently. – Sam Rogers Apr 09 '23 at 07:07

1 Answers1

0

Ok, I haven't tested this at all, since I don't have a Postgres server available at the moment, but I've made some adjustments that should hopefully get you closer to a solution.

Note that your database login and password will be (or certainly should be) different than a random users credentials, so they need to be given different argument names in the functions. I'm not entirely clear how the username and password to be authenticated are passed through to the check credentials function, but you've obviously based your attempt on the example from the shinymanager package, so I've just fixed that a little.

library(RPostgreSQL)
library(shiny)
library(shinymanager)
library(DBI)
library(pool)
library(sodium)

dbname <- "***********"
host <- "***********"
db_user <- "***********"
db_password <- "***********"

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

DBI::dbWriteTable(con, c("test", "test2"), data.frame(
    user = c("David"),
    password = sodium::password_store("123"),
    stringsAsFactors = FALSE
))

my_custom_check_creds <- function(dbname, host, db_user, db_password) { # Database creds
    function(user, password) { # User login creds
        
        con <- dbConnect(drv = dbDriver("PostgreSQL"),  
                         dbname = dbname,
                         host = host,
                         user = db_user,  # These are the database credentials
                         password = db_password)
        
        # Extract user login creds from database
        req <- sqlInterpolate(con, sql = "SELECT * FROM test.test2 WHERE test2.user = ({user}) AND test2.password = ({password})",
                              user = user, password = password)
        
        res <- dbGetQuery(con, statement = req)
        
        if (nrow(res) > 0) {
            
            hashed_password <- res$password
            
            if (sodium::password_verify(hashed_password, password)) {
                list(user = user, password = password, result = TRUE)
            } else {
                list(result = FALSE)
            }
        } 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( # Need to call the function here
            dbname, # Pass it the appropriate credentials
            host,
            db_user,
            db_password
        )
    )  
    output$auth_output <- renderPrint({
        reactiveValuesToList(res_auth)
    })
}

shinyApp(ui, server)
Sam Rogers
  • 787
  • 1
  • 8
  • 19
  • I have a working app with shinymanager and Postgres on a remote server. Is there any way to enable admin mode with Postgres? Apparently admin is only available using a SQLite database. – M.Qasim Jul 09 '23 at 13:51
  • 1
    @M.Qasim the short answer is I don't know. You'd be better off asking this as a new question. – Sam Rogers Jul 10 '23 at 16:13