Obtaining user name in shinyauthr to choose named object

Question

I'm working on a shinyapp which fetches data from a database via a pool from the pool package. I'm working on a login page via shinyauthr where the usernames correspond to the names of the tables in the pool (all users will only be allowed to fetch data that correspond to their username).

I haven't been able to understand how I obtain the user name in shinyauthr. I've looked at https://github.com/paulc91/shinyauthr and Reactive Filtering Based on User Login - Shinyauthr but I'm still struggling to understand how to proceed.

To exemplify, I've created a similar situation where I, instead of choosing table in a pool, choose a column in a df. On row 50, I want user_data to store the user name from credentials in order to filter df on row 55. I have tried several reactive arguments of which none have worked.

library(shinyauthr)
library(shinyjs)
library(tidyverse)

# dataframe that holds usernames, passwords and other user data
user_base <- data.frame(
  user = c("user1", "user2"),
  password = c("pass1", "pass2"), 
  permissions = c("admin", "standard"),
  name = c("user_one", "user_two"),
  stringsAsFactors = FALSE,
  row.names = NULL
)

#This will be a pool-object in the real app. For now df with two columns of which I want to choose one depending on username
{
user1 <- 1:5
user2 <- 6:10
df <- data.frame(user1,user2)
}

ui <- fluidPage(
  # must turn shinyjs on
  shinyjs::useShinyjs(),
  # add logout button UI 
  div(class = "pull-right", logoutUI(id = "logout")),
  # add login panel UI function
  loginUI(id = "login"),
  # setup table output to show user info after login
  tableOutput("user_table")
)

server <- function(input, output, session) {
  
  # call the logout module with reactive trigger to hide/show
  logout_init <- callModule(shinyauthr::logout, 
                            id = "logout", 
                            active = reactive(credentials()$user_auth))
  
  # call login module supplying data frame, user and password cols
  # and reactive trigger
  credentials <- callModule(shinyauthr::login, 
                            id = "login", 
                            data = user_base,
                            user_col = user,
                            pwd_col = password,
                            log_out = reactive(logout_init()))
  
  #Here I want to store a vector containing the username from credentials
  user_data <-
  

  output$user_table <- renderTable({
    req(credentials()$user_auth)
    df %>%   select(user_data) #Here I want to choose the column matching the username from credentials
    })
}

shinyApp(ui = ui, server = server)

Answer 1

The information you're looking for is stored in credentials()$info$user. I've used this to create the reactive user_data, but you could also use it directly.

library(shinyauthr)
library(shinyjs)
library(tidyverse)
library(shiny)

# dataframe that holds usernames, passwords and other user data
user_base <- data.frame(
  user = c("user1", "user2"),
  password = c("pass1", "pass2"), 
  permissions = c("admin", "standard"),
  name = c("user_one", "user_two"),
  stringsAsFactors = FALSE,
  row.names = NULL
)

#This will be a pool-object in the real app. For now df with two columns of which I want to choose one depending on username
# {
  user1 <- 1:5
  user2 <- 6:10
  df <- data.frame(user1,user2)
# }

ui <- fluidPage(
  # must turn shinyjs on
  shinyjs::useShinyjs(),
  # add logout button UI 
  div(class = "pull-right", logoutUI(id = "logout")),
  # add login panel UI function
  loginUI(id = "login"),
  # setup table output to show user info after login
  tableOutput("user_table")
)

server <- function(input, output, session) {
  
  # call the logout module with reactive trigger to hide/show
  logout_init <- callModule(shinyauthr::logout, 
                            id = "logout", 
                            active = reactive(credentials()$user_auth))
  
  # call login module supplying data frame, user and password cols
  # and reactive trigger
  credentials <- callModule(shinyauthr::login, 
                            id = "login", 
                            data = user_base,
                            user_col = user,
                            pwd_col = password,
                            log_out = reactive(logout_init()))
  
  #Here I want to store a vector containing the username from credentials
  user_data <- reactive({
    credentials()$info$user
  })
    
    
    output$user_table <- renderTable({
      req(credentials()$user_auth)
      df %>%   select(user_data()) #Here I want to choose the column matching the username from credentials
    })
}

shinyApp(ui = ui, server = server)