Figure out shiny integration #47
Comments
|
Some more notes Optional auth:
# 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?
})
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
Here is a minimal app where I'm just verifying state. This was easy to extend to PKCE by just adding an encrypted app.Rlibrary(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.Rget_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 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
|
|
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
Sys.setenv("MY_KEY" = "VERY_SECRET_KEY")
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"))
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
state <- get_cookie(session, "oauth_state")
+pkce_verifier <- get_cookie(session, "pkce_verifier") |> secret_decrypt("MY_KEY")
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 |
r-lib/gargle#157
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.
The text was updated successfully, but these errors were encountered: