Search code examples
rshinyshinydashboardshinyauthr

Reactive Filtering Based on User Login - Shinyauthr


I have a QA Shiny Dashboard app that has a master dataset that must filter the rows used in subsequent tables / maps according to user login details.

For example: if the user logs in with a particular username ([email protected]) then the reactive function selects rows that contain this username and passes these to the shiny app for rendering.

Example of basic premise:

username <- "[email protected]"

new_dataset <- filter(dataset, column %like% username

output$table <- renderTable ({
  new_dataset
)}

I am using the shiny author package to create this but I am having difficulty passing the user login details created by the in-built Shinyauthr functions to a reactive function. Code below:

users <- data.frame(user= c("user1", "user2", "user3"),
                         password = c("pass1", "pass2", "pass3"),
                         stringsAsFactors = FALSE)

ui <- dashboardPage(

  dashboardHeader(
    title = "QA App",

    tags$li(class = "dropdown", style = "padding: 8px;", shinyauthr::logoutUI("logout"))
  ),

  dashboardSidebar(
    collapsed = TRUE, sidebarMenuOutput("sidebar")
  ),

  dashboardBody(

    shinyjs::useShinyjs(),

    # shinyauthr login ui module here
    shinyauthr::loginUI("login"),

    tabItems(
      tabItem("tab", uiOutput("tab1_ui"))
    )
  )
)

server <- function(input, output) {

credentials <- callModule(shinyauthr::login, "login", 
                          data = users,
                          user_col = user,
                          pwd_col = password,
                          sodium_hashed = FALSE,
                          log_out = reactive(logout_init()))


# logout status managed by shinyauthr module and stored here
logout_init <- callModule(shinyauthr::logout, "logout", reactive(credentials()$user_auth))

output$sidebar <- renderMenu({
  req(credentials()$user_auth)
  sidebarMenu(

    menuItem("Tab", tabName = "tab", icon = icon("arrows-alt-v"))

  )
})

output$tab1_ui <- renderUI({

  req(credentials()$user_auth)
  fluidPage(

    mainPanel(
             tableOutput("table"),
      )
     )
  })
}

shinyApp(ui = ui, server = server)

I wish to create a reactive function that will render this new_dataset and pass it to the table output within the UI. The question is how to access user login credentials as characters strings to use in filtering?


Solution

  • As often happens in these cases, a lot of wrangling finally led to an answer but I will post my solution here in case anyone runs into a similar issue.

    R2Evans was correct in that it can be called with credentials()$info. The issue was trying to use eventReactive, rather than simply reactive.

    Reactive user details are collected via:

    credentials <- callModule(shinyauthr::login, "login", 
                              data = user_base,
                              user_col = user,
                              pwd_col = password,
                              sodium_hashed = FALSE,
                              log_out = reactive(logout_init()))
    
    user_info <- reactive({credentials()$info})
    
    filteredData <- reactive({
      filter(table, column %like% as.character(user_info()$user))
    })
    
    output$table <- renderTable(filteredData())