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)