Programmatically filter contents of a embedded (iframe) shiny application

Posit Professional & Hosted Products shinyapps.io
2

This is a crosspost - you can find an answer here.

Copy of my SO answer:

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:

result

1 Like