Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
308 views
in Technique[技术] by (71.8m points)

r - Modifying shinyauthr for a flexdashboard

I have built an interactive flexdashboard that uses a runtime shiny and I would like to create a user authentification login module/page. I stumbled across Paul Campbell's shinyauthr package which seems to do this but for a shiny dashboard, I would like adapt this code for my flexdashboard. I have tried to apply it to my Rmarkdown document but it has only resulted in the login module displaying in the sidebar panel or displaying above my graphs in the main panels to the right of the display. Either way this module doesn't serve the intended purpose of preventing users from using the dashboard until they input a username and password. Below is a minimal reproducible example of how to use the authentication modules in a shiny app. Could anyone advise on how to modify the code for a 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)

Update: After trying and failing to find a way to implement the shinyauthr code, I tried out the shinymanager package and adapted the code to work with a flexdashboard with the help of bthieurmel on github. So their solution would be the following steps. Hope this helps others!

  1. Setup the flexdashboard with a custom css.
    ---
    title: "Old Faithful Eruptions"
    output: 
      flexdashboard::flex_dashboard:
        css: inst/assets/styles-auth.css
    runtime: shiny
    ---
  1. You need to add a css file with at least this content below. Save the css file to a folder in your project directory with the name "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;
    }
  1. Then in global chunk, load shinymanager and define credentials.
    ```{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
    )
    ```
  1. Finally, anywhere, call the two modules:
    ```{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
    )
    ```

Full Solution: So the full example would look like the following. Apparently, it's not possible to use the admin mode for this package in flexdashboard which is fine for me, but I have yet to understand how to use the SQLite functionality of this package because I am very new to this so any additional advice on that aspect would be helpful.

    ---
    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
    )
    ```
question from:https://stackoverflow.com/questions/65545721/modifying-shinyauthr-for-a-flexdashboard

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)
Waitting for answers

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...