Using OAuth2 with Shiny

app.R

library(shiny)

# WARNING: This sketch does not make proper use of the "state" parameter.
# Doing so usually involves using cookies, which can be done with the
# Rook package but I have not done that here. If you choose to use this
# approach in production, please check the state parameter properly!

APP_URL <- if (interactive()) {
  # This might be useful for local development. If not, just hardcode APP_URL
  # to the deployed URL that you'll provide a few lines below.
  options(shiny.port = 8100)
  "http://localhost:8100/"
} else {
  # TODO: Provide the URL that will be used when deployed. This is the URL from
  # the browser's/end-user's perspective.
  "https://servername/path-to-app"
}

# TODO: Provide an actual client_id, client_secret, and scope here
client_id <- "a_real_client_id"
client_secret <- "a_real_client_secret"
scope <- "photos"

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

make_authorization_url <- function(req) {
  # TODO: Implement for real
  # 
  # The req object is a Rook request. This is just an environment object that 
  # gives you access to the request URL, HTTP headers, etc. The documentation 
  # for this object is here:
  # https://github.com/jeffreyhorner/Rook#the-environment
  #
  # Implement this function by returning the URL that we should redirect the
  # user to in order to 
  url_template <- "https://oauth2server.com/auth?client_id=%s&scope=&redirect_uri=%s&response_type=code&state=%s&scope=%s"
  redirect_uri <- APP_URL
  state <- "something"
  sprintf(url_template,
    utils::URLencode(client_id, reserved = TRUE, repeated = TRUE),
    utils::URLencode(redirect_uri, reserved = TRUE, repeated = TRUE),
    utils::URLencode(state, reserved = TRUE, repeated = TRUE),
    utils::URLencode(scope, reserved = TRUE, repeated = TRUE)
  )
}

ui <- fluidPage(
  # Your regular UI goes here, for when everything is properly auth'd
  textOutput("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))) {
    authorization_url <- make_authorization_url(req)
    # This is silently redirecting the user to oauth. If you prefer, this could
    # be a pretty login page with a button-link.
    return(tags$script(HTML(sprintf("location.replace(\"%s\");", authorization_url))))
  } else {
    ui
  }
}

server <- function(input, output, session) {
  params <- parseQueryString(isolate(session$clientData$url_search))
  if (!has_auth_code(params)) {
    return()
  }
  
  code <- params$code
  state <- params$state
  session_state <- params$session_state
  # etc.
  
  # TODO: Get the access token or whatever. If you do this synchronously here 
  # then you never have to consider the case of the access token not being
  # available.
  
  #access_token <- httr::something(...)
  resp <- httr::POST("https://api.oauth2server.com/token",
    body = list(
      client_id = client_id,
      scope = scope,
      code = code,
      redirect_uri = APP_URL,
      grant_type = "authorization_code"
      client_secret = client_secret
    ))
  respObj <- jsonlite::fromJSON(rawToChar(resp$content))
  str(respObj)

  output$code <- renderText({
    paste("The code is", code)
  })
}

# Note that we're using uiFunc, not ui!
shinyApp(uiFunc, server)