1
votes

I'm roughly following the instructions from Starting Shiny app after password input to add a password to my shiny app. It works perfectly when I run the app locally, but when I deploy it the only part that works is the password page. After I enter the username and password the app disconnects from the server. Why is it disconnecting instead of switching from ui1 to ui2? I'm not sure how to make this reproducible, but my code looks approximately like this:

UI

#Load Libraries

#this is really my whole ui.R file
shinyUI(htmlOutput("page"))

server.R

#Load Libraries
#Load Functions And Data

#Define variables to connect to MySQL
databaseName <- "****"
table <- "****"
options(
  mysql = list(
    "host" = "****",
    "port" = 3306,
    "user" = "****",
    "password" = "****"
  )
)

#SQL Data Retrieval Functions From http://deanattali.com/blog/shiny-persistent-data-storage/
saveData <- function(data) {
  # Connect to the database
  db <- dbConnect(MySQL(), dbname = databaseName, host = options()$mysql$host, 
                  port = options()$mysql$port, user = options()$mysql$user, 
                  password = options()$mysql$password)
  # Construct the update query by looping over the data fields
  query <- sprintf(
    "INSERT INTO %s (%s) VALUES ('%s')",
    table, 
    paste(names(data), collapse = ", "),
    paste(data, collapse = "', '")
  )
  # Submit the update query and disconnect
  dbGetQuery(db, query)
  dbDisconnect(db)
}

loadData <- function() {
  # Connect to the database
  db <- dbConnect(MySQL(), dbname = databaseName, host = options()$mysql$host, 
                  port = options()$mysql$port, user = options()$mysql$user, 
                  password = options()$mysql$password)
  # Construct the fetching query
  query <- sprintf("SELECT * FROM %s", table)
  # Submit the fetch query and disconnect
  data <- dbGetQuery(db, query)
  dbDisconnect(db)
  data
}

#define password
#password protection applied based on example here: https://stackguides.com/questions/28987622/starting-shiny-app-after-password-input
Logged = FALSE;
my_username <- "Administrator"
my_password <- "****"

#Actual UI
ui1 <- 
  function(){
    tagList(
      div(id = "login",
          wellPanel(textInput("userName", "Username"),
                    passwordInput("passwd", "Password"),
                    br(),actionButton("Login", "Log in"))),
      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 <- 
  fluidPage(
            shinyjs::useShinyjs(),
            sidebarPanel(
              #various elements of a sidebar panel
              ),
            mainPanel(
              #various elements of a main panel
            ),
            tabPanel(#tabPanel things),
            tabPanel(#tabPanel things),
            tabPanel(#tabPanel things),
            tabPanel(#tabPanel things)
              )



#Actual Server
server = (function(input, output) {
  
  #various reactive page elements such as tables, plots, and conditional panels
  
  #Server Side Password activity
  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
            } 
          }
        } 
      }
    }    
  })
  observe({
    if (USER$Logged == FALSE) {
      
      output$page <- renderUI({
        div(class="outer",do.call(bootstrapPage,c("",ui1())))
      })
    }
    if (USER$Logged == TRUE) 
    {
      output$page <- renderUI({
        ui2
      })
      print(ui)
    }
  })
})

In case this helps, here's what happens in the console log:

jquery.min.js:4 Synchronous XMLHttpRequest on the main thread is deprecated because of its detrimental effects to the end user's experience. For more help, check https://xhr.spec.whatwg.org/.
send @ jquery.min.js:4
ajax @ jquery.min.js:4
getSettings @ shinyapps.js:39
(anonymous) @ shinyapps.js:1
rstudio-connect.js:384 Mon Mar 06 2017 17:06:28 GMT-0600 (CST): Connection opened. https://zlevine.shinyapps.io/forcafha/
rstudio-connect.js:384 Mon Mar 06 2017 17:07:05 GMT-0600 (CST): Connection closed. Info: {"type":"close","code":1000,"reason":"Normal closure","wasClean":true}
1

1 Answers

2
votes

I simplified a bit your code and it now works as expected:

# ui.R
shinyUI(fluidPage(shinyjs::useShinyjs(),uiOutput("page")))

*******************************************************************************************

# server.R
shinyServer(function(input, output) {

  Logged = FALSE;
  my_username <- "Administrator"
  my_password <- "****"

  #Actual UI
  ui1 <-tagList(
    div(id = "login",
        wellPanel(textInput("userName", "Username"),
                  passwordInput("passwd", "Password"),
                  br(),actionButton("Login", "Log in"))),
    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 <- titlePanel("Loggedin!")

  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$page <- renderUI({
    if (USER$Logged == FALSE) 
      div(class="outer",do.call(bootstrapPage,c("",ui1)))
    else 
      ui2
  })
})