diff options
Diffstat (limited to 'src/scm/webid-oidc/dpop-proof.scm')
| -rw-r--r-- | src/scm/webid-oidc/dpop-proof.scm | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/src/scm/webid-oidc/dpop-proof.scm b/src/scm/webid-oidc/dpop-proof.scm index cc756d3..5e01235 100644 --- a/src/scm/webid-oidc/dpop-proof.scm +++ b/src/scm/webid-oidc/dpop-proof.scm @@ -28,6 +28,7 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) + #:use-module (oop goops) #:declarative? #t #:export ( @@ -81,6 +82,10 @@ make-invalid-dpop-proof invalid-dpop-proof?) +(define (parse-jwk data) + (false-if-exception + (jwk->key data))) + (define (the-dpop-proof x) (with-exception-handler (lambda (error) @@ -131,7 +136,7 @@ ,@(if iat '() '("iat")))))) `(((alg . ,(symbol->string alg)) (typ . "dpop+jwt") - (jwk . ,(strip jwk)) + (jwk . ,(key->jwk (public-key jwk))) ,@other-header-fields) . ((jti . ,jti) (htm . ,(symbol->string htm)) @@ -188,9 +193,11 @@ ((('typ . incorrect) header ...) (fail (format #f (G_ "the \"typ\" field should be \"dpop+jwt\", not ~s") incorrect))) - ((('jwk . (? jwk-public? given-jwk)) header ...) - (examine-header header alg typ (or jwk (the-public-jwk given-jwk)) + ((('jwk . (= parse-jwk (? (cute is-a? <> <public-key>) given-jwk))) header ...) + (examine-header header alg typ (or jwk given-jwk) other-header-fields)) + ((('jwk . (= parse-jwk (? (cute is-a? <> <key-pair>) given-jwk))) header ...) + (fail (format #f (G_ "the \"jwk\" field should not contain the private key")))) ((('jwk . incorrect) header ...) (fail (format #f (G_ "the \"jwk\" field should be a valid public key, not ~s") incorrect))) @@ -213,7 +220,7 @@ (define (dpop-proof-jwk proof) (match (the-dpop-proof proof) ((header . _) - (the-public-jwk (assq-ref header 'jwk))))) + (jwk->key (assq-ref header 'jwk))))) (define (dpop-proof-jti proof) (match (the-dpop-proof proof) @@ -356,7 +363,7 @@ (make-dpop-invalid-ath (dpop-proof-ath decoded) access-token) (make-exception-with-message final-message))))))) (if (string? cnf/check) - (unless (equal? cnf/check (stubs:jkt (dpop-proof-jwk decoded))) + (unless (equal? cnf/check (jkt (dpop-proof-jwk decoded))) (let ((final-message (format #f (G_ "the DPoP proof is signed with the wrong key")))) (raise-exception @@ -376,7 +383,7 @@ (make-exception-with-message final-message) error)))) (lambda () - (unless (cnf/check (stubs:jkt (dpop-proof-jwk decoded))) + (unless (cnf/check (jkt (dpop-proof-jwk decoded))) ;; You should throw an error instead! (fail (G_ "the cnf/check function returned #f")))))) (parameterize ((p:current-date current-date)) @@ -410,7 +417,7 @@ (the-dpop-proof `(((alg . ,(symbol->string alg)) (typ . "dpop+jwt") - (jwk . ,client-key)) + (jwk . ,(key->jwk (public-key client-key)))) . ((jti . ,(stubs:random 12)) (htm . ,(symbol->string htm)) (htu . ,(uri->string htu)) |