Restrict SelectInput Based on User

Question

I am currently trying to construct an app to visualize worker performance over time. I am trying to create a password protected dashboard where users marked as managers can view all other user stats, and non-manager users can only view their own stats. However I cannot get it to work. Here is what I have so far. The users list is employees matched with their username (2 variables) , and the credentials list is usernames and passwords (2 variables). The issue is somewhere with the observe function imo. If the user is not manager I want their selectinput button locked on their own name. ie. session$user==users$user

Any guidance would be much appreciated.

data<-read.csv("Data/data.csv")
data$Create.Date<-as.Date(data$Create.Date)
credentials<-unique(read.csv("Data/credentials.csv"))

ui<-secure_app(head_auth=tags$script(inactivity),
             dashboardPage(

dashboardHeader(title = "Services Dashboard"),

dashboardSidebar(
  selectInput("name","Select a User", users[,1]),
  dateRangeInput("date", "Select a Date Range",format="mm-dd-yy"),
  actionButton("go", "Go")
),

dashboardBody(
  plotlyOutput("plot"),
  tableOutput("table"),
)
)
)

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

res_auth<-secure_server(check_credentials = check_credentials(credentials))

user<-reactive({
  session$user
}
)

manager<-reactive({
  if(user()=="manager"){
    return(TRUE)
  }else{
    return(FALSE)
  }
})

observe({
  if(manager()==FALSE){
    updateSelectInput(session, "names", "Select A User", 
choices=users$user[users$username==user()])
  }
 })

    
 masterdata<-eventReactive(input$go, {
  data %>%
    filter(
      as.Date(Create.Date) >= as.Date(input$date[1]),
      as.Date(Create.Date) <= as.Date(input$date[2]),
      Staff.Created == input$name)
  })

 aggdata<-eventReactive(input$go, {
  data %>%
    filter(
      as.Date(Create.Date) >= as.Date(input$date[1]),
      as.Date(Create.Date) <= as.Date(input$date[2]),
      Staff.Created == input$name)%>%
    summarise(`Services Provided in Period Selected`=sum(count))
    
 })

 output$plot<-renderPlotly({
  ggplot(masterdata(), 
         aes(x=Create.Date, y=count, label=count),
         xmin=input$date[1], xmax=input$date[2], ymin=0, fill = input$date)+
    xlab("Date")+
    ylab("Services Provided")+
    geom_line(group=1, colour="#000099")+
    theme(axis.text.x = element_text(angle=45, vjust=0.5, size=8))+
    scale_x_date(breaks = "days", date_labels = "%m.%d")+
    geom_point()
    })

  output$table<-renderTable({
  aggdata()
 })

}

shinyApp(ui = ui, server = server)

and here is my error code: Warning: Error in if: argument is of length zero

Answer 1

I removed everything but a few essentials to mock what you want. What I changed is this:

I used the id of the select input consistently (in this sample it is "names"). Otherwise you are trying to access an input element that does not exist. This would simply return null when you are trying the read it.

Another possible cause could happen during initialisation. I am not exactly sure about the order in which things happen. But if session$user is not set when the code gets evaluated the first time, your code will assume a non-manager scenario and it will not be updated again once all the information is available. Hence:

• Check for null , too, when the reactive expression checks for manager rights. This might happen during initialisation.
• I added an else branch to restore all the names in the select input when a manager is logged in.

library(shiny)

users <- data.frame(
  username = LETTERS[1:10],
  user = letters[1:10]
)

ui <- fluidPage(
  # Needed for mocking the user id
  checkboxInput("MockScenario", "Mock a manager scenario"),

  # Original code
  selectInput("names", "Select a User", users$username),
  dateRangeInput("date", "Select a Date Range", format="mm-dd-yy"),
  actionButton("go", "Go")
)

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

  user <- reactive({
    # session$user # is not used in this sample but the mock
    ## Mocked user
    if (input$MockScenario == TRUE)
      "manager"
    else
      sample(users$user, 1)
  })
  
  manager <- reactive({
    if (isTruthy(user()) && user() == "manager") {
      return(TRUE)
    } else {
      return(FALSE)
    }
  })
  
  observe({
    if(manager() == FALSE) {
      updateSelectInput(session, "names", "Select A User", 
                        choices = users$username[users$user == user()])
    } else {
      updateSelectInput(session, "names", "Select A User", 
                        choices = users$username)
    }
  })
}

shinyApp(ui, server)