How to disable a shiny feature based on shinymanager credentials

user_2300622 0
Viewed 780

How can I disable a feature, using shinyjs, based on credentials entered with shinymanager?

In the example below, I added a level field to credentials, and I want to disable extraOutput if a users level is greater than zero. But the app crashes with error: Operation not allowed without an active reactive context.

library(shiny)
library(shinymanager)
library(shinyjs)

# define some credentials
credentials <- data.frame(
  user = c("shiny", "shiny2"), # mandatory
  password = c("111", "111"), # mandatory
  start = c("2015-04-15"), # optinal (all others)
  expire = c(NA, "2032-12-31"),
  admin = c(FALSE, TRUE),
  comment = "Simple and secure authentification mechanism 
  for single ‘Shiny’ applications.",
  stringsAsFactors = FALSE,
  moreInfo = c("someData1", "someData2"),
  level = c(2, 0)
)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  tags$h2("My secure application"),
  verbatimTextOutput("auth_output"),
  verbatimTextOutput("extraOutput")
)

# 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)
  )
  if(reactiveValuesToList(res_auth)$level > 0) disable(output$extraOutput) 
  output$auth_output <- renderPrint({
    reactiveValuesToList(res_auth)
  })
  output$extraOutput <- renderPrint({
    print("extra output based on level")
  })

  # your classic server logic

}

shinyApp(ui, server)

Edit------------------------

I managed to do it with a variable shinymanager_where, but I feel like it is a hack, so I'll leave question open for a better answer.


ui <- fluidPage(
    shinyjs::useShinyjs(),
    tags$h2("My secure application"),
    verbatimTextOutput("auth_output"),
    actionBttn(
        "extraOutput",
        label = "testButtonDisabled",
        icon = NULL,
        style = "unite",
        color = "default",
        size = "md",
        block = FALSE,
        no_outline = TRUE
    )
)

# 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$shinymanager_where, {
      if(input$shinymanager_where == "application"){
          print(reactiveValuesToList(res_auth))
          print(reactiveValuesToList(res_auth)$level)
          if(reactiveValuesToList(res_auth)$level > 0){
              shinyjs::disable("extraOutput")
          }
      }
  })
  output$auth_output <- renderPrint({
    reactiveValuesToList(res_auth)
  })
  observeEvent(input$extraOutput,{
    print("extra output based on level")
  })

  # your classic server logic

}

shinyApp(ui, server)
shiny r
2 Answers

Put credentials into reactive values. Then it can be reused for applying initial UI settings based on credentials as input parameters 

library(shiny)
library(shinymanager)
library(shinyjs)

# define some credentials
credentials <- data.frame(
  user = c("shiny", "shiny2"), # mandatory
  password = c("111", "111"), # mandatory
  start = c("2015-04-15"), # optinal (all others)
  expire = c(NA, "2032-12-31"),
  admin = c(FALSE, TRUE),
  comment = "Simple and secure authentification mechanism 
  for single ‘Shiny’ applications.",
  stringsAsFactors = FALSE,
  moreInfo = c("someData1", "someData2"),
  level = c(2, 0)
)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  tags$h2("My secure application"),
  verbatimTextOutput("auth_output"),
  verbatimTextOutput("extraOutput")
)

# 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)
  )
  # Create reactive values including all credentials
  creds_reactive <- reactive({
    reactiveValuesToList(res_auth)
  })

  # Hide extraOutput only when condition is TRUE
  observe({
    if (!is.null(creds_reactive()$level) && creds_reactive()$level > 0) shinyjs::hide("extraOutput")
  })

  output$auth_output <- renderPrint({
    reactiveValuesToList(res_auth)
  })

  output$extraOutput <- renderPrint({
    print("extra output based on level")
  })

  # your classic server logic
}

shinyApp(ui, server)
user_92769380

Wrap your if statement in observe and call res_auth directly because it is already a reactiveValues object. If-statement requires res_auth right away and thus runs into error, but if you use toggle (when condition is TRUE = show, FALSE = hide), then it works fine :

  observe({ shinyjs::toggle(output$extraOutput, condition = res_auth$level<1) })

Otherwise, if toggle does not work for you and you need an if-statement, consider having an event right after login and wrap the if statement in observeEvent for that.

user_62418690
Related