Home > Enterprise >  Create one shiny app with two users that log in to different versions of the app
Create one shiny app with two users that log in to different versions of the app

Time:12-27

I have the shiny app below in which let's say that we want to log in 2 different users. The "shiny" and the "shinymanager" as you can see from the credentials I gave. I want each one to log in to a different version of the app. One should see the selectInput and the table that are displayed now and the other the commented out ones. Maybe there is a different way than shinymanager package.

# define some credentials
credentials <- data.frame(
  user = c("shiny", "shinymanager"), # mandatory
  password = c("azerty", "12345"), # mandatory
  start = c("2019-04-15"), # optinal (all others)
  expire = c(NA, "2019-12-31"),
  admin = c(FALSE, TRUE),
  comment = "Simple and secure authentification mechanism 
  for single ‘Shiny’ applications.",
  stringsAsFactors = FALSE
)

library(shiny)
library(shinymanager)

ui <- fluidPage(
  tags$h2("My secure application"),
  selectInput("variable", "Variable:",
              c("Cylinders" = "cyl",
                "Transmission" = "am",
                "Gears" = "gear")),
  tableOutput("data")
  #selectInput("variable2", "Variable:",
   #           c("Cylinders" = "cyl"
    #            )),
  #tableOutput("data2")
)

# Wrap your UI with secure_app
ui <- secure_app(ui)


server <- function(input, output, session) {
  
  # call the server part
  # check_credentials returns a function to authenticate users
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )
  output$data <- renderTable({
    mtcars[, c("mpg", input$variable), drop = FALSE]
  }, rownames = TRUE)
  #output$data2 <- renderTable({
   # mtcars[, c("mpg", input$variable2), drop = FALSE]
  #}, rownames = TRUE)
  
  
  # your classic server logic
  
}

shinyApp(ui, server)

CodePudding user response:

One possible way of doing this with shinymanager is as below. Another self build solution can be found here with more explanation on github.

The quote regarding self-build authentication in shiny in the comments is of course correct: using an approach outside of shiny is the better way.

# define some credentials
credentials <- data.frame(
  user = c("shiny", "shinymanager"), # mandatory
  password = c("azerty", "12345"), # mandatory
  start = c("2019-04-15"), # optinal (all others)
  expire = c(NA, NA),
  admin = c(FALSE, TRUE),
  comment = "Simple and secure authentification mechanism
  for single ‘Shiny’ applications.",
  stringsAsFactors = FALSE
)

library(shiny)
library(shinymanager)

ui <- fluidPage(
  tags$h2("My secure application"),
  uiOutput("myinput"),
  tableOutput("data")
)

# Wrap your UI with secure_app
ui <- secure_app(ui)


server <- function(input, output, session) {
  
  # call the server part
  # check_credentials returns a function to authenticate users
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )

  output$myinput <- renderUI({

    if (reactiveValuesToList(res_auth)$user == "shiny") {
    # if (TRUE) {
      mychoices <- c("Cylinders" = "cyl",
                     "Transmission" = "am",
                     "Gears" = "gear")
    } else {
      mychoices <- c("Sepal Length" = "Sepal.Length",
                     "Sepal Width" = "Sepal.Width",
                     "Petal Length" = "Petal.Length",
                     "Petal Width" = "Petal.Width")
    }

    selectInput("variable",
                "Variable:",
                choices = mychoices)
  })
  
  output$data <- renderTable({
    
    expr = if (reactiveValuesToList(res_auth)$user == "shiny") {
      mtcars[, c("mpg", input$variable), drop = FALSE]
    } else {
      iris[, c("Species", input$variable), drop = FALSE]
    }
    })

}

shinyApp(ui, server)
  • Related