diff options
Diffstat (limited to 'tests/token-endpoint-issue.scm')
-rw-r--r-- | tests/token-endpoint-issue.scm | 182 |
1 files changed, 99 insertions, 83 deletions
diff --git a/tests/token-endpoint-issue.scm b/tests/token-endpoint-issue.scm index f986e8e..757e650 100644 --- a/tests/token-endpoint-issue.scm +++ b/tests/token-endpoint-issue.scm @@ -14,23 +14,29 @@ ;; 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 token-endpoint) - (webid-oidc authorization-code) - (webid-oidc dpop-proof) - (webid-oidc access-token) - (webid-oidc jwk) - (webid-oidc jws) - (webid-oidc jti) - (webid-oidc testing) - ((webid-oidc stubs) #:prefix stubs:) - ((webid-oidc parameters) #:prefix p:) - (web uri) - (web request) - (web response) - (srfi srfi-19) - (web response) - (ice-9 optargs) - (ice-9 receive)) +(define-module (tests token-endpoint-refresh) + #:use-module (webid-oidc server endpoint) + #:use-module (webid-oidc server endpoint identity-provider) + #:use-module (webid-oidc authorization-code) + #:use-module (webid-oidc refresh-token) + #:use-module (webid-oidc dpop-proof) + #:use-module (webid-oidc jwk) + #:use-module (webid-oidc access-token) + #:use-module (webid-oidc jws) + #:use-module (webid-oidc jti) + #:use-module (webid-oidc testing) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module ((webid-oidc parameters) #:prefix p:) + #:use-module (web uri) + #:use-module (web request) + #:use-module (web response) + #:use-module (srfi srfi-19) + #:use-module (web response) + #:use-module (ice-9 optargs) + #:use-module (ice-9 receive) + #:use-module (oop goops) + #:duplicates (merge-generics) + #:declarative? #t) (with-test-environment "token-endpoint-issue" @@ -46,18 +52,27 @@ (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 endpoint + (make <token-endpoint> + #:issuer "https://issuer.token-endpoint-issue.scm" + #:key-file "key-file.jwk")) (define authz (parameterize ((p:current-date 0)) (issue <authorization-code> key #:webid subject #:client-id client))) - (define endpoint - (make-token-endpoint - (string->uri "https://token-endpoint-issue.scm/token") - issuer "key-file.jwk")) - (receive (response response-body . _) - ;; The code is fake! + (with-exception-handler + (lambda (exn) + (unless (and (web-exception? exn) + (eqv? (web-exception-code exn) 400)) + (raise-exception + (make-exception + (make-exception-with-message + (format #f "the error code should be 400")) + exn)))) + (lambda () + ;; The refresh token is fake! (let ((dpop (parameterize ((p:current-date 0)) (issue <dpop-proof> @@ -67,69 +82,70 @@ #:htu (string->uri "https://token-endpoint-issue.scm/token"))))) (parameterize ((p:current-date 0)) - (endpoint - (build-request (string->uri - "http://localhost:8080/token") - #:headers `((content-type application/x-www-form-urlencoded) - (dpop . ,dpop)) - #:method 'POST - #:port #t) - "grant_type=authorization_code&code=fake"))) - (unless (eq? (response-code response) 400) + (handle endpoint + (build-request (string->uri + "http://localhost:8080/token") + #:headers `((content-type application/x-www-form-urlencoded) + (dpop . ,dpop)) + #:method 'POST + #:port #t) + "grant_type=authorization_code&code=fake"))) (exit 3)) - (receive (response response-body . _) - (let ((dpop - (parameterize ((p:current-date 10)) - (issue <dpop-proof> - client-key - #:jwk (public-key client-key) - #:htm 'POST - #:htu (string->uri - "https://token-endpoint-issue.scm/token"))))) - (parameterize ((p:current-date 10)) - (endpoint - (build-request (string->uri - "http://localhost:8080/token") - #:headers `((content-type application/x-www-form-urlencoded) - (dpop . ,dpop)) - #:method 'POST - #:port #t) - (string-append "grant_type=authorization_code&code=" authz)))) - (unless (eq? (response-code response) 200) - (exit 4)) - (unless (eq? (car (response-content-type response)) 'application/json) - (exit 5)) - (let ((response (stubs:json-string->scm response-body))) - (let ((access-token-enc (assq-ref response 'access_token)) - (refresh-token-enc (assq-ref response 'refresh_token))) - (unless access-token-enc - (exit 6)) - (unless refresh-token-enc - (exit 7)) - (let ((access-token - (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))) - "{ + #:unwind? #t + #:unwind-for-type &web-exception) + (receive (response response-body . _) + (let ((dpop + (parameterize ((p:current-date 10)) + (issue <dpop-proof> + client-key + #:jwk (public-key client-key) + #:htm 'POST + #:htu (string->uri + "https://token-endpoint-issue.scm/token"))))) + (parameterize ((p:current-date 10)) + (handle endpoint + (build-request (string->uri + "http://localhost:8080/token") + #:headers `((content-type application/x-www-form-urlencoded) + (dpop . ,dpop)) + #:method 'POST + #:port #t) + (string-append "grant_type=authorization_code&code=" authz)))) + (unless (eq? (response-code response) 200) + (exit 4)) + (unless (eq? (car (response-content-type response)) 'application/json) + (exit 5)) + (let ((response (stubs:json-string->scm response-body))) + (let ((access-token-enc (assq-ref response 'access_token)) + (refresh-token-enc (assq-ref response 'refresh_token))) + (unless access-token-enc + (exit 6)) + (unless refresh-token-enc + (exit 7)) + (let ((access-token + (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)))))) - (decode <access-token> access-token-enc)))) - (unless access-token - (exit 8)) - (let ((access-token-cnf/jkt (cnf/jkt access-token))) - (unless access-token-cnf/jkt - (exit 9)) - (unless (string=? access-token-cnf/jkt (jkt client-key)) - (exit 10)))))))))) + ((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))) + (unless access-token-cnf/jkt + (exit 9)) + (unless (string=? access-token-cnf/jkt (jkt client-key)) + (exit 10))))))))) |