shiny::showModal doesn't work with shinymanager

Question

I inserted a shiny::showModal in an application with shinymanager. However, authentication stops working because of modal.

Run this code:

library(shiny)
library(shinydashboard)
library(shinymanager)

# Credentials as data.frame
credentials <- data.frame(
  user = c("shiny", "shinymanager"), # mandatory
  password = c("azerty", "12345"), # mandatory
  stringsAsFactors = FALSE
)

# Change labels
set_labels(
  language = "en",
  "Please authenticate" = "Bitte authentifizieren",
  "Username:" = "Benutzername:",
  "Password:" = "Passwort:",
  "Login" = "Anmeldung"
)

# Classic shinydashboard
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(),
  title = "Dashboard example"
)


# Wrap your UI with secure_app
ui <- secure_app(
  ui = ui,
  tags_top = 
    tags$div(
      tags$h4("Demo", style = "align:center"),
      tags$img(
        src = "https://www.r-project.org/logo/Rlogo.png", width = 100
      )
    ),
  # add information on bottom ?
  tags_bottom = tags$div(
    tags$p(
      "For any question, please  contact ",
      tags$a(
        href = "mailto:someone@example.com?Subject=Shiny%20aManager",
        target="_top", "administrator"
      )
    )
  )
)

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

  observeEvent("", {
    showModal(modalDialog(
      includeHTML("intro_text.html"),
      easyClose = TRUE,
      footer = tagList(
        actionButton(inputId = "intro", label = "OK", icon = icon("info-circle"))
      )
    ))
  })
  
  observeEvent(input$intro,{
    removeModal()
  })
  
  # With creadentials data.frame (for the example)
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )
  
}

shinyApp(ui, server)

The login screen:

The intro_text.html file is here.

I tried using req(input$intro) in observeEvent function (like in this answer), but it wasn't helpful.

user_2753526 · Answer

Not 100% why this is behaving this way, but what we can do is listen to the res_auth and once the user logs in, we can display the modal, like so:

library(shiny)
library(shinydashboard)
library(shinymanager)

# Credentials as data.frame
credentials <- data.frame(
  user = c("1", "shinymanager"), # mandatory
  password = c("1", "12345"), # mandatory
  stringsAsFactors = FALSE
)

# Change labels
set_labels(
  language = "en",
  "Please authenticate" = "Bitte authentifizieren",
  "Username:" = "Benutzername:",
  "Password:" = "Passwort:",
  "Login" = "Anmeldung"
)

# Classic shinydashboard
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(),
  title = "Dashboard example"
)


# Wrap your UI with secure_app
ui <- secure_app(
  ui = ui,
  tags_top = 
    tags$div(
      tags$h4("Demo", style = "align:center"),
      tags$img(
        src = "https://www.r-project.org/logo/Rlogo.png", width = 100
      )
    ),
  # add information on bottom ?
  tags_bottom = tags$div(
    tags$p(
      "For any question, please  contact ",
      tags$a(
        href = "mailto:someone@example.com?Subject=Shiny%20aManager",
        target="_top", "administrator"
      )
    )
  )
)

# Server
server <- function(input, output, session) {
  
  observeEvent(data()$user,{
    showModal(modalDialog(
      includeHTML("intro_text.html"),
      easyClose = TRUE,
      footer = tagList(
        actionButton(inputId = "intro", label = "OK", icon = icon("info-circle"))
      )
    ))
  })

  observeEvent(input$intro,{
    removeModal()
  })
  
  # With creadentials data.frame (for the example)
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )
  
  data <- reactive({
    reactiveValuesToList(res_auth)
  })
  
}

shinyApp(ui, server)

shiny::showModal doesn't work with shinymanager

1 Answers