Skip to content

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.

Copy link

commented Feb 18, 2018

it's not worked for me

@blakiseskream

This comment has been minimized.

Copy link

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.

Copy link

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.

Copy link

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
You can’t perform that action at this time.