JWK: document it, and use GOOPS

8 files changed, 372 insertions, 182 deletions

diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm
index 626cc6a..54c6e07 100644
--- a/src/scm/webid-oidc/client/accounts.scm
+++ b/src/scm/webid-oidc/client/accounts.scm
@@ -26,6 +26,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-19)
   #:use-module (webid-oidc errors)
+  #:use-module (webid-oidc web-i18n)
   #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module ((webid-oidc oidc-id-token) #:prefix id:)
@@ -85,12 +86,7 @@
    )
   #:declarative? #t)
 
-(define (G_ text)
-  (let ((out (gettext text)))
-    (if (string=? out text)
-        ;; No translation, disambiguate
-        (car (reverse (string-split text #\|)))
-        out)))
+(define <jwk:key-pair> jwk:<key-pair>)
 
 ;; This exception is continuable! Continue with the authorization
 ;; code.
@@ -159,7 +155,7 @@
 
 (define-method (->sexp (account <account>))
   `(begin
-     (use-modules (oop goops) (webid-oidc client accounts))
+     (use-modules (oop goops) (webid-oidc client accounts) (webid-oidc jwk))
      (make <account>
        #:subject ,(uri->string (subject account))
        #:issuer ,(uri->string (issuer account))
@@ -175,7 +171,7 @@
            (if refresh-token
                `(#:refresh-token ,refresh-token)
                '()))
-       #:key-pair (quote ,(key-pair account)))))
+       #:key-pair (jwk->key (quote ,(key->jwk (key-pair account)))))))
 
 (define-method (write (account <account>) port)
   (let ((code (->sexp account)))
@@ -496,7 +492,7 @@
     (slot-set! ret 'refresh-token refresh-token)
     ret))
 
-(define-method (set-key-pair (a <account>) key-pair)
+(define-method (set-key-pair (a <account>) (key-pair <jwk:key-pair>))
   (let ((ret (shallow-clone a)))
     (slot-set! ret 'key-pair key-pair)
     ret))
diff --git a/src/scm/webid-oidc/client/client.scm b/src/scm/webid-oidc/client/client.scm
index 1bf1c7c..5da701b 100644
--- a/src/scm/webid-oidc/client/client.scm
+++ b/src/scm/webid-oidc/client/client.scm
@@ -58,6 +58,8 @@
    )
   #:declarative? #t)
 
+(define <jwk:key-pair> jwk:<key-pair>)
+
 (define-class <client> ()
   (client-id #:init-keyword #:client-id #:getter client-id)
   (key-pair #:init-keyword #:key-pair #:getter client-key-pair)
@@ -65,10 +67,10 @@
 
 (define-method (->sexp (client <client>))
   `(begin
-     (use-modules (oop goops) (webid-oidc client))
+     (use-modules (oop goops) (webid-oidc client) (webid-oidc jwk))
      (make <client>
        #:client-id ,(uri->string (client-id client))
-       #:key-pair (quote ,(client-key-pair client))
+       #:key-pair (jwk->key (quote ,(key->jwk (client-key-pair client))))
        #:redirect-uri ,(uri->string (client-redirect-uri client)))))
 
 (define-method (write (client <client>) port)
@@ -92,7 +94,7 @@
      (match `(,client-id ,key-pair ,redirect-uri)
        (((or (? string? (= string->uri (? uri? client-id)))
              (? uri? client-id))
-         (? jwk:jwk? client-key)
+         (? (cute is-a? <> <jwk:key-pair>) client-key)
          (or (? string? (= string->uri (? uri? redirect-uri)))
              (? uri? redirect-uri)))
         (begin
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))
diff --git a/src/scm/webid-oidc/example-app.scm b/src/scm/webid-oidc/example-app.scm
index 9bf99c1..c293d69 100644
--- a/src/scm/webid-oidc/example-app.scm
+++ b/src/scm/webid-oidc/example-app.scm
@@ -23,7 +23,6 @@
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
   #:use-module ((webid-oidc config) #:prefix cfg:)
-  #:use-module ((webid-oidc jwk) #:prefix jwk:)
   #:use-module (web uri)
   #:use-module (web client)
   #:use-module (web request)
diff --git a/src/scm/webid-oidc/identity-provider.scm b/src/scm/webid-oidc/identity-provider.scm
index 7f1fb48..cf06b62 100644
--- a/src/scm/webid-oidc/identity-provider.scm
+++ b/src/scm/webid-oidc/identity-provider.scm
@@ -41,6 +41,7 @@
   #:use-module (sxml match)
   #:use-module (srfi srfi-19)
   #:use-module (rnrs bytevectors)
+  #:use-module (oop goops)
   #:declarative? #t
   #:export
   (
@@ -66,7 +67,10 @@
   (let ((key
          (catch #t
            (lambda ()
-             (call-with-input-file key-file stubs:json->scm))
+             (call-with-input-file key-file
+               (lambda (port)
+                 (jwk->key
+                  (stubs:json->scm port)))))
            (lambda error
              (format (current-error-port)
                      (G_ "Warning: generating a new key pair."))
@@ -74,7 +78,7 @@
                (stubs:call-with-output-file*
                 key-file
                 (lambda (port)
-                  (stubs:scm->json k port #:pretty #t)))
+                  (stubs:scm->json (key->jwk k) port #:pretty #t)))
                k)))))
     (let ((alg
            (if (eq? (kty key) 'RSA)
@@ -109,7 +113,7 @@
                             (exp-sec (+ current-sec 3600))
                             (exp (time-utc->date
                                   (make-time time-utc 0 exp-sec))))
-                       (serve-jwks exp (make-jwks (list key)))))
+                       (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)
diff --git a/src/scm/webid-oidc/jwk.scm b/src/scm/webid-oidc/jwk.scm
index e4f2119..7675d04 100644
--- a/src/scm/webid-oidc/jwk.scm
+++ b/src/scm/webid-oidc/jwk.scm
@@ -25,26 +25,28 @@
   #:use-module (web response)
   #:use-module (web client)
   #:use-module (rnrs bytevectors)
+  #:use-module (oop goops)
   #:declarative? #t
   #:export
   (
-   the-jwk
-   jwk?
+   <private-key>
+   <public-key>
+   <key-pair> public-key private-key
+   <rsa-key-pair>
+   <ec-key-pair>
+   <rsa-private-key> rsa-d rsa-p rsa-q rsa-dp rsa-dq rsa-qi
+   <rsa-public-key> rsa-n rsa-e
+   <ec-scalar> ec-crv ec-x ec-y
+   <ec-point> ec-z
+   <jwks> keys
+
+   check-key
+   key->jwk
+   jwk->key
    kty
-   the-public-jwk
-   jwk-public?
-   strip
    jkt
-   make-rsa-public-key
-   make-rsa-private-key
-   make-ec-point
-   make-ec-scalar
    generate-key
-   the-jwks
-   jwks?
-   make-jwks
-   jwks-keys
-   serve-jwks
+   serve
    get-jwks
 
    &not-a-jwk
@@ -68,7 +70,165 @@
   make-not-a-jwks
   not-a-jwks?)
 
-(define (the-jwk x)
+(define-class <private-key> ())
+
+(define-class <public-key> ())
+
+(define-class <key-pair> ()
+  (public-key #:init-keyword #:public-key #:accessor public-key)
+  (private-key #:init-keyword #:private-key #:accessor private-key))
+
+(define-class <rsa-key-pair> (<key-pair>))
+
+(define-class <ec-key-pair> (<key-pair>)
+  (crv #:init-keyword #:crv #:accessor ec-crv))
+
+(define-class <rsa-private-key> (<private-key>)
+  (d #:init-keyword #:d #:accessor rsa-d)
+  (p #:init-keyword #:p #:accessor rsa-p)
+  (q #:init-keyword #:q #:accessor rsa-q)
+  (dp #:init-keyword #:dp #:accessor rsa-dp)
+  (dq #:init-keyword #:dq #:accessor rsa-dq)
+  (qi #:init-keyword #:qi #:accessor rsa-qi))
+
+(define-class <rsa-public-key> (<public-key>)
+  (n #:init-keyword #:n #:accessor rsa-n)
+  (e #:init-keyword #:e #:accessor rsa-e))
+
+(define-class <ec-scalar> (<private-key>)
+  (crv #:init-keyword #:crv #:accessor ec-crv)
+  (z #:init-keyword #:z #:accessor ec-z))
+
+(define-class <ec-point> (<public-key>)
+  (crv #:init-keyword #:crv #:accessor ec-crv)
+  (x #:init-keyword #:x #:accessor ec-x)
+  (y #:init-keyword #:y #:accessor ec-y))
+
+(define-method (initialize-key-pair (key <key-pair>) (public <rsa-public-key>) (private <rsa-private-key>))
+  (set! (public-key key) public)
+  (set! (private-key key) private))
+
+(define-method (initialize-key-pair (key <key-pair>) (public <ec-point>) (private <ec-scalar>))
+  (set! (public-key key) public)
+  (set! (private-key key) private))
+
+(define-method (initialize (key <key-pair>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((public-key #f)
+    (private-key #f))
+   (initialize-key-pair key public-key private-key))
+  (check-key key))
+
+(define-method (initialize-rsa-key-pair (key <rsa-key-pair>) (public <rsa-public-key>) (private <rsa-private-key>))
+  #t)
+
+(define-method (initialize (key <rsa-key-pair>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((public-key #f)
+    (private-key #f))
+   (initialize-rsa-key-pair key public-key private-key))
+  (check-key key))
+
+(define-method (initialize-ec-key-pair (key <ec-key-pair>) (public <ec-point>) (private <ec-scalar>))
+  (unless (eq? (ec-crv public) (ec-crv private))
+    (raise-exception
+     (make-exception
+      (make-not-a-jwk)
+      (make-exception-with-message (G_ "the point and scalar are not on the same curve")))))
+  (set! (ec-crv key) (ec-crv public)))
+
+(define-method (initialize (key <ec-key-pair>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((public-key #f)
+    (private-key #f))
+   (initialize-ec-key-pair key public-key private-key)
+   (check-key key)))
+
+(define-method (initialize (key <rsa-private-key>) initargs)
+  (next-method)
+  (check-key key))
+
+(define-method (initialize (key <rsa-public-key>) initargs)
+  (next-method)
+  (check-key key))
+
+(define-method (initialize (key <ec-point>) initargs)
+  (next-method)
+  (check-key key))
+
+(define-method (initialize (key <ec-scalar>) initargs)
+  (next-method)
+  (check-key key))
+
+(define-method (rsa-d (key <rsa-key-pair>))
+  (rsa-d (private-key key)))
+
+(define-method (rsa-p (key <rsa-key-pair>))
+  (rsa-p (private-key key)))
+
+(define-method (rsa-q (key <rsa-key-pair>))
+  (rsa-q (private-key key)))
+
+(define-method (rsa-dp (key <rsa-key-pair>))
+  (rsa-dp (private-key key)))
+
+(define-method (rsa-dq (key <rsa-key-pair>))
+  (rsa-dq (private-key key)))
+
+(define-method (rsa-qi (key <rsa-key-pair>))
+  (rsa-qi (private-key key)))
+
+(define-method (rsa-n (key <rsa-key-pair>))
+  (rsa-n (public-key key)))
+
+(define-method (rsa-e (key <rsa-key-pair>))
+  (rsa-e (public-key key)))
+
+(define-method (ec-x (key <ec-key-pair>))
+  (ec-x (public-key key)))
+
+(define-method (ec-y (key <ec-key-pair>))
+  (ec-y (public-key key)))
+
+(define-method (ec-z (key <ec-key-pair>))
+  (ec-z (private-key key)))
+
+(define-method (equal? (x <key-pair>) (y <key-pair>))
+  (and (equal? (public-key x) (public-key y))
+       (equal? (private-key x) (private-key y))))
+
+(define-method (equal? (x <public-key>) (y <public-key>))
+  #f)
+
+(define-method (equal? (x <private-key>) (y <private-key>))
+  #f)
+
+(define-method (equal? (x <rsa-public-key>) (y <rsa-public-key>))
+  (and (equal? (rsa-n x) (rsa-n y))
+       (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))
+       (equal? (rsa-p x) (rsa-p y))
+       (equal? (rsa-q x) (rsa-q y))
+       (equal? (rsa-dp x) (rsa-dp y))
+       (equal? (rsa-dq x) (rsa-dq y))
+       (equal? (rsa-qi x) (rsa-qi y))))
+
+(define-method (equal? (x <ec-point>) (y <ec-point>))
+  (and (equal? (ec-x x) (ec-x y))
+       (equal? (ec-y x) (ec-y y))))
+
+(define-method (equal? (x <ec-scalar>) (y <ec-scalar>))
+  (equal? (ec-z x) (ec-z y)))
+
+(define (check-and-kty key)
   (with-exception-handler
       (lambda (error)
         (let ((final-message
@@ -82,150 +242,156 @@
             (make-exception-with-message final-message)
             error))))
     (lambda ()
-      (let ((kty (stubs:kty x)))
-        (unless (or (eq? kty 'EC) (eq? kty 'RSA))
-          (fail (format #f (G_ "unknown key type ~s")
-                        kty)))
-        x))))
+      (let ((kty (stubs:kty (key->jwk key))))
+        (unless kty
+          (fail (G_ "cannot compute the key type")))
+        kty))))
 
-(define (jwk? x)
-  (false-if-exception
-   (and (the-jwk x) #t)))
+(define-method (key->jwk (key <key-pair>))
+  (append (key->jwk (public-key key))
+          (key->jwk (private-key key))))
 
-(define (kty x)
-  (stubs:kty (the-jwk x)))
+(define-method (key->jwk (key <rsa-private-key>))
+  `((d . ,(rsa-d key))
+    (p  . ,(rsa-p key))
+    (q . ,(rsa-q key))
+    (dp . ,(rsa-dp key))
+    (dq . ,(rsa-dq key))
+    (qi . ,(rsa-qi key))))
 
-(define (the-public-jwk x)
-  (with-exception-handler
-      (lambda (error)
-        (let ((final-message
-               (if (exception-with-message? error)
-                   (format #f (G_ "the public JWK is invalid: ~a")
-                           (exception-message error))
-                   (format #f (G_ "the public JWK is invalid")))))
-          (raise-exception
-           (make-exception
-            (make-not-a-jwk)
-            (make-exception-with-message final-message)
-            error))))
-    (lambda ()
-      (let ((key (the-jwk x)))
-        (let ((crv (assq-ref key 'crv))
-              (x (assq-ref key 'x))
-              (y (assq-ref key 'y))
-              (n (assq-ref key 'n))
-              (e (assq-ref key 'e)))
-          (let ((ec-part `((crv . ,crv)
-                           (x . ,x)
-                           (y . ,y)))
-                (rsa-part `((n . ,n)
-                            (e . ,e))))
-            (case (stubs:kty key)
-              ((EC) ec-part)
-              ((RSA) rsa-part))))))))
-
-(define (jwk-public? key)
-  (false-if-exception
-   (and (the-public-jwk key) #t)))
-
-(define (strip key)
-  (with-exception-handler
-      (lambda (error)
-        (let ((final-message
-               (if (exception-with-message? error)
-                   (format #f (G_ "cannot extract the public part of the key: ~a")
-                           (exception-message error))
-                   (format #f (G_ "cannot extract the public part of the key")))))
-          (raise-exception
-           (make-exception
-            (make-not-a-jwk)
-            (make-exception-with-message final-message)
-            error))))
-    (lambda ()
-      (stubs:strip-key key))))
+(define-method (key->jwk (key <rsa-public-key>))
+  `((n . ,(rsa-n key))
+    (e . ,(rsa-e key))))
+
+(define-method (key->jwk (key <ec-point>))
+  `((crv . ,(symbol->string (ec-crv key)))
+    (x . ,(ec-x key))
+    (y . ,(ec-y key))))
+
+(define-method (key->jwk (key <ec-scalar>))
+  `((crv . ,(symbol->string (ec-crv key)))
+    (z . ,(ec-z key))))
+
+(define-method (check-key key)
+  (check-and-kty (key->jwk key)))
+
+(define (check-rsa-key key)
+  (unless (eq? (check-and-kty key) 'RSA)
+    (raise-exception
+     (make-exception
+      (make-not-a-jwk)
+      (make-exception-with-message
+       (format #f (G_ "it is built as an RSA key or key pair, but it is not")))))))
+
+(define (check-ec-key key)
+  (unless (eq? (check-and-kty key) 'EC)
+    (raise-exception
+     (make-exception
+      (make-not-a-jwk)
+      (make-exception-with-message
+       (format #f (G_ "it is built as an elliptic curve key or key pair, but it is not")))))))
+
+(define-method (check-key (key <rsa-key-pair>))
+  (check-rsa-key key))
+
+(define-method (check-key (key <rsa-public-key>))
+  (check-rsa-key key))
+
+(define-method (check-key (key <rsa-private-key>))
+  (check-rsa-key key))
+
+(define-method (check-key (key <ec-key-pair>))
+  (check-ec-key key))
+
+(define-method (check-key (key <ec-point>))
+  (check-ec-key key))
+
+(define-method (check-key (key <ec-scalar>))
+  (check-ec-key key))
+
+(define-method (kty (key <rsa-key-pair>)) 'RSA)
+(define-method (kty (key <rsa-public-key>)) 'RSA)
+(define-method (kty (key <rsa-private-key>)) 'RSA)
+
+(define-method (kty (key <ec-key-pair>)) 'EC)
+(define-method (kty (key <ec-point>)) 'EC)
+(define-method (kty (key <ec-scalar>)) 'EC)
+
+(define-method (public-key (key <public-key>))
+  key)
+
+(define-method (private-key (key <private-key>))
+  key)
+
+(define (jwk->key fields)
+  (let ((kty (stubs:kty fields)))
+    (case kty
+      ((RSA)
+       (let ((d (assq-ref fields 'd))
+             (p (assq-ref fields 'p))
+             (q (assq-ref fields 'q))
+             (dp (assq-ref fields 'dp))
+             (dq (assq-ref fields 'dq))
+             (qi (assq-ref fields 'qi))
+             (n (assq-ref fields 'n))
+             (e (assq-ref fields 'e)))
+         (let ((public
+                (and n e
+                     (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))))
+           (if (and public private)
+               (make <rsa-key-pair> #:public-key public #:private-key private)
+               (or public private)))))
+      ((EC)
+       (let ((crv (string->symbol (assq-ref fields 'crv)))
+             (x (assq-ref fields 'x))
+             (y (assq-ref fields 'y))
+             (z (assq-ref fields 'z)))
+         (let ((public
+                (and x y
+                     (make <ec-point> #:crv crv #:x x #:y y)))
+               (private
+                (and z
+                     (make <ec-scalar> #:crv crv #:z z))))
+           (if (and public private)
+               (make <ec-key-pair> #:public-key public #:private-key private)
+               (or public private)))))
+      (else
+       (raise-exception
+        (make-exception
+         (make-not-a-jwk)
+         (make-exception-with-message (G_ "this is neither a RSA key nor an elliptic curve key"))))))))
 
 (define (jkt x)
-  (stubs:jkt (the-public-jwk x)))
-
-(define (make-rsa-public-key n e)
-  (the-public-jwk
-   `((n . ,n)
-     (e . ,e))))
-
-(define (make-rsa-private-key d p q dp dq qi)
-  (the-jwk
-   `((d . ,d)
-     (p . ,p)
-     (q . ,q)
-     (dp . ,dp)
-     (dq . ,dq)
-     (qi . ,qi))))
-
-(define (make-ec-point crv x y)
-  (if (symbol? crv)
-      (make-ec-point (symbol->string crv) x y)
-      (the-public-jwk
-       `((crv . ,crv)
-         (x . ,x)
-         (y . ,y)))))
-
-(define (make-ec-scalar crv d)
-  (if (symbol? crv)
-      (make-ec-scalar (symbol->string crv) d)
-      (the-jwk
-       `((crv . ,crv)
-         (d . ,d)))))
-
-(define generate-key stubs:generate-key)
-
-(define (the-public-keys keys)
-  (map the-public-jwk keys))
-
-(define (the-jwks jwks)
-  (let ((keys (vector->list (assoc-ref jwks 'keys))))
-    (unless keys
-      (let ((final-message
-             (format #f (G_ "the JWKS is invalid, because it does not have keys"))))
-        (raise-exception
-         (make-exception
-          (make-not-a-jwks)
-          (make-exception-with-message final-message)))))
-    (with-exception-handler
-        (lambda (error)
-          (let ((final-message
-                 (if (exception-with-message? error)
-                     (format #f (G_ "the JWKS is invalid: ~a")
-                             (exception-message error))
-                     (format #f (G_ "the JWKS is invalid")))))
-            (raise-exception
-             (make-exception
-              (make-not-a-jwks)
-              (make-exception-with-message final-message)
-              error))))
-      (lambda ()
-        `((keys . ,(list->vector (the-public-keys keys))))))))
+  (stubs:jkt (key->jwk x)))
 
-(define (jwks? jwks)
-  (false-if-exception
-   (and (the-jwks jwks) #t)))
+(define (generate-key . args)
+  (jwk->key (apply stubs:generate-key args)))
 
-(define (make-jwks keys)
-  (if (vector? keys)
-      (make-jwks (vector->list keys))
-      (let ((pubs (list->vector (map strip keys))))
-        (the-jwks `((keys . ,pubs))))))
+(define-class <jwks> ()
+  (keys #:init-keyword #:keys #:accessor keys))
 
-(define (jwks-keys jwks)
-  (vector->list (assq-ref (the-jwks jwks) 'keys)))
+(define-method (initialize (jwks <jwks>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((keys '()))
+   (slot-set! jwks 'keys (map public-key keys))))
 
-(define (serve-jwks expiration-date jwks)
-  (values (build-response
-           #:headers `((content-type . (application/json))
-                       (expires . ,expiration-date)))
-          (stubs:scm->json-string (the-jwks jwks))))
+(define-method (serve (jwks <jwks>) expiration-date)
+  (values
+   (build-response
+    #:headers `((content-type . (application/json))
+                (expires . ,expiration-date)))
+   (stubs:scm->json-string
+    `((keys
+       . ,(list->vector
+           (map key->jwk (keys jwks))))))))
 
-(define* (get-jwks uri #:key (http-get http-get))
-  (receive (response response-body) (http-get uri)
+(define* (get-jwks uri #:key (http-request http-request))
+  (receive (response response-body) (http-request uri)
     (with-exception-handler
         (lambda (error)
           (raise-exception
@@ -252,4 +418,6 @@
             (fail (format #f (G_ "invalid content-type: ~s") content-type)))
           (unless (string? response-body)
             (set! response-body (utf8->string response-body)))
-          (the-jwks (stubs:json-string->scm response-body)))))))
+          (let ((data (stubs:json-string->scm response-body)))
+            (let ((keys (vector->list (assq-ref data 'keys))))
+              (make <jwks> #:keys (map jwk->key keys)))))))))
diff --git a/src/scm/webid-oidc/jws.scm b/src/scm/webid-oidc/jws.scm
index 24a8bbc..3e5e50b 100644
--- a/src/scm/webid-oidc/jws.scm
+++ b/src/scm/webid-oidc/jws.scm
@@ -23,6 +23,7 @@
   #:use-module (ice-9 receive)
   #:use-module (ice-9 exceptions)
   #:use-module (ice-9 match)
+  #:use-module (oop goops)
   #:declarative? #t
   #:export
   (
@@ -228,10 +229,22 @@
                    error))))
              (try-with-key keys))
          (lambda ()
-           (stubs:verify alg next-key payload signature))
+           (stubs:verify alg (key->jwk next-key) payload signature))
          #:unwind? #t
          #:unwind-for-type stubs:&invalid-signature)))))
 
+;; For verification, we can supply a JWKS, or a public key, or a list
+;; of public keys. The JWKS case is handled in (webid-oidc jwk).
+
+(define-method (keys (key <public-key>))
+  (list key))
+
+(define-method (keys (key <key-pair>))
+  (list (public-key key)))
+
+(define-method (keys (keys <list>))
+  (map public-key keys))
+
 (define (jws-decode str lookup-keys)
   (with-exception-handler
       (lambda (error)
@@ -248,11 +261,8 @@
     (lambda ()
       (parse str
              (lambda (jws payload signature)
-               (let ((keys (lookup-keys jws)))
-                 (let ((keys (cond ((jwk? keys) (list keys))
-                                   ((jwks? keys) (jwks-keys keys))
-                                   (else keys))))
-                   (verify-any (jws-alg jws) keys payload signature))))))))
+               (let ((k (keys (lookup-keys jws))))
+                 (verify-any (jws-alg jws) k payload signature)))))))
 
 (define (jws-encode jws key)
   (with-exception-handler
@@ -275,5 +285,5 @@
            (let ((header (stubs:base64-encode header))
                  (payload (stubs:base64-encode payload)))
              (let ((payload (string-append header "." payload)))
-               (let ((signature (stubs:sign (jws-alg jws) key payload)))
+               (let ((signature (stubs:sign (jws-alg jws) (key->jwk key) payload)))
                  (string-append payload "." signature))))))))))
diff --git a/src/scm/webid-oidc/oidc-configuration.scm b/src/scm/webid-oidc/oidc-configuration.scm
index d9aab84..2233d95 100644
--- a/src/scm/webid-oidc/oidc-configuration.scm
+++ b/src/scm/webid-oidc/oidc-configuration.scm
@@ -141,8 +141,12 @@
 (define oidc-configuration-token-endpoint
   (uri-field 'token_endpoint))
 
-(define (oidc-configuration-jwks cfg . args)
-  (apply get-jwks (oidc-configuration-jwks-uri cfg) args))
+(define* (oidc-configuration-jwks cfg #:key (http-get http-get))
+  (let ((http-request-for-get-jwks
+         (lambda* (uri #:key (method 'GET))
+           (http-get uri))))
+    (get-jwks (oidc-configuration-jwks-uri cfg)
+              #:http-request http-request-for-get-jwks)))
 
 (define (serve-oidc-configuration expiration-date cfg)
   (values (build-response #:headers `((content-type . (application/json))