R Shiny: user authentication for a single app.R

ShinyProxy, an open-source Docker- and Spring Java-based Shiny server, was designed to address this issue. It allows you to hard-code users in the application configuration file, connect to an LDAP server, use SSO/Keycloak, or Social network sign-in.

The polished R package adds authentication and user management to any Shiny app: https://github.com/Tychobra/polished

Here is a screenshot of the default sign in page that you get with polished:
You can easily replace the placeholder logos and colors with your own branding on the sign in and register pages.

Polished also comes with a dashboard to manage the users of your app:

More detail: https://polished.tech/

Well, you can do it via from code by using renderUI and changing the UI on the fly. Here is an example of how to do it:

library(shiny)
library(ggplot2)

u <- shinyUI(fluidPage(
  titlePanel("Shiny Password"),

  sidebarLayout(position = "left",
                sidebarPanel( h3("sidebar panel"),
                              uiOutput("in.pss"),
                              uiOutput("in.clr"),
                              uiOutput("in.titl"),
                              uiOutput("in.cnt"),
                              uiOutput("in.seed")

                ),
                mainPanel(h3("main panel"),
                          textOutput('echo'),
                          plotOutput('stdplot')
                )
  )
))

pok <- F

s <- shinyServer(function(input, output) 
{
  output$in.pss   <- renderUI({ input$pss; if (pok) return(NULL) else return(textInput("pss","Password:","")) })
  output$in.clr   <- renderUI({ input$pss; if (pok) return(selectInput("clr","Color:",c("red","blue"))) else return(NULL) })
  output$in.titl  <- renderUI({ input$pss; if (pok) return(textInput("titl","Title:","Data")) else return(NULL) })
  output$in.cnt   <- renderUI({ input$pss; if (pok) return(sliderInput("cnt","Count:",100,1000,500,5)) else return(NULL) })
  output$in.seed  <- renderUI({ input$pss; if (pok) return(numericInput("seed","Seed:",1234,1,10000,1)) else return(NULL) })
  histdata <- reactive(
    {
      input$pss;
      validate(need(input$cnt,"Need count"),need(input$seed,"Need seed"))
      set.seed(input$seed)
      df <- data.frame(x=rnorm(input$cnt))
    }
  )
  observe({
     if (!pok) {
       password <- input$pss
       if (!is.null(password) && password == "pass") {
         pok <<- TRUE
       }
     }
   }
  )
  output$echo = renderText(
    {
      if (pok) {
        s <- sprintf("the %s is %s and has %d rows and uses the %d seed",
           input$ent,input$clr,nrow(histdata()),input$seed)
      } else {
        s <- ""
      }
      return(s)
    }
  )
  output$stdplot = renderPlot(
    {
      input$pss
      if (pok) {
        return(qplot(data = histdata(),x,fill = I(input$clr),binwidth = 0.2,main=input$titl))
      } else {
        return(NULL)
      }
    }
  )
}
)
shinyApp(ui=u,server=s)

Yields

this at login:

And this once you have entered the hardcoded password "pass".

Of course programming this way is a bit awkward, but you could use tabs and hide them perhaps using a similar logic.

Or if you are using shinyServer you could probably put a filter in front of the site. But this is how I would approach it in Shiny.

Here is an example how to use cookies for authentication. More information can be found in my blog here.

First download cookie js to the www/ folder:

if (!dir.exists('www/')) {
    dir.create('www')
}

download.file(
  url = 'https://cdn.jsdelivr.net/npm/js-cookie@2/src/js.cookie.min.js',
  destfile = 'www/js.cookies.js'
)

Install the necessary packages:

install.packages(c('shiny', 'shinyjs', 'bcrypt'))

Save the following code as app.R and click the "Run App" button:

library(shiny)
library(shinyjs)
library(bcrypt)


# This would usually come from your user database.

# Never store passwords as clear text
password_hash <- hashpw('secret123') 

# Our not so random sessionid
# sessionid <- paste(
#   collapse = '', 
#   sample(x = c(letters, LETTERS, 0:9), size = 64, replace = TRUE)
# )
sessionid <- "OQGYIrpOvV3KnOpBSPgOhqGxz2dE5A9IpKhP6Dy2kd7xIQhLjwYzskn9mIhRAVHo" 


jsCode <- '
  shinyjs.getcookie = function(params) {
    var cookie = Cookies.get("id");
    if (typeof cookie !== "undefined") {
      Shiny.onInputChange("jscookie", cookie);
    } else {
      var cookie = "";
      Shiny.onInputChange("jscookie", cookie);
    }
  }
  shinyjs.setcookie = function(params) {
    Cookies.set("id", escape(params), { expires: 0.5 });  
    Shiny.onInputChange("jscookie", params);
  }
  shinyjs.rmcookie = function(params) {
    Cookies.remove("id");
    Shiny.onInputChange("jscookie", "");
  }
'

server <- function(input, output) {

  status <- reactiveVal(value = NULL)
  # check if a cookie is present and matching our super random sessionid  
  observe({
    js$getcookie()
    if (!is.null(input$jscookie) && 
        input$jscookie == sessionid) {
          status(paste0('in with sessionid ', input$jscookie))
    }
    else {
      status('out')
    }
  })

  observeEvent(input$login, {
    if (input$username == 'admin' & 
        checkpw(input$password, hash = password_hash)) {
      # generate a sessionid and store it in your database,
      # sessionid <- paste(
      #   collapse = '', 
      #   sample(x = c(letters, LETTERS, 0:9), size = 64, replace = TRUE)
      # )
      # but we keep it simple in this example...
      js$setcookie(sessionid)
    } else {
      status('out, cause you don\'t know the password secret123 for user admin.')
    }
  })

  observeEvent(input$logout, {
    status('out')
    js$rmcookie()
  })

  output$output <- renderText({
    paste0('You are logged ', status())}
  )
}

ui <- fluidPage(
  tags$head(
    tags$script(src = "js.cookies.js")
  ),
  useShinyjs(),
  extendShinyjs(text = jsCode),
  sidebarLayout(
    sidebarPanel(
      textInput('username', 'User', placeholder = 'admin'),
      passwordInput('password', 'Password', placeholder = 'secret123'),
      actionButton('login', 'Login'),
      actionButton('logout', 'Logout')
    ),
    mainPanel(
      verbatimTextOutput('output')
    )
  )
)

shinyApp(ui = ui, server = server)