Question

我正在尝试改编Paul Campbell的闪亮认证示例https://paul.rbind.io/2018/11/04/introducing-shinyauthr/

创建具有密码验证功能的闪亮仪表板。我尝试了多种选择，并且阅读了有关类似问题的问题，但是我无法适应它们来解决我的问题。我可以要求密码才能访问仪表板，但不能将内容放入仪表板选项卡。

这是我的最小工作示例，试图扩展Paul的示例。

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)

Hello与表格一起到达，但我希望将其附加到“ Portfolio”选项卡上。我在这里使用tags$div方法是因为标准仪表板menuItem方法不起作用，所以我遵循了以下建议：Using shiny modules and shinydashboard: shiny.tag error

Rob

Answer 1

我认为我已经解决了，这就是答案。每个选项卡都有其自己的输入，只有在提供密码后才会显示。

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)

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

1 个答案: