Authentication

Lesson 8 — R Shiny

Lesson 8 of 11 Intermediate to advanced ~70 min

Learning objectives

  • Distinguish authentication, authorisation and auditing
  • Read identity from a hosting platform rather than building a login
  • Implement role-based authorisation correctly on the server
  • Understand what a Shiny-level login can and cannot protect
  • Audit access in a way that satisfies a regulated environment

Three different things

Question Example
Authentication Who are you? Login, SSO, certificate
Authorisation What may you do? Reviewer can read; programmer can edit
Auditing What did you do? Access log, change log

They are frequently conflated. An app can authenticate perfectly and still leak data because authorisation is enforced only in the UI.

The first rule

Do not write your own authentication if a platform can do it for you.

Platform Authentication How you read the user
Posit Connect LDAP, SAML, OAuth, PAM session$user, session$groups
Posit Workbench / Shiny Server Pro PAM, LDAP, SSO session$user
ShinyProxy LDAP, OpenID, Keycloak HTTP headers
Behind a reverse proxy Whatever the proxy does Headers set by the proxy
shinyapps.io Basic (paid tiers) Limited
Self-hosted open-source Shiny Server None —

A platform-level authentication runs before the Shiny process, so an unauthenticated request never reaches your R code. A login screen implemented inside Shiny does not have that property, which is the crucial distinction below.

server <- function(input, output, session) {
  user   <- session$user            # NULL when unauthenticated
  groups <- session$groups          # character vector on Connect

  output$whoami <- renderText({
    sprintf("Signed in as %s (%s)",
            user %||% "anonymous",
            paste(groups, collapse = ", "))
  })
}

Behind a reverse proxy, identity arrives in headers:

server <- function(input, output, session) {
  hdrs <- session$request

  user  <- hdrs$HTTP_X_FORWARDED_USER  %||%
           hdrs$HTTP_X_AUTH_REQUEST_USER %||%
           session$user

  email <- hdrs$HTTP_X_AUTH_REQUEST_EMAIL
}
ImportantHeaders are only trustworthy if the proxy sets them

Any client can send X-Forwarded-User: admin directly to the Shiny port. This is safe only if the Shiny process is unreachable except through the proxy, and the proxy overwrites (not appends) the header. Bind Shiny to 127.0.0.1 and firewall the port.

In-app login: what it is and is not

Sometimes there is no platform. A Shiny-level login is then better than nothing — provided you are clear about what it protects.

library(shiny)
library(bslib)

# Password hashes, never plaintext. Stored outside the app in production.
USERS <- tibble::tribble(
  ~username,  ~hash,                        ~role,
  "rgaduputi", sodium::password_store("..."), "programmer",
  "jsmith",    sodium::password_store("..."), "reviewer"
)

login_ui <- function() {
  bslib::page_fillable(
    theme = bslib::bs_theme(version = 5),
    tags$div(
      class = "d-flex justify-content-center align-items-center",
      style = "height: 100vh;",
      bslib::card(
        style = "max-width: 380px;",
        bslib::card_header("Study ABC-101 — Sign in"),
        bslib::card_body(
          textInput("username", "Username"),
          passwordInput("password", "Password"),
          actionButton("login", "Sign in", class = "btn-primary w-100"),
          uiOutput("login_error")
        )
      )
    )
  )
}

ui <- uiOutput("app_ui")

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

  auth <- reactiveValues(ok = FALSE, user = NULL, role = NULL, attempts = 0L)

  output$app_ui <- renderUI({
    if (isTRUE(auth$ok)) main_ui() else login_ui()
  })

  observeEvent(input$login, {

    # Rate limit
    if (auth$attempts >= 5) {
      output$login_error <- renderUI(
        tags$div(class = "alert alert-danger mt-3 mb-0",
                 "Too many failed attempts. Contact the study team.")
      )
      return()
    }

    row <- USERS[USERS$username == input$username, ]

    ok <- nrow(row) == 1 &&
      sodium::password_verify(row$hash, input$password)

    # Constant-ish delay whether or not the user exists,
    # so timing does not reveal valid usernames
    Sys.sleep(0.4)

    if (ok) {
      auth$ok   <- TRUE
      auth$user <- row$username
      auth$role <- row$role
      log_event("login_success", row$username, session)
    } else {
      auth$attempts <- auth$attempts + 1L
      log_event("login_failure", input$username, session)
      output$login_error <- renderUI(
        tags$div(class = "alert alert-warning mt-3 mb-0",
                 "Invalid username or password.")
      )
    }
  })

  # The rest of the server, guarded
  observe({
    req(auth$ok)
    main_server(input, output, session, role = auth$role)
  })
}
WarningWhat this does not protect

The R process is already running and has already loaded the data before anyone logs in. An in-app login prevents a casual user from seeing the UI; it does not prevent a determined one from talking to the websocket directly, and it does nothing at all if the app is reachable at a URL.

Use it for convenience and for an audit trail. Do not use it as the only control on confidential data. For that you need platform authentication, or at minimum a reverse proxy that authenticates before Shiny sees the request.

Never store plaintext passwords, and never hash with MD5 or SHA-1:

# WRONG
password == "secret123"
digest::digest("secret123", algo = "md5")

# RIGHT — argon2 via sodium, or bcrypt via bcrypt
hash <- sodium::password_store("secret123")
sodium::password_verify(hash, input$password)

shinymanager

A ready-made login layer with a user database, password expiry and an admin panel:

library(shinymanager)

credentials <- data.frame(
  user      = c("reviewer", "programmer"),
  password  = c("...", "..."),
  admin     = c(FALSE, TRUE),
  role      = c("reviewer", "programmer"),
  expire    = c(NA, NA),
  stringsAsFactors = FALSE
)

# Encrypted SQLite database
create_db(credentials_data = credentials, sqlite_path = "db.sqlite",
          passphrase = Sys.getenv("APP_PASSPHRASE"))

ui <- secure_app(ui, enable_admin = TRUE)

server <- function(input, output, session) {
  res_auth <- secure_server(
    check_credentials = check_credentials("db.sqlite",
                                          passphrase = Sys.getenv("APP_PASSPHRASE"))
  )

  user_role <- reactive(res_auth$role)
}

Same caveat as above: it is a Shiny-level control. It is a reasonable choice for an internal tool on a trusted network; it is not a substitute for platform authentication on anything sensitive.

Authorisation

Once you know who the user is, decide what they may do — on the server.

PERMISSIONS <- list(
  reviewer   = c("view_data", "export_csv"),
  programmer = c("view_data", "export_csv", "edit_data", "run_derivation"),
  admin      = c("view_data", "export_csv", "edit_data", "run_derivation",
                 "manage_users", "view_audit")
)

can <- function(role, action) {
  action %in% (PERMISSIONS[[role]] %||% character())
}

Hide in the UI, enforce on the server

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

  role <- reactive(get_role(session$user))

  # UI convenience: hide what the user cannot do
  output$admin_panel <- renderUI({
    req(can(role(), "manage_users"))
    admin_ui()
  })

  observe({
    shinyjs::toggle("edit_button", condition = can(role(), "edit_data"))
  })

  # SECURITY: the real check, on every privileged action
  observeEvent(input$save, {
    if (!can(role(), "edit_data")) {
      log_event("authorisation_denied", session$user, session,
                detail = "edit_data")
      showNotification("You do not have permission to edit data.", type = "error")
      return()
    }
    save_changes(input)
    log_event("data_edited", session$user, session)
  })
}
ImportantHiding a button is not a permission check

shinyjs::hide() removes an element from view. The corresponding input$save can still be triggered by a crafted websocket message. Every privileged observeEvent needs its own server-side check — the UI-level hiding is purely for usability.

The same applies to data: filtering a table by the user’s site in renderDT() is a display choice. If the underlying reactive holds all sites, a download handler or a different output may expose them. Filter at the source:

user_data <- reactive({
  d <- load_all_data()
  if (role() != "admin") d <- dplyr::filter(d, SITEID %in% sites_for(session$user))
  d
})

Every downstream output then reads user_data() and cannot see more.

Auditing

In a regulated environment, who accessed what and when is part of the record.

log_event <- function(event, user, session, detail = NULL) {
  entry <- data.frame(
    timestamp = format(Sys.time(), "%Y-%m-%dT%H:%M:%S%z"),
    event     = event,
    user      = user %||% "anonymous",
    session   = session$token,
    ip        = session$request$REMOTE_ADDR %||% NA_character_,
    detail    = detail %||% NA_character_,
    stringsAsFactors = FALSE
  )

  readr::write_csv(entry, "logs/audit.csv", append = TRUE)
}

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

  log_event("session_start", session$user, session)

  session$onSessionEnded(function() {
    log_event("session_end", isolate(session$user), session)
  })

  observeEvent(input$download, {
    log_event("data_export", session$user, session,
              detail = sprintf("%d rows, arm=%s", nrow(filtered()), input$arm))
  })
}

For anything beyond a small internal tool, write audit records to a database rather than a CSV — concurrent sessions appending to one file will interleave and eventually corrupt rows.

What to log:

  • Session start and end, with user and IP
  • Every data export, with what was exported
  • Every data modification, with before and after
  • Every authorisation denial
  • Login successes and failures

What not to log: passwords, session tokens in plaintext, and patient identifiers beyond what the audit requires.

Secrets

Never in source code, never in Git.

# .Renviron (not committed)
DB_PASSWORD=hunter2
API_KEY=sk-...
APP_PASSPHRASE=...
db_password <- Sys.getenv("DB_PASSWORD")
if (db_password == "") stop("DB_PASSWORD is not set")

# Better still, a credential store
config <- config::get(file = "config.yml")   # environment-aware
keyring::key_get("study-db", "app_user")     # OS keychain

On Posit Connect, set environment variables per-application in the dashboard — they are encrypted at rest and never appear in the bundle.

Common mistakes

Mistake Consequence Fix
Rolling your own auth when a platform exists Weak, unmaintained Use the platform
Plaintext or MD5 passwords Trivially compromised sodium::password_store()
Checking permissions only in the UI Bypassable Server-side check per action
Filtering data at the output Other outputs leak it Filter at the source reactive
Trusting proxy headers on an open port Trivial impersonation Bind to localhost, firewall
Secrets in source Leaked on first push .Renviron, keyring, platform env vars
No audit trail Cannot answer inspection questions Log to a database
Audit CSV with concurrent sessions Interleaved, corrupt rows Use a database

Exercise 8.1 — Role-based app

Build an app with three roles. viewer sees the table only. analyst also sees the export button. admin also sees an admin panel and can edit data. Enforce the permissions correctly.

Show solution 
library(shiny); library(bslib); library(shinyjs); library(dplyr)

PERMISSIONS <- list(
  viewer  = c("view"),
  analyst = c("view", "export"),
  admin   = c("view", "export", "edit", "manage")
)

can <- function(role, action) action %in% (PERMISSIONS[[role]] %||% character())

ui <- page_sidebar(
  useShinyjs(),
  title = "Study data review",
  sidebar = sidebar(
    # Role selector only for the demo; in production this comes from the platform
    selectInput("demo_role", "Simulated role", names(PERMISSIONS)),
    hr(),
    uiOutput("role_badge"),
    hidden(downloadButton("export", "Export CSV", class = "w-100 mt-2")),
    hidden(actionButton("edit", "Edit selected", class = "w-100 mt-2"))
  ),
  card(card_header("Data"), DT::DTOutput("table")),
  uiOutput("admin_panel")
)

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

  # In production:  role <- reactive(lookup_role(session$user))
  role <- reactive(input$demo_role)

  # --- Data is filtered AT SOURCE by what the role may see -----------------
  visible_data <- reactive({
    d <- readRDS("data/adsl.rds")
    if (!can(role(), "manage")) {
      d <- select(d, -any_of(c("SUBJINIT", "BRTHDT")))   # drop identifiers
    }
    d
  })

  output$table <- DT::renderDT(
    DT::datatable(visible_data(), rownames = FALSE, selection = "single")
  )

  # --- UI convenience: show only what is usable ----------------------------
  output$role_badge <- renderUI({
    tags$span(class = "badge bg-secondary",
              sprintf("Role: %s", role()))
  })

  observe({
    toggle("export", condition = can(role(), "export"))
    toggle("edit",   condition = can(role(), "edit"))
  })

  output$admin_panel <- renderUI({
    if (!can(role(), "manage")) return(NULL)
    card(card_header("Administration"),
         card_body(actionButton("purge", "Clear cache", class = "btn-warning"),
                   verbatimTextOutput("audit_tail")))
  })

  # --- SECURITY: every privileged action rechecks ---------------------------
  output$export <- downloadHandler(
    filename = function() "export.csv",
    content = function(file) {
      if (!can(role(), "export")) {
        audit("authorisation_denied", role(), "export")
        writeLines("Permission denied.", file)
        return()
      }
      audit("data_export", role(), sprintf("%d rows", nrow(visible_data())))
      readr::write_csv(visible_data(), file)
    }
  )

  observeEvent(input$edit, {
    if (!can(role(), "edit")) {
      audit("authorisation_denied", role(), "edit")
      showNotification("You do not have permission to edit.", type = "error")
      return()
    }
    req(input$table_rows_selected)
    showModal(modalDialog(title = "Edit record", "..."))
  })

  observeEvent(input$purge, {
    if (!can(role(), "manage")) {
      audit("authorisation_denied", role(), "manage")
      return()
    }
    audit("cache_cleared", role(), NULL)
    showNotification("Cache cleared.", type = "message")
  })

  output$audit_tail <- renderPrint({
    req(can(role(), "manage"))
    tail(readr::read_csv("logs/audit.csv", show_col_types = FALSE), 10)
  })
}

The three levels of defence, in order of importance:

  1. visible_data() drops identifier columns for non-admins. This is the real control — nothing downstream can expose what is not in the reactive.
  2. Every privileged handler rechecks. input$edit can be triggered even when the button is hidden.
  3. toggle() hides controls. Usability only.
The output$export handler writing “Permission denied.” to the file rather than erroring is deliberate: a downloadHandler that raises produces a confusing browser error, and the denial is already recorded in the audit log.

Exercise 8.2 — Site-scoped data access

A monitoring app must show each user only the sites they are assigned to. Implement this so that no output, download or debug endpoint can leak another site’s data.

Show solution 
library(shiny); library(dplyr); library(cli)

# --- Authorisation lookup, from a database in production ------------------
user_sites <- function(user) {
  assignments <- readRDS("config/site_assignments.rds")
  sites <- assignments$site_id[assignments$user == user]
  if (length(sites) == 0) character(0) else sites
}

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

  user <- session$user %||% Sys.getenv("SHINY_DEMO_USER", "unknown")

  # --- The single, authoritative data reactive ---------------------------
  # EVERYTHING downstream reads this. Nothing reads the full dataset.
  authorised_data <- reactive({
    sites <- user_sites(user)

    if (length(sites) == 0) {
      audit("access_denied_no_sites", user, NULL)
      validate("You are not assigned to any sites. Contact the study manager.")
    }

    all_data <- readRDS("data/monitoring.rds")

    out <- filter(all_data, SITEID %in% sites)

    audit("data_access", user,
          sprintf("sites=%s rows=%d", paste(sites, collapse = ","), nrow(out)))

    out
  })

  # --- Every consumer uses authorised_data() -----------------------------
  filtered <- reactive({
    d <- authorised_data()
    if (!is.null(input$site) && input$site != "All") {
      d <- filter(d, SITEID == input$site)
    }
    d
  })

  # The site dropdown itself is built from the authorised set,
  # so an unassigned site is not even offered
  observe({
    updateSelectInput(session, "site",
                      choices = c("All", sort(unique(authorised_data()$SITEID))))
  })

  output$table <- DT::renderDT(DT::datatable(filtered(), rownames = FALSE))

  output$plot <- renderPlot({
    ggplot2::ggplot(filtered(), ggplot2::aes(SITEID)) +
      ggplot2::geom_bar(fill = "#16355e")
  }, res = 96)

  output$download <- downloadHandler(
    filename = function() sprintf("monitoring_%s.csv", Sys.Date()),
    content  = function(file) {
      # Re-derive from authorised_data(), never from a cached wider object
      readr::write_csv(filtered(), file)
      audit("data_export", user, sprintf("rows=%d", nrow(filtered())))
    }
  )

  session$onSessionEnded(function() {
    audit("session_end", isolate(user), NULL)
  })
}

The architectural point: there is exactly one place where the full dataset is read, and it is immediately filtered. Every other reactive derives from authorised_data(). That makes the authorisation property checkable by reading a single function rather than auditing every output.

The anti-pattern to avoid:

# DANGEROUS — the full dataset lives in a reactive that anything can reach
all_data <- reactive(readRDS("data/monitoring.rds"))

output$table <- DT::renderDT({
  filter(all_data(), SITEID %in% user_sites(user))   # filtered per-output
})

output$download <- downloadHandler(
  content = function(file) readr::write_csv(all_data(), file)   # LEAK
)

Here the filtering is applied per-output, and the download handler forgets it. That bug is invisible in review because each output looks reasonable on its own.

Additional hardening for a real deployment:

  • Enforce the site filter in the SQL query, not in R, so the unauthorised rows never leave the database.
  • Log the row count on every access so an anomaly (a user suddenly seeing 10× more rows) is detectable.
  • Fail closed: user_sites() returning empty must block access, never default to “all sites”.

Recap

  • Authentication, authorisation and auditing are three separate problems
  • Prefer platform authentication — it runs before your R code does
  • In-app logins are a convenience layer, not a control on confidential data
  • Hash with sodium/bcrypt; never MD5, never plaintext
  • Enforce permissions server-side on every privileged action, not in the UI
  • Filter data at the source reactive so no output can leak more than allowed
  • Log sessions, exports, edits and denials — to a database, not a CSV

Next: Testing Shiny applications.

Back to top