JWK: document it, and use GOOPS

7 files changed, 52 insertions, 34 deletions

diff --git a/tests/dpop-proof-valid.scm b/tests/dpop-proof-valid.scm
index ec6b32a..893687d 100644
--- a/tests/dpop-proof-valid.scm
+++ b/tests/dpop-proof-valid.scm
@@ -1,4 +1,4 @@
-;; webid-oidc, implementation of the Solid specification
+;; disfluid, implementation of the Solid specification
 ;; Copyright (C) 2020, 2021  Vivien Kraus
 
 ;; This program is free software: you can redistribute it and/or modify
diff --git a/tests/jwk-kty-rsa-incorrect.scm b/tests/jwk-kty-rsa-incorrect.scm
index a13b430..c86297a 100644
--- a/tests/jwk-kty-rsa-incorrect.scm
+++ b/tests/jwk-kty-rsa-incorrect.scm
@@ -22,14 +22,13 @@
 (with-test-environment
  "jwk-kty-rsa-incorrect"
  (lambda ()
-   (let* ((key (json-string->scm "{\"kty\":\"RSA\",\"e\":\"AQAB\",\"kid\":\"db7cdbbf-0ca3-48da-abf6-8f34002a4651\",\"n\":\"--\"}"))
-          (kty
-           (with-exception-handler
-               (lambda (exn)
-                 #f)
-             (lambda ()
-               (kty key))
-             #:unwind? #t
-             #:unwind-for-type &not-a-jwk)))
-     (when kty
-       (exit 1)))))
+   (with-exception-handler
+       (lambda (exn)
+         (unless (not-a-jwk? exn)
+           (exit 1))
+         #f)
+     (lambda ()
+       (jwk->key (json-string->scm "{\"kty\":\"RSA\",\"e\":\"AQAB\",\"kid\":\"db7cdbbf-0ca3-48da-abf6-8f34002a4651\",\"n\":\"--\"}"))
+       (exit 2))
+     #:unwind? #t
+     #:unwind-for-type &not-a-jwk)))
diff --git a/tests/jwk-public.scm b/tests/jwk-public.scm
index 4830845..c3a6b99 100644
--- a/tests/jwk-public.scm
+++ b/tests/jwk-public.scm
@@ -1,4 +1,4 @@
-;; webid-oidc, implementation of the Solid specification
+;; disfluid, implementation of the Solid specification
 ;; Copyright (C) 2020, 2021  Vivien Kraus
 
 ;; This program is free software: you can redistribute it and/or modify
@@ -15,12 +15,19 @@
 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 (use-modules (webid-oidc jwk)
-             (webid-oidc testing))
+             (webid-oidc testing)
+             (oop goops))
 
 (with-test-environment
  "jwk-public"
  (lambda ()
    (let ((key
-          '((kty . "RSA") (alg . "RS256") (n . "sV158-MQ-5-sP2iTJibiMap1ug8tNY97laOud3Se_3jd4INq36NwhLpgU3FC5SCfJOs9wehTLzv_hBuo-sW0JNjAEtMEE-SDtx5486gjymDR-5Iwv7bgt25tD0cDgiboZLt1RLn-nP-V3zgYHZa_s9zLjpNyArsWWcSh6tWe2R8yW6BqS8l4_9z8jkKeyAwWmdpkY8BtKS0zZ9yljiCxKvs8CKjfHmrayg45sZ8V1-aRcjtR2ECxATHjE8L96_oNddZ-rj2axf2vTmnkx3OvIMgx0tZ0ycMG6Wy8wxxaR5ir2LV3Gkyfh72U7tI8Q1sokPmH6G62JcduNY66jEQlvQ") (kid . "dedc012d07f52aedfd5f97784e1bcbe23c19724d") (use . "sig") (e . "AQAB"))))
-     (unless (jwk-public? key)
+          (jwk->key
+           '((kty . "RSA")
+             (alg . "RS256")
+             (n . "sV158-MQ-5-sP2iTJibiMap1ug8tNY97laOud3Se_3jd4INq36NwhLpgU3FC5SCfJOs9wehTLzv_hBuo-sW0JNjAEtMEE-SDtx5486gjymDR-5Iwv7bgt25tD0cDgiboZLt1RLn-nP-V3zgYHZa_s9zLjpNyArsWWcSh6tWe2R8yW6BqS8l4_9z8jkKeyAwWmdpkY8BtKS0zZ9yljiCxKvs8CKjfHmrayg45sZ8V1-aRcjtR2ECxATHjE8L96_oNddZ-rj2axf2vTmnkx3OvIMgx0tZ0ycMG6Wy8wxxaR5ir2LV3Gkyfh72U7tI8Q1sokPmH6G62JcduNY66jEQlvQ")
+             (kid . "dedc012d07f52aedfd5f97784e1bcbe23c19724d")
+             (use . "sig")
+             (e . "AQAB")))))
+     (unless (is-a? key <public-key>)
        (exit 1)))))
diff --git a/tests/jwks-get.scm b/tests/jwks-get.scm
index 8e9169e..8f23492 100644
--- a/tests/jwks-get.scm
+++ b/tests/jwks-get.scm
@@ -1,4 +1,4 @@
-;; webid-oidc, implementation of the Solid specification
+;; disfluid, implementation of the Solid specification
 ;; Copyright (C) 2020, 2021  Vivien Kraus
 
 ;; This program is free software: you can redistribute it and/or modify
@@ -19,14 +19,17 @@
              (webid-oidc cache)
              (web uri)
              (srfi srfi-19)
-             (web response))
+             (web response)
+             (oop goops))
 
 (with-test-environment
  "jwks-get"
  (lambda ()
-   (define* (respond uri #:key (headers '()))
+   (define* (respond uri #:key (headers '()) (method 'GET))
      (unless (null? headers)
        (exit 1))
+     (unless (eq? method 'GET)
+       (exit 2))
      (when (string? uri)
        (set! uri (string->uri uri)))
      (if (string=? (uri->string uri) "https://example.com/keys")
@@ -54,16 +57,20 @@
   ]
 }
 ")
-         (exit 2)))
+         (exit 3)))
    (define cache-http-get
      (with-cache
       #:http-get respond))
+   (define* (cache-http-request uri #:key (headers '()) (method 'GET))
+     (unless (eq? method 'GET)
+       (exit 4))
+     (cache-http-get uri #:headers headers))
    (define jwks (get-jwks "https://example.com/keys"
-                          #:http-get cache-http-get))
-   (define keys (jwks-keys jwks))
-   (unless (eq? (length keys) 2)
-     (exit 3))
+                          #:http-request cache-http-request))
+   (define the-keys (keys jwks))
+   (unless (eq? (length the-keys) 2)
+     (exit 5))
    (map (lambda (k)
-          (unless (jwk-public? k)
-            (exit 4)))
-        keys)))
+          (unless (is-a? k <public-key>)
+            (exit 6)))
+        the-keys)))
diff --git a/tests/jws.scm b/tests/jws.scm
index 981e751..a5c9330 100644
--- a/tests/jws.scm
+++ b/tests/jws.scm
@@ -15,13 +15,16 @@
 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 (use-modules (webid-oidc stubs)
+             (webid-oidc jwk)
              (webid-oidc jws)
              (webid-oidc testing))
 
 (with-test-environment
  "jws"
  (lambda ()
-   (let* ((key (json-string->scm "{\"kty\":\"RSA\",\"e\":\"AQAB\",\"kid\":\"db7cdbbf-0ca3-48da-abf6-8f34002a4651\",\"n\":\"nzyis1ZjfNB0bBgKFMSvvkTtwlvBsaJq7S5wA-kzeVOVpVWwkWdVha4s38XM_pa_yr47av7-z3VTmvDRyAHcaT92whREFpLv9cj5lTeJSibyr_Mrm_YtjCZVWgaOYIhwrXwKLqPr_11inWsAkfIytvHWTxZYEcXLgAXFuUuaS3uF9gEiNQwzGTU1v0FqkqTBr4B8nW3HCN47XUu0t8Y0e-lf4s4OxQawWD79J9_5d3Ry0vbV3Am1FtGJiJvOwRsIfVChDpYStTcHTCMqtvWbV6L11BWkpzGXSW4Hv43qa-GSYOD2QU68Mb59oSk2OB-BtOLpJofmbGEGgvmwyCI9Mw\"}"))
+   (let* ((key
+           (jwk->key
+            (json-string->scm "{\"kty\":\"RSA\",\"e\":\"AQAB\",\"kid\":\"db7cdbbf-0ca3-48da-abf6-8f34002a4651\",\"n\":\"nzyis1ZjfNB0bBgKFMSvvkTtwlvBsaJq7S5wA-kzeVOVpVWwkWdVha4s38XM_pa_yr47av7-z3VTmvDRyAHcaT92whREFpLv9cj5lTeJSibyr_Mrm_YtjCZVWgaOYIhwrXwKLqPr_11inWsAkfIytvHWTxZYEcXLgAXFuUuaS3uF9gEiNQwzGTU1v0FqkqTBr4B8nW3HCN47XUu0t8Y0e-lf4s4OxQawWD79J9_5d3Ry0vbV3Am1FtGJiJvOwRsIfVChDpYStTcHTCMqtvWbV6L11BWkpzGXSW4Hv43qa-GSYOD2QU68Mb59oSk2OB-BtOLpJofmbGEGgvmwyCI9Mw\"}")))
           (other-key (generate-key #:n-size 2048))
           (encoded "eyJhbGciOiJQUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiIxMjM0NTY3ODkwIiwibmFtZSI6IkpvaG4gRG9lIiwiYWRtaW4iOnRydWUsImlhdCI6MTUxNjIzOTAyMn0.hZnl5amPk_I3tb4O-Otci_5XZdVWhPlFyVRvcqSwnDo_srcysDvhhKOD01DigPK1lJvTSTolyUgKGtpLqMfRDXQlekRsF4XhAjYZTmcynf-C-6wO5EI4wYewLNKFGGJzHAknMgotJFjDi_NCVSjHsW3a10nTao1lB82FRS305T226Q0VqNVJVWhE4G0JQvi2TssRtCxYTqzXVt22iDKkXeZJARZ1paXHGV5Kd1CljcZtkNZYIGcwnj65gvuCwohbkIxAnhZMJXCLaVvHqv9l-AAUV7esZvkQR1IpwBAiDQJh4qxPjFGylyXrHMqh5NlT_pWL2ZoULWTg_TJjMO9TuQ")
           (expected-alg "PS256")
diff --git a/tests/oidc-configuration.scm b/tests/oidc-configuration.scm
index 983c0f7..7f76280 100644
--- a/tests/oidc-configuration.scm
+++ b/tests/oidc-configuration.scm
@@ -22,10 +22,11 @@
              (web uri)
              (web response)
              (srfi srfi-19)
-             (ice-9 receive))
+             (ice-9 receive)
+             (oop goops))
 
 (with-test-environment
- "jwks-get"
+ "oidc-configuration"
  (lambda ()
    (define* (respond uri #:key (headers '()))
      (unless (null? headers)
@@ -127,7 +128,7 @@
                  #:http-get cache-http-get))
    (unless (oidc-configuration? cfg)
      (exit 3))
-   (unless (jwks? jwks)
+   (unless (is-a? jwks <jwks>)
      (exit 4))
    (let ((my-oidc `((jwks_uri . "https://example.com/keys")
                     (authorization_endpoint . "https://example.com/authorize")
diff --git a/tests/resource-server.scm b/tests/resource-server.scm
index b9f1036..4df742f 100644
--- a/tests/resource-server.scm
+++ b/tests/resource-server.scm
@@ -29,14 +29,15 @@
              (srfi srfi-19)
              (web response)
              (ice-9 optargs)
-             (ice-9 receive))
+             (ice-9 receive)
+             (oop goops))
 
 (with-test-environment
  "resource-server"
  (lambda ()
    (define client-key (generate-key #:n-size 2048))
    (define idp-key (generate-key #:n-size 2048))
-   (define jwks (make-jwks (list idp-key)))
+   (define jwks (make <jwks> #:keys (list idp-key)))
    (define jwks-uri (string->uri "https://identity.provider/keys"))
    (define oidc-config
      `((jwks_uri . ,(uri->string jwks-uri))
@@ -52,7 +53,7 @@
      (cond ((equal? uri oidc-config-uri)
             (serve-oidc-configuration exp oidc-config))
            ((equal? uri jwks-uri)
-            (serve-jwks exp jwks))
+            (serve jwks exp))
            (else (exit 1))))
    (define access-token
      (parameterize ((p:current-date 10))