How I can hide a tab with shinyjs? - r

Question

Hi and thanks for reading me
I am working with an application that has a password layer and I would like to know how I could hide a tab item based on the person entering the application. So far it is what I have but I have not managed to make it work:
library(shinymanager)
library(shinyjs)
library(shiny)
library(shinydashboard)
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)
)
if (interactive()) {
header <- dashboardHeader()
sidebar <- dashboardSidebar(
shinyjs::useShinyjs(),
sidebarUserPanel("User Name",
subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
# Image file should be in www/ subdir
image = "userimage.png"
),
sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new",
badgeColor = "green"),
menuItem("Charts", icon = icon("bar-chart-o"),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
)
)
)
body <- dashboardBody(
tabItems(
tabItem("dashboard",
div(p("Dashboard tab content"))
),
tabItem("widgets",
"Widgets tab content"
),
tabItem("subitem1",
"Sub-item 1 tab content"
),
tabItem("subitem2",
"Sub-item 2 tab content"
)
)
)
shinyApp(
ui = secure_app(dashboardPage(header, sidebar, body)),
server = function(input, output, session) {
res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)
# Create reactive values including all credentials
creds_reactive <- reactive({
reactiveValuesToList(res_auth)
})
observe({
req(creds_reactive())
if (!is.null(creds_reactive()$user) %in% c("shiny") ) shinyjs::hide("widgets")
})
}
)
}
Anyone have any ideas how to correct that?I can't get the tab item to hide when a certain user enters the application :(

Answer 1

I'd use renderMenu instead of hiding the menuItem - otherwise users not allowed to access the contents can simply change the style of the UI element in their browser as explained here (I assume the contents of your tabItems are also generated on the server side).
library(shinymanager)
library(shinyjs)
library(shiny)
library(shinydashboard)
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)
)
header <- dashboardHeader()
sidebar <- dashboardSidebar(
shinyjs::useShinyjs(),
sidebarUserPanel("User Name",
subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
# Image file should be in www/ subdir
image = "userimage.png"
),
sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItemOutput("widgetsOutput"),
menuItem("Charts", icon = icon("bar-chart-o"),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
)
)
)
body <- dashboardBody(
tabItems(
tabItem("dashboard",
div(p("Dashboard tab content"))
),
tabItem("widgets",
"Widgets tab content"
),
tabItem("subitem1",
"Sub-item 1 tab content"
),
tabItem("subitem2",
"Sub-item 2 tab content"
)
)
)
shinyApp(
ui = secure_app(dashboardPage(header, sidebar, body)),
server = function(input, output, session) {
res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)
# Create reactive values including all credentials
creds_reactive <- reactive({
reactiveValuesToList(res_auth)
})
output$widgetsOutput <- renderMenu({
if(creds_reactive()$user == "shiny"){
menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new", badgeColor = "green")
}
})
}
)