How to authenticate users directly in Shiny without having a separate authentification layer before starting shiny?

I am looking for tips and best practises on how to add authentification in a shiny app.

I have developed a shiny app, which consists of a public part accessible for everyone and a private part only accessible after login. The public app shows aggregated data of all users, while the private part shows the logged in user's data with more functionality.

There is lots of information on authentification functionality for shiny in blog posts, but nearly all handling authentification by adding an authentification layer before starting the shiny app. This is not applicable in my use case because the home page of the app should include shiny contents like plots etc.

So my current approach is to have two separate modules (module_public_app and module_private_app), a user database with encrypted passwords and a reactive value about the user's authentification status, then generating the user interface with renderUI depending on the status. Is this a good approach?

One problem I have found was that inputs still exist after logout and can be therefore a problem when logging in again, so I increased the id of the modules with every login. I need to make sure that nothing from the previous user session is still accessible. What happens to reactive elements that have been created, but are not used anymore? Could this affect performance?

This is my code:

library(shiny)

ui <- fluidPage(
  uiOutput("ui")
)

mod_public_app_ui <- function(id) {
  ns <- NS(id)
  tagList(
    textInput(ns("user_name"), "Username", value = ""),
    passwordInput(ns("user_pw"), "Password", value = ""),
    actionButton(ns("user_login"), "Login")
  )
}

mod_public_app <- function(input, output, session) {
  rv_user <- reactiveValues(user_name = NULL)

  observeEvent(input$user_login, {
    rv_user$user_name <- input$user_name
  })

  reactive({rv_user$user_name})
}

mod_private_app_ui <- function(id) {
  ns <- NS(id)
  tagList(
    verbatimTextOutput(ns("welcome")),
    actionButton(ns("user_logout"), "Logout")
  )
}

mod_private_app <- function(input, output, session, .user) {
  output$welcome <- renderPrint({paste0("Hello ", .user)})
  reactive({input$user_logout})
}

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

  values <- reactiveValues(user = NULL, id = 0)

  observe({
    req(is.null(values$user))
    output$ui <- renderUI({
      mod_public_app_ui(paste0("public", values$id))
    })

    user <- callModule(mod_public_app, paste0("public", values$id))

    observeEvent(user(), {
      values$user <- user()
    })
  })

  observe({
    req(values$user)
    output$ui <- renderUI({
      mod_private_app_ui(paste0("private", values$id))
    })

    logout <- callModule(mod_private_app, paste0("private", values$id), .user = values$user)

    observeEvent(logout(), {
      values$user <- NULL
      values$id <- values$id + 1L
    })
  })
}

shinyApp(ui, server)

Is this a good approach?

Seems very fair to me. Good work!

What happens to reactive elements that have been created, but are not used anymore? Could this affect performance?

The input reactive list will be new when the browser refreshes. The input reactive list is a different reactive list for each individually loaded webpage (a Shiny session). We only need to safeguard against successive logins without a page refresh.

During a session, reactive values persist until they are invalidated. I would instead make the user information an isolated reactiveVal, rather than a value within a reactiveValues. This is so that the reactiveVal object can be passed into the mod_private_app code. (Could also be done by passing in the whole values reactiveValues object and retrieving values$user each time the user is needed.)

The statement renderPrint({paste0("Hello ", .user)}), would be changed to renderPrint({paste0("Hello ", .user())}). If the .user() object is invalidated, then all reactives that depend on it will be invalidated as well (effectively wiping their state). Remember that the user reactive value doesn't necessarily need to be used in the output, as long as it is used in the reactive expression to invalidate the object being produced.

In your observeEvent for logout you would set user to NULL and all outputs that are a reactive child of user() will be invalidated as well.

user <- reactiveVal(NULL)

observe({
  req(user())
  output$ui <- renderUI({
    mod_private_app_ui(paste0("private", user()))
  })

  logout <- callModule(mod_private_app, paste0("private", user()), .user = user)

  # (this code could be put inside mod_private_app definition.)
  observeEvent(logout(), {
    user(NULL)
  })
})

I recently built an R package that you might find useful for this sort of thing.

1 Like

Thank you both for your feedback :slight_smile:

@paul Nice work! Your code is actually very similar to what I have been using so far. Would love to see some more customization options (e.g. to be able to change the button labels etc into a different language). Could I use the module without having to download the whole user database? Currently I am building an SQL query to fetch only the data of the supplied username and if there is none or the password didn't match, throw an error else login.

Hi @markusdumke,

Good idea on the customisation options. It's my first R package attempt so I definitely haven't covered all bases! Feel free to submit a pull request with any customisation you'd like to see :smile:.

You could definitely alter the login module code to attempt to query a single user from a DB rather than use a local user database, and then log them in or throw an error depending on if the query returned a match or not.

However, if your user base would easily fit into memory, it might be simpler to query the whole table on app launch then use the modules as they are currently setup.

Let me know how it goes.

Hi Markus. Just to let you know - I've just added some label customisation options to the package. Thanks for the suggestion!

2 Likes

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.