Shiny 中受密码保护的仪表板选项卡

Question

I am trying adapt Paul Campbell's shinyauthr example https://paul.rbind.io/2018/11/04/introducing-shinyauthr/

to create a shiny dashboard with password authentication. I have tried a number of options and I have read questions about similar problems but I have been unable to adapt them to solve my issue. I can require a password to access the dashboard but I cannot cannot put things into the dashboard tabs.

This is my minimum working example which tries to extend Paul's example.

library(shiny)
library(shinyauthr)
library(shinyjs)
library(shinydashboard)

# dataframe that holds usernames, passwords and other user data
user_base <- data.frame(
  user = c("user1", "user2"),
  password = c("pass1", "pass2"), 
  permissions = c("admin", "standard"),
  name = c("User One", "User Two"),
  stringsAsFactors = FALSE
)

ui <-dashboardPage(
  dashboardHeader(title = "Hello"),
  dashboardSidebar(
    sidebarMenu("Select Security", tabName = "select_security"),
    sidebarMenu("Portfolio", tabName = "portfolio")
  ),
  dashboardBody(

  shinyjs::useShinyjs(),
  div(class = "pull-right", shinyauthr::logoutUI(id = "logout")),
  shinyauthr::loginUI(id = "login"),
  tags$div(tabName = "portfolio", tableOutput("user_table"), 
           class = "tab_content"), 
  tags$div(tabName = "select_security", textOutput("welcome_note"), class = "tab_content")
)
)

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

  logout_init <- callModule(shinyauthr::logout, 
                            id = "logout", 
                            active = reactive(credentials()$user_auth))

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

    output$user_table <- renderTable({
    req(credentials()$user_auth)
    user_data()
    })
  output$welcome_note <- renderText({
  req(credentials()$user_auth)
  print("Hello")
})

} 

shinyApp(ui = ui, server = server)

The Hello arrives with the table but I want it to be attached to the 'Portfolio' tab. I am using the tags$div method here because the standard dashboard menuItem approach did not work so I followed this advice: Using shiny modules and shinydashboard: shiny.tag error

Rob

Answer 1

I think that I solved it and I think that this is the answer. Each tab has its own input and that is only revealed when the password is supplied.

library(shiny)
library(shinyauthr)
library(shinyjs)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "My Dashboard",

  dashboardSidebar( 
  shinyjs::useShinyjs(),
  sidebarMenu(
    menuItem("Security Selection", tabName = "security_selection", icon = icon("dashboard")), 
      menuItem("Portfolio", tabName = "portfolio", icon = icon("th"))
       ), 


  dashboardBody(
    useShinyjs(),
    tags$head(tags$style(".table{margin: 0 auto;}"),

              tags$script(src="https://cdnjs.cloudflare.com/ajax/libs/iframe-resizer/3.5.16/iframeResizer.contentWindow.min.js",
                          type="text/javascript"),
              includeScript("returnClick.js")
    ),
    shinyauthr::loginUI("login"),
    tabItems(
      # first tab content
    tabItem(tabName = "security_selection", uiOutput("security_selection")),
    tabItem(tabName = "portfolio", uiOutput("portfolio"))

    )
)
)


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

  credentials <- callModule(shinyauthr::login, "login", 
                            data = user_base,
                            user_col = user,
                            pwd_col = password_hash,
                            sodium_hashed = TRUE,
                            log_out = reactive(logout_init()))

  logout_init <- callModule(shinyauthr::logout, "logout", reactive(credentials()$user_auth))


  user_info <- reactive({credentials()$info})

  user_data <- reactive({
    req(credentials()$user_auth)


   output$security_selection <- renderUI({
    req(credentials()$user_auth)
    tagList(selectInput("name", "Name", choice = "user1", selected = "user1"),
                 selectInput("asset", "Asset", choice = c("Equity", "Debt", "Gold", "BTC"),
                              selected = "SPY"),
                  selectInput("action", "Action", choice = c("Buy", "Sell"), selected = "Buy"),
                  numericInput("quantity", "Assets to buy or sell", value = 100, min = 0, 
                               max = 10e6),
                  actionButton("submit", "Submit")
    )  

  })

   output$portfolio <- renderUI({
    req(credentials()$user_auth)
    tabItem("portfolow", 
    tags$p("THis is a note")
)
})

  }

shiny::shinyApp(ui, server)