How to build login page in R Shiny App

This tutorial covers how you can build login page where user needs to add username and password for authentication in shiny app. RStudio offers paid products like Shiny Server or RStudio Connect which has authentication feature to verify the identify of user. But if you want this feature for free, you can follow the steps mentioned below.

Features of R Program shown in the tutorial below

1. Dashboard will be opened only when user enters correct username and password
2. You can hide or show functionalities of dashboard (like tabs, widgets etc) based on type of permission
3. Encrypt password with hashing algorithm which mitigates brute-force attacks

Steps to add login authentication feature in Shiny

Step 1 : Install the following packages by using the command install.packages(package-name)

• shiny
• shinydashboard
• DT
• shinyjs
• sodium

Step 2 : Run the program below

library(shiny)
library(shinydashboard)
library(DT)
library(shinyjs)
library(sodium)

# Main login screen
loginpage <- div(id = "loginpage", style = "width: 500px; max-width: 100%; margin: 0 auto; padding: 20px;",
                 wellPanel(
                   tags$h2("LOG IN", class = "text-center", style = "padding-top: 0;color:#333; font-weight:600;"),
                   textInput("userName", placeholder="Username", label = tagList(icon("user"), "Username")),
                   passwordInput("passwd", placeholder="Password", label = tagList(icon("unlock-alt"), "Password")),
                   br(),
                   div(
                     style = "text-align: center;",
                     actionButton("login", "SIGN IN", style = "color: white; background-color:#3c8dbc;
                                 padding: 10px 15px; width: 150px; cursor: pointer;
                                 font-size: 18px; font-weight: 600;"),
                     shinyjs::hidden(
                       div(id = "nomatch",
                           tags$p("Oops! Incorrect username or password!",
                                  style = "color: red; font-weight: 600; 
                                            padding-top: 5px;font-size:16px;", 
                                  class = "text-center"))),
                     br(),
                     br(),
                     tags$code("Username: myuser  Password: mypass"),
                     br(),
                     tags$code("Username: myuser1  Password: mypass1")
                   ))
)

credentials = data.frame(
  username_id = c("myuser", "myuser1"),
  passod   = sapply(c("mypass", "mypass1"),password_store),
  permission  = c("basic", "advanced"), 
  stringsAsFactors = F
  )

header <- dashboardHeader( title = "Simple Dashboard", uiOutput("logoutbtn"))

sidebar <- dashboardSidebar(uiOutput("sidebarpanel")) 
body <- dashboardBody(shinyjs::useShinyjs(), uiOutput("body"))
ui<-dashboardPage(header, sidebar, body, skin = "blue")

server <- function(input, output, session) {

  login = FALSE
  USER <- reactiveValues(login = login)

  observe({ 
    if (USER$login == FALSE) {
      if (!is.null(input$login)) {
        if (input$login > 0) {
          Username <- isolate(input$userName)
          Password <- isolate(input$passwd)
          if(length(which(credentials$username_id==Username))==1) { 
            pasmatch  <- credentials["passod"][which(credentials$username_id==Username),]
            pasverify <- password_verify(pasmatch, Password)
            if(pasverify) {
            USER$login <- TRUE
            } else {
              shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
              shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
            }
          } else {
            shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
            shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
          }
        } 
      }
    }    
  })

  output$logoutbtn <- renderUI({
    req(USER$login)
    tags$li(a(icon("fa fa-sign-out"), "Logout", 
              href="javascript:window.location.reload(true)"),
            class = "dropdown", 
            style = "background-color: #eee !important; border: 0;
                    font-weight: bold; margin:5px; padding: 10px;")
  })

  output$sidebarpanel <- renderUI({
    if (USER$login == TRUE ){ 
      sidebarMenu(
        menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard"))
      )
    }
  })

  output$body <- renderUI({
    if (USER$login == TRUE ) {
      tabItem(tabName ="dashboard", class = "active",
              fluidRow(
                box(width = 12, dataTableOutput('results'))
              ))
    }
    else {
      loginpage
    }
  })

  output$results <-  DT::renderDataTable({
    datatable(iris, options = list(autoWidth = TRUE,
                                   searching = FALSE))
  })

}

runApp(list(ui = ui, server = server), launch.browser = TRUE)

1. In the above program, two user names and passwords are defined
   Username : myuser Password : mypassUsername : myuser1 Password : mypass1. To change them, you can edit the following code in R program.

   
   credentials = data.frame(
     username_id = c("myuser", "myuser1"),
     passod   = sapply(c("mypass", "mypass1"),password_store),
     permission  = c("basic", "advanced"), 
     stringsAsFactors = F
     )
   

2. In order to modify sidebar section, you can edit the following section of code.

       if (USER$login == TRUE ){ 
         sidebarMenu(
           menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard"))
         )
       }
   

   In order to edit main body of the app, you can make modification in the following section of code.

     if (USER$login == TRUE ) {
         tabItem(tabName ="dashboard", class = "active",
                 fluidRow(
                   box(width = 12, dataTableOutput('results'))
                 ))
       }
       else {
         loginpage
       }
   

3. Suppose you want to show multiple tabs if permission level is set "advanced". Otherwise show a single tab. If you login with credentials Username : myuser1 Password : mypass1, you would find two tabs. Else it would show only one tab named "Main Page". Replace renderUI function of output$sidebarpanel and output$body with the following script.

     output$sidebarpanel <- renderUI({
       if (USER$login == TRUE ){ 
         if (credentials[,"permission"][which(credentials$username_id==input$userName)]=="advanced") {
           sidebarMenu(
           menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard")),
           menuItem("About Page", tabName = "About", icon = icon("th"))
           )
         }
         else{
           sidebarMenu(
             menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard"))
           )
   
         }
       }
     })
   
   
     output$body <- renderUI({
       if (USER$login == TRUE ) {
       if (credentials[,"permission"][which(credentials$username_id==input$userName)]=="advanced") {
       tabItems(
                 tabItem(
                  tabName ="dashboard", class = "active",
                  fluidRow(
                   box(width = 12, dataTableOutput('results'))
                 ))
           ,
             tabItem(
               tabName ="About",
               h2("This is second tab")
                 )
       )
       } 
         else {
           tabItem(
             tabName ="dashboard", class = "active",
             fluidRow(
               box(width = 12, dataTableOutput('results'))
             ))
   
         }
   
       }
       else {
         loginpage
       }
     })