Selective Tab Security Implementation with shinymanager

[henrykironde]

We are exploring the possibility of implementing selective tab security using the shinymanager package.

Our goal is to secure specific tabs while leaving others unsecured. For instance, we want to secure the 'Private Data' tab, requiring authentication, while leaving tabs like the landing page, About, and public data pages accessible without authentication.

We would like to discuss and understand the recommended approach or any existing features within shinymanager that support this selective tab security implementation. Any insights or guidance on how to achieve this would be highly appreciated

[aswansyahputra]

Hi @henrykironde, I'm using removeUI() to tackle this case. Perhaps this snippet would be helpful for you:

library(shiny)
library(glue)
library(shinymanager)

credentials <- data.frame(
  user = c("user1", "user2", "user3"),
  password = c("123", "456", "789"),
  restricted = c("mod1", "mod1,mod2", NA_character_)
)

mod_ui <- function(id) {
  ns <- NS(id)
  tagList(
    textOutput(ns("out"))
  )
}

mod_server <- function(id, toprint) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    output$out <- renderText({ toprint })
    return(toprint)
  })
}

ui <- secure_app(
  navbarPage(
    "Selective Feature",
    id = "current_tab",
    tabPanel(
      "main",
      "Nothing to do here"
    ),
    tabPanel("mod1", mod_ui("id1")),
    tabPanel("mod2", mod_ui("id2"))
  )
)

server <- function(input, output, session) {

  rv_auth <-
    secure_server(
      check_credentials = check_credentials(credentials)
    )

  rv <-
    reactiveValues(
      user = reactive({
        rv_auth$user
      }),
      current_tab = reactive({
        input$current_tab
      }),
      restricted_section = reactive({
        tryCatch(
          unlist(strsplit(rv_auth$restricted, ",")),
          error = function(e) NA_character_
        )
      })
    )

  observe({
    lapply(
      rv$restricted_section(),
      \(x) removeUI(selector = glue("a[data-value='{x}']"))
    )
  })

  observe({
    if (rv$current_tab() == "mod1" && is.null(rv$mod1)) {
      rv$mod1 <- mod_server("id1", "Hello")
    }
    if (rv$current_tab() == "mod2" && is.null(rv$mod2)) {
      rv$mod2 <- mod_server("id2", "World")
    }
  }) |>
    bindEvent(rv$current_tab())

}

shinyApp(ui, server)

[mkaranja]

Thank you @henrykironde for raising this feature. I also would like to secure some Tabs and leave others open to everyone.

[antoine4ucsd]

Hello I am very interested in selective access too. is there a way we can restrict the choice of input based on credentials.

  pickerInput("input_select", "Country:",   
          choices = # here I would like the choices to be based on credentials???, 
          selected =NA,
            multiple = F)

thank you!