diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-17 18:07:19 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-21 22:25:03 +0200 |
commit | 6d70723f85635b23aa8b52bb5adfb3140d9029bd (patch) | |
tree | 33b08efeea4ab4ea150c207b7404a0d359cecf0d /src | |
parent | fa486f2e136a898d1b1548ec90757a78c65a0b70 (diff) |
JWK: add an explicit value for kty in the JSON representation
Diffstat (limited to 'src')
-rw-r--r-- | src/scm/webid-oidc/jwk.scm | 39 |
1 files changed, 35 insertions, 4 deletions
diff --git a/src/scm/webid-oidc/jwk.scm b/src/scm/webid-oidc/jwk.scm index 7675d04..e0308cb 100644 --- a/src/scm/webid-oidc/jwk.scm +++ b/src/scm/webid-oidc/jwk.scm @@ -21,6 +21,8 @@ #:use-module (ice-9 receive) #:use-module (ice-9 optargs) #:use-module (ice-9 exceptions) + #:use-module (ice-9 hash-table) + #:use-module (ice-9 match) #:use-module (srfi srfi-19) #:use-module (web response) #:use-module (web client) @@ -248,11 +250,30 @@ kty)))) (define-method (key->jwk (key <key-pair>)) - (append (key->jwk (public-key key)) - (key->jwk (private-key key)))) + ;; kty and crv fields are present in both the public and private + ;; key, but they must not be duplicated, and we want to keep all + ;; fields in order. + (let ((with-duplicates + (append (key->jwk (public-key key)) + (key->jwk (private-key key))))) + (let ((lookup + (alist->hash-table with-duplicates))) + (let keep-unique-in-order ((order (map car with-duplicates)) + (constructed '())) + (match order + (() + (reverse constructed)) + ((hd tl ...) + (let ((found (hash-ref lookup hd))) + (when found + (hash-remove! lookup hd)) + (if found + (keep-unique-in-order tl `((,hd . ,found) ,@constructed)) + (keep-unique-in-order tl constructed))))))))) (define-method (key->jwk (key <rsa-private-key>)) - `((d . ,(rsa-d key)) + `((kty . ,(symbol->string (kty key))) + (d . ,(rsa-d key)) (p . ,(rsa-p key)) (q . ,(rsa-q key)) (dp . ,(rsa-dp key)) @@ -260,16 +281,19 @@ (qi . ,(rsa-qi key)))) (define-method (key->jwk (key <rsa-public-key>)) - `((n . ,(rsa-n key)) + `((kty . ,(symbol->string (kty key))) + (n . ,(rsa-n key)) (e . ,(rsa-e key)))) (define-method (key->jwk (key <ec-point>)) `((crv . ,(symbol->string (ec-crv key))) + (kty . ,(symbol->string (kty key))) (x . ,(ec-x key)) (y . ,(ec-y key)))) (define-method (key->jwk (key <ec-scalar>)) `((crv . ,(symbol->string (ec-crv key))) + (kty . ,(symbol->string (kty key))) (z . ,(ec-z key)))) (define-method (check-key key) @@ -325,6 +349,13 @@ (define (jwk->key fields) (let ((kty (stubs:kty fields))) + (let ((explicit-kty (assq-ref fields 'kty))) + (when (and kty explicit-kty (not (eq? kty (string->symbol explicit-kty)))) + (raise-exception + (make-exception + (make-not-a-jwk) + (make-exception-with-message (format #f (G_ "the key advertises a key type of ~s, but actually it is ~s") + explicit-kty kty)))))) (case kty ((RSA) (let ((d (assq-ref fields 'd)) |