Files
AVSDevR.UserFrosting/R/ufWrapApplication.R

132 lines
3.8 KiB
R

#' Wraps an application with UserFrosting user & session authentication
#' @param app The application to wrap
#' @param ufURI The UserFrosting API instance
#' @param with_users Wether to enable user authentication
#' @param user_optional Inidicates wether authenticated users are optional. If
#' FALSE then any un-authenticated user can still access the application
#' @param app_name The name of the application (used in the UFApi calls)
#' @export
ufWrapApplication <- function(
app, ufURI, with_users = TRUE, user_optional = FALSE, app_name = NULL
) {
inner_server <- app$serverFuncSource()
wrapped_server <- function(input, output, session, ...) {
##### User Frosting integration
ufApi <- UFApi$new(ufURI, app_name)
ufApi$setShinySession(session)
printMarkerBegin <- function() {
# nolint start: line_length_linter
cat("#####UF-SVR-BEGIN###############################################################\n")
# nolint end
}
printMarkerEnd <- function() {
# nolint start: line_length_linter
cat("#####UF-SVR-END#################################################################\n\n")
# nolint end
}
isSessionRequired <- function() {
return(!(length(with_users) > 0 && !with_users))
}
isSessionValid <- function() {
return(ufApi$verifyUFSession(shiny::getQueryString(session)))
}
isSessionOptional <- function() {
return(length(user_optional) > 0 && user_optional)
}
handleNoSessionRequired <- function() {
printMarkerBegin()
cat("Starting server - No UF session required\n")
cat("Session started for non-UF user:", ufApi$getClientIp(), "\n")
printMarkerEnd()
inner_server(
input, output, session, ufApi = ufApi, ufUser = NULL, ...
)
}
handleSessionVerified <- function() {
printMarkerBegin()
cat("Starting server - UF user verified\n")
session$onSessionEnded(ufApi$onSessionEnd)
ufUser <- ufApi$fetchUser()
session$userData$user_id <- ufUser$id
cat("Session started for user:", ufUser$id, "\n")
printMarkerEnd()
inner_server(
input, output, session, ufApi = ufApi, ufUser = ufUser, ...
)
}
handleSessionOptional <- function() {
printMarkerBegin()
cat("Starting server - UF user optional\n")
session$onSessionEnded(ufApi$onSessionEnd)
cat("Session started for non-UF user:", ufApi$getClientIp(), "\n")
printMarkerEnd()
inner_server(
input, output, session, ufApi = ufApi, ufUser = NULL, ...
)
}
handleSessionInvalid <- function() {
printMarkerBegin()
cat("Not starting server - UF user invalid\n")
windowTarget <- paste0(
session$clientData$url_protocol, "//", session$clientData$url_hostname
)
if (nchar(session$clientData$url_port) > 0
&& !(session$clientData$url_port %in% c("80", "443"))
) {
windowTarget <- paste0(windowTarget, ":", session$clientData$url_port)
}
if (requireNamespace("shinyjs")) {
if (requireNamespace("AVSDevR.ShinyDisconnectHandler")) {
shinyjs::runjs(paste0("bannerDisconnectHandler.disableOverlay();"))
}
shinyjs::runjs(paste0(
"window.parent.postMessage('reload', '", windowTarget, "');"
))
}
cat("Stopping server with 401...\n")
printMarkerEnd()
stop(401)
}
##### UF <--> R User
runOnce <- shiny::observe({
if (!isSessionRequired()) {
handleNoSessionRequired()
} else if (isSessionValid()) {
handleSessionVerified()
} else if (isSessionOptional()) {
handleSessionOptional()
} else {
handleSessionInvalid()
}
runOnce$destroy()
})
}
app$serverFuncSource <- function() {
wrapped_server
}
return(app)
}