shinyauthr with shinydashboard layout

[wlam]

Hello R Community,

I was wondering if you could help me set up an authentication feature for my shinydashboard app. I am looking to incorporate shinyauthr but I am have trouble making it work with the shinydashboard layout. The example given uses a fluidPage but I don't think shinydashboard layout has a fluidPage function, right? To keep it simple, how would you advise I add the shinyauthr code into the shiny dashboard layout below to make it functional? I am hoping to make it so that the user will see the login page first to log in and then once they log in they can see the data from the dashboard. I hope this will help other people too in the R-Community. Thank you.

library(shinydashboard)

shinyUI(
    dashboardHeader(title = "Dashboard"),
    dashboardSiderbar(),
    dashboardBody()
)

shinyServer(function(input, output){
})

shinyApp(ui, server)

[paul]

Hi @wlam. So I have an example of shinyauthr being used with shinydashboard in the package repo:

PaulC91/shinyauthr/blob/master/inst/shiny-examples/shinyauthr_example/app.R

The live app is hosted here: https://cultureofinsight.shinyapps.io/shinyauthr/

Let me know if you have any questions!

[wlam]

Hi @paul can you explain what the bare minimum code I would need to make the authentication piece functional for the ui.r piece and the server.r piece? I am a little confuse with the code here in the sample. I am trying to add only the shinyauthr piece onto my existing shiny app. Thank you.

[paul]

Hi @wlam, please see below for a minimal example of shinyauthr in use with shinydashboard.

Basically, when a successful login occurs:

• the sidebar is opened
• a sidebar menu is rendered with 2 options
• the ui and output content of each tab is rendered

This is done by moving UI code to the server and use the req() function to tell shiny to only run the code when credentials()$user_auth is TRUE (a successful login has happened). When the logout button is clicked credentials()$user_auth becomes FALSE so the sidebar menu and content of each tab disappears.

library(shiny)
library(shinydashboard)
library(shinyauthr)
library(dplyr)
library(shinyjs)
library(DT)

# sample logins dataframe with passwords hashed by sodium package
user_base <- tibble(
  user = c("user1", "user2"),
  password = sapply(c("pass1", "pass2"), sodium::password_store), 
  permissions = c("admin", "standard"),
  name = c("User One", "User Two")
)

ui <- dashboardPage(
  
  # put the shinyauthr logout ui module in here
  dashboardHeader(
    title = "shinyauthr",
    tags$li(class = "dropdown", style = "padding: 8px;", shinyauthr::logoutUI("logout"))
  ),
  
  # setup a sidebar menu to be rendered server-side
  dashboardSidebar(
    collapsed = TRUE, sidebarMenuOutput("sidebar")
  ),
  
  
  dashboardBody(
    shinyjs::useShinyjs(),
    
    # put the shinyauthr login ui module here
    shinyauthr::loginUI("login"),
    
    # setup any tab pages you want after login here with uiOutputs
    tabItems(
      tabItem("tab1", uiOutput("tab1_ui")),
      tabItem("tab2", uiOutput("tab2_ui"))
    )
  )
)

server <- function(input, output, session) {
  
  # login status and info will be managed by shinyauthr module and stores here
  credentials <- callModule(shinyauthr::login, "login", 
                            data = user_base,
                            user_col = user,
                            pwd_col = password,
                            sodium_hashed = TRUE,
                            log_out = reactive(logout_init()))
  
  # logout status managed by shinyauthr module and stored here
  logout_init <- callModule(shinyauthr::logout, "logout", reactive(credentials()$user_auth))
  
  # this opens or closes the sidebar on login/logout
  observe({
    if(credentials()$user_auth) {
      shinyjs::removeClass(selector = "body", class = "sidebar-collapse")
    } else {
      shinyjs::addClass(selector = "body", class = "sidebar-collapse")
    }
  })
  
  # only when credentials()$user_auth is TRUE, render your desired sidebar menu
  output$sidebar <- renderMenu({
    req(credentials()$user_auth)
    sidebarMenu(
      id = "tabs",
      menuItem("Storms Data", tabName = "tab1"),
      menuItem("Starwars Data", tabName = "tab2")
    )
  })
  
  # tab 1 UI and output ----------------------------------------
  output$tab1_ui <- renderUI({
    req(credentials()$user_auth)
    DT::DTOutput("table1")
  })
  
  output$table1 <- DT::renderDT({
    DT::datatable(dplyr::storms, options = list(scrollX = TRUE))
  })
  
  # tab 2 UI and output ----------------------------------------
  output$tab2_ui <- renderUI({
    req(credentials()$user_auth)
    DT::DTOutput("table2")
  })
  
  output$table2 <- DT::renderDT({
    DT::datatable(dplyr::starwars[,1:10], options = list(scrollX = TRUE))
  })
  
}

shiny::shinyApp(ui, server)