Managing Users

 1## Authentication
 2## This is a small app to demonstrate user-managed authentication without encoded passwords.
 3## Users are stored in a SQL database with passwords along with roles.  
 4## Once a user is logged in the shiny app responds to the user's role.
 5## In order to use in a real setting, additional code for password management,
 6## changing and resetting would need to be implemented.
 7
 8library(shiny)
 9library(RSQLite)
10
11## create the initial password database
12## This code should be run once to create the initial database of users, passwords and roles
13##
14# db.pw <- data.frame(user = c('Augustin', 'Matt', 'Harvey'), role = c('Manager', 'User', 'User'), password = c('ABC', 'DEF', 'GHI'))
15# db = dbConnect(SQLite(), dbname = 'auth_nohash.sqlite')
16# dbSendQuery(db, 'CREATE TABLE pw (user TEXT, password TEXT, role TEXT)')
17# apply(db.pw, 1, function(x) dbSendQuery(db, paste0('INSERT INTO pw VALUES("', x['user'], '", "', x['password'], '", "', x['role'], '")')))
18# dbDisconnect(db)
19
20## Connect to the database (may be a remote connection)
21db = dbConnect(SQLite(), dbname = 'auth_nohash.sqlite')
22
23server <- function(input, output, session) {
24  
25  ## Initialize - user is not logged in
26  user <- reactiveValues(login = FALSE, name = NULL, role = NULL, header = NULL)
27  
28  ## Display login modal
29  observe({
30    showModal(modalDialog(
31      title = "Enter Login Details",
32      textInput('userInp', 'Login'),
33      passwordInput('pwInp', 'Password'),
34      actionButton('butLogin', 'Login', class = 'btn action-button btn-success', icon = icon('sign-in')),
35      size = 's',
36      easyClose = FALSE,
37      footer = NULL
38    ))
39  })
40  
41  ## Check for user in database
42  observeEvent(input$butLogin, {  ## login button pressed
43    req(input$userInp, input$pwInp)  ## ensure we have inputs
44    removeModal()  ## remove the modal
45    pw_out <- dbGetQuery(db, paste0('SELECT password FROM pw WHERE user = \"', input$userInp, '\"'))  ## query database
46    if (nrow(pw_out) == 0) {  ## user does not exist
47      user$login <- FALSE
48      user$header <- 'ERROR - UNKNOWN USER'
49    } else {
50      pw <- as.character(pw_out$password)[[1]]  ## grab password from database
51      passwordVerified <- pw == input$pwInp  ## check that it matches user input
52      if (passwordVerified) {  ## match
53        user$login <- TRUE
54        user$name <- input$userInp
55        user$role <- db.pw[db.pw$user == input$userInp, 'role']
56        user$header <- paste0(user$name, ' (', user$role, ')')
57      } else {  ## no match
58        user$login <- FALSE
59        user$header <- 'ERROR - INCORRECT PASSWORD'
60      }
61    }
62  })
63  
64  ## close database on exit
65  session$onSessionEnded(function(){
66    dbDisconnect(db)
67  })
68  
69  output$data <- renderUI({
70    h4(user$header)
71  })
72  
73  output$myPlot <- renderPlot({
74    req(user$login)
75    if (user$role == 'Manager') {  ## If manager role, display iris plot
76      plot(iris$Sepal.Length, iris$Sepal.Width)
77    } else {  ## If user role, display mtcars plot
78      plot(mtcars$mpg, mtcars$cyl)
79    }
80  })
81  
82}
83
84ui <- fluidPage(
85  uiOutput('data'),
86  plotOutput('myPlot')
87)
88
89shinyApp(ui = ui, server = server)

 1## Authentication
 2## This is a small app to demonstrate user-managed authentication using a hash to encode passwords.
 3## Users are stored in a SQL database with passwords along with roles.
 4## Once a user is logged in the shiny app responds to the user's role.
 5## In order to use in a real setting, additional code for password management,
 6## changing and resetting would need to be implemented.
 7
 8library(shiny)
 9library(RSQLite)
10library(sodium)
11
12## create the initial password database
13## This code should be run once to create the initial database of users, passwords and roles
14##
15# db.pw <- data.frame(user = c('Augustin', 'Matt', 'Harvey'), role = c('Manager', 'User', 'User'), password = c('ABC', 'DEF', 'GHI'))
16# db.pw$encrypt <- apply(db.pw, 1, function(x) password_store(x['password']))
17# db = dbConnect(SQLite(), dbname = 'auth_hash.sqlite')
18# dbSendQuery(db, 'CREATE TABLE pw (user TEXT, password TEXT, role TEXT)')
19# apply(db.pw, 1, function(x) dbSendQuery(db, paste0('INSERT INTO pw VALUES("', x['user'], '", "', x['encrypt'], '", "', x['role'], '")')))
20# dbDisconnect(db)
21
22## Connect to the database (may be a remote connection)
23db = dbConnect(SQLite(), dbname = 'auth_hash.sqlite')
24
25server <- function(input, output, session) {
26  
27  ## Initialize - user is not logged in
28  user <- reactiveValues(login = FALSE, name = NULL, role = NULL, header = NULL)
29  
30  ## Display login modal
31  observe({
32    showModal(modalDialog(
33      title = "Enter Login Details",
34      textInput('userInp', 'Login'),
35      passwordInput('pwInp', 'Password'),
36      actionButton('butLogin', 'Login', class = 'btn action-button btn-success', icon = icon('sign-in')),
37      size = 's',
38      easyClose = FALSE,
39      footer = NULL
40    ))
41  })
42  
43  ## Check for user in database
44  observeEvent(input$butLogin, {  ## login button pressed
45    req(input$userInp, input$pwInp)  ## ensure we have inputs
46    removeModal()  ## remove the modal
47    pw_out <- dbGetQuery(db, paste0('SELECT password FROM pw WHERE user = \"', input$userInp, '\"'))  ## query database
48    if (nrow(pw_out) == 0) {  ## user does not exist
49      user$login <- FALSE
50      user$header <- 'ERROR - UNKNOWN USER'
51    } else {
52      pw <- as.character(pw_out$password)[[1]]  ## grab password from database
53      passwordVerified <- password_verify(pw, input$pwInp)  ## check that it matches user input
54      if (passwordVerified) {  ## match
55        user$login <- TRUE
56        user$name <- input$userInp
57        user$role <- db.pw[db.pw$user == input$userInp, 'role']
58        user$header <- paste0(user$name, ' (', user$role, ')')
59      } else {  ## no match
60        user$login <- FALSE
61        user$header <- 'ERROR - INCORRECT PASSWORD'
62      }
63    }
64  })
65  
66  ## close database on exit
67  session$onSessionEnded(function(){
68    dbDisconnect(db)
69  })
70  
71  output$data <- renderUI({
72    h4(user$header)
73  })
74  
75  output$myPlot <- renderPlot({
76    req(user$login)
77    if (user$role == 'Manager') {  ## If manager role, display iris plot
78      plot(iris$Sepal.Length, iris$Sepal.Width)
79    } else {  ## If user role, display mtcars plot
80      plot(mtcars$mpg, mtcars$cyl)
81    }
82  })
83  
84}
85
86ui <- fluidPage(
87  uiOutput('data'),
88  plotOutput('myPlot')
89)
90
91shinyApp(ui = ui, server = server)