Created
March 30, 2017 12:37
-
-
Save harveyl888/3e5123a6469fbdc3830123e3efb31a2a to your computer and use it in GitHub Desktop.
Manage users with encryption (R Shiny App)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
## 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) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment