Require password for selectInput selections

[hikipoklica]

Hi all!

I have a Shiny app where a selectInput selection calls for a dataset to be loaded and displayed to the user. Is there a way to prompt the user for a password before the selection they made gets passed to the app? In essence, I want every user to be only able to select themselves from the dropdown list and not snoop around in the data of others.

Thanks a lot in advance!
Cheers!

[scottyd22]

Welcome to the community @hikipoklica ! Below is one way to accomplish the workflow you described. In this example, the users and associated passwords are stored in a data frame (passwords) at the beginning of the script. When a user is selected from the dropdown, a modal is launched requesting a password. If an incorrect password is entered, an error message is displayed. If a correct password is entered, the modal closes and the dataset (mtcars) is displayed.

library(shiny)

# dataset of interest ----
mydata = mtcars

# password list ----
passwords = data.frame(user = c('User1', 'User2', 'User3'),
                       password = c('Password1', 'Password2', 'Password3'))

# UI ----
ui <- fluidPage(
  br(),
  selectInput('user',
              'Pick a user',
              choices = c('Select a User' = '', 'User1', 'User2', 'User3'),
              multiple = F),
  br(),
  tableOutput('table')
)

# server ----
server <- function(input, output, session) {
  
  # password prompt when user is selected
  observeEvent(input$user, {
    
    # launch the password modal
    if(input$user != '') {
      showModal(
        modalDialog(
          title = "",
          "",
          div(passwordInput('password_input', '', placeholder = 'Enter a password'), style = 'display: inline-block'),
          actionButton('password_button', 'Submit', style = 'inline-block'),
          br(),
          textOutput('password_check'),
          footer = tagList(modalButton("Cancel"))
          )
        )
      }
    }, 
    ignoreInit = T)
  
  # password check (toggle between yes and no)
  password_check_value = reactiveVal('no')
  
  # password check message (toggle between blank message and "Incorrect...")
  password_check_message = reactiveValues(d = ' ')
  
  # when password button is clicked
  observeEvent(input$password_button, {
    req(input$password_input)
    
    # get actual password for selected user from passwords data frame
    actual_password = passwords$password[passwords$user == input$user]
    
    # if password doesn't match - set to "no" and update to error message
    if(input$password_input != actual_password) {
      password_check_value('no')
      password_check_message$d = 'Incorrect password. Please try again.'
      
      # if password matches - set to "yes" and update to blank message
      } else {
      password_check_value('yes')
      password_check_message$d = ' '
      removeModal()
    }
    
  })
  
  # if password input is removed, update to blank message
  observeEvent(input$password_input, {
    if(input$password_input == '') {
      password_check_message$d = ' '
    }
  })
  
  # password message text to display (blank or "Incorrect...")
  output$password_check = renderText(password_check_message$d)
  
  # remove data set if new user selected (by setting to "no")
  observeEvent(input$user, {
      password_check_value('no')
  })
  
  # data to show (only when "yes")
  output$table = renderTable({
    if(password_check_value() == 'yes') {
      head(mydata, 10)
      }
  })
}

shinyApp(ui, server)

[hikipoklica]

Thank you @scottyd22, you are a hero! This serves my purpose very well!