diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-17 18:31:01 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-21 22:25:03 +0200 |
commit | 55195e4659339f56036c2f98d06cfd59a0141514 (patch) | |
tree | 0e4853d1039021ac337b5879a9d3d89d05287dd5 /src | |
parent | 6d70723f85635b23aa8b52bb5adfb3140d9029bd (diff) |
JWK: the default signature algorithm "alg" is now a key parameter
Diffstat (limited to 'src')
-rw-r--r-- | src/scm/webid-oidc/access-token.scm | 3 | ||||
-rw-r--r-- | src/scm/webid-oidc/authorization-code.scm | 4 | ||||
-rw-r--r-- | src/scm/webid-oidc/authorization-endpoint.scm | 3 | ||||
-rw-r--r-- | src/scm/webid-oidc/client.scm | 3 | ||||
-rw-r--r-- | src/scm/webid-oidc/client/accounts.scm | 3 | ||||
-rw-r--r-- | src/scm/webid-oidc/dpop-proof.scm | 3 | ||||
-rw-r--r-- | src/scm/webid-oidc/identity-provider.scm | 126 | ||||
-rw-r--r-- | src/scm/webid-oidc/jwk.scm | 45 | ||||
-rw-r--r-- | src/scm/webid-oidc/oidc-id-token.scm | 4 | ||||
-rw-r--r-- | src/scm/webid-oidc/token-endpoint.scm | 4 |
10 files changed, 107 insertions, 91 deletions
diff --git a/src/scm/webid-oidc/access-token.scm b/src/scm/webid-oidc/access-token.scm index 0cc8c27..7e67270 100644 --- a/src/scm/webid-oidc/access-token.scm +++ b/src/scm/webid-oidc/access-token.scm @@ -325,7 +325,6 @@ (define* (issue-access-token issuer-key #:key - (alg #f) (webid #f) (iss #f) (validity 3600) @@ -338,7 +337,7 @@ (exp (+ iat validity))) (jws-encode (the-access-token - `(((alg . ,(symbol->string alg))) + `(((alg . ,(symbol->string (alg issuer-key)))) . ((webid . ,(uri->string webid)) (iss . ,(uri->string iss)) (aud . "solid") diff --git a/src/scm/webid-oidc/authorization-code.scm b/src/scm/webid-oidc/authorization-code.scm index ff7fe60..1481b2c 100644 --- a/src/scm/webid-oidc/authorization-code.scm +++ b/src/scm/webid-oidc/authorization-code.scm @@ -18,6 +18,7 @@ #:use-module (webid-oidc errors) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (webid-oidc jws) + #:use-module (webid-oidc jwk) #:use-module (webid-oidc jti) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (web uri) @@ -209,14 +210,13 @@ (define* (issue-authorization-code issuer-key #:key - alg (validity 120) webid client-id) (let* ((iat (time-second (date->time-utc ((p:current-date))))) (exp (+ iat validity))) (authorization-code-encode - `(((alg . ,(symbol->string alg))) + `(((alg . ,(symbol->string (alg issuer-key)))) . ((webid . ,(uri->string webid)) (client_id . ,(uri->string client-id)) (exp . ,exp) diff --git a/src/scm/webid-oidc/authorization-endpoint.scm b/src/scm/webid-oidc/authorization-endpoint.scm index 86a8a4d..cf45a9c 100644 --- a/src/scm/webid-oidc/authorization-endpoint.scm +++ b/src/scm/webid-oidc/authorization-endpoint.scm @@ -43,7 +43,7 @@ (let ((c (crypt password encrypted-password))) (string=? c encrypted-password))) -(define* (make-authorization-endpoint subject encrypted-password alg jwk validity +(define* (make-authorization-endpoint subject encrypted-password jwk validity #:key (http-get http-get)) (define (parse-arg x decode-plus-to-space?) @@ -108,7 +108,6 @@ (lambda () (let ((code (issue-authorization-code jwk - #:alg alg #:webid subject #:client-id client-id)) (mf (get-client-manifest client-id diff --git a/src/scm/webid-oidc/client.scm b/src/scm/webid-oidc/client.scm index 52a33a4..5b6b0ef 100644 --- a/src/scm/webid-oidc/client.scm +++ b/src/scm/webid-oidc/client.scm @@ -139,9 +139,6 @@ (let ((key-pair (account:key-pair account))) (issue-dpop-proof key-pair - #:alg (case (kty key-pair) - ((EC) 'ES256) - ((RSA) 'RS256)) #:htm method #:htu uri #:access-token access-token)))) diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm index 54c6e07..ddb592a 100644 --- a/src/scm/webid-oidc/client/accounts.scm +++ b/src/scm/webid-oidc/client/accounts.scm @@ -255,9 +255,6 @@ (let ((dpop-proof (dpop:issue-dpop-proof key-pair - #:alg (case (jwk:kty key-pair) - ((EC) 'ES256) - ((RSA) 'RS256)) #:htm 'POST #:htu token-endpoint))) (receive (response response-body) diff --git a/src/scm/webid-oidc/dpop-proof.scm b/src/scm/webid-oidc/dpop-proof.scm index 5e01235..8c66f68 100644 --- a/src/scm/webid-oidc/dpop-proof.scm +++ b/src/scm/webid-oidc/dpop-proof.scm @@ -409,13 +409,12 @@ (define* (issue-dpop-proof client-key #:key - (alg #f) (htm #f) (htu #f) (access-token #f)) (dpop-proof-encode (the-dpop-proof - `(((alg . ,(symbol->string alg)) + `(((alg . ,(symbol->string (alg client-key))) (typ . "dpop+jwt") (jwk . ,(key->jwk (public-key client-key)))) . ((jti . ,(stubs:random 12)) diff --git a/src/scm/webid-oidc/identity-provider.scm b/src/scm/webid-oidc/identity-provider.scm index cf06b62..7973917 100644 --- a/src/scm/webid-oidc/identity-provider.scm +++ b/src/scm/webid-oidc/identity-provider.scm @@ -80,73 +80,69 @@ (lambda (port) (stubs:scm->json (key->jwk k) port #:pretty #t))) k))))) - (let ((alg - (if (eq? (kty key) 'RSA) - 'RS256 - 'ES256))) - (let ((authorization-endpoint - (make-authorization-endpoint subject encrypted-password alg key 120 - #:http-get http-get)) - (token-endpoint - (make-token-endpoint token-endpoint-uri issuer alg key 3600)) - (openid-configuration - `((jwks_uri . ,(uri->string jwks-uri)) - (authorization_endpoint . ,(uri->string authorization-endpoint-uri)) - (token_endpoint . ,(uri->string token-endpoint-uri)) - (solid_oidc_supported . "https://solidproject.org/TR/solid-oidc"))) - (openid-configuration-uri - (build-uri 'https - #:host (uri-host issuer) - #:path "/.well-known/openid-configuration"))) - (lambda (request request-body) - (let ((uri (request-uri request)) - (current-time ((p:current-date)))) - (parameterize ((web-locale request)) - (cond ((same-uri? uri openid-configuration-uri) - (let* ((current-sec (time-second (date->time-utc current-time))) - (exp-sec (+ current-sec 3600)) - (exp (time-utc->date - (make-time time-utc 0 exp-sec)))) - (serve-oidc-configuration exp openid-configuration))) - ((same-uri? uri jwks-uri) - (let* ((current-sec (time-second (date->time-utc current-time))) - (exp-sec (+ current-sec 3600)) - (exp (time-utc->date - (make-time time-utc 0 exp-sec)))) - (serve (make <jwks> #:keys (list key)) exp))) - ((same-uri? uri authorization-endpoint-uri #:skip-query #t) - (authorization-endpoint request request-body)) - ((same-uri? uri token-endpoint-uri) - (token-endpoint request request-body)) - ((same-uri? uri subject) - (values - (build-response #:headers '((content-type text/turtle)) - #:port #f) - (format #f - "@prefix foaf: <http://xmlns.com/foaf/0.1/> . + (let ((authorization-endpoint + (make-authorization-endpoint subject encrypted-password key 120 + #:http-get http-get)) + (token-endpoint + (make-token-endpoint token-endpoint-uri issuer key 3600)) + (openid-configuration + `((jwks_uri . ,(uri->string jwks-uri)) + (authorization_endpoint . ,(uri->string authorization-endpoint-uri)) + (token_endpoint . ,(uri->string token-endpoint-uri)) + (solid_oidc_supported . "https://solidproject.org/TR/solid-oidc"))) + (openid-configuration-uri + (build-uri 'https + #:host (uri-host issuer) + #:path "/.well-known/openid-configuration"))) + (lambda (request request-body) + (let ((uri (request-uri request)) + (current-time ((p:current-date)))) + (parameterize ((web-locale request)) + (cond ((same-uri? uri openid-configuration-uri) + (let* ((current-sec (time-second (date->time-utc current-time))) + (exp-sec (+ current-sec 3600)) + (exp (time-utc->date + (make-time time-utc 0 exp-sec)))) + (serve-oidc-configuration exp openid-configuration))) + ((same-uri? uri jwks-uri) + (let* ((current-sec (time-second (date->time-utc current-time))) + (exp-sec (+ current-sec 3600)) + (exp (time-utc->date + (make-time time-utc 0 exp-sec)))) + (serve (make <jwks> #:keys (list key)) exp))) + ((same-uri? uri authorization-endpoint-uri #:skip-query #t) + (authorization-endpoint request request-body)) + ((same-uri? uri token-endpoint-uri) + (token-endpoint request request-body)) + ((same-uri? uri subject) + (values + (build-response #:headers '((content-type text/turtle)) + #:port #f) + (format #f + "@prefix foaf: <http://xmlns.com/foaf/0.1/> . @prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> . <#~a> a foaf:Person ; rdfs:comment \"It works. Now you should use another service to serve that resource.\" . " - (uri-fragment subject)))) - (else - (values - (build-response #:code 404 - #:reason-phrase (W_ "reason-phrase|Not Found") - #:headers '((content-type application/xhtml+xml))) - (with-output-to-string - (lambda () - (sxml->xml - `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") - (html (@ (xmlns "http://www.w3.org/1999/xhtml") - (xml:lang ,(W_ "xml-lang|en"))) - (body - ,(sxml-match - (xml->sxml - (W_ (format #f "<h1>Resource not found</h1>"))) - ((*TOP* ,title) title)) - ,(sxml-match - (xml->sxml - (W_ (format #f "<p>This OpenID Connect identity provider does not know the resource you are requesting.</p>"))) - ((*TOP* ,p) p)))))))))))))))))) + (uri-fragment subject)))) + (else + (values + (build-response #:code 404 + #:reason-phrase (W_ "reason-phrase|Not Found") + #:headers '((content-type application/xhtml+xml))) + (with-output-to-string + (lambda () + (sxml->xml + `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") + (html (@ (xmlns "http://www.w3.org/1999/xhtml") + (xml:lang ,(W_ "xml-lang|en"))) + (body + ,(sxml-match + (xml->sxml + (W_ (format #f "<h1>Resource not found</h1>"))) + ((*TOP* ,title) title)) + ,(sxml-match + (xml->sxml + (W_ (format #f "<p>This OpenID Connect identity provider does not know the resource you are requesting.</p>"))) + ((*TOP* ,p) p))))))))))))))))) diff --git a/src/scm/webid-oidc/jwk.scm b/src/scm/webid-oidc/jwk.scm index e0308cb..f06818d 100644 --- a/src/scm/webid-oidc/jwk.scm +++ b/src/scm/webid-oidc/jwk.scm @@ -31,7 +31,7 @@ #:declarative? #t #:export ( - <private-key> + <private-key> alg <public-key> <key-pair> public-key private-key <rsa-key-pair> @@ -72,7 +72,8 @@ make-not-a-jwks not-a-jwks?) -(define-class <private-key> ()) +(define-class <private-key> () + (alg #:init-keyword #:alg #:accessor alg)) (define-class <public-key> ()) @@ -154,6 +155,12 @@ (define-method (initialize (key <rsa-private-key>) initargs) (next-method) + (let-keywords + initargs #t + ((alg #f)) + (when (string? alg) + (set! alg (string->symbol alg))) + (slot-set! key 'alg (or alg 'RS256))) (check-key key)) (define-method (initialize (key <rsa-public-key>) initargs) @@ -166,8 +173,17 @@ (define-method (initialize (key <ec-scalar>) initargs) (next-method) + (let-keywords + initargs #t + ((alg #f)) + (when (string? alg) + (set! alg (string->symbol alg))) + (slot-set! key 'alg (or alg 'ES256))) (check-key key)) +(define-method (alg (key <key-pair>)) + (alg (private-key key))) + (define-method (rsa-d (key <rsa-key-pair>)) (rsa-d (private-key key))) @@ -216,7 +232,8 @@ (equal? (rsa-e x) (rsa-e y)))) (define-method (equal? (x <rsa-private-key>) (y <rsa-private-key>)) - (and (equal? (rsa-d x) (rsa-d y)) + (and (equal? (alg x) (alg y)) + (equal? (rsa-d x) (rsa-d y)) (equal? (rsa-p x) (rsa-p y)) (equal? (rsa-q x) (rsa-q y)) (equal? (rsa-dp x) (rsa-dp y)) @@ -228,7 +245,8 @@ (equal? (ec-y x) (ec-y y)))) (define-method (equal? (x <ec-scalar>) (y <ec-scalar>)) - (equal? (ec-z x) (ec-z y))) + (and (equal? (alg x) (alg y)) + (equal? (ec-z x) (ec-z y)))) (define (check-and-kty key) (with-exception-handler @@ -273,6 +291,7 @@ (define-method (key->jwk (key <rsa-private-key>)) `((kty . ,(symbol->string (kty key))) + (alg . ,(symbol->string (alg key))) (d . ,(rsa-d key)) (p . ,(rsa-p key)) (q . ,(rsa-q key)) @@ -294,6 +313,7 @@ (define-method (key->jwk (key <ec-scalar>)) `((crv . ,(symbol->string (ec-crv key))) (kty . ,(symbol->string (kty key))) + (alg . ,(symbol->string (alg key))) (z . ,(ec-z key)))) (define-method (check-key key) @@ -348,7 +368,8 @@ key) (define (jwk->key fields) - (let ((kty (stubs:kty fields))) + (let ((kty (stubs:kty fields)) + (alg (assq-ref fields 'alg))) (let ((explicit-kty (assq-ref fields 'kty))) (when (and kty explicit-kty (not (eq? kty (string->symbol explicit-kty)))) (raise-exception @@ -371,7 +392,14 @@ (make <rsa-public-key> #:n n #:e e))) (private (and d p q dp dq qi - (make <rsa-private-key> #:d d #:p p #:q q #:dp dp #:dq dq #:qi qi)))) + (make <rsa-private-key> + #:alg (and alg (string->symbol alg)) + #:d d + #:p p + #:q q + #:dp dp + #:dq dq + #:qi qi)))) (if (and public private) (make <rsa-key-pair> #:public-key public #:private-key private) (or public private))))) @@ -385,7 +413,10 @@ (make <ec-point> #:crv crv #:x x #:y y))) (private (and z - (make <ec-scalar> #:crv crv #:z z)))) + (make <ec-scalar> + #:alg (and alg (string->symbol alg)) + #:crv crv + #:z z)))) (if (and public private) (make <ec-key-pair> #:public-key public #:private-key private) (or public private))))) diff --git a/src/scm/webid-oidc/oidc-id-token.scm b/src/scm/webid-oidc/oidc-id-token.scm index e44d946..abef88d 100644 --- a/src/scm/webid-oidc/oidc-id-token.scm +++ b/src/scm/webid-oidc/oidc-id-token.scm @@ -18,6 +18,7 @@ #:use-module (webid-oidc oidc-configuration) #:use-module (webid-oidc errors) #:use-module (webid-oidc jws) + #:use-module (webid-oidc jwk) #:use-module (webid-oidc jti) #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc stubs) #:prefix stubs:) @@ -302,7 +303,6 @@ (define* (issue-id-token issuer-key #:key - (alg #f) (webid #f) (iss #f) (sub #f) @@ -314,7 +314,7 @@ (exp (+ iat validity))) (jws-encode (the-id-token - `(((alg . ,(symbol->string alg))) + `(((alg . ,(symbol->string (alg issuer-key)))) . ((webid . ,(uri->string webid)) (iss . ,(uri->string iss)) (sub . ,sub) diff --git a/src/scm/webid-oidc/token-endpoint.scm b/src/scm/webid-oidc/token-endpoint.scm index 30a78d4..81f8e48 100644 --- a/src/scm/webid-oidc/token-endpoint.scm +++ b/src/scm/webid-oidc/token-endpoint.scm @@ -177,7 +177,7 @@ port))))))) thunk)))) -(define (make-token-endpoint token-endpoint-uri iss alg jwk validity) +(define (make-token-endpoint token-endpoint-uri iss jwk validity) (lambda (request request-body) (when (bytevector? request-body) (set! request-body (utf8->string request-body))) @@ -290,7 +290,6 @@ (let ((id-token (issue-id-token jwk - #:alg alg #:webid webid #:sub (uri->string webid) #:iss iss @@ -299,7 +298,6 @@ (access-token (issue-access-token jwk - #:alg alg #:webid webid #:iss iss #:validity 3600 |