I was wondering if it was possible to protect a shiny application with shinymanager but with having the possibility to access the first tab of the app before entering username and password while the second and third tab are hidden ?
I would like a "connect" button to launch the shinymanager page and then display the other tabs.
Does someone know if it is doable or should I use my own authentification form (which means less secured...) ?
My attempt:
library(shiny)
library(shinymanager)
library(shinydashboard)
library(shinyWidgets)
library(shinythemes)
credentials <- data.frame(
user = c("user1"),
password = c("1"),
stringsAsFactors = FALSE
)
# user interface
ui <- navbarPage(id="navbarid",
"TEST", theme = shinytheme("cosmo"),
header = tagList(
useShinydashboard()),
tabPanel(
"Welcome", fluidRow(align = "center",
column(6, offset=4,
box(title = "Authentification", background = "black",
fluidRow(column(6, align = "center", style='padding-top:20px;',
actionButton(inputId = "connect", label = "Log in")),
column(6, align = "center", style='padding-top:20px;',
actionButton(inputId = "register", label = "Register here"))))))),
tabPanel("Tab2", verbatimTextOutput("label1")
),
tabPanel("Tab3", verbatimTextOutput("label2")
))
ui <- secure_app(ui)
server <- function(input, output, session) {
res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)
output$icon1 <- renderText(as.character(icon("sign-in-alt")))
output$icon2 <- renderText(as.character(icon("users")))
output$label1 <- renderText("First tab content here")
output$label2 <- renderText("Second tab content here")
}
shinyApp(ui, server)
I tried to add
observeEvent(input$connect, {
res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)})
at the beginning of my server part but it didn't work !
The following is a combination of my earlier answers here and here.
I'm using two separate R sessions - both hosting a shiny app.
A parent shiny app with public contents is launched as usual. This app contains an iframe to show the secured contents of the shiny app launched in a child process via callr::r_bg.
A current drawback of this approach is, that shinymanager's logout button can't be used, as it is clearing the query string (reloading the shiny session I guess), which is needed to determine which tab is accessed.
Please check the following:
library(shiny)
library(shinymanager)
library(shinydashboard)
library(shinyWidgets)
library(shinythemes)
library(callr)
secured_ui <- secure_app(fluidPage(uiOutput("iframecontent")), fab_position = "none")
secured_server <- function(input, output, session) {
credentials <- data.frame(
user = c("admin", "user1", "user2"),
password = c("admin", "user1", "user2"),
admin = c(TRUE, FALSE, FALSE),
permission = c("advanced", "basic", "basic"),
job = c("CEO", "CTO", "DRH"),
stringsAsFactors = FALSE)
res_auth <- shinymanager::secure_server(
check_credentials = shinymanager::check_credentials(credentials)
)
output$iframecontent <- renderUI({
currentQueryString <- getQueryString(session)$tab # alternative: parseQueryString(session$clientData$url_search)$tab
if (is.null(currentQueryString)){
return(div(h2("There is nothing here", style = "color: red;")))
} else {
req(currentQueryString, cancelOutput = TRUE)
req(res_auth$permission, cancelOutput = TRUE)
fluidPage(
if(!is.null(currentQueryString) && currentQueryString == "tab1" && res_auth$permission %in% c("basic", "advanced")){
div(h2("First tab content here"))
} else if (!is.null(currentQueryString) && currentQueryString == "tab2" && res_auth$permission == "advanced"){
div(h2("Second tab content here"))
} else {
div(h2("Access not permitted", style = "color: red;"))
}, theme = shinythemes::shinytheme("cosmo")
)
}
})
}
secured_child_app <- shinyApp(secured_ui, secured_server)
# run secured_child_app in a background R process - not needed when e.g. hosted on shinyapps.io
secured_child_app_process <- callr::r_bg(
func = function(app) {
shiny::runApp(
appDir = app,
port = 3838L,
launch.browser = FALSE,
host = "127.0.0.1" # secured_child_app is accessible only locally (or via the iframe)
)
},
args = list(secured_child_app),
stdout = "|",
stderr = "2>&1",
supervise = TRUE
)
print("Waiting for secured child app to get ready...")
while(!any(grepl("Listening on http", secured_child_app_process$read_output_lines()))){
Sys.sleep(0.5)
}
public_ui <- navbarPage(id="navbarid",
"Secured Tabs Test",
theme = shinytheme("cosmo"),
header = tagList(useShinydashboard()),
tabPanel(
"Welcome", h2("Public content here")
),
tabPanel("Tab1",
tags$iframe(
src = "http://127.0.0.1:3838/?tab=tab1",
style = "border: none;
overflow: hidden;
height: calc(100vh - 100px);
width : 100vw;
position: relative;
top:0px;
padding:0px;"
)),
tabPanel("Tab2", tags$iframe(
src = "http://127.0.0.1:3838/?tab=tab2",
style = "border: none;
overflow: hidden;
height: calc(100vh - 100px);
width : 100vw;
position: relative;
top:0px;
padding:0px;"
))
)
public_server <- function(input, output, session) {}
public_parent_app <- shinyApp(public_ui, public_server, onStart = function() {
cat("Doing application setup\n")
onStop(function() {
cat("Doing application cleanup\n")
secured_child_app_process$kill() # kill secured_child_app if public_parent_app is exited - not needed when hosted separately
})
})
# run public_parent_app
runApp(appDir = public_parent_app,
port = 3939L,
launch.browser = TRUE,
host = "0.0.0.0")