diff options
Diffstat (limited to 'tests/client-token.scm')
| -rw-r--r-- | tests/client-token.scm | 137 |
1 files changed, 0 insertions, 137 deletions
diff --git a/tests/client-token.scm b/tests/client-token.scm deleted file mode 100644 index 576019a..0000000 --- a/tests/client-token.scm +++ /dev/null @@ -1,137 +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/>. - -(use-modules (webid-oidc client) - (webid-oidc testing) - (webid-oidc token-endpoint) - (webid-oidc jwk) - (webid-oidc authorization-code) - (webid-oidc oidc-configuration) - (webid-oidc jws) - (webid-oidc oidc-id-token) - ((webid-oidc parameters) #:prefix p:) - (web uri) - (web request) - (web response) - (srfi srfi-19) - (ice-9 optargs) - (ice-9 receive) - (ice-9 hash-table)) - -(with-test-environment - "client-token" - (lambda () - (define the-current-time 0) - (parameterize ((p:current-date (lambda () the-current-time))) - (define issuer-key (generate-key #:n-size 2048)) - (define issuer-configuration - (make-oidc-configuration - "https://issuer.client-token.scm/keys" - "https://issuer.client-token.scm/authorize" - "https://issuer.client-token.scm/token")) - (define token-endpoint (make-token-endpoint - (string->uri "https://issuer.client-token.scm/token") - (string->uri "https://issuer.client-token.scm") - 'RS256 - issuer-key - 3600)) - (define client-key (generate-key #:n-size 2048)) - (define authorization-code - (issue-authorization-code 'RS256 issuer-key 120 - (string->uri "https://client-token.scm/profile/card#me") - (string->uri "https://app.client-token.scm/app#id"))) - (define* (http-get uri #:key (headers '())) - (cond - ((equal? uri (string->uri "https://issuer.client-token.scm/.well-known/openid-configuration")) - (serve-oidc-configuration - (time-utc->date (make-time time-utc 0 (+ the-current-time 3600))) - issuer-configuration)) - ((equal? uri (string->uri "https://issuer.client-token.scm/keys")) - (serve-jwks - (time-utc->date (make-time time-utc 0 (+ the-current-time 3600))) - (make-jwks (list issuer-key)))) - (else - (format (current-error-port) "GET request to ~a: error.\n" (uri->string uri)) - (exit 1)))) - (define* (http-post uri #:key (body #f) (headers '())) - (unless (equal? uri (oidc-configuration-token-endpoint issuer-configuration)) - (format (current-error-port) - "Wrong URI for token negociation: ~a (expected ~a).\n" - (uri->string uri) - (uri->string - (oidc-configuration-token-endpoint - issuer-configuration))) - (exit 2)) - (unless (equal? body (format #f "grant_type=authorization_code&code=~a" - authorization-code)) - (format (current-error-port) - "Wrong body: ~s\n" body) - (exit 3)) - (unless (equal? - (assoc-ref headers 'content-type) - '(application/x-www-form-urlencoded)) - (format (current-error-port) - "Wrong content type: ~s\n" (assoc-ref headers 'content-type)) - (exit 4)) - (let ((request - (build-request uri - #:method 'POST - #:headers headers - #:port (open-input-string body))) - (request-body body)) - (receive (response response-body user error) - (token-endpoint request request-body) - (values response response-body)))) - (let ((response - (token "https://issuer.client-token.scm" - client-key - #:authorization-code authorization-code - #:http-get http-get - #:http-post http-post))) - (let ((id-token (assq-ref response 'id_token)) - (access-token (assq-ref response 'access_token)) - (token-type (assq-ref response 'token_type)) - (token-expiration (assq-ref response 'expires_in)) - (refresh-token (assq-ref response 'refresh_token))) - (let ((id-token-dec (id-token-decode id-token #:http-get http-get)) - (access-token-dec (jws-decode access-token (lambda (jws) issuer-key)))) - (unless id-token-dec - (format (current-error-port) "Could not decode the ID token from ~s (~s)" - id-token response) - (exit 5)) - (unless access-token-dec - (format (current-error-port) "Could not decode the access token from ~s (~s)" - access-token response) - (exit 6)) - (unless refresh-token - (format (current-error-port) "There does not seem to be a refresh token in ~s" - response) - (exit 6)) - (unless (equal? (id-token-webid id-token-dec) - (string->uri "https://client-token.scm/profile/card#me")) - (exit 7)) - (unless (equal? (id-token-iss id-token-dec) - (string->uri "https://issuer.client-token.scm")) - (exit 8)) - (unless (equal? (id-token-aud id-token-dec) - (string->uri "https://app.client-token.scm/app#id")) - (exit 9)) - ;; It’s not the job of the client to check that the access - ;; token is correct; TODO: add a check with a resource - ;; server. - - ;; TODO: try to negociate a refresh token. - )))))) |