Adding Login spinner

[nicoloverardo]

I'm currently using a custom authentication function with check_credentials, and to authenticate it connects to a very slow API: this leaves the authentication frame as it is, for even up to 5-10 secs, after clicking login. To the end user, this would look like their click on the login button wasn't registered.

Thus, is there any way to add, say, a spinner or an UI element to inform the user that the login is in progress? Integrating something like the ones from {shinybusy} for example...

Thanks in advance and Great work though!

[pvictor]

Hello,

In secure_app() you can add tags above or under user/password input fields, so you can add a placeholder and then in your check_credentials function use insertUI to add a spinner and some text. Here's an example:

library(shiny)
library(shinymanager)

my_custom_check_creds <- function(user, password) {

  insertUI(
    selector = "#placeholder-loading",
    immediate = TRUE,
    ui = tagList(
      tags$div(
        style = "width: 60px; height: 60px; position: relative; margin: auto;",
        shinybusy::spin_epic("hollow-dots")
      ),
      tags$div(
        style = "text-align: center;",
        "Authentication in progress, please wait..."
      )
    )
  )

  Sys.sleep(5)

  # always return TRUE for demo (dont check user/password)
  list(result = TRUE)
}

ui <- fluidPage(
  tags$h2("My secure application"),
  verbatimTextOutput("auth_output")
)
ui <- secure_app(
  ui = ui, 
  tags_bottom = tagList(
    tags$div(id = "placeholder-loading")
  )
)

server <- function(input, output, session) {
  res_auth <- secure_server(
    check_credentials = my_custom_check_creds
  )  
  output$auth_output <- renderPrint({
    reactiveValuesToList(res_auth)
  })

}

shinyApp(ui, server)

Does this help you?

Victor

[nicoloverardo]

Hi Victor,

Many thanks for your quick reply. That definitely works, thanks!

Maybe just to complement, we would also need to take care of what happens if the user inputs wrong credentials and the authentication doesn't go through. I've adapted a bit your solution. We wrap the two divs containing the spinner and the text into another div, we call it "loading-ui" for example. Then, we can use removeUI to remove this div by leaving intact the placeholder.

library(shiny)
library(shinymanager)

my_custom_check_creds <- function(user, password) {
  insertUI(
    selector = "#placeholder-loading",
    immediate = TRUE,
    ui = tagList(
      tags$div(
        id = "loading-ui",
        tags$div(
          style = "width: 60px; height: 60px; position: relative; margin: auto;",
          shinybusy::spin_epic("hollow-dots")
        ),
        tags$div(
          style = "text-align: center;",
          "Authentication in progress, please wait..."
        )
      )
    )
  )

  # My function that actually checks that the credentials are correct
  auth <- doLogin(user, password)

  # We now remove the loading UI since the job is finished,
  # we'll just return the result
  removeUI(
    selector = "#loading-ui",
    immediate = TRUE
  )

  # Return the result
  if (auth) {
    list(result = TRUE, user_info = list(user = user))
  } else {
    list(result = FALSE)
  }
}

ui <- fluidPage(
  tags$h2("My secure application"),
  verbatimTextOutput("auth_output")
)
ui <- secure_app(
  ui = ui, 
  tags_bottom = tagList(
    tags$div(id = "placeholder-loading")
  )
)

server <- function(input, output, session) {
  res_auth <- secure_server(
    check_credentials = my_custom_check_creds
  )  
  output$auth_output <- renderPrint({
    reactiveValuesToList(res_auth)
  })

}

shinyApp(ui, server)