修改 flexdashboard 的 Shinyauth

Question

我已经构建了一个使用运行时闪亮的交互式 flexdashboard，我想创建一个用户身份验证登录模块/页面。我偶然发现了Paul Campbell 的 Shinyauth 包，它似乎可以做到这一点，但对于闪亮的仪表板，我想为我的 flexdashboard 调整此代码。我试图将它应用到我的 Rmarkdown 文档，但它只导致登录模块显示在侧边栏面板中或显示在显示屏右侧的主面板中的图形上方。无论哪种方式，该模块都无法达到阻止用户在输入用户名和密码之前使用仪表板的预期目的。下面是如何在闪亮的应用程序中使用身份验证模块的最小可重现示例。任何人都可以就如何修改 flexdashboard 的代码提出建议吗？

    library(shiny)
    library(shinyauthr)
    library(shinyjs)
    
    # 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 <- fluidPage(
      # must turn shinyjs on
      shinyjs::useShinyjs(),
      # add logout button UI 
      div(class = "pull-right", shinyauthr::logoutUI(id = "logout")),
      # add login panel UI function
      shinyauthr::loginUI(id = "login"),
      # setup table output to show user info after login
      tableOutput("user_table")
    )
    
    server <- function(input, output, session) {
      
      # call the logout module with reactive trigger to hide/show
      logout_init <- callModule(shinyauthr::logout, 
                                id = "logout", 
                                active = reactive(credentials()$user_auth))
      
      # call login module supplying data frame, user and password cols
      # and reactive trigger
      credentials <- callModule(shinyauthr::login, 
                                id = "login", 
                                data = user_base,
                                user_col = user,
                                pwd_col = password,
                                log_out = reactive(logout_init()))
      
      # pulls out the user information returned from login module
      user_data <- reactive({credentials()$info})
      
      output$user_table <- renderTable({
        # use req to only render results when credentials()$user_auth is TRUE
        req(credentials()$user_auth)
        user_data()
      })
    }
    
    shinyApp(ui = ui, server = server)

更新： 在尝试并未能找到实现 Shinyauth 代码的方法后，我尝试了Shinymanager 包，并在 github 上的 bthieurmel 的帮助下调整了代码以与 flexdashboard 一起使用。所以他们的解决方案是以下步骤。希望这对其他人有帮助！

1. 使用自定义 css 设置 flexdashboard。

    ---
    title: "Old Faithful Eruptions"
    output: 
      flexdashboard::flex_dashboard:
        css: inst/assets/styles-auth.css
    runtime: shiny
    ---

2. 您需要添加一个至少包含以下内容的 css 文件。将 css 文件保存到项目目录中名为“www”的文件夹中。

    .panel-auth {
      position: fixed;
      top:0;
      bottom: 0;
      left: 0;
      right: 0;
      background-color: #FFF;
      opacity: 1;
      z-index: 99997;
      overflow-x: hidden;
      overflow-y: scroll;
    }

3. 然后在全局块中，加载 Shinymanager 并定义凭据。

    ```{r global, include=FALSE}
    # load data in 'global' chunk so it can be shared by all users of the dashboard
    library(datasets)
    library(shinymanager)
    data(faithful)
    
    # define some credentials (you can also use sqlite database)
    credentials <- data.frame(
      user = c("shiny", "shinymanager"),
      password = c("azerty", "12345"),
      stringsAsFactors = FALSE
    )
    ```

4. 最后，在任何地方，调用这两个模块：

    ```{r}
    auth_ui(id = "auth")
    
    auth <- callModule(
        module = auth_server,
        id = "auth",
        check_credentials = check_credentials(credentials) # data.frame
        # check_credentials = check_credentials("path/to/credentials.sqlite", passphrase = "supersecret") # sqlite
    )
    ```

完整解决方案：因此完整示例如下所示。显然，不能在 flexdashboard 中使用这个包的管理模式，这对我来说很好，但我还没有理解如何使用这个包的 SQLite 功能，因为我对此很陌生，所以任何关于这方面的额外建议会很有帮助。

    ---
    title: "Old Faithful Eruptions"
    output: 
      flexdashboard::flex_dashboard:
        css: inst/assets/styles-auth.css
    runtime: shiny
    ---
    
    ```{r global, include=FALSE}
    # load data in 'global' chunk so it can be shared by all users of the dashboard
    library(datasets)
    library(shinymanager)
    data(faithful)
    
    # define some credentials (you can also use sqlite database)
    credentials <- data.frame(
      user = c("shiny", "shinymanager"),
      password = c("azerty", "12345"),
      stringsAsFactors = FALSE
    )
    ```
    
    Column {.sidebar}
    -----------------------------------------------------------------------
    
    Waiting time between eruptions and the duration of the eruption for the
    Old Faithful geyser in Yellowstone National Park, Wyoming, USA.
    
    ```{r}
    selectInput("n_breaks", label = "Number of bins:",
                choices = c(10, 20, 35, 50), selected = 20)
    
    sliderInput("bw_adjust", label = "Bandwidth adjustment:",
                min = 0.2, max = 2, value = 1, step = 0.2)
    ```
    
    Column
    -----------------------------------------------------------------------
    
    ### Geyser Eruption Duration
    
    ```{r}
    
    renderPlot({
      hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(input$n_breaks),
           xlab = "Duration (minutes)", main = "Geyser Eruption Duration")
    
      dens <- density(faithful$eruptions, adjust = input$bw_adjust)
      lines(dens, col = "blue")
    })
    
    
    auth_ui(id = "auth")
    
    auth <- callModule(
        module = auth_server,
        id = "auth",
        check_credentials = check_credentials(credentials) # data.frame
        # check_credentials = check_credentials("path/to/credentials.sqlite", passphrase = "supersecret") # sqlite
    )
    ```