In an app with 2 different versions of shiny widget for each user speicic user may be able to set th-CodePudding

I have the shiny app below in which there are 2 users the shiny(admin) and the shinymanager. Depending on which credentials the user may use he sees a different selectInput() "Variable".

What I want to do is to give the shiny user the ability to set the values that the shinymanager will see in his "Variable" selectInput() with the "Choices" selectInput().

# 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"),
  uiOutput("chs"),
  actionButton("action_logout", "Logout")
  
)

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


server <- function(input, output, session) {
  observeEvent(input$action_logout, {
    session$reload()
  })
  # call the server part
  # check_credentials returns a function to authenticate users
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )
  output$chs<-renderUI({
    if (reactiveValuesToList(res_auth)$user == "shiny") {
      selectInput("ch",
                  "Choices:",
                  choices = c("Cylinders" = "cyl",
                              "Transmission" = "am",
                              "Gears" = "gear"),selected="cyl,multiple = T)
    }
    else{
      
    }
      
  })
  output$myinput <- renderUI({
    
    if (reactiveValuesToList(res_auth)$user == "shiny") {
      # if (TRUE) {
      mychoices <- c("Cylinders" = "cyl",
                     "Transmission" = "am",
                     "Gears" = "gear")
    } else {
      mychoices <- input$ch
    }
    
    selectInput("variable",
                "Variable:",
                choices = mychoices)
  })
  
  
  
}

shinyApp(ui, server)

CodePudding user response：

We somehow need to save the choices made by the shiny user, but you would need to think about, to which point in time the choices should be saved. In the example below I just save the choices each time the input$choices are changed. I just use saveRDS and readRDS to save it in the working directory of the app, but you can use a subfolder or a database or whatever other options you might have.

You would also need to think about, what the shinymanager see if no choices have been saved so far - I left this out in the approach below.

# 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"),
  uiOutput("chs"),
  actionButton("action_logout", "Logout")
  
)

# 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)
  )
  
  observeEvent(input$action_logout, {
    session$reload()
  })
  
  observeEvent(input$choices, {
    if (reactiveValuesToList(res_auth)$user == "shiny") {
      print("Lets save")
      print(getwd())
      saveRDS(input$choices, file = "save_choices.rds")
    }
  })
  
  output$chs <- renderUI({
    if (reactiveValuesToList(res_auth)$user == "shiny") {
      selectInput("choices",
                  "Choices:",
                  choices = c("Cylinders" = "cyl",
                              "Transmission" = "am",
                              "Gears" = "gear"),
                  multiple = TRUE)
    }
  })
  
  output$myinput <- renderUI({
    
    if (reactiveValuesToList(res_auth)$user == "shiny") {
      
      mychoices <- c("Cylinders" = "cyl",
                     "Transmission" = "am",
                     "Gears" = "gear")
    } else if (file.exists("save_choices.RDS")) {
      
      mychoices <- readRDS(file = "save_choices.rds")
      
    } else {
      
      mychoices <- NULL
      
    } 
  
  selectInput("variable",
              "Variable:",
              choices = mychoices)
  })
  
}

shinyApp(ui, server)