The following script creates two shiny apps:
The child_app is running in a seperate background R process (depending on how you deploy your app this might not be needed), which can be controlled (filtered) via query strings.
The parent_app displays the child_app in an iframe and changes the query string (iframe's src) depending on the user accessing the app (permission level):
library(shiny)
library(shinymanager)
library(callr)
library(datasets)
library(DT)
# create child_app --------------------------------------------------------
# which will be shown in an iframe of the parent_app and can be controlled by passing query strings
ui <- fluidPage(
DT::DTOutput("filteredTable")
)
server <- function(input, output, session) {
permission <- reactive({shiny::getQueryString(session)$permission})
# req: if child_app is accessed without providing a permission query string nothing is shown
# "virginica" is default (unknown permission level - query string other than "advanced" / "basic")
# http://127.0.0.1:3838/?permission=unknown
output$filteredTable <- DT::renderDT({
permissionFilter <- switch(req(permission()),
"advanced" = "setosa",
"basic" = "versicolor",
"virginica")
if(!is.null(permissionFilter) && permissionFilter %in% unique(iris$Species)){
datasets::iris[datasets::iris$Species == permissionFilter,]
} else {
datasets::iris
}
})
}
child_app <- shinyApp(ui, server)
# run child_app in a background R process - not needed when e.g. hosted on shinyapps.io
child_app_process <- callr::r_bg(
func = function(app) {
shiny::runApp(
appDir = app,
port = 3838L,
launch.browser = FALSE,
host = "127.0.0.1" # child_app is accessible only locally (or via the iframe)
)
},
args = list(child_app),
supervise = TRUE
)
# child_app_process$is_alive()
# create parent app -------------------------------------------------------
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)
ui <- fluidPage(
fluidRow(tags$h2("My secure application"),
verbatimTextOutput("auth_output"),
uiOutput("child_app_iframe"))
)
ui <- secure_app(ui)
server <- function(input, output, session) {
res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)
output$auth_output <- renderPrint({
reactiveValuesToList(res_auth)
})
output$child_app_iframe <- renderUI({
tags$iframe(
src = sprintf("http://127.0.0.1:3838/?permission=%s", res_auth$permission),
style = "border: none;
overflow: hidden;
height: 65vh;
width : 100%;
position: relative;
top:15px;
padding:0;"
# position: absolute;
)
})
}
parent_app <- shinyApp(ui, server, onStart = function() {
cat("Doing application setup\n")
onStop(function() {
cat("Doing application cleanup\n")
child_app_process$kill() # kill child_app if parent_app is exited - not needed when hosted separately
})
})
# run parent_app
runApp(appDir = parent_app,
port = 3939L,
launch.browser = TRUE,
host = "0.0.0.0")
Please note the Species column:
Edit: Here is a clean multi-file approach avoiding nested render-functions (This needs to be adapted when used with shiny-server - please see my comments):
child_app.R:
library(shiny)
library(shinymanager)
library(datasets)
library(DT)
ui <- fluidPage(
DT::DTOutput("filteredTable")
)
server <- function(input, output, session) {
permission <- reactive({shiny::getQueryString(session)$permission})
table_data <- reactive({
permissionFilter <- switch(req(permission()),
"advanced" = "setosa",
"basic" = "versicolor",
"virginica")
if(!is.null(permissionFilter) && permissionFilter %in% unique(iris$Species)){
datasets::iris[datasets::iris$Species == permissionFilter,]
} else {
NULL # don't show something without permission
}
})
output$filteredTable <- DT::renderDT({
table_data()
})
}
child_app <- shinyApp(ui, server)
# run parent_app (local deployment)
runApp(
appDir = child_app,
port = 3838L,
launch.browser = FALSE,
host = "127.0.0.1" # child_app is accessible only locally (or via the iframe)
)
parent_app.R:
library(shiny)
library(shinymanager)
library(datasets)
library(DT)
credentials <- data.frame(
user = c("admin", "user1", "user2"),
password = c("admin", "user1", "user2"),
permission = c("advanced", "basic", "basic"),
stringsAsFactors = FALSE)
ui <- fluidPage(
fluidRow(tags$h2("My secure application"),
verbatimTextOutput("auth_output"),
uiOutput("child_app_iframe"))
)
ui <- secure_app(ui)
server <- function(input, output, session) {
res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)
output$auth_output <- renderPrint({
reactiveValuesToList(res_auth)
})
output$child_app_iframe <- renderUI({
tags$iframe(
# src = sprintf("child_app_link/child_app/?permission=%s", res_auth$permission), # shiny-server
src = sprintf("http://127.0.0.1:3838/?permission=%s", res_auth$permission), # local deployment
style = "border: none;
overflow: hidden;
height: 500px;
width : 95%;
# position: relative;
# top:15px;
# padding:0;
"
)
})
}
parent_app <- shinyApp(ui, server)
# run parent_app (local deployment)
runApp(appDir = parent_app,
port = 3939L,
launch.browser = TRUE,
host = "0.0.0.0")
