Implement the token endpoint

3 files changed, 207 insertions, 1 deletions

diff --git a/tests/Makefile.am b/tests/Makefile.am
index 457d462..3d5e46d 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -33,7 +33,9 @@ TESTS = %reldir%/load-library.scm \
   %reldir%/unknown-client-locale.scm \
   %reldir%/authorization-endpoint-no-args.scm \
   %reldir%/authorization-endpoint-get-form.scm \
-  %reldir%/authorization-endpoint-submit-form.scm
+  %reldir%/authorization-endpoint-submit-form.scm \
+  %reldir%/token-endpoint-issue.scm \
+  %reldir%/token-endpoint-refresh.scm
 
 EXTRA_DIST += $(TESTS) %reldir%/ChangeLog
 
diff --git a/tests/token-endpoint-issue.scm b/tests/token-endpoint-issue.scm
new file mode 100644
index 0000000..706b908
--- /dev/null
+++ b/tests/token-endpoint-issue.scm
@@ -0,0 +1,103 @@
+(use-modules (webid-oidc token-endpoint)
+             (webid-oidc authorization-code)
+             (webid-oidc dpop-proof)
+             (webid-oidc jwk)
+             (webid-oidc jws)
+             (webid-oidc jti)
+             (webid-oidc testing)
+             ((webid-oidc stubs) #:prefix stubs:)
+             (web uri)
+             (web request)
+             (web response)
+             (srfi srfi-19)
+             (web response)
+             (ice-9 optargs)
+             (ice-9 receive))
+
+(with-test-environment
+ "token-endpoint-issue"
+ (lambda ()
+   (define alg 'RS256)
+   (define key (generate-key #:n-size 2048))
+   (define client-key (generate-key #:n-size 2048))
+   (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 jti-list (make-jti-list))
+   (define authz (issue-authorization-code
+                  alg key
+                  (time-utc->date (make-time time-utc 0 120))
+                  subject
+                  client))
+   (define the-time 0)
+   (define (current-time)
+     (make-time time-utc 0 the-time))
+   (define endpoint (make-token-endpoint
+                     (string->uri "https://token-endpoint-issue.scm/token")
+                     issuer alg key validity jti-list
+                     #:current-time current-time))
+   (receive (response response-body)
+       ;; The code is fake!
+       (let ((dpop
+              (issue-dpop-proof
+               client-key
+               #:alg alg
+               #:htm 'POST
+               #:htu (string->uri
+                      "https://token-endpoint-issue.scm/token")
+               #:iat (time-utc->date (make-time time-utc 0 0)))))
+         (set! the-time 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)
+       (exit 3))
+     (receive (response response-body)
+         (let ((dpop
+                (issue-dpop-proof
+                 client-key
+                 #:alg alg
+                 #:htm 'POST
+                 #:htu (string->uri
+                        "https://token-endpoint-issue.scm/token")
+                 #:iat (time-utc->date (make-time time-utc 0 10)))))
+           (set! the-time 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)
+         (write response)
+         (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 (jws-decode access-token-enc
+                                           (lambda (h) key))))
+             (unless access-token
+               (exit 8))
+             (let ((access-token-cnf (assq-ref (jws-payload access-token)
+                                               'cnf)))
+               (unless access-token-cnf
+                 (exit 9))
+               (let ((access-token-cnf/jkt (assq-ref access-token-cnf 'jkt)))
+                 (unless access-token-cnf/jkt
+                   (exit 10))
+                 (unless (string=? access-token-cnf/jkt (jkt client-key))
+                   (exit 11)))))))))))
diff --git a/tests/token-endpoint-refresh.scm b/tests/token-endpoint-refresh.scm
new file mode 100644
index 0000000..293d656
--- /dev/null
+++ b/tests/token-endpoint-refresh.scm
@@ -0,0 +1,101 @@
+(use-modules (webid-oidc token-endpoint)
+             (webid-oidc authorization-code)
+             (webid-oidc refresh-token)
+             (webid-oidc dpop-proof)
+             (webid-oidc jwk)
+             (webid-oidc jws)
+             (webid-oidc jti)
+             (webid-oidc testing)
+             ((webid-oidc stubs) #:prefix stubs:)
+             (web uri)
+             (web request)
+             (web response)
+             (srfi srfi-19)
+             (web response)
+             (ice-9 optargs)
+             (ice-9 receive))
+
+(with-test-environment
+ "token-endpoint-refresh"
+ (lambda ()
+   (define alg 'RS256)
+   (define key (generate-key #:n-size 2048))
+   (define client-key (generate-key #:n-size 2048))
+   (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 jti-list (make-jti-list))
+   (define refresh-code
+     (issue-refresh-token subject client (jkt client-key)))
+   (define the-time 0)
+   (define (current-time)
+     (make-time time-utc 0 the-time))
+   (define endpoint (make-token-endpoint
+                     (string->uri "https://token-endpoint-issue.scm/token")
+                     issuer alg key validity jti-list
+                     #:current-time current-time))
+   (receive (response response-body)
+       ;; The refresh token is fake!
+       (let ((dpop
+              (issue-dpop-proof
+               client-key
+               #:alg alg
+               #:htm 'POST
+               #:htu (string->uri
+                      "https://token-endpoint-issue.scm/token")
+               #:iat (time-utc->date (make-time time-utc 0 0)))))
+         (set! the-time 0)
+         (endpoint
+          (build-request (string->uri
+                          "http://localhost:8080/token")
+                         #:headers `((content-type application/x-www-form-urlencoded)
+                                     (dpop . ,dpop))
+                         #:method 'POST
+                         #:port #t)
+          "refresh_token=fake"))
+     (unless (eq? (response-code response) 400)
+       (exit 3))
+     (receive (response response-body)
+         (let ((dpop
+                (issue-dpop-proof
+                 client-key
+                 #:alg alg
+                 #:htm 'POST
+                 #:htu (string->uri
+                        "https://token-endpoint-issue.scm/token")
+                 #:iat (time-utc->date (make-time time-utc 0 10)))))
+           (set! the-time 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=refresh_token&refresh_token=" refresh-code)))
+       (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 (jws-decode access-token-enc
+                                           (lambda (h) key))))
+             (unless access-token
+               (exit 8))
+             (let ((access-token-cnf (assq-ref access-token 'cnf)))
+               (unless access-token-cnf
+                 (exit 9))
+               (let ((access-token-cnf/jkt (assq-ref access-token-cnf 'jkt)))
+                 (unless access-token-cnf/jkt
+                   (exit 10))
+                 (unless (string=? access-token-cnf/jkt (jkt client-key))
+                   (exit 11))))
+             (unless (string=? refresh-token-enc refresh-code)
+               (exit 12)))))))))