Starting Shiny app after password input (with Shinydashboard)

Question

In this topic is well explained how to start the shinyapp after some password input. I am trying to do the same, but instead of \"navbarPage\", I would like to have a \"dash

Answer 1

Here is another solution that takes a slightly different approach than @Enzo's. It creates a second UI so users cannot see what the app is displaying on the first menu tab. The only downside is everything is basically brought to the Server side which may cause some issues for your code depending on how it is written.

library(shiny)
library(shinydashboard)

my_username <- "test"
my_password <- "abc"

###########################/ui.R/##################################

header <- dashboardHeader(title = "my heading")
sidebar <- dashboardSidebar(uiOutput("sidebarpanel"))
body <- dashboardBody(uiOutput("body") )

ui <- dashboardPage(header, sidebar, body)

###########################/server.R/##################################

server <- function(input, output, session) {
  Logged <- FALSE

  USER <<- reactiveValues(Logged = Logged)

  observe({ 
    if (USER$Logged == FALSE) {
      if (!is.null(input$Login)) {
        if (input$Login > 0) {
          Username <- isolate(input$userName)
          Password <- isolate(input$passwd)
          Id.username <- which(my_username == Username)
          Id.password <- which(my_password == Password)
          if (length(Id.username) > 0 & length(Id.password) > 0) {
            if (Id.username == Id.password) {
              USER$Logged <<- TRUE
            } 
          }
        } 
      }
    }    
  })

  output$sidebarpanel <- renderUI({
    if (USER$Logged == TRUE) { 
      dashboardSidebar(
        sidebarUserPanel("myuser", subtitle = a(icon("user"), "Logout", href="")),
        selectInput("in_var", "myvar", multiple = FALSE,
                    choices = c("option 1","option 2")),
        sidebarMenu(
          menuItem("Item 1", tabName = "t_item1", icon = icon("line-chart")),
          menuItem("Item 2", tabName = "t_item2", icon = icon("dollar")),
          menuItem("Item 3", tabName = "t_item3", icon = icon("credit-card")),
          menuItem("Item 4", tabName = "t_item4", icon = icon("share-alt"))
        ))}
  })

  output$body <- renderUI({
    if (USER$Logged == TRUE) {
      B <- c(2,3,4,3,7,5,4)

      box(
        title = p("Histogram", actionLink("Expand", "", icon = icon("expand"))), status = "primary", solidHeader = TRUE, width = 4,
        hist(B)
      )
    }
    if (USER$Logged == FALSE) {
      box(title = "Login",textInput("userName", "Username"),
          passwordInput("passwd", "Password"),
          br(),
          actionButton("Login", "Log in"))
    }
  })
}

shinyApp(ui, server)

September 2018 Update

I was able to figure out @Enzo's original code to make the do.call function work with shinydashboard. Please see below. Credit to @Enzo for this, I just slightly changed some lines. I think this solution is better than my first code above since it allows the correct output codes to stay in the UI side. I've also added a message pop-up if the username and password is incorrect.

rm(list = ls())
library(shiny)
library(shinydashboard)

my_username <- "test"
my_password <- "abc"

###########################/ui.R/##################################

ui1 <- function(){
  tagList(
    div(id = "login",
        wellPanel(textInput("userName", "Username"),
                  passwordInput("passwd", "Password"),
                  br(),
                  actionButton("Login", "Log in"),
                  verbatimTextOutput("dataInfo")
        )
    ),
    tags$style(type="text/css", "#login {font-size:10px;   text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}")
  )}

ui2 <- function(){tagList(
  "You did it!"
)}

header <- dashboardHeader(title = "Test Login")
sidebar <- dashboardSidebar()
body <- dashboardBody(
  tags$head(tags$style("#dataInfo{color: red")),
  htmlOutput("page")
)

ui <- dashboardPage(header, sidebar, body)

###########################/server.R/##################################

server = (function(input, output,session) {

  Logged <- FALSE
  Security <- TRUE

  USER <- reactiveValues(Logged = Logged)
  SEC <- reactiveValues(Security = Security)

  observe({ 
    if (USER$Logged == FALSE) {
      if (!is.null(input$Login)) {
        if (input$Login > 0) {
          Username <- isolate(input$userName)
          Password <- isolate(input$passwd)
          if(my_username == Username & my_password == Password) {
            USER$Logged <- TRUE
          } else {SEC$Security <- FALSE}
        } 
      }
    }    
  })

  observe({
    if (USER$Logged == FALSE) {output$page <- renderUI({ui1()})}
    if (USER$Logged == TRUE) {output$page <- renderUI({ui2()})}
  })

  observe({
    output$dataInfo <- renderText({
      if (SEC$Security) {""}
      else {"Your username or password is not correct"}
    })
  })

})

runApp(list(ui = ui, server = server))