# need globals to make ui available to Rook requests on Shiny launch
.gar_shiny_env <- new.env(parent = emptyenv())
#' Make a Google Authorisation URL for Shiny
#'
#' Set this within your login_ui where you need the Google login.
#'
#' @param req a Rook request, do not set as this will be used by Shiny to generate URL
#' @param state URL state
#' @param client.id client.id
#' @param client.secret client.secret
#' @param scope API scopes
#' @param access_type whether to keep the token
#' @param prompt Auto-login if user is recognised or always force signin
#'
#' @export
#' @family pre-load shiny authentication
gar_shiny_auth_url <- function(req,
state = getOption("googleAuthR.securitycode"),
client.id = getOption("googleAuthR.webapp.client_id"),
client.secret = getOption("googleAuthR.webapp.client_secret"),
scope = getOption("googleAuthR.scopes.selected"),
access_type = c("online","offline"),
prompt = c("consent", "select_account", "both", "none")) {
access_type <- match.arg(access_type)
prompt <- match.arg(prompt)
url_redirect <- workout_redirect(req)
gar_shiny_getAuthUrl(url_redirect,
state = state,
client.id = client.id,
client.secret = client.secret,
scope = scope,
access_type = access_type,
prompt = prompt)
}
workout_redirect <- function(req){
if(getOption("googleAuthR.redirect") != ""){
return(getOption("googleAuthR.redirect"))
}
if(Sys.getenv("R_CONFIG_ACTIVE") == "shinyapps"){
return(getOption("googleAuthR.redirect", "googleAuthR.redirect_option_not_configured"))
}
if(req$SERVER_NAME == "127.0.0.1"){
host <- "localhost"
} else {
host <- req$SERVER_NAME
}
url_redirect <- paste0(req$rook.url_scheme,"://",host,":",req$SERVER_PORT)
if(req$PATH_INFO != "/"){
url_redirect <- paste0(url_redirect, req$PATH_INFO)
}
url_redirect
}
#' Create a Google login before your Shiny UI launches
#'
#' A function that will turn your ui object into one that will look for Google
#' authentication before loading the main app. Use together with \link{gar_shiny_auth}
#'
#' @param ui A Shiny ui object
#' @param login_ui A UI or HTML template that is seen before the main app and contains a login in link generated by \link{gar_shiny_auth_url}
#'
#' @details
#'
#' Put this at the bottom of your ui.R or pass into \link[shiny]{shinyApp} wrapping your created ui.
#'
#' @export
#'
#' @author Based on \href{https://gist.github.com/jcheng5/44bd750764713b5a1df7d9daf5538aea}{this gist} by Joe Cheng, RStudio
#'
#' @examples
#'
#' \dontrun{
#' library(shiny)
#' library(googleAuthR)
#' gar_set_client()
#'
#' fileSearch <- function(query) {
#' googleAuthR::gar_api_generator("https://www.googleapis.com/drive/v3/files/",
#' "GET",
#' pars_args=list(q=query),
#' data_parse_function = function(x) x$files)()
#' }
#'
#' ## ui.R
#' ui <- fluidPage(title = "googleAuthR Shiny Demo",
#' textInput("query",
#' label = "Google Drive query",
#' value = "mimeType != 'application/vnd.google-apps.folder'"),
#' tableOutput("gdrive")
#' )
#'
#' ## server.R
#' server <- function(input, output, session){
#'
#' # this is not reactive, no need as you only reach here authenticated
#' gar_shiny_auth(session)
#'
#' output$gdrive <- renderTable({
#' req(input$query)
#'
#' # no need for with_shiny()
#' fileSearch(input$query)
#'
#' })
#' }
#'
#' # gar_shiny_ui() needs to wrap the ui you have created above.
#' shinyApp(gar_shiny_ui(ui), server)
#' }
#' @family pre-load shiny authentication
gar_shiny_ui <- function(ui, login_ui = silent_auth){
check_package_loaded("shiny")
# make the ui available globally
assertthat::assert_that(is.list(ui),
is.function(login_ui))
.gar_shiny_env$ui <- ui
.gar_shiny_env$login_ui <- login_ui
# output the function
make_googleAuth_ui
}
#' Silent auth
#'
#' The default for logging in via \link{gar_shiny_ui}, this creates no login page and just takes you straight to authentication on Shiny app load.
#'
#' @param req What Shiny uses to check the URL parameters
#'
#'
#' @export
#' @family pre-load shiny authentication
silent_auth <- function(req){
shiny::tags$script(shiny::HTML(
sprintf("location.replace(\"%s\");", gar_shiny_auth_url(req)
)))
}
#' A login page for Shiny
#'
#' An alternative to the immediate login provided by default by \link{gar_shiny_ui}
#'
#' @param req Passed to \link{gar_shiny_auth_url} to generate login URL
#' @param title The title of the page
#'
#' @details Use \link{gar_shiny_auth_url} to create the login URL. You must leave the first argument free as this is used to generate the login, but you can pass other arguments to customise your UI.
#'
#' @export
#' @family pre-load shiny authentication
gar_shiny_login_ui <- function(req, title = "googleAuthR Login Demo"){
check_package_loaded("shiny")
shiny::addResourcePath("img", system.file("img", package = "googleAuthR"))
shiny::addResourcePath("css", system.file("css", package = "googleAuthR"))
shiny::fillPage(
padding = 50,
title = title,
shiny::tags$head(
shiny::tags$link(rel="stylesheet", href="css/button.css")
),
shiny::a(href = gar_shiny_auth_url(req),
shiny::tags$button(class = "loginBtn loginBtn--google",
"Login with Google"
)
)
)
}
make_googleAuth_ui <- function(req){
if(is.null(has_auth_code(shiny::parseQueryString(req$QUERY_STRING)))){
return(.gar_shiny_env$login_ui(req))
} else {
.gar_shiny_env$ui
}
}
#' Create Authentication within Shiny's server.R
#'
#' If using \link{gar_shiny_ui}, put this at the top of your server.R function
#'
#' @param session Shiny session argument
#'
#' @description
#'
#' This can be used at the top of the server function for authentication when you have used
#' \link{gar_shiny_ui} to create a login page for your ui function.
#'
#' In some platforms the URL you are authenticating from will not match the Docker container the script is running in (e.g. shinyapps.io or a kubernetes cluster) - in that case you can manually set it via `options(googleAuthR.redirect = http://your-shiny-url`). In other circumstances the Shiny app should be able to detect this itself.
#'
#' @export
#'
#' @author Based on a gist by Joe Cheng, RStudio
#'
#' @examples
#'
#' \dontrun{
#' library(shiny)
#' library(googleAuthR)
#' gar_set_client()
#'
#' fileSearch <- function(query) {
#' googleAuthR::gar_api_generator("https://www.googleapis.com/drive/v3/files/",
#' "GET",
#' pars_args=list(q=query),
#' data_parse_function = function(x) x$files)()
#' }
#'
#' ## ui.R
#' ui <- fluidPage(title = "googleAuthR Shiny Demo",
#' textInput("query",
#' label = "Google Drive query",
#' value = "mimeType != 'application/vnd.google-apps.folder'"),
#' tableOutput("gdrive")
#' )
#'
#' ## server.R
#' server <- function(input, output, session){
#'
#' # this is not reactive, no need as you only reach here authenticated
#' gar_shiny_auth(session)
#'
#' output$gdrive <- renderTable({
#' req(input$query)
#'
#' # no need for with_shiny()
#' fileSearch(input$query)
#'
#' })
#' }
#'
#' # gar_shiny_ui() needs to wrap the ui you have created above.
#' shinyApp(gar_shiny_ui(ui), server)
#' }
#' @family pre-load shiny authentication
gar_shiny_auth <- function(session){
check_package_loaded("shiny")
params <- shiny::parseQueryString(shiny::isolate(session$clientData$url_search))
if(is.null(has_auth_code(params))) {
return()
}
url_redirect <- gar_shiny_getUrl(session)
token <- gar_shiny_getToken(params$code,
redirect.uri = url_redirect)
gar_auth(token)
}
has_auth_code <- function(pars, securityCode=getOption("googleAuthR.securitycode")){
if(!is.null(pars$state)){
if(pars$state != securityCode){
warning("securityCode check failed in Authentication! Code:",
pars$state,
" Expected:",
securityCode)
return(NULL)
}
}
# NULL if it isn't there
pars$code
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.