summaryrefslogtreecommitdiff
path: root/tests/token-endpoint-issue.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/token-endpoint-issue.scm')
-rw-r--r--tests/token-endpoint-issue.scm182
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)))))))))
generated by cgit v1.2.3 (git 2.44.0) at 2024-05-18 13:18:44 +0000