Sketch of shiny + oauth

shiny-oauth.r

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)

Thanks for the great source of inspiration.
I forked and made some modifications to handle both simple user/password authentication (admin / azerty) and github SSO
https://gist.github.com/phileas-condemine/4c57ce92e044adb5d9ce6ea155b02e24
@hadley, still I don't quite understand the uiFunc magic, is there a doc that explains this feature (other that bookmarking) ?
Also this tags$script(HTML(redirect)) seems very powerful but also a bit dangerous as it resets reactiveVal and other objects defined in the server function definition, right ?

I am using ui.R and server. R files for the ShinyApp. But i don't get the "Session" object in the server file once the app gets redirected.
May i know, what is the problem in uiFunc()?

First, thank you very much for this. I have been successfully using this for some time.

For someone with the same problems, this works nicely if it shiny app is run "Externa" (in RStudio). However, if it is run in Viewer Pane, the code does not work as expected, as instead of opening just one page/tab with authentication page, new authentication pages keep poping up until I kill the R process.

@aleszib I have the same issue as you, I use the code for Azure authentication, the new authentication pages keep on popping up. How did you manage to solve the problem? Thanks.

@aleszib
This happens when you run the code locally. To solve this (locally), see the issue here. On the server the solution works fine.

Azure/AzureAuth#83 (comment)

@aleszib I have the same issue as you, I use the code for Azure authentication, the new authentication pages keep on popping up. How did you manage to solve the problem? Thanks.

@liqi6811 I soled the problem by simply running the app in the web browser, not in a pane of the Rstudio.