Skip to content

Instantly share code, notes, and snippets.

@fdlk
Last active July 9, 2020 13:43
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save fdlk/2d6c1593fe71a0db5af9aa8320c4cf01 to your computer and use it in GitHub Desktop.
Save fdlk/2d6c1593fe71a0db5af9aa8320c4cf01 to your computer and use it in GitHub Desktop.
.get_info <- function(armadillo_server) {
info_url <- armadillo_server
urltools::path(info_url) <- "actuator/info"
response <- httr::GET(info_url)
httr::stop_for_status(response, task="fetch server info")
return(httr::content(response))
}
.discover_endpoint <- function(auth_server) {
openid_config_url <- auth_server
urltools::path(openid_config_url) <- ".well-known/openid-configuration"
response <- httr::GET(openid_config_url)
httr::stop_for_status(response, task="discover OpenID configuration")
configuration <- httr::content(response)
return(httr::oauth_endpoint(request=NULL,
authorize = configuration$authorization_endpoint,
access = configuration$token_endpoint,
user = configuration$userinfo_endpoint,
device = configuration$device_authorization_endpoint,
logout = configuration$end_session_endpoint))
}
.authenticate_using_device_flow <-
function(endpoint, client_id) {
stopifnot(
inherits(endpoint, "oauth_endpoint"),
is.character(client_id),
is.character(endpoint$device)
)
response <- httr::POST(endpoint$device,
body = list(
client_id = client_id,
scope = "openid offline_access"
)
)
httr::stop_for_status(response, task="initiate OpenID Device Flow authentication")
auth_res <- httr::content(response)
print(paste0(
"We're opening a browser so you can log in with code ",
auth_res$user_code
))
verification_url <- auth_res$verification_uri_complete
verification_url <- urltools::param_set(
verification_url,
"client_id", client_id
)
browseURL(verification_url)
response <- httr::RETRY(
url = endpoint$access,
verb = "POST",
pause_base = auth_res$interval,
pause_cap = auth_res$interval,
pause_min = auth_res$interval,
times = auth_res$expires_in / auth_res$interval,
quiet = FALSE,
body = list(
"client_id" = client_id,
"grant_type" = "urn:ietf:params:oauth:grant-type:device_code",
"device_code" = auth_res$device_code
)
)
httr::stop_for_status(response, task="retrieve id token")
return(httr::content(response))
}
#' Get ID Token
#'
#' Get an ID token to log in on a server
#'
#' @param server the URL of the server
#'
#' @return The ID token string
#'
#' @export
getToken <- function(server) {
auth_info <- .get_info(server)$auth
endpoint <- .discover_endpoint(auth_info$issuerUri)
credentials <- .authenticate_using_device_flow(
endpoint,
auth_info$clientId
)
return(credentials$id_token)
}
app <- httr::oauth_app("armadillo", auth_info$clientId)
token <- httr::oauth2.0_token(endpoint,
app,
use_basic_auth = FALSE,
credentials = token_res)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment