diff options
Diffstat (limited to 'tests/authorization-endpoint-submit-form.scm')
| -rw-r--r-- | tests/authorization-endpoint-submit-form.scm | 66 |
1 files changed, 42 insertions, 24 deletions
diff --git a/tests/authorization-endpoint-submit-form.scm b/tests/authorization-endpoint-submit-form.scm index 78216a9..de5c76c 100644 --- a/tests/authorization-endpoint-submit-form.scm +++ b/tests/authorization-endpoint-submit-form.scm @@ -15,13 +15,15 @@ ;; along with this program. If not, see <https://www.gnu.org/licenses/>. (define-module (tests authorization-endpoint-submit-form) - #:use-module (webid-oidc authorization-endpoint) #:use-module (webid-oidc authorization-code) + #:use-module (webid-oidc server endpoint) + #:use-module (webid-oidc server endpoint identity-provider) #:use-module (webid-oidc client-manifest) #:use-module (webid-oidc jwk) #:use-module (webid-oidc cache) #:use-module (webid-oidc jti) #:use-module (webid-oidc testing) + #:use-module (webid-oidc errors) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (web uri) @@ -31,6 +33,7 @@ #:use-module (web response) #:use-module (ice-9 optargs) #:use-module (ice-9 receive) + #:use-module (ice-9 exceptions) #:use-module (oop goops) #:declarative? #t #:duplicates (merge-generics)) @@ -54,8 +57,10 @@ (define the-response (car served)) (define the-response-body (cdr served)) (define endpoint - (make-authorization-endpoint - subject encrypted-password "key-file.jwk")) + (make <authorization-endpoint> + #:subject subject + #:encrypted-password encrypted-password + #:key-file "key-file.jwk")) (parameterize ((p:anonymous-http-request (lambda* (uri #:key (headers '()) #:allow-other-keys) (unless (equal? uri what-uri-to-expect) @@ -63,30 +68,43 @@ (values the-response the-response-body)))) (use-cache (lambda () - (receive (response response-body) + (with-exception-handler + (lambda (exn) + (unless (and (web-exception? exn) + (eqv? (web-exception-code exn) 401)) + (raise-exception + (make-exception + (make-exception-with-message + (if (web-exception? exn) + (format #f "the error code should be 401, not ~a" + (web-exception-code exn)) + (format #f "there should be a web error"))) + exn)))) + (lambda () ;; 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) + (handle 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") + (exit 3))) + #:unwind? #t + #:unwind-for-type &web-exception) + (receive (response response-body response-meta) (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) + (handle 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)) |