r-lib
Figure out shiny integration
https://github.com/r-lib/gargle/pull/157
- Need to ensure that expiry is a parameter of the setup; the current default sets the lifetime to null, which means that the cookies will be expired on next log in.
- Cookies are encrypted so that they can't be read by browser; need to double check encryption if there's no client secret. Might be adequate to encrypt with common httr2 key?
- Double check that cookies are scoped to given path so they only apply for one app.
- PR to shiny to provide https://github.com/r-lib/gargle/pull/157/files#diff-169b8f234d0b208affb106fce375f86fefe2f16dba4ad66495a1dc06c8a4cd7bR145-R185
Code in PR currently uses OAuth as gate to access app; might also want to use it as optional feature (i.e. log in to save this file to your google drive), so will also need to work out that flow.
Some more notes
Optional auth:
- User clicks button, and is redirected to
oauth_flow_auth_code_url()- OAuth "state" stored in cookie
- Set
redirect_urito{my_url}/login
- After logging in to resource server, redirected to
/loginwith code in query string- If error, need to display to user somehow
- Then compare state in query to state in cookie
- Retrive token, encrypt, and store in cookie
- Redirect back to app
- Need to update UI and store token in reactive?
# What needs to go outside?
# * registering login and logout endpoints
# * capturing token into userData?
library(shiny)
# Not reactive because it can't change within a session; cookies have to
# change which requires a new connection
token <- oauth_session_token()
# Shortcut for getDefaultReactiveDomain()$userData$httr2_token
# with appropriate error handling
# Could parse from ...$request$COOKIE_HEADER but that's not available on shinyapps
# Dynamic UI - in principle could also do this from ui() function since
# cookie header will indicate whether or not its available
input$tweet <- renderUI({
if (is.null(token())) {
actionButton("login", "Log in with twitter to tweet about this")
} else {
activeButton("save", "Send tweet")
}
})
observeEvent(input$save, {
# How does re-auth work? Don't want to redirect user away if that loses state
# Would it be better to do via js in a child window?
request() %>% req_oauth_shiny_auth_code()
# could call oauth_session_token() or could make that explicit
})
observeEvent(input$login, {
# how to redirect?
})
- How does a package developer facilitate auth either via command line or via shiny? Add flag to request object?
token_from_cookies <- function(req) {
cookies <- parse_cookies(req[["HTTP_COOKIE"]])
secret_unserialize(cookies$token, obfuscate_key())
}
response_login <- function(redirect, state, cookie_opts) {
headers <- list(
"Cache-Control" = "no-store",
`Set-Cookie` = cookie_set("httr2_state", state, cookie_opts),
)
response_redirect(redirect, headers)
}
response_oauth_callback <- function(redirect_url, token, cookie_opts) {
token <- secret_serialize(token, obfuscate_key())
headers <- list(
"Cache-Control" = "no-store",
`Set-Cookie` = cookie_del("httr2_state", cookie_opts),
`Set-Cookie` = cookie_set("httr2_token", token, cookie_opts),
)
# But maybe this doesn't work - because it adds an extra redirect
response_redirect("./", headers)
}
response_logout <- function(cookie_opts) {
headers <- list2(
`Cache-Control` = "no-store",
`Set-Cookie` = cookie_del("httr2_token", cookie_opts),
)
response_redirect("./", header)
}
response_redirect <- function(url, headers) {
shiny::httpResponse(
status = 307L,
content_type = NULL,
headers = c(list(Location = url), headers)
)
}
I recently had to implement something similar to your second scenario (not using OAuth as gate to access app, but to retrieve an access token to fetch data inside app, e.g. from Github). I don't know if it's helpful, but I'm leaving my notes here.
I opted to not go for the uifunc-approach (passing ui as a function as shown in the gargle PR), but instead doing everything from the server side using cookies, which had some gotchas:
-
Localhost Redirect URI and cookies: Shiny needs to run at a valid IP4 or IP6-address, which means you can't actually pass
host = 'localhost'. I naively assumed 127.0.0.1 and localhost were equivalent, but the browser treats them as different domains. So if your redirect URI is set as localhost, a cookie set at 127.0.0.1 would not be available after redirection to localhost. The solution is to set redirect URI to 127.0.0.1, and never use localhost. This took me hours. -
Setting session cookies: I could not find a good way to set this from the server side at first (see #3524). I figured I could do this by "abusing" the
session$registerDataObjwhich can pass ashiny::httpResponse, but I could not find a way to actually trigger this until I discovered the trick of just passing the endpoint to InsertUI. Works great, but feels a bit hacky. After the redirect, the cookies are available insession$request$HTTP_COOKIE -
Redirecting from server side: I tried to use the same method as for cookies (
session$registerDataObj) and passing status 307 and location toshiny::httpResponsesimilarly to the gargle PR . This kept giving CORS-errors which I believe is due to the XHR having rich headers which I was unable to remove. In the end, I went for a custom message usingShiny.addCustomMessageHandler...andwindow.locationwhich seems to be the recommended way to go, but I would have preferred usinghttpResponse. Maybe @jcheng5 could comment. -
Splitting up the oauth flow: Compared to the family of
req_oauth_*functions, this approach requires the logic to be splitted into two parts. I am sure better abstractions could be found here, and I'm still trying to find the best approach for tying it together, anyways:- Trigger flow using
observeEvent(input$login_btn), set cookies and redirect - Catch redirect using
observeEvent(session$clientData$url_search), retrieve cookie, verify state and PKCE and fetch token
- Trigger flow using
-
Requires launch.browser=TRUE: Due to the redirect.
Here is a minimal app where I'm just verifying state. This was easy to extend to PKCE by just adding an encrypted PKCE_COOKIE and verifying the same way.
app.R
library(shiny)
library(httr2)
source("utils.R")
client <- oauth_client(
id = "",
secret = "",
token_url = "https://github.com/login/oauth/access_token",
name = "OAuth Test APP"
)
authorize_url <- "https://github.com/login/oauth/authorize"
redirect_uri <- "http://127.0.0.1:1410"
ui <- fluidPage(
tags$script('Shiny.addCustomMessageHandler("redirect", function(msg) {
window.location.href = (msg);
});'),
titlePanel("OAuth2 Github"),
mainPanel(
h4("Log in:"),
actionButton("login", "Login"),
h4("Access token"),
verbatimTextOutput("token", placeholder = TRUE)
)
)
server <- function(input, output, session) {
access_token <- reactiveVal()
observeEvent(input$login, {
oauth_state <- httr2:::base64_url_rand()
set_cookie(session, "oauth_state", oauth_state)
auth_url <- oauth_flow_auth_code_url(
client = client,
auth_url = authorize_url,
redirect_uri = redirect_uri,
state = oauth_state)
session$sendCustomMessage("redirect", auth_url)
})
observeEvent(session$clientData$url_search, {
query <- parseQueryString(session$clientData$url_search)
if (!is.null(query$code) && !is.null(query$state)) {
state <- get_cookie(session, "oauth_state")
code <- httr2:::oauth_flow_auth_code_parse(query, state)
token <- httr2:::oauth_client_get_token(
client = client,
grant_type = "authorization_code",
code = query$code,
state = query$state)
updateQueryString("/", mode = "replace", session = session)
access_token(token)
}
})
output$token <- renderText({
req(access_token())
paste0(substring(access_token()$access_token, 1, 5), "***************")
})
}
shinyApp(ui, server = server, options = list(port = 1410, launch.browser = TRUE))
I used some wrappers for the cookie handling, in addition to the cookie functions in the gargle PR
utils.R
get_cookie <- function(session, name) {
parse_cookies(session$request)[[name]]
}
set_cookie <- function(session, name, value){
manage_cookie(session, "set", name, value)
}
del_cookie <- function(session, name){
manage_cookie(session, "del", name)
}
manage_cookie <- function(session, type = c("set", "del"), name, value) {
cookie_opts <- list(path = "/", same_site = "None", secure = TRUE)
if(type == "set") {
hdr <- set_cookie_header(name, value, cookie_opts)
} else {
hdr <- delete_cookie_header(name, cookie_opts)
}
script_url <- session$registerDataObj(
name = paste("type", "cookie", httr2:::base64_url_rand(), sep = "_"),
data = httpResponse(headers = hdr),
filterFunc = function(data, req) {data}
)
# Trigger cookie
# Adopted from: https://github.com/andyquinterom/keycloakAuthR/blob/be24d05c39ed2eb18e6c3fc7d4f1ca14421ad4a5/R/shiny.R#L149
insertUI(
"body",
where = "afterBegin",
ui = tagList(tags$script(src = script_url)),
immediate = TRUE,
session = session
)
}
# Remaining functions are from Gargle PR
# https://github.com/r-lib/gargle/blob/bd35392da45b271e5199ccbe28fb766135712461/R/shiny-cookies.R
parse_cookies <- function(req) {
cookie_header <- req[["HTTP_COOKIE"]]
if (is.null(cookie_header)) {
return(NULL)
}
cookies <- strsplit(cookie_header, "; *")[[1]]
m <- regexec("(.*?)=(.*)", cookies)
matches <- regmatches(cookies, m)
names <- vapply(matches, function(x) {
if (length(x) == 3) {
x[[2]]
} else {
""
}
}, character(1))
if (any(names == "")) {
# Malformed cookie
return(NULL)
}
values <- vapply(matches, function(x) {
x[[3]]
}, character(1))
stats::setNames(as.list(values), names)
}
cookie_options <- function(max_age = NULL, domain = NULL, path = NULL,
secure = NULL, http_only = TRUE, same_site = NULL, expires = NULL) {
if (!is.null(expires)) {
stopifnot(length(expires) == 1 && (inherits(expires, "POSIXt") || is.character(expires)))
if (inherits(expires, "POSIXt")) {
expires <- as.POSIXlt(expires, tz = "GMT")
expires <- sprintf("%s, %02d %s %04d %02d:%02d:%02.0f GMT",
c("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")[[expires$wday + 1]],
expires$mday,
c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")[[expires$mon + 1]],
expires$year + 1900,
expires$hour,
expires$min,
expires$sec
)
}
}
stopifnot(is.null(max_age) || (is.numeric(max_age) && length(max_age) == 1))
if (!is.null(max_age)) {
max_age <- sprintf("%.0f", max_age)
}
stopifnot(is.null(domain) || (is.character(domain) && length(domain) == 1))
stopifnot(is.null(path) || (is.character(path) && length(path) == 1))
stopifnot(is.null(secure) || isTRUE(secure) || isFALSE(secure))
if (isFALSE(secure)) {
secure <- NULL
}
stopifnot(is.null(http_only) || isTRUE(http_only) || isFALSE(http_only))
if (isFALSE(http_only)) {
http_only <- NULL
}
stopifnot(is.null(same_site) || (is.character(same_site) && length(same_site) == 1 &&
grepl("^(strict|lax|none)$", same_site, ignore.case = TRUE)))
# Normalize case
if (!is.null(same_site)) {
same_site <- c(strict = "Strict", lax = "Lax", none = "None")[[tolower(same_site)]]
}
list(
"Expires" = expires,
"Max-Age" = max_age,
"Domain" = domain,
"Path" = path,
"Secure" = secure,
"HttpOnly" = http_only,
"SameSite" = same_site
)
}
set_cookie_header <- function(name, value, cookie_options = cookie_options()) {
stopifnot(is.character(name) && length(name) == 1)
stopifnot(is.null(value) || (is.character(value) && length(value) == 1))
value <- value %||% ""
parts <- rlang::list2(
!!name := value,
!!!cookie_options
)
parts <- parts[!vapply(parts, is.null, logical(1))]
names <- names(parts)
sep <- ifelse(vapply(parts, isTRUE, logical(1)), "", "=")
values <- ifelse(vapply(parts, isTRUE, logical(1)), "", as.character(parts))
header <- paste(collapse = "; ", paste0(names, sep, values))
list("Set-Cookie" = header)
}
# Returns a list, suitable for `!!!`-ing into a list of HTTP headers
delete_cookie_header <- function(name, cookie_options = cookie_options()) {
cookie_options[["Expires"]] <- NULL
cookie_options[["Max-Age"]] <- 0
set_cookie_header(name, "", cookie_options)
}
Thanks for httr2! It's an awesome package and you can tell a lot of thought has gone into making great APIs for users 👍
Thanks a lot @thohan88 for the minimal example you shared, it is super helpful and provides a practical approach to tackle this issue. My question is regarding the scenario with PKCE, say I used the httr2::oauth_flow_auth_code_pkce() function to generate code verifier, method, and challenge PKCE components, then I used cookies (e.g., PKCE_COOKIE) to save/retrieve them. How should we alter the get token function call to work in this scenario? I tried the following with no success :-(
token <- httr2:::oauth_client_get_token(client = client,
grant_type = "authorization_code",
code = query$code,
state = query$state,
code_verifier = pkce$verifier)
It is not clear to me what other token_params I have to pass in this function parameters. I believe both code_challenge and code_challenge_method PKCE components are belongs to the auth_params list, not token_params (httr2/R/oauth-flow-auth-code.R source code). I will highly appreciate it if you can help me find what I miss in this puzzle :-)
NOTE: When I set the
grant_type = "authorization_code_with_pkce", I get an OAuth failure [unsupported_grant_type]
Your intuition is right, I will see if I can come up with a better structure now that I have gotten my head around it.
Meanwhile, I think this should work:
Before redirect
- Set a key for encrypting the verifier for PKCE that does not vary by session (e.g. don't use
secret_make_key()):
Sys.setenv("MY_KEY" = "VERY_SECRET_KEY")
- Set a cookie for the encrypted pkce_verifier at the same place you set the state cookie, e.g:
oauth_state <- httr2:::base64_url_rand()
+pkce <- oauth_flow_auth_code_pkce()
set_cookie(session, "oauth_state", oauth_state)
+set_cookie(session, "pkce_verifier", secret_encrypt(pkce$verifier, "MY_KEY"))
- Now, modify the auth_url to include PKCE challenge and method:
auth_url <- oauth_flow_auth_code_url(
client = client,
auth_url = authorize_url,
redirect_uri = redirect_uri,
state = oauth_state,
auth_params = list(
scope = scopes,
+ code_challenge = pkce$challenge,
+ code_challenge_method = pkce$method
)
)
After redirect
- Retrieve the PKCE verifier and decrypt the same place as you retrieve state
state <- get_cookie(session, "oauth_state")
+pkce_verifier <- get_cookie(session, "pkce_verifier") |> secret_decrypt("MY_KEY")
- Include it when you ask for a token
token <- httr2:::oauth_client_get_token(
client,
code = code,
grant_type = "authorization_code",
redirect_uri = redirect_uri,
+ code_verifier = pkce_verifier
)
If it does not work, set a browser() right before oauth_client_get_token() and observe your input. Good luck!