diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-16 23:03:12 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-21 22:25:03 +0200 |
commit | fa486f2e136a898d1b1548ec90757a78c65a0b70 (patch) | |
tree | 7601f939c6859547cc2df38e587c5d9473bae76d /tests | |
parent | 86bd90866fdc2ab5234c6e09e39bfa972f7fa395 (diff) |
JWK: document it, and use GOOPS
Diffstat (limited to 'tests')
-rw-r--r-- | tests/dpop-proof-valid.scm | 2 | ||||
-rw-r--r-- | tests/jwk-kty-rsa-incorrect.scm | 21 | ||||
-rw-r--r-- | tests/jwk-public.scm | 15 | ||||
-rw-r--r-- | tests/jwks-get.scm | 29 | ||||
-rw-r--r-- | tests/jws.scm | 5 | ||||
-rw-r--r-- | tests/oidc-configuration.scm | 7 | ||||
-rw-r--r-- | tests/resource-server.scm | 7 |
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 ¬-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 ¬-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)) |