在shinyauthr中获取用户名选择命名对象

Obtaining user name in shinyauthr to choose named object

我正在开发一个 shinyapp,它通过池包中的池从数据库中获取数据。我正在通过 shinyauthr 在登录页面上工作,其中用户名对应于池中 table 的名称(所有用户将只被允许获取与其用户名对应的数据)。

我一直无法理解我是如何在 shinyauthr 中获取用户名的。我看过 https://github.com/paulc91/shinyauthr and ,但我仍在努力了解如何继续。

为了举例说明,我创建了一个类似的情况,我没有在池中选择 table,而是在 df 中选择一列。在第 50 行,我希望 user_data 存储来自 credentials 的用户名,以便在第 55 行过滤 df。我尝试了几个反应参数,其中 none 有效.

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)

您要查找的信息存储在credentials()$info$user中。我用它来创建反应式 user_data,但您也可以直接使用它。

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)