diff options
Diffstat (limited to 'src/scm/webid-oidc/jwk.scm')
-rw-r--r-- | src/scm/webid-oidc/jwk.scm | 45 |
1 files changed, 38 insertions, 7 deletions
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))))) |