diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-22 13:11:21 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-22 18:08:47 +0200 |
commit | 555e59deba33284067298ce6130c379c75e3d2a3 (patch) | |
tree | c15c823913e917bc474f1cf163caf65a117ee9c3 /tests | |
parent | 0d74f8c1ca9c1e9bf9a04b85f598ba7a175d1d86 (diff) |
Use anonymous-http-request from (webid-oidc parameters) everywhere
Diffstat (limited to 'tests')
-rw-r--r-- | tests/acl-with-group.scm | 27 | ||||
-rw-r--r-- | tests/acl.scm | 93 | ||||
-rw-r--r-- | tests/authorization-endpoint-get-form.scm | 6 | ||||
-rw-r--r-- | tests/authorization-endpoint-no-args.scm | 7 | ||||
-rw-r--r-- | tests/authorization-endpoint-submit-form.scm | 123 | ||||
-rw-r--r-- | tests/cache-revalidate.scm | 25 | ||||
-rw-r--r-- | tests/client-manifest-fraudulent.scm | 29 | ||||
-rw-r--r-- | tests/client-manifest-public.scm | 5 | ||||
-rw-r--r-- | tests/client-manifest.scm | 99 | ||||
-rw-r--r-- | tests/client-workflow.scm | 2 | ||||
-rw-r--r-- | tests/crud.scm | 25 | ||||
-rw-r--r-- | tests/dpop-proof-no-explicit-exp.scm | 22 | ||||
-rw-r--r-- | tests/jwks-get.scm | 16 | ||||
-rw-r--r-- | tests/oidc-configuration.scm | 74 | ||||
-rw-r--r-- | tests/provider-confirmation.scm | 9 | ||||
-rw-r--r-- | tests/resource-server.scm | 6 | ||||
-rw-r--r-- | tests/token-endpoint-issue.scm | 31 | ||||
-rw-r--r-- | tests/token-endpoint-refresh.scm | 29 |
18 files changed, 303 insertions, 325 deletions
diff --git a/tests/acl-with-group.scm b/tests/acl-with-group.scm deleted file mode 100644 index 3e715d9..0000000 --- a/tests/acl-with-group.scm +++ /dev/null @@ -1,27 +0,0 @@ -;; webid-oidc, implementation of the Solid specification -;; Copyright (C) 2020, 2021 Vivien Kraus - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU Affero General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, or (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU Affero General Public License for more details. - -;; You should have received a copy of the GNU Affero General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -(define (http-get uri) - (unless (equal? uri - (string->uri "https://group-server.example.com/the#group")) - (exit 1) - (values - (build-response #:headers '((content-type text/turtle))) - "@prefix vcard: <http://www.w3.org/2006/vcard/ns#>. - -<#group> a vcard:Group; - vcard:hasMember <https://other-user.example.com/profile/card#me> . -"))) diff --git a/tests/acl.scm b/tests/acl.scm index 3d76c54..9a11eb6 100644 --- a/tests/acl.scm +++ b/tests/acl.scm @@ -17,6 +17,7 @@ (use-modules (webid-oidc server resource wac) (webid-oidc server resource content) (webid-oidc server resource path) + ((webid-oidc parameters) #:prefix p:) (webid-oidc testing) (web http) (web request) @@ -203,54 +204,52 @@ (define (run-test path modes-alice modes-bob modes-fbi modes-anonymous) (define (uri< a b) (string< (uri->string a) (uri->string b))) - (let ((alice (wac-get-modes + (parameterize + ((p:anonymous-http-request http-get)) + (let ((alice (wac-get-modes + server-name path + (string->uri "https://alice.databox.me/profile/card#me"))) + (bob (wac-get-modes server-name path - (string->uri "https://alice.databox.me/profile/card#me") - #:http-get http-get)) - (bob (wac-get-modes - server-name path - (string->uri "https://bob.databox.me/profile/card#me") - #:http-get http-get)) - (fbi (wac-get-modes - server-name path - (string->uri "https://the-spy.databox.me/profile/card#me") - #:http-get http-get)) - (anonymous (wac-get-modes - server-name path - #f - #:http-get http-get))) - (unless (equal? alice - modes-alice) - (format (current-error-port) - "Alice’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" - path - (map uri->string modes-alice) - (map uri->string alice)) - (exit 2)) - (unless (equal? bob - modes-bob) - (format (current-error-port) - "Bob’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" - path - (map uri->string modes-bob) - (map uri->string bob)) - (exit 3)) - (unless (equal? fbi - modes-fbi) - (format (current-error-port) - "Spy’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" - path - (map uri->string modes-fbi) - (map uri->string fbi)) - (exit 4)) - (unless (equal? anonymous - modes-anonymous) - (format (current-error-port) - "Anonymous modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" - path - (map uri->string modes-anonymous) - (map uri->string anonymous)) - (exit 5)))) + (string->uri "https://bob.databox.me/profile/card#me"))) + (fbi (wac-get-modes + server-name path + (string->uri "https://the-spy.databox.me/profile/card#me"))) + (anonymous (wac-get-modes + server-name path + #f))) + (unless (equal? alice + modes-alice) + (format (current-error-port) + "Alice’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" + path + (map uri->string modes-alice) + (map uri->string alice)) + (exit 2)) + (unless (equal? bob + modes-bob) + (format (current-error-port) + "Bob’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" + path + (map uri->string modes-bob) + (map uri->string bob)) + (exit 3)) + (unless (equal? fbi + modes-fbi) + (format (current-error-port) + "Spy’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" + path + (map uri->string modes-fbi) + (map uri->string fbi)) + (exit 4)) + (unless (equal? anonymous + modes-anonymous) + (format (current-error-port) + "Anonymous modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" + path + (map uri->string modes-anonymous) + (map uri->string anonymous)) + (exit 5))))) (let ((read (string->uri "http://www.w3.org/ns/auth/acl#Read")) (write (string->uri "http://www.w3.org/ns/auth/acl#Write")) (control (string->uri "http://www.w3.org/ns/auth/acl#Control"))) diff --git a/tests/authorization-endpoint-get-form.scm b/tests/authorization-endpoint-get-form.scm index 6830df8..27f22f9 100644 --- a/tests/authorization-endpoint-get-form.scm +++ b/tests/authorization-endpoint-get-form.scm @@ -32,13 +32,9 @@ (define key (generate-key #:n-size 2048)) (define subject (string->uri "https://authorization-endpoint-get-form.scm/profile/card#me")) (define password "p4ssw0rd") - (define validity 120) - (define* (http-get uri #:key (headers '())) - (exit 2)) (define endpoint (make-authorization-endpoint - subject password key validity - #:http-get http-get)) + subject password key)) (receive (response response-body) (parameterize ((p:current-date 0)) (endpoint diff --git a/tests/authorization-endpoint-no-args.scm b/tests/authorization-endpoint-no-args.scm index a9661cd..164e345 100644 --- a/tests/authorization-endpoint-no-args.scm +++ b/tests/authorization-endpoint-no-args.scm @@ -32,13 +32,8 @@ (define key (generate-key #:n-size 2048)) (define subject (string->uri "https://authorization-endpoint-get-form.scm/profile/card#me")) (define password "p4ssw0rd") - (define validity 120) - (define* (http-get uri #:key (headers '())) - (exit 2)) (define endpoint - (make-authorization-endpoint - subject password key validity - #:http-get http-get)) + (make-authorization-endpoint subject password key)) (receive (response response-body) (parameterize ((p:current-date 0)) (endpoint diff --git a/tests/authorization-endpoint-submit-form.scm b/tests/authorization-endpoint-submit-form.scm index 2fc7197..3de3e19 100644 --- a/tests/authorization-endpoint-submit-form.scm +++ b/tests/authorization-endpoint-submit-form.scm @@ -39,7 +39,6 @@ (define redirect (string->uri "https://authorization-endpoint-submit-form.scm/client/redirect")) (define password "p4ssw0rd") (define encrypted-password (crypt password "$6$this.is.the.salt")) - (define validity 120) (define what-uri-to-expect client) (define served (receive (response response-body) @@ -49,66 +48,66 @@ (cons response response-body))) (define the-response (car served)) (define the-response-body (cdr served)) - (define* (http-get uri #:key (headers '())) - (unless (equal? uri what-uri-to-expect) - (exit 2)) - (values the-response the-response-body)) - (define cached-http-get - (with-cache #:http-get http-get)) (define endpoint (make-authorization-endpoint - subject encrypted-password key validity - #:http-get cached-http-get)) - (receive (response response-body) - ;; The password is fake! - (parameterize ((p:current-date 0)) - (endpoint - (build-request (string->uri - (format #f "https://authorization-endpoint-submit-form.scm/authorize?client_id=~a&redirect_uri=~a" - (uri-encode (uri->string client)) - (uri-encode (uri->string redirect)))) - #:headers '((content-type application/x-www-form-urlencoded)) - #:method 'POST - #:port #t) - "password=fake")) - (when (eq? (response-code response) 302) - (exit 3))) - (receive (response response-body) - (parameterize ((p:current-date 0)) - (endpoint - (build-request (string->uri - (format #f "https://authorization-endpoint-submit-form.scm/authorize?client_id=~a&redirect_uri=~a" - (uri-encode (uri->string client)) - (uri-encode (uri->string redirect)))) - #:headers '((content-type application/x-www-form-urlencoded)) - #:method 'POST - #:port #t) - "password=p4ssw0rd")) - (unless (eq? (response-code response) 302) - (exit 4)) - (let ((loc (response-location response))) - (unless (uri? loc) - (exit 5)) - (let ((loc-scheme (uri-scheme loc)) - (loc-host (uri-host loc)) - (loc-path (uri-path loc)) - (loc-query (uri-query loc))) - (unless (eq? loc-scheme 'https) - (exit 6)) - (unless (string=? loc-host "authorization-endpoint-submit-form.scm") - (exit 7)) - (unless (string=? loc-path "/client/redirect") - (exit 8)) - (let* ((kv (string-split loc-query #\&)) - (args (map (lambda (x) - (map uri-decode (string-split x #\=))) - kv))) - (unless (assoc-ref args "code") - (exit 9)) - (let ((parsed - (parameterize ((p:current-date 60)) - (decode <authorization-code> - (car (assoc-ref args "code")) - #:issuer-key key)))) - (unless parsed - (exit 10))))))))) + subject encrypted-password key)) + (parameterize ((p:anonymous-http-request + (lambda* (uri #:key (headers '()) #:allow-other-keys) + (unless (equal? uri what-uri-to-expect) + (exit 2)) + (values the-response the-response-body)))) + (use-cache + (lambda () + (receive (response response-body) + ;; The password is fake! + (parameterize ((p:current-date 0)) + (endpoint + (build-request (string->uri + (format #f "https://authorization-endpoint-submit-form.scm/authorize?client_id=~a&redirect_uri=~a" + (uri-encode (uri->string client)) + (uri-encode (uri->string redirect)))) + #:headers '((content-type application/x-www-form-urlencoded)) + #:method 'POST + #:port #t) + "password=fake")) + (when (eq? (response-code response) 302) + (exit 3))) + (receive (response response-body) + (parameterize ((p:current-date 0)) + (endpoint + (build-request (string->uri + (format #f "https://authorization-endpoint-submit-form.scm/authorize?client_id=~a&redirect_uri=~a" + (uri-encode (uri->string client)) + (uri-encode (uri->string redirect)))) + #:headers '((content-type application/x-www-form-urlencoded)) + #:method 'POST + #:port #t) + "password=p4ssw0rd")) + (unless (eq? (response-code response) 302) + (exit 4)) + (let ((loc (response-location response))) + (unless (uri? loc) + (exit 5)) + (let ((loc-scheme (uri-scheme loc)) + (loc-host (uri-host loc)) + (loc-path (uri-path loc)) + (loc-query (uri-query loc))) + (unless (eq? loc-scheme 'https) + (exit 6)) + (unless (string=? loc-host "authorization-endpoint-submit-form.scm") + (exit 7)) + (unless (string=? loc-path "/client/redirect") + (exit 8)) + (let* ((kv (string-split loc-query #\&)) + (args (map (lambda (x) + (map uri-decode (string-split x #\=))) + kv))) + (unless (assoc-ref args "code") + (exit 9)) + (let ((parsed + (parameterize ((p:current-date 60)) + (decode <authorization-code> + (car (assoc-ref args "code")) + #:issuer-key key)))) + (unless parsed + (exit 10)))))))))))) diff --git a/tests/cache-revalidate.scm b/tests/cache-revalidate.scm index caa6e3e..a4eab3e 100644 --- a/tests/cache-revalidate.scm +++ b/tests/cache-revalidate.scm @@ -16,6 +16,7 @@ (use-modules (webid-oidc cache) (webid-oidc testing) + ((webid-oidc parameters) #:prefix p:) (web uri) (web request) (web response) @@ -44,15 +45,15 @@ (build-response #:code 304 #:reason-phrase "Not Modified" #:headers `((date . ,(time-utc->date (make-time time-utc 0 10))))) #f)) - (receive (response response-body) - (revalidate (string->uri "https://example.com") original-response "hello" - #:headers `((if-none-match . ("yyy" . #t)) - (if-unmodified-since . ,(time-utc->date (make-time time-utc 0 42))) - (user-agent . "Testbed")) - #:http-get backend) - (unless (eqv? (response-code response) 200) - (exit 5)) - (unless (equal? (response-headers response) - `((date . ,(time-utc->date (make-time time-utc 0 10))) - (content-type text/plain))) - (exit 6))))) + (parameterize ((p:anonymous-http-request backend)) + (receive (response response-body) + (revalidate (string->uri "https://example.com") original-response "hello" + #:headers `((if-none-match . ("yyy" . #t)) + (if-unmodified-since . ,(time-utc->date (make-time time-utc 0 42))) + (user-agent . "Testbed"))) + (unless (eqv? (response-code response) 200) + (exit 5)) + (unless (equal? (response-headers response) + `((date . ,(time-utc->date (make-time time-utc 0 10))) + (content-type text/plain))) + (exit 6)))))) diff --git a/tests/client-manifest-fraudulent.scm b/tests/client-manifest-fraudulent.scm index a1bfe20..548f6c1 100644 --- a/tests/client-manifest-fraudulent.scm +++ b/tests/client-manifest-fraudulent.scm @@ -17,6 +17,7 @@ (use-modules (webid-oidc client-manifest) (webid-oidc cache) (webid-oidc testing) + ((webid-oidc parameters) #:prefix p:) (webid-oidc errors) (web uri) (srfi srfi-19) @@ -58,17 +59,17 @@ (unless (equal? headers headers-to-expect) (exit 2)) (values what-to-respond what-to-respond-body)) - (define cache-http-get - (with-cache - #:http-get respond)) - (with-exception-handler - (lambda (error) - (unless (inconsistent-client-manifest? error) - (exit 3))) - (lambda () - (get-client-manifest - (string->uri "https://fraudulent-app.example.com/id#app") - #:http-get cache-http-get) - (exit 4)) - #:unwind? #t - #:unwind-for-type &inconsistent-client-manifest))) + (parameterize ((p:anonymous-http-request respond)) + (use-cache + (lambda () + (with-exception-handler + (lambda (error) + (unless (inconsistent-client-manifest? error) + (exit 3))) + (lambda () + (parameterize ((p:current-date 0)) + (get-client-manifest + (string->uri "https://fraudulent-app.example.com/id#app"))) + (exit 4)) + #:unwind? #t + #:unwind-for-type &inconsistent-client-manifest)))))) diff --git a/tests/client-manifest-public.scm b/tests/client-manifest-public.scm index 76eb8ba..f4e0bd5 100644 --- a/tests/client-manifest-public.scm +++ b/tests/client-manifest-public.scm @@ -26,10 +26,7 @@ (lambda () (define mf (get-client-manifest - (string->uri "http://www.w3.org/ns/solid/terms#PublicOidcClient") - #:http-get - (lambda args - (exit 1)))) + (string->uri "http://www.w3.org/ns/solid/terms#PublicOidcClient"))) (define id (client-manifest-client-id mf)) (unless (equal? id (string->uri "http://www.w3.org/ns/solid/terms#PublicOidcClient")) (exit 2)) diff --git a/tests/client-manifest.scm b/tests/client-manifest.scm index 8e98091..7f8e130 100644 --- a/tests/client-manifest.scm +++ b/tests/client-manifest.scm @@ -14,15 +14,17 @@ ;; You should have received a copy of the GNU Affero General Public License ;; along with this program. If not, see <https://www.gnu.org/licenses/>. -(use-modules (webid-oidc client-manifest) - (webid-oidc cache) - (webid-oidc testing) - (webid-oidc errors) - (web uri) - (srfi srfi-19) - (web response) - (ice-9 optargs) - (ice-9 receive)) +(define-module (tests client-manifest) + #:use-module (webid-oidc client-manifest) + #:use-module (webid-oidc cache) + #:use-module (webid-oidc testing) + #:use-module ((webid-oidc parameters) #:prefix p:) + #:use-module (webid-oidc errors) + #:use-module (web uri) + #:use-module (srfi srfi-19) + #:use-module (web response) + #:use-module (ice-9 optargs) + #:use-module (ice-9 receive)) (with-test-environment "client-manifest" @@ -52,42 +54,43 @@ (string->uri "https://app.example.com/id#app")) (exit 2)) (values what-to-respond what-to-respond-body)) - (define cache-http-get - (with-cache - #:http-get respond)) - (define mf - (get-client-manifest - (string->uri "https://app.example.com/id#app") - #:http-get cache-http-get)) - (define id (client-manifest-client-id mf)) - (unless (equal? id (string->uri "https://app.example.com/id#app")) - (exit 3)) - (unless (client-manifest-check-redirect-uri mf "https://app.example.com/callback") - (exit 4)) - (with-exception-handler - (lambda (error) - (unless (unauthorized-redirect-uri? error) - (exit 5))) - (lambda () - (client-manifest-check-redirect-uri mf "https://fraudulent-app.example.com/callback") - (exit 55)) - #:unwind? #t - #:unwind-for-type &unauthorized-redirect-uri) - (receive (response response-body) - (serve-client-manifest - (time-utc->date (make-time time-utc 0 3600)) - mf) - (unless (equal? (response-content-type response) '(application/ld+json)) - (exit 6)) - (set! what-to-respond response) - (set! what-to-respond-body response-body) - (let ((re-parsed (get-client-manifest - (string->uri "https://app.example.com/id#app") - #:http-get cache-http-get))) - (map (lambda (key) - (unless (equal? (assq-ref mf key) - (assq-ref re-parsed key)) - (exit 9))) - '(client_id redirect_uris client_name client_uri - logo_uri tos_uri scope grant_types response_types - default_max_age require_auth_time)))))) + (parameterize ((p:anonymous-http-request respond)) + (use-cache + (lambda () + (define mf + (parameterize ((p:current-date 0)) + (get-client-manifest + (string->uri "https://app.example.com/id#app")))) + (define id (client-manifest-client-id mf)) + (unless (equal? id (string->uri "https://app.example.com/id#app")) + (exit 3)) + (unless (client-manifest-check-redirect-uri mf "https://app.example.com/callback") + (exit 4)) + (with-exception-handler + (lambda (error) + (unless (unauthorized-redirect-uri? error) + (exit 5))) + (lambda () + (client-manifest-check-redirect-uri mf "https://fraudulent-app.example.com/callback") + (exit 55)) + #:unwind? #t + #:unwind-for-type &unauthorized-redirect-uri) + (receive (response response-body) + (serve-client-manifest + (time-utc->date (make-time time-utc 0 3600)) + mf) + (unless (equal? (response-content-type response) '(application/ld+json)) + (exit 6)) + (set! what-to-respond response) + (set! what-to-respond-body response-body) + (let ((re-parsed + (parameterize ((p:current-date 10)) + (get-client-manifest + (string->uri "https://app.example.com/id#app"))))) + (map (lambda (key) + (unless (equal? (assq-ref mf key) + (assq-ref re-parsed key)) + (exit 9))) + '(client_id redirect_uris client_name client_uri + logo_uri tos_uri scope grant_types response_types + default_max_age require_auth_time))))))))) diff --git a/tests/client-workflow.scm b/tests/client-workflow.scm index 50514d8..9c74198 100644 --- a/tests/client-workflow.scm +++ b/tests/client-workflow.scm @@ -75,7 +75,7 @@ #:client-id "https://client@client-workflow.scm/id" #:redirect-uri (string->uri "https://client@client-workflow.scm/authorized"))) - (client:anonymous-http-request + (p:anonymous-http-request (cute sim:request simulation <...>))) (parameterize ((p:current-date 0) (client:authorization-process diff --git a/tests/crud.scm b/tests/crud.scm index 40ec7b1..fa33138 100644 --- a/tests/crud.scm +++ b/tests/crud.scm @@ -22,6 +22,7 @@ (webid-oidc server resource path) (webid-oidc errors) (webid-oidc testing) + ((webid-oidc parameters) #:prefix p:) (webid-oidc fetch) (webid-oidc rdf-index) (web http) @@ -158,12 +159,12 @@ (when (cdr etag) (exit 15)) (with-index - (fetch "https://example.com/" - #:http-get - (lambda (uri . rest) - (values - (build-response #:headers `((content-type . ,content-type))) - root))) + (parameterize ((p:anonymous-http-request + (lambda (uri . rest) + (values + (build-response #:headers `((content-type . ,content-type))) + root)))) + (fetch "https://example.com/")) (lambda (rdf-match) (when (null? (rdf-match "https://example.com/" "http://www.w3.org/ns/ldp#contains" @@ -199,12 +200,12 @@ (when (cdr etag) (exit 22)) (with-index - (fetch "https://example.com/.acl" - #:http-get - (lambda (uri . rest) - (values - (build-response #:headers `((content-type . ,content-type))) - /.acl))) + (parameterize ((p:anonymous-http-request + (lambda (uri . rest) + (values + (build-response #:headers `((content-type . ,content-type))) + /.acl)))) + (fetch "https://example.com/.acl")) (lambda (rdf-match) (when (null? (rdf-match #f "http://www.w3.org/1999/02/22-rdf-syntax-ns#type" diff --git a/tests/dpop-proof-no-explicit-exp.scm b/tests/dpop-proof-no-explicit-exp.scm index c485cac..5a4ccbc 100644 --- a/tests/dpop-proof-no-explicit-exp.scm +++ b/tests/dpop-proof-no-explicit-exp.scm @@ -26,18 +26,34 @@ (srfi srfi-19) (web response) (ice-9 receive) + (ice-9 optargs) (oop goops)) (define-class <dpop-proof-with-exp> (<dpop-proof>)) +(define-method (initialize (token <dpop-proof-with-exp>) initargs) + (next-method) + ;; Override exp + (let-keywords + initargs #t + ((validity #f)) + (slot-set! token 'exp + (let ((iat (time-second (date->time-utc (iat token))))) + (time-utc->date + (make-time time-utc 0 + (+ iat validity))))))) + (define malicious-jwt-created? #f) (define-method (token->jwt (token <dpop-proof-with-exp>)) (set! malicious-jwt-created? #t) (receive (header payload) (next-method) - (values header - `((exp . ,(time-second (date->time-utc (exp token)))) - ,@payload)))) + (let ((exp (time-second (date->time-utc (exp token))))) + (unless (equal? exp 3600) + (exit 3)) + (values header + `((exp . ,exp) + ,@payload))))) (with-test-environment "dpop-proof-no-explicit-exp" diff --git a/tests/jwks-get.scm b/tests/jwks-get.scm index 8f23492..ffc0bbb 100644 --- a/tests/jwks-get.scm +++ b/tests/jwks-get.scm @@ -16,6 +16,7 @@ (use-modules (webid-oidc jwk) (webid-oidc testing) + ((webid-oidc parameters) #:prefix p:) (webid-oidc cache) (web uri) (srfi srfi-19) @@ -58,15 +59,12 @@ } ") (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-request cache-http-request)) + (define jwks + (parameterize ((p:anonymous-http-request respond) + (p:current-date 0)) ;; the cache requires it + (use-cache + (lambda () + (get-jwks "https://example.com/keys"))))) (define the-keys (keys jwks)) (unless (eq? (length the-keys) 2) (exit 5)) diff --git a/tests/oidc-configuration.scm b/tests/oidc-configuration.scm index 736c3f8..3d31b9d 100644 --- a/tests/oidc-configuration.scm +++ b/tests/oidc-configuration.scm @@ -120,43 +120,41 @@ \"solid_oidc_supported\": \"https://solidproject.org/TR/solid-oidc\" }")) (else (exit 2)))) - (define cache-http-get - (with-cache - #:http-get respond)) - (define cfg - (make <oidc-configuration> - #:server "example.com" - #:http-request cache-http-get)) - (define my-jwks - (parameterize ((p:anonymous-http-request cache-http-get)) - (jwks cfg))) - (unless (is-a? cfg <oidc-configuration>) - (exit 3)) - (unless (is-a? my-jwks <jwks>) - (exit 4)) - (let ((my-oidc + (parameterize ((p:anonymous-http-request respond) + (p:current-date 0)) ;; for the cache + (use-cache + (lambda () + (define cfg (make <oidc-configuration> - #:jwks-uri "https://example.com/keys" - #:authorization-endpoint "https://example.com/authorize" - #:token-endpoint "https://example.com/token" - #:solid-oidc-supported "https://solidproject.org/TR/solid-oidc"))) - (receive (response response-body) - (serve my-oidc (time-utc->date (make-time time-utc 0 3600))) - (unless (eqv? (car (response-content-type response)) 'application/json) - (exit 5)) - (let ((parsed - (->json-data + #:server "example.com")) + (define my-jwks (jwks cfg)) + (unless (is-a? cfg <oidc-configuration>) + (exit 3)) + (unless (is-a? my-jwks <jwks>) + (exit 4)) + (let ((my-oidc (make <oidc-configuration> - #:json-data (stubs:json-string->scm response-body))))) - (unless (equal? (assq-ref parsed 'jwks_uri) - "https://example.com/keys") - (exit 7)) - (unless (equal? (assq-ref parsed 'authorization_endpoint) - "https://example.com/authorize") - (exit 8)) - (unless (equal? (assq-ref parsed 'token_endpoint) - "https://example.com/token") - (exit 9)) - (unless (equal? (assq-ref parsed 'solid_oidc_supported) - "https://solidproject.org/TR/solid-oidc") - (exit 10))))))) + #:jwks-uri "https://example.com/keys" + #:authorization-endpoint "https://example.com/authorize" + #:token-endpoint "https://example.com/token" + #:solid-oidc-supported "https://solidproject.org/TR/solid-oidc"))) + (receive (response response-body) + (serve my-oidc (time-utc->date (make-time time-utc 0 3600))) + (unless (eqv? (car (response-content-type response)) 'application/json) + (exit 5)) + (let ((parsed + (->json-data + (make <oidc-configuration> + #:json-data (stubs:json-string->scm response-body))))) + (unless (equal? (assq-ref parsed 'jwks_uri) + "https://example.com/keys") + (exit 7)) + (unless (equal? (assq-ref parsed 'authorization_endpoint) + "https://example.com/authorize") + (exit 8)) + (unless (equal? (assq-ref parsed 'token_endpoint) + "https://example.com/token") + (exit 9)) + (unless (equal? (assq-ref parsed 'solid_oidc_supported) + "https://solidproject.org/TR/solid-oidc") + (exit 10)))))))))) diff --git a/tests/provider-confirmation.scm b/tests/provider-confirmation.scm index fe9f4a2..e326ac8 100644 --- a/tests/provider-confirmation.scm +++ b/tests/provider-confirmation.scm @@ -16,6 +16,7 @@ (use-modules (webid-oidc provider-confirmation) (webid-oidc testing) + ((webid-oidc parameters) #:prefix p:) (web uri) (srfi srfi-19) (web response) @@ -42,9 +43,11 @@ (unless (equal? headers what-headers-to-expect) (exit 2)) (values what-to-respond what-to-respond-body)) - (define cnf (get-provider-confirmations - (string->uri "https://provider-confirmation.scm/id#webid") - #:http-get http-get)) + (define cnf + (parameterize + ((p:anonymous-http-request http-get)) + (get-provider-confirmations + (string->uri "https://provider-confirmation.scm/id#webid")))) (unless (eq? (length cnf) 2) (format (current-error-port) "~s\n" cnf) (exit 3)) diff --git a/tests/resource-server.scm b/tests/resource-server.scm index 89df999..767088d 100644 --- a/tests/resource-server.scm +++ b/tests/resource-server.scm @@ -92,10 +92,10 @@ DPoP: ~a\r\n\r\n" (define rq-body "") (define authenticator (make-authenticator - #:server-uri server-uri - #:http-get http-get)) + #:server-uri server-uri)) (define parsed - (parameterize ((p:current-date 20)) + (parameterize ((p:current-date 20) + (p:anonymous-http-request http-get)) (authenticator rq rq-body))) (unless (uri? parsed) (exit 2)) diff --git a/tests/token-endpoint-issue.scm b/tests/token-endpoint-issue.scm index 0815c30..8fdd1ad 100644 --- a/tests/token-endpoint-issue.scm +++ b/tests/token-endpoint-issue.scm @@ -40,7 +40,6 @@ (define subject (string->uri "https://token-endpoint-issue.scm/profile/card#me")) (define client (string->uri "https://token-endpoint-issue.scm/client/card#app")) (define issuer (string->uri "https://issuer.token-endpoint-issue.scm")) - (define validity 3600) (define authz (parameterize ((p:current-date 0)) (issue <authorization-code> @@ -50,7 +49,7 @@ (define endpoint (make-token-endpoint (string->uri "https://token-endpoint-issue.scm/token") - issuer key validity)) + issuer key)) (receive (response response-body . _) ;; The code is fake! (let ((dpop @@ -103,25 +102,25 @@ (unless refresh-token-enc (exit 7)) (let ((access-token - (parameterize ((p:current-date 20)) - (decode <access-token> access-token-enc - #:http-request - (lambda* (uri . args) - (cond - ((equal? uri (string->uri "https://issuer.token-endpoint-issue.scm/.well-known/openid-configuration")) - (values (build-response #:headers '((content-type application/json))) - "{ + (parameterize ((p:current-date 20) + (p:anonymous-http-request + (lambda* (uri . args) + (cond + ((equal? uri (string->uri "https://issuer.token-endpoint-issue.scm/.well-known/openid-configuration")) + (values (build-response #:headers '((content-type application/json))) + "{ \"jwks_uri\": \"https://token-endpoint-issue.scm/keys\", \"token_endpoint\": \"https://token-endpoint-issue.scm/token\", \"authorization_endpoint\": \"https://token-endpoint-issue.scm/authorize\", \"solid_oidc_supported\": \"https://solidproject.org/TR/solid-oidc\" }")) - ((equal? uri (string->uri "https://token-endpoint-issue.scm/keys")) - (values (build-response #:headers '((content-type application/json))) - (stubs:scm->json-string `((keys . ,(list->vector (list (key->jwk key)))))))) - (else - (format (current-error-port) "Unknown URI: ~s\n" (uri->string uri)) - (exit 11)))))))) + ((equal? uri (string->uri "https://token-endpoint-issue.scm/keys")) + (values (build-response #:headers '((content-type application/json))) + (stubs:scm->json-string `((keys . ,(list->vector (list (key->jwk key)))))))) + (else + (format (current-error-port) "Unknown URI: ~s\n" (uri->string uri)) + (exit 11)))))) + (decode <access-token> access-token-enc)))) (unless access-token (exit 8)) (let ((access-token-cnf/jkt (cnf/jkt access-token))) diff --git a/tests/token-endpoint-refresh.scm b/tests/token-endpoint-refresh.scm index f0174b8..90e2625 100644 --- a/tests/token-endpoint-refresh.scm +++ b/tests/token-endpoint-refresh.scm @@ -41,12 +41,11 @@ (define subject (string->uri "https://token-endpoint-issue.scm/profile/card#me")) (define client (string->uri "https://token-endpoint-issue.scm/client/card#app")) (define issuer (string->uri "https://issuer.token-endpoint-issue.scm")) - (define validity 3600) (define refresh-code (issue-refresh-token subject client (jkt client-key))) (define endpoint (make-token-endpoint (string->uri "https://token-endpoint-issue.scm/token") - issuer key validity)) + issuer key)) (receive (response response-body . _) ;; The refresh token is fake! (let ((dpop @@ -98,24 +97,24 @@ (unless refresh-token-enc (exit 7)) (let ((access-token - (parameterize ((p:current-date 20)) - (decode <access-token> access-token-enc - #:http-request - (lambda* (uri . args) - (cond - ((equal? uri (string->uri "https://issuer.token-endpoint-issue.scm/.well-known/openid-configuration")) - (values (build-response #:headers '((content-type application/json))) - "{ + (parameterize ((p:current-date 20) + (p:anonymous-http-request + (lambda* (uri . args) + (cond + ((equal? uri (string->uri "https://issuer.token-endpoint-issue.scm/.well-known/openid-configuration")) + (values (build-response #:headers '((content-type application/json))) + "{ \"jwks_uri\": \"https://token-endpoint-issue.scm/keys\", \"token_endpoint\": \"https://token-endpoint-issue.scm/token\", \"authorization_endpoint\": \"https://token-endpoint-issue.scm/authorize\", \"solid_oidc_supported\": \"https://solidproject.org/TR/solid-oidc\" }")) - ((equal? uri (string->uri "https://token-endpoint-issue.scm/keys")) - (values (build-response #:headers '((content-type application/json))) - (stubs:scm->json-string `((keys . ,(list->vector (list (key->jwk key)))))))) - (else - (exit 8)))))))) + ((equal? uri (string->uri "https://token-endpoint-issue.scm/keys")) + (values (build-response #:headers '((content-type application/json))) + (stubs:scm->json-string `((keys . ,(list->vector (list (key->jwk key)))))))) + (else + (exit 8)))))) + (decode <access-token> access-token-enc)))) (unless access-token (exit 9)) (let ((access-token-cnf/jkt (cnf/jkt access-token))) |