Last active
December 12, 2021 03:53
-
-
Save josephguillaume/41eed73967e0cf2ff4714b38be55dcfc to your computer and use it in GitHub Desktop.
Login to an Identity Provider and request resource from a Solid Pod using DPoP
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Login to an Identity Provider and request resource from a Solid Pod using DPoP | |
# Following https://solid.github.io/solid-oidc/primer/ | |
library(httr2) | |
library(jsonlite) | |
library(jose) | |
# httr2 uses req_oauth_{name} to cache access tokens from oauth_flow_{name} | |
# - we define req_oauth_solid_dpop | |
# - oauth_client has to be called manually. We instead register a client dynamically with the IDP | |
# using solid_client_register_dyn | |
# - For the auth step, httr2 calls oauth_client_req_auth_{client$auth}. | |
# We implement oauth_client_req_auth_dpop to add the dpop header and pass it as a function | |
# - For a request, req_perform calls auth_oauth_sign, which calls exec on the flow if needed | |
# and adds a req_auth_bearer_token | |
# We need a DPoP token, not Bearer token, so can't use this approach | |
# Instead, req_oauth_solid_dpop invokes the authorization itself, | |
# i.e. it does not wait for req_perform | |
# Modified to allow typ to be overridden | |
# https://github.com/r-lib/jose/blob/master/R/jwt.R | |
jwt_encode_sig <- function(claim = jwt_claim(), key, size = 256, header = NULL) { | |
stopifnot(inherits(claim, "jwt_claim")) | |
key <- read_key(key) | |
if(!inherits(key, "key")) | |
stop("key must be rsa/ecdsa private key") | |
# See http://tools.ietf.org/html/draft-ietf-jose-json-web-algorithms-40#section-3.4 | |
jwt_header <- if(inherits(key, "rsa")){ | |
if(as.list(key)$size < 2048) | |
stop("RSA keysize must be at least 2048 bit") | |
jose:::to_json(modifyList(list( | |
typ = "JWT", | |
alg = paste0("RS", size) | |
), header)) | |
} else if(inherits(key, "ecdsa")){ | |
# See http://tools.ietf.org/html/draft-ietf-jose-json-web-algorithms-40#section-3.4 | |
size <- switch(as.list(key)$data$curve, | |
"P-256" = 256, "P-384" = 384, "P-521" = 512, stop("invalid curve")) | |
jose:::to_json(modifyList(list( | |
typ = "JWT", | |
alg = paste0("ES", size) | |
), header)) | |
} else { | |
stop("Key must be RSA or ECDSA private key") | |
} | |
doc <- paste(base64url_encode(jwt_header), base64url_encode(jose:::to_json(claim)), sep = ".") | |
dgst <- sha2(charToRaw(doc), size = size) | |
sig <- signature_create(dgst, hash = NULL, key = key) | |
if(inherits(key, "ecdsa")){ | |
params <- openssl::ecdsa_parse(sig) | |
bitsize <- ceiling(size / 8) | |
sig <- c(pad_bignum(params$r, size), pad_bignum(params$s, size)) | |
} | |
paste(doc, base64url_encode(sig), sep = ".") | |
} | |
solid_client_register_dyn <- function(IDP){ | |
# 3. Retrieves OP Configuration | |
# i.e. Fetch IDP openid configuration | |
openid_config_url <- IDP | |
urltools::path(openid_config_url) <- ".well-known/openid-configuration" | |
configuration <- request(openid_config_url) %>% | |
req_perform() %>% | |
resp_body_json() | |
# Dynamic client registration | |
# TODO: could use client doc instead? | |
# https://solid.github.io/solid-oidc/primer/#authorization-code-pkce-flow-step-7 | |
rego <- request(configuration$registration_endpoint) %>% | |
req_body_json(list(application_type = "web", | |
redirect_uris = list("http://localhost:1410/"), | |
subject_type = "public", | |
token_endpoint_auth_method = "client_secret_basic", | |
id_token_signed_response_alg = "RS256", | |
grant_types = list("authorization_code", "refresh_token") | |
)) %>% | |
req_perform %>% | |
resp_body_json() | |
# 12. Generates a DPoP Client Key Pair | |
key <- openssl::rsa_keygen() | |
client <- oauth_client(rego$client_id, | |
configuration$token_endpoint, | |
auth=oauth_client_req_auth_dpop, | |
key=key | |
) | |
client$authorization_endpoint <- configuration$authorization_endpoint | |
client | |
} | |
# This is similar to oauth_client_req_auth_jwt_sig (auth="jwt_sig") | |
# but uses a DPoP Header instead of urn:ietf:params:oauth:client-assertion-type:jwt-bearer | |
oauth_client_req_auth_dpop <- function(req,client){ | |
params <- httr2:::compact(list(client_id = client$id)) | |
key <- client$key | |
# 13. Generates a DPoP Header | |
jwk_pub <- parse_json(write_jwk(key$pubkey)) | |
token_claim <- jwt_claim( | |
htu=client$token_url, | |
htm="POST", | |
jti=httr2:::base64_url_rand(32), | |
iat=unclass(Sys.time()) | |
) | |
token_DPoP=jwt_encode_sig(token_claim,key=key,header=list(typ="dpop+jwt",jwk=jwk_pub)) | |
# This will tell the OP what the client’s public key is | |
req <- req_headers(req,DPoP=token_DPoP) | |
req_body_form(req, params) | |
} | |
req_oauth_solid_dpop <- function(req,client){ | |
cache <- httr2:::cache_mem(client,key=NULL) | |
# 4. Generates PKCE code challenge and code verifier | |
# 5. Saves code verifier to session storage | |
# 6. Authorization request | |
# 9. Alice Logs In - opens browser window | |
# 13. Generates a DPoP Header - auth="dpop" | |
# 14. Token request with code and code verifier | |
# Server does: | |
# Skips 7. Fetch RP Client ID Document - uses dynamic registration instead | |
# 8. Validate redirect url with Client ID Document - hardcoded in dynamic registration above | |
# 10. Generate a code | |
# 11. Send code to redirect url | |
# 15. Validate code verifier | |
# 16. Validates DPoP Token Signature | |
# 17. Converts the DPoP public key to a JWK thumbprint | |
# 18. Generates access token | |
# 19. Generates the id_token | |
# 20. Generates refresh token | |
# 21. Sends tokens | |
flow <- "oauth_flow_auth_code" | |
flow_params = list( | |
client = client, | |
auth_url = client$authorization_endpoint, | |
scope = "openid webid offline_access", | |
port = 1410 | |
) | |
# adapted from https://github.com/r-lib/httr2/blob/main/R/oauth.R | |
token <- cache$get() | |
if (is.null(token)) { | |
token <- rlang::exec(flow, !!!flow_params) | |
} else { | |
if (httr2:::token_has_expired(token)) { | |
cache$clear() | |
if (is.null(token$refresh_token)) { | |
token <- rlang::exec(flow, !!!flow_params) | |
} else { | |
token <- httr2:::token_refresh(client, token$refresh_token) | |
} | |
} | |
} | |
cache$set(token) | |
# From here on is the equivalent of req_auth_bearer_token(req, token$access_token) | |
key=client$key | |
# Request flow starts | |
# 1. An AJAX request is initiated | |
# 2. Creates a DPoP header token | |
request_claim <- jwt_claim( | |
htu=req$url, | |
htm=httr2:::req_method_get(req), | |
jti=httr2:::base64_url_rand(32), | |
iat=unclass(Sys.time()) | |
) | |
jwk_pub <- parse_json(write_jwk(key$pubkey)) | |
# Not sure why this is needed, but it is expected by community-server via @solid/access-token-verifier | |
# https://github.com/solid/access-token-verifier/blob/2090eb5d92d3c07fc43cd4c743a6afaca802bb15/src/guard/DPoPJWKGuard.ts#L64 | |
jwk_pub$alg <- "RS256" | |
request_dpop=jwt_encode_sig(request_claim,key=key,header=list(typ="dpop+jwt",jwk=jwk_pub)) | |
# 3. Sends request | |
# Server does: | |
# 4. Checks Access Token expirations | |
# 5. Checks the DPoP token url and method | |
# 5.1. (Optional) Checks DPoP token unique identifier | |
# 6. Checks DPoP signature against Access Token | |
# 7. Retrieves Profile | |
# 8. Checks issuer | |
# 9. Retrieves OP configuration | |
# 10. Requests JWKS | |
# 11. Checks access token signature validity | |
# 12. Performs Authorization | |
# 13. Returns Result | |
req %>% | |
req_headers(authorization=sprintf("DPoP %s",token$access_token)) %>% | |
req_headers(dpop=request_dpop) | |
} | |
client <- solid_client_register_dyn("http://solidcommunity.net") | |
# GET | |
url <- "https://MY_PRIVATE_URL" | |
request(url) %>% | |
req_oauth_solid_dpop(client) %>% | |
req_perform() %>% | |
resp_body_string() | |
# PUT | |
url <- "https://MY_PRIVATE_URL/file.txt" | |
body <- "file contents" | |
created <- request(url) %>% | |
# Needs to come before auth in order for the request to be processed as correct method | |
req_method("PUT") %>% | |
# If missing Content-Type header, server returns status code 400 | |
req_body_raw(body = body, type="text/plain") %>% | |
req_oauth_solid_dpop(client) %>% | |
req_perform() | |
created %>% resp_body_string() | |
etag <- created$headers$ETag | |
# POST - server assigns url, optionally based on Slug | |
url <- "https://MY_PRIVATE_URL/folder" | |
slug <- "newfile.txt" | |
body <- "file contents" | |
created <- request(url) %>% | |
# Needs to come before auth in order for the request to be processed as correct method | |
# If missing Content-Type header, server returns status code 400 | |
req_body_raw(body = body, type="text/plain") %>% | |
# If missing, server assigns a URI to the resource | |
req_headers(Slug=slug) %>% | |
req_oauth_solid_dpop(client) %>% | |
req_perform() | |
created %>% resp_body_string() | |
etag <- created$headers$ETag | |
url <- paste0(dirname(created$url),created$headers$Location) | |
# DELETE | |
deleted <- request(url) %>% | |
# Needs to come before auth in order for the request to be processed as correct method | |
req_method("DELETE") %>% | |
req_headers("If-Match"=etag) %>% | |
req_oauth_solid_dpop(client) %>% | |
req_perform() | |
resp_status_desc(deleted) | |
# PUT, OPTIONS and PATCH | |
url <- "https://MY_PRIVATE_URL/test.ttl" | |
body <- "<test.ttl#this> a <test.ttl#thing> ." | |
created <- request(url) %>% | |
# Needs to come before auth in order for the request to be processed as correct method | |
req_method("PUT") %>% | |
# If missing Content-Type header, server returns status code 400 | |
req_body_raw(body = body, type="text/turtle") %>% | |
req_oauth_solid_dpop(client) %>% | |
req_perform() | |
created %>% resp_body_string() | |
etag <- created$headers$ETag | |
opts <- request(url) %>% | |
# Needs to come before auth in order for the request to be processed as correct method | |
req_method("OPTIONS") %>% | |
req_oauth_solid_dpop(client) %>% | |
req_perform() | |
opts$headers | |
opts$headers$`Accept-Patch` | |
body = "INSERT DATA {<test.ttl#second> a <test.ttl#thing> .}" | |
update <- request(url) %>% | |
# Needs to come before auth in order for the request to be processed as correct method | |
req_method("PATCH") %>% | |
req_headers("If-Match"=etag) %>% | |
# If missing Content-Type header, server returns status code 400 | |
req_body_raw(body = body, type="application/sparql-update") %>% | |
req_oauth_solid_dpop(client) %>% | |
req_perform() | |
resp_status_desc(update) | |
etag <- update$headers$ETag |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This code has been abandoned. See unmaintained R package at https://github.com/josephguillaume/solidR instead