There are several ways that users can be managed in Shiny apps but they all require access to the config file. User access can be managed within the app itself using a database to hold user information. Two examples are given below: The first utilizes a simple database in which the passwords are not encrypted (not recommended for multiple reasons!) The second is very similar but it uses the sodium library to encode the passwords in the database. These are very simplistic examples and contain no functions for password management (such as users being able to change their passwords or password reset) but these would be straight forward to add.
User login - No encrpytion
https://gist.github.com/harveyl888/a85e17c3048e0da03cf4e6b52d1da3db
## Authentication
## This is a small app to demonstrate user-managed authentication without encoded passwords.
## Users are stored in a SQL database with passwords along with roles.
## Once a user is logged in the shiny app responds to the user's role.
## In order to use in a real setting, additional code for password management,
## changing and resetting would need to be implemented.
library(shiny)
library(RSQLite)
## create the initial password database
## This code should be run once to create the initial database of users, passwords and roles
##
# db.pw <- data.frame(user = c('Augustin', 'Matt', 'Harvey'), role = c('Manager', 'User', 'User'), password = c('ABC', 'DEF', 'GHI'))
# db = dbConnect(SQLite(), dbname = 'auth_nohash.sqlite')
# dbSendQuery(db, 'CREATE TABLE pw (user TEXT, password TEXT, role TEXT)')
# apply(db.pw, 1, function(x) dbSendQuery(db, paste0('INSERT INTO pw VALUES("', x['user'], '", "', x['password'], '", "', x['role'], '")')))
# dbDisconnect(db)
## Connect to the database (may be a remote connection)
db = dbConnect(SQLite(), dbname = 'auth_nohash.sqlite')
server <- function(input, output, session) {
## Initialize - user is not logged in
user <- reactiveValues(login = FALSE, name = NULL, role = NULL, header = NULL)
## Display login modal
observe({
showModal(modalDialog(
title = "Enter Login Details",
textInput('userInp', 'Login'),
passwordInput('pwInp', 'Password'),
actionButton('butLogin', 'Login', class = 'btn action-button btn-success', icon = icon('sign-in')),
size = 's',
easyClose = FALSE,
footer = NULL
))
})
## Check for user in database
observeEvent(input$butLogin, { ## login button pressed
req(input$userInp, input$pwInp) ## ensure we have inputs
removeModal() ## remove the modal
pw_out <- dbGetQuery(db, paste0('SELECT password FROM pw WHERE user = \"', input$userInp, '\"')) ## query database
if (nrow(pw_out) == 0) { ## user does not exist
user$login <- FALSE
user$header <- 'ERROR - UNKNOWN USER'
} else {
pw <- as.character(pw_out$password)[[1]] ## grab password from database
passwordVerified <- pw == input$pwInp ## check that it matches user input
if (passwordVerified) { ## match
user$login <- TRUE
user$name <- input$userInp
user$role <- db.pw[db.pw$user == input$userInp, 'role']
user$header <- paste0(user$name, ' (', user$role, ')')
} else { ## no match
user$login <- FALSE
user$header <- 'ERROR - INCORRECT PASSWORD'
}
}
})
## close database on exit
session$onSessionEnded(function(){
dbDisconnect(db)
})
output$data <- renderUI({
h4(user$header)
})
output$myPlot <- renderPlot({
req(user$login)
if (user$role == 'Manager') { ## If manager role, display iris plot
plot(iris$Sepal.Length, iris$Sepal.Width)
} else { ## If user role, display mtcars plot
plot(mtcars$mpg, mtcars$cyl)
}
})
}
ui <- fluidPage(
uiOutput('data'),
plotOutput('myPlot')
)
shinyApp(ui = ui, server = server)
User login - With encrpytion
https://gist.github.com/harveyl888/3e5123a6469fbdc3830123e3efb31a2a
## Authentication
## This is a small app to demonstrate user-managed authentication using a hash to encode passwords.
## Users are stored in a SQL database with passwords along with roles.
## Once a user is logged in the shiny app responds to the user's role.
## In order to use in a real setting, additional code for password management,
## changing and resetting would need to be implemented.
library(shiny)
library(RSQLite)
library(sodium)
## create the initial password database
## This code should be run once to create the initial database of users, passwords and roles
##
# db.pw <- data.frame(user = c('Augustin', 'Matt', 'Harvey'), role = c('Manager', 'User', 'User'), password = c('ABC', 'DEF', 'GHI'))
# db.pw$encrypt <- apply(db.pw, 1, function(x) password_store(x['password']))
# db = dbConnect(SQLite(), dbname = 'auth_hash.sqlite')
# dbSendQuery(db, 'CREATE TABLE pw (user TEXT, password TEXT, role TEXT)')
# apply(db.pw, 1, function(x) dbSendQuery(db, paste0('INSERT INTO pw VALUES("', x['user'], '", "', x['encrypt'], '", "', x['role'], '")')))
# dbDisconnect(db)
## Connect to the database (may be a remote connection)
db = dbConnect(SQLite(), dbname = 'auth_hash.sqlite')
server <- function(input, output, session) {
## Initialize - user is not logged in
user <- reactiveValues(login = FALSE, name = NULL, role = NULL, header = NULL)
## Display login modal
observe({
showModal(modalDialog(
title = "Enter Login Details",
textInput('userInp', 'Login'),
passwordInput('pwInp', 'Password'),
actionButton('butLogin', 'Login', class = 'btn action-button btn-success', icon = icon('sign-in')),
size = 's',
easyClose = FALSE,
footer = NULL
))
})
## Check for user in database
observeEvent(input$butLogin, { ## login button pressed
req(input$userInp, input$pwInp) ## ensure we have inputs
removeModal() ## remove the modal
pw_out <- dbGetQuery(db, paste0('SELECT password FROM pw WHERE user = \"', input$userInp, '\"')) ## query database
if (nrow(pw_out) == 0) { ## user does not exist
user$login <- FALSE
user$header <- 'ERROR - UNKNOWN USER'
} else {
pw <- as.character(pw_out$password)[[1]] ## grab password from database
passwordVerified <- password_verify(pw, input$pwInp) ## check that it matches user input
if (passwordVerified) { ## match
user$login <- TRUE
user$name <- input$userInp
user$role <- db.pw[db.pw$user == input$userInp, 'role']
user$header <- paste0(user$name, ' (', user$role, ')')
} else { ## no match
user$login <- FALSE
user$header <- 'ERROR - INCORRECT PASSWORD'
}
}
})
## close database on exit
session$onSessionEnded(function(){
dbDisconnect(db)
})
output$data <- renderUI({
h4(user$header)
})
output$myPlot <- renderPlot({
req(user$login)
if (user$role == 'Manager') { ## If manager role, display iris plot
plot(iris$Sepal.Length, iris$Sepal.Width)
} else { ## If user role, display mtcars plot
plot(mtcars$mpg, mtcars$cyl)
}
})
}
ui <- fluidPage(
uiOutput('data'),
plotOutput('myPlot')
)
shinyApp(ui = ui, server = server)