How to require user authentication in R Shiny before users see any part of the app using shinyauthr?

Question

I have a R Shiny app that I want users to authenticate themselves before they see anything, including the main panel and every tab. I know I could use "req(credentials()$user_auth)" before each item, but that seems like overkill for even my main panel. However, if I don't, it looks awkward:

How can I require credentials before users see anything? Is there a way to specify the above-req() argument just once?

I know that shinymanager can do this through the secureapp() function, but to my knowledge, you cannot used hashed passwords. My app uses the sodium package to hash passwords, so shinyauthr is preferred because it can easily decode. Open to other solutions only if they can use hashed passwords.

Here's a reproducible example:

library(shiny)
library(shinyauthr)

user_base <- tibble::tibble(
  user = c("user1", "user2"),
  permissions = c("admin", "standard"),
  name = c("User One", "User Two"),
  pwd_col = "password"
)


ui <- fluidPage(
  # add logout button UI
  div(class = "pull-right", shinyauthr::logoutUI(id = "logout")),
  # add login panel UI function
  shinyauthr::loginUI(id = "login"),
  tabsetPanel(
    tabPanel("View 1", 
  
  h4("Select Your Desired Filters"),
  div(id = "inputs",
      dateRangeInput(
        inputId = "date_filter",
        label = "Filter by Month and Year",
        start = today(),
        end = (today() + 90),
        min = "Apr-2021",
        max = NULL,
        format = "M-yyyy",
        startview = "month",
        weekstart = 0,
        language = "en",
        separator = " to ",
        width = NULL,
        autoclose = TRUE
      ))),
  tabPanel("View 2", 
  # setup table output to show user info after login
  tableOutput("user_table")
)))

server <- function(input, output, session) {
  
  # call login module supplying data frame, 
  # user and password cols and reactive trigger
  credentials <- shinyauthr::loginServer(
    id = "login",
    data = user_base,
    user_col = user,
    pwd_col = pwd_col,
    sodium_hashed = FALSE,
    log_out = reactive(logout_init())
  )
  
  # call the logout module with reactive trigger to hide/show
  logout_init <- shinyauthr::logoutServer(
    id = "logout",
    active = reactive(credentials()$user_auth)
  )
  
  output$user_table <- renderTable({
    # use req to only render results when credentials()$user_auth is TRUE
    req(credentials()$user_auth)
    credentials()$info
  })
}

shinyApp(ui = ui, server = server)

J.Sabree · Accepted Answer · 2021-08-11T21:15:24.197

Update:

Though I can't find an answers using shinyauthr and sodium, I have found a way to accomplish my goal with shinymanger and scyrpt.

The code below is modified from the first answer on this post, and it includes an encrypted password. To access the app, the password is "ice" without the quotations. The username is "1", again without the quotations.

The important part is, within credentials, to set the is_hashed_password argument to TRUE. The hashing it recognizes is scrypt's method, not sodium.

I'll keep this question open for a few more days in case someone can figure out the answer to my original question. Otherwise, I'll consider this equivalent solution as acceptable:

library(shiny)
library(shinymanager)
library(scrypt)

inactivity <- "function idleTimer() {
var t = setTimeout(logout, 120000);
window.onmousemove = resetTimer; // catches mouse movements
window.onmousedown = resetTimer; // catches mouse movements
window.onclick = resetTimer;     // catches mouse clicks
window.onscroll = resetTimer;    // catches scrolling
window.onkeypress = resetTimer;  //catches keyboard actions

function logout() {
window.close();  //close the window
}

function resetTimer() {
clearTimeout(t);
t = setTimeout(logout, 120000);  // time is in milliseconds (1000 is 1 second)
}
}
idleTimer();"

password <- "c2NyeXB0ABAAAAAIAAAAAVYhtzTyvRJ9e3hYVOOk63KUzmu7rdoycf3MDQ2jKLDQUkpCpweMU3xCvI3C6suJbKss4jrNBxaEdT/fBzxJitY3vGABhpPahksMpNu/Jou5"

# data.frame with credentials info
credentials <- data.frame(
  user = c("1", "fanny", "victor", "benoit"),
  password = password,
  is_hashed_password = TRUE,
  # comment = c("alsace", "auvergne", "bretagne"), %>% 
  stringsAsFactors = FALSE
)

ui <- secure_app(head_auth = tags$script(inactivity),
                 fluidPage(
                   # classic app
                   headerPanel('Iris k-means clustering'),
                   sidebarPanel(
                     selectInput('xcol', 'X Variable', names(iris)),
                     selectInput('ycol', 'Y Variable', names(iris),
                                 selected=names(iris)[[2]]),
                     numericInput('clusters', 'Cluster count', 3,
                                  min = 1, max = 9)
                   ),
                   mainPanel(
                     plotOutput('plot1'),
                     verbatimTextOutput("res_auth")
                   )
                   
                 ))

server <- function(input, output, session) {
  
  result_auth <- secure_server(check_credentials = check_credentials(credentials))
  
  output$res_auth <- renderPrint({
    reactiveValuesToList(result_auth)
  })
  
  # classic app
  selectedData <- reactive({
    iris[, c(input$xcol, input$ycol)]
  })
  
  clusters <- reactive({
    kmeans(selectedData(), input$clusters)
  })
  
  output$plot1 <- renderPlot({
    palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
              "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))
    
    par(mar = c(5.1, 4.1, 0, 1))
    plot(selectedData(),
         col = clusters()$cluster,
         pch = 20, cex = 3)
    points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
  })
  
}


shinyApp(ui = ui, server = server)

How to require user authentication in R Shiny before users see any part of the app using shinyauthr?

1 Answers1