R/shiny-modifyurl.R

In googleAuthR: Authenticate and Create Google APIs

# 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
  
}