Advertisement
Guest User

Untitled

a guest
Mar 30th, 2017
70
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.05 KB | None | 0 0
  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.  
  8. library(shiny)
  9. library(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)
  21. db = dbConnect(SQLite(), dbname = 'auth_nohash.sqlite')
  22.  
  23. server <- 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.  
  84. ui <- fluidPage(
  85. uiOutput('data'),
  86. plotOutput('myPlot')
  87. )
  88.  
  89. shinyApp(ui = ui, server = server)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement