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)
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)