The most secure way to limit particular users to given content

ShinyProxy
#1

Hi all!

I’m building an app that would allow different groups of people to log in. I want to show different content to each user group within a single app. Imagine I have a single dropdown. Group 1 will see only options A and B and group 2 will see options C and D.

This is possible using the environment variable SHINYPROXY_USERGROUPS.

I can simply make a dropdown that contains different things depending on the group this user belongs to:

output$dropdown <- renderUI({
  selectInput(
    inputId = "variableSelector",
    label = "Select variable to plot",
    choices = switch(
      Sys.getenv("SHINYPROXY_USERGROUPS"),
      GROUP1 = c("Option A", "Option B"),
      GROUP2 = c("Option C", "Option D")
    )
  )
})

However I wonder how secure is this? If this was an app deployed on regular Shiny Server I could simply enter JavaScript console and do something like

Shiny.setInputValue('variableSelector', 'Option D')

And this will work even if I’m logged as user from Group 1. However this seems to be harder when using ShinyProxy. Is such solution sufficient in the ShinyProxy context?

#2

I believe the same ‘trick’ would work with ShinyProxy, as it is not shinyserver-specific, but shiny-specific.
A way to restrict such behaviour (note that this applies to virtually any web app not limited to shiny apps) is to have extra checks on the ‘server’ side, i.e. in this case whenever input$variableSelector is being used by further R code.

#3

Thanks! That’s what I thought as well. However, I was not able to replicate the Shiny.setInputValue('variableSelector', 'Option D') trick in ShinyProxy.

I ended up having a separate reactive checking if what is selected belongs to the options available for the group. Such reactive could be used in any render expression. Something like:

shinyServer(function(input, output) {
  
  # Reactive storing group name pulled from Linux environment variables
  group <- reactive({
    Sys.getenv("SHINYPROXY_USERGROUPS")
  })

  # Store vector of proper choices as reactive
  choices <- reactive({
    switch(
      group(),
      GROUP1 = c("Option A", "Option B"),
      GROUP2 = c("Option C", "Option D")
    )
  })
  
  # Render dropdown with proper choices
  output$dropdown <- renderUI({
    
    req(group())
    
    selectInput(
      inputId = "variableSelector",
      label = "Select variable to plot",
      choices = choices()
    )
  })
  
  # Create a reactive that will return true only if user from a given group 
  # has selected an option that should be available for him.
  verification <- reactive({
    req(input$variableSelector)
    
    input$variableSelector %in% choices()
  })
  
  # Render histogram
  output$distPlot <- renderPlot({
    
    req(input$variableSelector)
    
    validate(
      need(verification(), "This content is not available for your user group.")
    )
    
    ### Code of the plot goes here
  })
  
})