Instantly share code, notes, and snippets.

Embed
What would you like to do?
Sketch of shiny + oauth
library(shiny)
library(httr)
# OAuth setup --------------------------------------------------------
# Most OAuth applications require that you redirect to a fixed and known
# set of URLs. Many only allow you to redirect to a single URL: if this
# is the case for, you'll need to create an app for testing with a localhost
# url, and an app for your deployed app.
if (interactive()) {
# testing url
options(shiny.port = 8100)
APP_URL <- "http://localhost:8100/"
} else {
# deployed URL
APP_URL <- "https://servername/path-to-app"
}
# Note that secret is not really secret, and it's fine to include inline
app <- oauth_app("shinygithub",
key = "51d46f96810d1fd182a2",
secret = "66eec8782825eeb61007dbef32f91afc9c3587aa",
redirect_uri = APP_URL
)
# Here I'm using a canned endpoint, but you can create with oauth_endpoint()
api <- oauth_endpoints("github")
# Always request the minimal scope needed. For github, an empty scope
# gives read-only access to public info
scope <- ""
# Shiny -------------------------------------------------------------------
has_auth_code <- function(params) {
# params is a list object containing the parsed URL parameters. Return TRUE if
# based on these parameters, it looks like auth codes are present that we can
# use to get an access token. If not, it means we need to go through the OAuth
# flow.
return(!is.null(params$code))
}
ui <- fluidPage(
# Your regular UI goes here, for when everything is properly auth'd
verbatimTextOutput("code")
)
# A little-known feature of Shiny is that the UI can be a function, not just
# objects. You can use this to dynamically render the UI based on the request.
# We're going to pass this uiFunc, not ui, to shinyApp(). If you're using
# ui.R/server.R style files, that's fine too--just make this function the last
# expression in your ui.R file.
uiFunc <- function(req) {
if (!has_auth_code(parseQueryString(req$QUERY_STRING))) {
url <- oauth2.0_authorize_url(api, app, scope = scope)
redirect <- sprintf("location.replace(\"%s\");", url)
tags$script(HTML(redirect))
} else {
ui
}
}
server <- function(input, output, session) {
params <- parseQueryString(isolate(session$clientData$url_search))
if (!has_auth_code(params)) {
return()
}
# Manually create a token
token <- oauth2.0_token(
app = app,
endpoint = api,
credentials = oauth2.0_access_token(api, app, params$code),
cache = FALSE
)
resp <- GET("https://api.github.com/user", config(token = token))
# TODO: check for success/failure here
output$code <- renderText(content(resp, "text"))
}
# Note that we're using uiFunc, not ui!
shinyApp(uiFunc, server)
@sourourarbi

This comment has been minimized.

sourourarbi commented Feb 18, 2018

it's not worked for me

@blakiseskream

This comment has been minimized.

blakiseskream commented Mar 23, 2018

@hadley this worked fantastic thank you, launched a prototype on heroku here- https://oauth-shiny.herokuapp.com

I made a modification where the token is saved to the environment, but a stop_for_status(resp) before launching UI in order to avoid running any of the server function.

Is there a reason why you would want the # TODO: check for success/failure here in the server vs the uiFunc (see below)?

uiFunc <- function(req) {
  if (!has_auth_code(parseQueryString(req$QUERY_STRING))) {
    url <- oauth2.0_authorize_url(api, app, scope = scope)
    redirect <- sprintf("location.replace(\"%s\");", url)
    tags$script(HTML(redirect))
  } else {
     # Manually create a token
     token <<- oauth2.0_token(
         app = app,
         endpoint = api,
         credentials = oauth2.0_access_token(api, app, parseQueryString(req$QUERY_STRING)$code),
         cache = FALSE
       )
     # validate before launching UI
     resp <- GET("https://api.github.com/user", config(token = token))
     stop_for_status(resp)
     ui
  }
}

to avoid resetting the token you then refer to it directly in the server,

server <- function(input, output, session) {
  params <- parseQueryString(isolate(session$clientData$url_search))
  if (!has_auth_code(params)) {
    return()
  }
  
  # Use the token created above
  resp <- GET("https://api.github.com/user", config(token = token))
  output$code <- renderText(content(resp, "text"))
}

btw, thank you as always for being an amazing resource

@ashbaldry

This comment has been minimized.

ashbaldry commented May 31, 2018

This has worked for me and have managed to get it working using a different type of authentication, thanks very much for that!

My one problem is that the return URL I get doesn't involve a query but instead a hash and am struggling to find the # equivalent of req$QUERY_STRING. This is the first time I have seen the UI used as a function so struggling to find the location I need.

@vincentliu98

This comment has been minimized.

vincentliu98 commented Jul 28, 2018

@ashbadry I am in the same situation as you are. The token that I want to retrieve is from an url starting with a pound sign. I have tried many ways but they all didn't work.

These are couple problems I have:

  1. I am unable to retrieve the url with # sign from global environment
  2. I tried to move the authentication page in the beginning part of the server, the authentication page won't appear.

I don't understand how req$QUERY_STRING works, and there is no such thing as req$URL_HASH. Is there any solution to solve this problem?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment