summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/authorization-endpoint-get-form.scm20
-rw-r--r--tests/authorization-endpoint-no-args.scm16
-rw-r--r--tests/authorization-endpoint-submit-form.scm59
-rw-r--r--tests/cache-valid.scm56
-rw-r--r--tests/client-manifest-fraudulent.scm4
-rw-r--r--tests/client-manifest.scm5
-rw-r--r--tests/client-token.scm202
-rw-r--r--tests/dpop-proof-iat-in-future.scm25
-rw-r--r--tests/dpop-proof-iat-too-late.scm25
-rw-r--r--tests/dpop-proof-invalid-ath.scm48
-rw-r--r--tests/dpop-proof-no-ath.scm27
-rw-r--r--tests/dpop-proof-replay.scm25
-rw-r--r--tests/dpop-proof-valid-ath.scm48
-rw-r--r--tests/dpop-proof-valid.scm25
-rw-r--r--tests/dpop-proof-wrong-htm.scm25
-rw-r--r--tests/dpop-proof-wrong-htu.scm25
-rw-r--r--tests/dpop-proof-wrong-key.scm25
-rw-r--r--tests/jwks-get.scm4
-rw-r--r--tests/oidc-configuration.scm4
-rw-r--r--tests/resource-server.scm40
-rw-r--r--tests/token-endpoint-issue.scm72
-rw-r--r--tests/token-endpoint-refresh.scm56
22 files changed, 402 insertions, 434 deletions
diff --git a/tests/authorization-endpoint-get-form.scm b/tests/authorization-endpoint-get-form.scm
index d71d534..7dbf6ba 100644
--- a/tests/authorization-endpoint-get-form.scm
+++ b/tests/authorization-endpoint-get-form.scm
@@ -17,6 +17,7 @@
(use-modules (webid-oidc authorization-endpoint)
(webid-oidc jwk)
(webid-oidc testing)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(web request)
(web response)
@@ -33,23 +34,20 @@
(define subject (string->uri "https://authorization-endpoint-get-form.scm/profile/card#me"))
(define password "p4ssw0rd")
(define validity 120)
- (define the-time 0)
- (define (current-time)
- (make-time time-utc 0 the-time))
(define* (http-get uri #:key (headers '()))
(exit 2))
(define endpoint
(make-authorization-endpoint
subject password alg key validity
- #:http-get http-get
- #:current-time current-time))
+ #:http-get http-get))
(receive (response response-body)
- (endpoint
- (build-request (string->uri
- (format #f "https://authorization-endpoint-get-form.scm/authorize?client_id=~a&redirect_uri=~a"
- (uri-encode "https://authorization-endpoint-get-form.scm/client/card#app")
- (uri-encode "https://authorization-endpoint-get-form.scm/client/redirect"))))
- "")
+ (parameterize ((p:current-date 0))
+ (endpoint
+ (build-request (string->uri
+ (format #f "https://authorization-endpoint-get-form.scm/authorize?client_id=~a&redirect_uri=~a"
+ (uri-encode "https://authorization-endpoint-get-form.scm/client/card#app")
+ (uri-encode "https://authorization-endpoint-get-form.scm/client/redirect"))))
+ ""))
(unless (eq? (response-code response) 200)
(exit 3))
(unless (response-content-type response)
diff --git a/tests/authorization-endpoint-no-args.scm b/tests/authorization-endpoint-no-args.scm
index bd24fa2..66579a2 100644
--- a/tests/authorization-endpoint-no-args.scm
+++ b/tests/authorization-endpoint-no-args.scm
@@ -17,6 +17,7 @@
(use-modules (webid-oidc authorization-endpoint)
(webid-oidc jwk)
(webid-oidc testing)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(web request)
(web response)
@@ -33,20 +34,17 @@
(define subject (string->uri "https://authorization-endpoint-get-form.scm/profile/card#me"))
(define password "p4ssw0rd")
(define validity 120)
- (define the-time 0)
- (define (current-time)
- (make-time time-utc 0 the-time))
(define* (http-get uri #:key (headers '()))
(exit 2))
(define endpoint
(make-authorization-endpoint
subject password alg key validity
- #:http-get http-get
- #:current-time current-time))
+ #:http-get http-get))
(receive (response response-body)
- (endpoint
- (build-request (string->uri
- "https://authorization-endpoint-get-form.scm/authorize"))
- "")
+ (parameterize ((p:current-date 0))
+ (endpoint
+ (build-request (string->uri
+ "https://authorization-endpoint-get-form.scm/authorize"))
+ ""))
(unless (eq? (response-code response) 400)
(exit 3)))))
diff --git a/tests/authorization-endpoint-submit-form.scm b/tests/authorization-endpoint-submit-form.scm
index f379e38..ef84f40 100644
--- a/tests/authorization-endpoint-submit-form.scm
+++ b/tests/authorization-endpoint-submit-form.scm
@@ -21,6 +21,7 @@
(webid-oidc cache)
(webid-oidc jti)
(webid-oidc testing)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(web request)
(web response)
@@ -40,9 +41,6 @@
(define password "p4ssw0rd")
(define encrypted-password (crypt password "$6$this.is.the.salt"))
(define validity 120)
- (define the-time 0)
- (define (current-time)
- (make-time time-utc 0 the-time))
(define what-uri-to-expect client)
(define served
(receive (response response-body)
@@ -57,37 +55,36 @@
(exit 2))
(values the-response the-response-body))
(define cached-http-get
- (with-cache #:http-get http-get
- #:current-time current-time))
- (define jti-list (make-jti-list))
+ (with-cache #:http-get http-get))
(define endpoint
(make-authorization-endpoint
subject encrypted-password alg key validity
- #:http-get cached-http-get
- #:current-time current-time))
+ #:http-get cached-http-get))
(receive (response response-body)
;; The password is fake!
- (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")
+ (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)
- (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")
+ (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=p4ssw0rd"))
(unless (eq? (response-code response) 302)
(exit 4))
(let ((loc (response-location response)))
@@ -109,10 +106,10 @@
kv)))
(unless (assoc-ref args "code")
(exit 9))
- (let ((parsed (authorization-code-decode
- 60
- jti-list
- (car (assoc-ref args "code"))
- key)))
+ (let ((parsed
+ (parameterize ((p:current-date 60))
+ (authorization-code-decode
+ (car (assoc-ref args "code"))
+ key))))
(unless parsed
(exit 10)))))))))
diff --git a/tests/cache-valid.scm b/tests/cache-valid.scm
index cf5c0f1..04e7c22 100644
--- a/tests/cache-valid.scm
+++ b/tests/cache-valid.scm
@@ -16,6 +16,7 @@
(use-modules (webid-oidc cache)
(webid-oidc testing)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(web request)
(web response)
@@ -44,31 +45,42 @@
(last-modified . ,(time-utc->date (make-time time-utc 0 10)))
(date . ,(time-utc->date (make-time time-utc 0 30))))))
;; response-not-stored: never valid.
- (when (valid? response-not-stored #:current-time 0)
- (exit 1))
- (when (valid? response-not-stored #:current-time 100)
- (exit 2))
+ (parameterize ((p:current-date 0))
+ (when (valid? response-not-stored)
+ (exit 1)))
+ (parameterize ((p:current-date 100))
+ (when (valid? response-not-stored)
+ (exit 2)))
;; response-not-cached: never valid.
- (when (valid? response-not-cached #:current-time 0)
- (exit 3))
- (when (valid? response-not-cached #:current-time 100)
- (exit 4))
+ (parameterize ((p:current-date 0))
+ (when (valid? response-not-cached)
+ (exit 3)))
+ (parameterize ((p:current-date 100))
+ (when (valid? response-not-cached)
+ (exit 4)))
;; response-with-expires: valid at 110, invalid at 130.
- (unless (valid? response-with-expires #:current-time 110)
- (exit 5))
- (when (valid? response-with-expires #:current-time 130)
- (exit 6))
+ (parameterize ((p:current-date 110))
+ (unless (valid? response-with-expires)
+ (exit 5)))
+ (parameterize ((p:current-date 130))
+ (when (valid? response-with-expires)
+ (exit 6)))
;; response-with-overriden-expires: valid at 105, invalid at 115
- (unless (valid? response-with-overriden-expires #:current-time 105)
- (exit 7))
- (when (valid? response-with-overriden-expires #:current-time 115)
- (exit 8))
+ (parameterize ((p:current-date 105))
+ (unless (valid? response-with-overriden-expires)
+ (exit 7)))
+ (parameterize ((p:current-date 115))
+ (when (valid? response-with-overriden-expires)
+ (exit 8)))
;; response-without-max-age: not valid, cannot get a heuristic
- (when (valid? response-without-max-age #:current-time 10)
- (exit 9))
+ (parameterize ((p:current-date 10))
+ (when (valid? response-without-max-age)
+ (exit 9)))
;; response-with-heuristic-max-age: the heuristic max age is 2, so
;; it is valid at 31 but not at 33.
- (unless (valid? response-with-heuristic-max-age #:current-time 31)
- (exit 10))
- (when (valid? response-with-heuristic-max-age #:current-time 33)
- (exit 11))))
+ (parameterize ((p:current-date 31))
+ (unless (valid? response-with-heuristic-max-age)
+ (exit 10)))
+ (parameterize ((p:current-date 33))
+ (when (valid? response-with-heuristic-max-age)
+ (exit 11)))))
diff --git a/tests/client-manifest-fraudulent.scm b/tests/client-manifest-fraudulent.scm
index da77c27..b786140 100644
--- a/tests/client-manifest-fraudulent.scm
+++ b/tests/client-manifest-fraudulent.scm
@@ -30,9 +30,6 @@
(with-test-environment
"client-manifest-fraudulent"
(lambda ()
- (define the-current-time 0)
- (define (current-time)
- (make-time time-utc 0 the-current-time))
(define what-to-respond
(build-response #:headers '((content-type text/turtle))))
(define what-to-respond-body
@@ -63,7 +60,6 @@
(values what-to-respond what-to-respond-body))
(define cache-http-get
(with-cache
- #:current-time current-time
#:http-get respond))
(with-exception-handler
(lambda (error)
diff --git a/tests/client-manifest.scm b/tests/client-manifest.scm
index fb40901..2812ede 100644
--- a/tests/client-manifest.scm
+++ b/tests/client-manifest.scm
@@ -52,12 +52,8 @@
(string->uri "https://app.example.com/id#app"))
(exit 2))
(values what-to-respond what-to-respond-body))
- (define current-time 0)
(define cache-http-get
(with-cache
- #:current-time
- (lambda ()
- (make-time time-utc 0 current-time))
#:http-get respond))
(define mf
(get-client-manifest
@@ -85,7 +81,6 @@
(exit 6))
(set! what-to-respond response)
(set! what-to-respond-body response-body)
- (set! current-time 10)
(let ((re-parsed (get-client-manifest
(string->uri "https://app.example.com/id#app")
#:http-get cache-http-get)))
diff --git a/tests/client-token.scm b/tests/client-token.scm
index 9c55582..576019a 100644
--- a/tests/client-token.scm
+++ b/tests/client-token.scm
@@ -18,11 +18,11 @@
(webid-oidc testing)
(webid-oidc token-endpoint)
(webid-oidc jwk)
- (webid-oidc jti)
(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)
@@ -35,105 +35,103 @@
"client-token"
(lambda ()
(define the-current-time 0)
- (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 ;; 1 hour
- (make-jti-list)
- #:current-time (lambda () the-current-time)))
- (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
- #:current-time (lambda () the-current-time))))
- (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.
+ (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.
- )))))
+ ;; TODO: try to negociate a refresh token.
+ ))))))
diff --git a/tests/dpop-proof-iat-in-future.scm b/tests/dpop-proof-iat-in-future.scm
index 4f167ca..b5dd3f8 100644
--- a/tests/dpop-proof-iat-in-future.scm
+++ b/tests/dpop-proof-iat-in-future.scm
@@ -19,6 +19,7 @@
(webid-oidc jwk)
(webid-oidc testing)
(webid-oidc errors)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(srfi srfi-19)
(web response))
@@ -28,26 +29,24 @@
(lambda ()
(define jwk (generate-key #:n-size 2048))
(define cnf (jkt jwk))
- (define blacklist (make-jti-list))
(define proof
- (issue-dpop-proof
- jwk
- #:alg 'RS256
- #:htm 'GET
- #:htu (string->uri "https://example.com/res#frag")
- #:iat (time-utc->date (make-time time-utc 0 10))))
+ (parameterize ((p:current-date 10))
+ (issue-dpop-proof
+ jwk
+ #:alg 'RS256
+ #:htm 'GET
+ #:htu (string->uri "https://example.com/res#frag"))))
(with-exception-handler
(lambda (error)
(unless ((record-predicate &dpop-signed-in-future)
((record-accessor &cannot-decode-dpop-proof 'cause) error))
(raise-exception error)))
(lambda ()
- (dpop-proof-decode (time-utc->date (make-time time-utc 0 0))
- blacklist
- 'GET
- (string->uri "https://example.com/res?query")
- proof
- cnf)
+ (parameterize ((p:current-date 0))
+ (dpop-proof-decode 'GET
+ (string->uri "https://example.com/res?query")
+ proof
+ cnf))
(exit 2))
#:unwind? #t
#:unwind-for-type &cannot-decode-dpop-proof)))
diff --git a/tests/dpop-proof-iat-too-late.scm b/tests/dpop-proof-iat-too-late.scm
index e1b7a47..0e1f4ed 100644
--- a/tests/dpop-proof-iat-too-late.scm
+++ b/tests/dpop-proof-iat-too-late.scm
@@ -18,6 +18,7 @@
(webid-oidc jti)
(webid-oidc jwk)
(webid-oidc testing)
+ ((webid-oidc parameters) #:prefix p:)
(webid-oidc errors)
(web uri)
(srfi srfi-19)
@@ -28,26 +29,24 @@
(lambda ()
(define jwk (generate-key #:n-size 2048))
(define cnf (jkt jwk))
- (define blacklist (make-jti-list))
(define proof
- (issue-dpop-proof
- jwk
- #:alg 'RS256
- #:htm 'GET
- #:htu (string->uri "https://example.com/res#frag")
- #:iat (time-utc->date (make-time time-utc 0 0))))
+ (parameterize ((p:current-date 0))
+ (issue-dpop-proof
+ jwk
+ #:alg 'RS256
+ #:htm 'GET
+ #:htu (string->uri "https://example.com/res#frag"))))
(with-exception-handler
(lambda (error)
(unless ((record-predicate &dpop-too-old)
((record-accessor &cannot-decode-dpop-proof 'cause) error))
(raise-exception error)))
(lambda ()
- (dpop-proof-decode (time-utc->date (make-time time-utc 0 600))
- blacklist
- 'GET
- (string->uri "https://example.com/res?query")
- proof
- cnf)
+ (parameterize ((p:current-date 600))
+ (dpop-proof-decode 'GET
+ (string->uri "https://example.com/res?query")
+ proof
+ cnf))
(exit 2))
#:unwind? #t
#:unwind-for-type &cannot-decode-dpop-proof)))
diff --git a/tests/dpop-proof-invalid-ath.scm b/tests/dpop-proof-invalid-ath.scm
index e802ffe..90cd168 100644
--- a/tests/dpop-proof-invalid-ath.scm
+++ b/tests/dpop-proof-invalid-ath.scm
@@ -16,11 +16,11 @@
(use-modules (webid-oidc dpop-proof)
(webid-oidc access-token)
- (webid-oidc jti)
(webid-oidc jwk)
(webid-oidc testing)
(webid-oidc errors)
((webid-oidc stubs) #:prefix stubs:)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(srfi srfi-19)
(web response))
@@ -31,25 +31,24 @@
(define jwk (generate-key #:n-size 2048))
(define idp-key (generate-key #:n-size 2048))
(define cnf (jkt jwk))
- (define blacklist (make-jti-list))
(define access-token
- (issue-access-token
- idp-key
- #:alg 'RS256
- #:webid "https://data.provider/subject"
- #:iss "https://identity.provider"
- #:iat 10
- #:exp 3610
- #:client-key jwk
- #:client-id "https://client"))
+ (parameterize ((p:current-date 10))
+ (issue-access-token
+ idp-key
+ #:alg 'RS256
+ #:webid "https://data.provider/subject"
+ #:iss "https://identity.provider"
+ #:validity 3600
+ #:client-key jwk
+ #:client-id "https://client")))
(define proof
- (issue-dpop-proof
- jwk
- #:alg 'RS256
- #:htm 'GET
- #:htu (string->uri "https://example.com/res?query")
- #:iat (time-utc->date (make-time time-utc 0 0))
- #:access-token "aaaaaaaaaaaaaaa"))
+ (parameterize ((p:current-date 0))
+ (issue-dpop-proof
+ jwk
+ #:alg 'RS256
+ #:htm 'GET
+ #:htu (string->uri "https://example.com/res?query")
+ #:access-token "aaaaaaaaaaaaaaa")))
(with-exception-handler
(lambda (error)
(let ((cause
@@ -61,13 +60,12 @@
(equal? (dpop-invalid-access-token-hash-access-token cause) access-token))
(exit 1))))
(lambda ()
- (dpop-proof-decode (time-utc->date (make-time time-utc 0 10))
- blacklist
- 'GET
- (string->uri "https://example.com/res?query")
- proof
- cnf
- #:access-token access-token)
+ (parameterize ((p:current-date 10))
+ (dpop-proof-decode 'GET
+ (string->uri "https://example.com/res?query")
+ proof
+ cnf
+ #:access-token access-token))
(exit 2))
#:unwind? #t
#:unwind-for-type &cannot-decode-dpop-proof)))
diff --git a/tests/dpop-proof-no-ath.scm b/tests/dpop-proof-no-ath.scm
index 67b8a70..35bff75 100644
--- a/tests/dpop-proof-no-ath.scm
+++ b/tests/dpop-proof-no-ath.scm
@@ -18,6 +18,7 @@
(webid-oidc jti)
(webid-oidc jwk)
(webid-oidc testing)
+ ((webid-oidc parameters) #:prefix p:)
(webid-oidc errors)
(web uri)
(srfi srfi-19)
@@ -28,14 +29,13 @@
(lambda ()
(define jwk (generate-key #:n-size 2048))
(define cnf (jkt jwk))
- (define blacklist (make-jti-list))
(define proof
- (issue-dpop-proof
- jwk
- #:alg 'RS256
- #:htm 'GET
- #:htu (string->uri "https://example.com/res?query")
- #:iat (time-utc->date (make-time time-utc 0 0))))
+ (parameterize ((p:current-date 0))
+ (issue-dpop-proof
+ jwk
+ #:alg 'RS256
+ #:htm 'GET
+ #:htu (string->uri "https://example.com/res?query"))))
(with-exception-handler
(lambda (error)
(let ((cause
@@ -47,13 +47,12 @@
;; claim
(exit 1))))
(lambda ()
- (dpop-proof-decode (time-utc->date (make-time time-utc 0 10))
- blacklist
- 'GET
- (string->uri "https://example.com/res?query")
- proof
- cnf
- #:access-token "aaa")
+ (parameterize ((p:current-date 10))
+ (dpop-proof-decode 'GET
+ (string->uri "https://example.com/res?query")
+ proof
+ cnf
+ #:access-token "aaa"))
(exit 2))
#:unwind? #t
#:unwind-for-type &cannot-decode-dpop-proof)))
diff --git a/tests/dpop-proof-replay.scm b/tests/dpop-proof-replay.scm
index 132a150..b8f4668 100644
--- a/tests/dpop-proof-replay.scm
+++ b/tests/dpop-proof-replay.scm
@@ -19,6 +19,7 @@
(webid-oidc jwk)
(webid-oidc testing)
(webid-oidc errors)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(srfi srfi-19)
(web response))
@@ -28,21 +29,19 @@
(lambda ()
(define jwk (generate-key #:n-size 2048))
(define cnf (jkt jwk))
- (define blacklist (make-jti-list))
(define proof
- (issue-dpop-proof
- jwk
- #:alg 'RS256
- #:htm 'GET
- #:htu (string->uri "https://example.com/res#frag")
- #:iat (time-utc->date (make-time time-utc 0 0))))
+ (parameterize ((p:current-date 0))
+ (issue-dpop-proof
+ jwk
+ #:alg 'RS256
+ #:htm 'GET
+ #:htu (string->uri "https://example.com/res#frag"))))
(define (decode)
- (dpop-proof-decode (time-utc->date (make-time time-utc 0 10))
- blacklist
- 'GET
- (string->uri "https://example.com/res?query")
- proof
- cnf))
+ (parameterize ((p:current-date 10))
+ (dpop-proof-decode 'GET
+ (string->uri "https://example.com/res?query")
+ proof
+ cnf)))
(define decoded-once (decode))
(with-exception-handler
(lambda (error)
diff --git a/tests/dpop-proof-valid-ath.scm b/tests/dpop-proof-valid-ath.scm
index 259190f..1e15e17 100644
--- a/tests/dpop-proof-valid-ath.scm
+++ b/tests/dpop-proof-valid-ath.scm
@@ -16,9 +16,9 @@
(use-modules (webid-oidc dpop-proof)
(webid-oidc access-token)
- (webid-oidc jti)
(webid-oidc jwk)
(webid-oidc testing)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(srfi srfi-19)
(web response))
@@ -29,32 +29,30 @@
(define jwk (generate-key #:n-size 2048))
(define idp-key (generate-key #:n-size 2048))
(define cnf (jkt jwk))
- (define blacklist (make-jti-list))
(define access-token
- (issue-access-token
- idp-key
- #:alg 'RS256
- #:webid "https://data.provider/subject"
- #:iss "https://identity.provider"
- #:iat 10
- #:exp 3610
- #:client-key jwk
- #:client-id "https://client"))
+ (parameterize ((p:current-date 10))
+ (issue-access-token
+ idp-key
+ #:alg 'RS256
+ #:webid "https://data.provider/subject"
+ #:iss "https://identity.provider"
+ #:validity 3600
+ #:client-key jwk
+ #:client-id "https://client")))
(define proof
- (issue-dpop-proof
- jwk
- #:alg 'RS256
- #:htm 'GET
- #:htu (string->uri "https://example.com/res#frag")
- #:iat (time-utc->date (make-time time-utc 0 0))
- #:access-token access-token))
+ (parameterize ((p:current-date 0))
+ (issue-dpop-proof
+ jwk
+ #:alg 'RS256
+ #:htm 'GET
+ #:htu (string->uri "https://example.com/res#frag")
+ #:access-token access-token)))
(define decoded
- (dpop-proof-decode (time-utc->date (make-time time-utc 0 10))
- blacklist
- 'GET
- (string->uri "https://example.com/res?query")
- proof
- cnf
- #:access-token access-token))
+ (parameterize ((p:current-date 10))
+ (dpop-proof-decode 'GET
+ (string->uri "https://example.com/res?query")
+ proof
+ cnf
+ #:access-token access-token)))
(unless decoded
(exit 1))))
diff --git a/tests/dpop-proof-valid.scm b/tests/dpop-proof-valid.scm
index 52da33b..ec6b32a 100644
--- a/tests/dpop-proof-valid.scm
+++ b/tests/dpop-proof-valid.scm
@@ -18,6 +18,7 @@
(webid-oidc jti)
(webid-oidc jwk)
(webid-oidc testing)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(srfi srfi-19)
(web response))
@@ -27,20 +28,18 @@
(lambda ()
(define jwk (generate-key #:n-size 2048))
(define cnf (jkt jwk))
- (define blacklist (make-jti-list))
(define proof
- (issue-dpop-proof
- jwk
- #:alg 'RS256
- #:htm 'GET
- #:htu (string->uri "https://example.com/res#frag")
- #:iat (time-utc->date (make-time time-utc 0 0))))
+ (parameterize ((p:current-date 0))
+ (issue-dpop-proof
+ jwk
+ #:alg 'RS256
+ #:htm 'GET
+ #:htu (string->uri "https://example.com/res#frag"))))
(define decoded
- (dpop-proof-decode (time-utc->date (make-time time-utc 0 10))
- blacklist
- 'GET
- (string->uri "https://example.com/res?query")
- proof
- cnf))
+ (parameterize ((p:current-date 10))
+ (dpop-proof-decode 'GET
+ (string->uri "https://example.com/res?query")
+ proof
+ cnf)))
(unless decoded
(exit 1))))
diff --git a/tests/dpop-proof-wrong-htm.scm b/tests/dpop-proof-wrong-htm.scm
index eaedfe5..1b30161 100644
--- a/tests/dpop-proof-wrong-htm.scm
+++ b/tests/dpop-proof-wrong-htm.scm
@@ -19,6 +19,7 @@
(webid-oidc jwk)
(webid-oidc testing)
(webid-oidc errors)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(srfi srfi-19)
(web response))
@@ -28,26 +29,24 @@
(lambda ()
(define jwk (generate-key #:n-size 2048))
(define cnf (jkt jwk))
- (define blacklist (make-jti-list))
(define proof
- (issue-dpop-proof
- jwk
- #:alg 'RS256
- #:htm 'POST
- #:htu (string->uri "https://example.com/res#frag")
- #:iat (time-utc->date (make-time time-utc 0 0))))
+ (parameterize ((p:current-date 0))
+ (issue-dpop-proof
+ jwk
+ #:alg 'RS256
+ #:htm 'POST
+ #:htu (string->uri "https://example.com/res#frag"))))
(with-exception-handler
(lambda (error)
(unless ((record-predicate &dpop-method-mismatch)
((record-accessor &cannot-decode-dpop-proof 'cause) error))
(raise-exception error)))
(lambda ()
- (dpop-proof-decode (time-utc->date (make-time time-utc 0 10))
- blacklist
- 'GET
- (string->uri "https://example.com/res?query")
- proof
- cnf)
+ (parameterize ((p:current-date 10))
+ (dpop-proof-decode 'GET
+ (string->uri "https://example.com/res?query")
+ proof
+ cnf))
(exit 2))
#:unwind? #t
#:unwind-for-type &cannot-decode-dpop-proof)))
diff --git a/tests/dpop-proof-wrong-htu.scm b/tests/dpop-proof-wrong-htu.scm
index c65d1fc..6f3ac0a 100644
--- a/tests/dpop-proof-wrong-htu.scm
+++ b/tests/dpop-proof-wrong-htu.scm
@@ -19,6 +19,7 @@
(webid-oidc jwk)
(webid-oidc testing)
(webid-oidc errors)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(srfi srfi-19)
(web response))
@@ -28,26 +29,24 @@
(lambda ()
(define jwk (generate-key #:n-size 2048))
(define cnf (jkt jwk))
- (define blacklist (make-jti-list))
(define proof
- (issue-dpop-proof
- jwk
- #:alg 'RS256
- #:htm 'GET
- #:htu (string->uri "https://example.com/other-res#frag")
- #:iat (time-utc->date (make-time time-utc 0 0))))
+ (parameterize ((p:current-date 0))
+ (issue-dpop-proof
+ jwk
+ #:alg 'RS256
+ #:htm 'GET
+ #:htu (string->uri "https://example.com/other-res#frag"))))
(with-exception-handler
(lambda (error)
(unless ((record-predicate &dpop-uri-mismatch)
((record-accessor &cannot-decode-dpop-proof 'cause) error))
(raise-exception error)))
(lambda ()
- (dpop-proof-decode (time-utc->date (make-time time-utc 0 10))
- blacklist
- 'GET
- (string->uri "https://example.com/res?query")
- proof
- cnf)
+ (parameterize ((p:current-date 10))
+ (dpop-proof-decode 'GET
+ (string->uri "https://example.com/res?query")
+ proof
+ cnf))
(exit 2))
#:unwind? #t
#:unwind-for-type &cannot-decode-dpop-proof)))
diff --git a/tests/dpop-proof-wrong-key.scm b/tests/dpop-proof-wrong-key.scm
index ae6f177..497ae0e 100644
--- a/tests/dpop-proof-wrong-key.scm
+++ b/tests/dpop-proof-wrong-key.scm
@@ -19,6 +19,7 @@
(webid-oidc jwk)
(webid-oidc testing)
(webid-oidc errors)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(srfi srfi-19)
(web response))
@@ -28,26 +29,24 @@
(lambda ()
(define jwk (generate-key #:n-size 2048))
(define cnf (jkt (generate-key #:n-size 2048)))
- (define blacklist (make-jti-list))
(define proof
- (issue-dpop-proof
- jwk
- #:alg 'RS256
- #:htm 'GET
- #:htu (string->uri "https://example.com/res#frag")
- #:iat (time-utc->date (make-time time-utc 0 0))))
+ (parameterize ((p:current-date 0))
+ (issue-dpop-proof
+ jwk
+ #:alg 'RS256
+ #:htm 'GET
+ #:htu (string->uri "https://example.com/res#frag"))))
(with-exception-handler
(lambda (error)
(unless ((record-predicate &dpop-unconfirmed-key)
((record-accessor &cannot-decode-dpop-proof 'cause) error))
(raise-exception error)))
(lambda ()
- (dpop-proof-decode (time-utc->date (make-time time-utc 0 10))
- blacklist
- 'GET
- (string->uri "https://example.com/res?query")
- proof
- cnf)
+ (parameterize ((p:current-date 10))
+ (dpop-proof-decode 'GET
+ (string->uri "https://example.com/res?query")
+ proof
+ cnf))
(exit 2))
#:unwind? #t
#:unwind-for-type &cannot-decode-dpop-proof)))
diff --git a/tests/jwks-get.scm b/tests/jwks-get.scm
index 66174a2..8e9169e 100644
--- a/tests/jwks-get.scm
+++ b/tests/jwks-get.scm
@@ -55,12 +55,8 @@
}
")
(exit 2)))
- (define current-time 0)
(define cache-http-get
(with-cache
- #:current-time
- (lambda ()
- (make-time time-utc 0 current-time))
#:http-get respond))
(define jwks (get-jwks "https://example.com/keys"
#:http-get cache-http-get))
diff --git a/tests/oidc-configuration.scm b/tests/oidc-configuration.scm
index 7f02941..f7b3bbc 100644
--- a/tests/oidc-configuration.scm
+++ b/tests/oidc-configuration.scm
@@ -115,12 +115,8 @@
]
}"))
(else (exit 2))))
- (define current-time 0)
(define cache-http-get
(with-cache
- #:current-time
- (lambda ()
- (make-time time-utc 0 current-time))
#:http-get respond))
(define cfg (get-oidc-configuration
"example.com"
diff --git a/tests/resource-server.scm b/tests/resource-server.scm
index ef5e0b7..aba4bb0 100644
--- a/tests/resource-server.scm
+++ b/tests/resource-server.scm
@@ -23,6 +23,7 @@
(webid-oidc dpop-proof)
(webid-oidc resource-server)
(webid-oidc testing)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(web request)
(srfi srfi-19)
@@ -33,7 +34,6 @@
(with-test-environment
"resource-server"
(lambda ()
- (define jti (make-jti-list))
(define client-key (generate-key #:n-size 2048))
(define idp-key (generate-key #:n-size 2048))
(define jwks (make-jwks (list idp-key)))
@@ -55,26 +55,26 @@
(serve-jwks exp jwks))
(else (exit 1))))
(define access-token
- (issue-access-token
- idp-key
- #:alg 'RS256
- #:webid subject
- #:iss "https://identity.provider"
- #:iat 10
- #:exp 3610
- #:client-key client-key
- #:client-id "https://client"))
+ (parameterize ((p:current-date 10))
+ (issue-access-token
+ idp-key
+ #:alg 'RS256
+ #:webid subject
+ #:iss "https://identity.provider"
+ #:validity 3600
+ #:client-key client-key
+ #:client-id "https://client")))
(define uri (string->uri "https://resource.server/resource"))
(define server-uri (string->uri "https://resource.server/"))
(define method 'GET)
(define dpop-proof
- (issue-dpop-proof
- client-key
- #:alg 'RS256
- #:htm method
- #:htu uri
- #:iat (time-utc->date (make-time time-utc 0 15))
- #:access-token access-token))
+ (parameterize ((p:current-date 15))
+ (issue-dpop-proof
+ client-key
+ #:alg 'RS256
+ #:htm method
+ #:htu uri
+ #:access-token access-token)))
(define rq
(call-with-input-string
(format #f "GET /resource HTTP/1.1\r\n\
@@ -90,11 +90,11 @@ DPoP: ~a\r\n\r\n"
(define rq-body "")
(define authenticator
(make-authenticator
- jti
#:server-uri server-uri
- #:current-time (lambda () (make-time time-utc 0 20))
#:http-get http-get))
- (define parsed (authenticator rq rq-body))
+ (define parsed
+ (parameterize ((p:current-date 20))
+ (authenticator rq rq-body)))
(unless (uri? parsed)
(exit 2))
(unless (equal? parsed subject)
diff --git a/tests/token-endpoint-issue.scm b/tests/token-endpoint-issue.scm
index 6f7d4dc..9438dfe 100644
--- a/tests/token-endpoint-issue.scm
+++ b/tests/token-endpoint-issue.scm
@@ -22,6 +22,7 @@
(webid-oidc jti)
(webid-oidc testing)
((webid-oidc stubs) #:prefix stubs:)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(web request)
(web response)
@@ -40,50 +41,27 @@
(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))
+ (define authz
+ (issue-authorization-code
+ alg key
+ (time-utc->date (make-time time-utc 0 120))
+ subject
+ client))
+ (define endpoint
+ (make-token-endpoint
+ (string->uri "https://token-endpoint-issue.scm/token")
+ issuer alg key validity))
(receive (response response-body user error)
;; 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 user error)
- (let ((dpop
+ (parameterize ((p:current-date 0))
(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)
+ "https://token-endpoint-issue.scm/token")))))
+ (parameterize ((p:current-date 0))
(endpoint
(build-request (string->uri
"http://localhost:8080/token")
@@ -91,7 +69,27 @@
(dpop . ,dpop))
#:method 'POST
#:port #t)
- (string-append "grant_type=authorization_code&code=" authz)))
+ "grant_type=authorization_code&code=fake")))
+ (unless (eq? (response-code response) 400)
+ (exit 3))
+ (receive (response response-body user error)
+ (let ((dpop
+ (parameterize ((p:current-date 10))
+ (issue-dpop-proof
+ client-key
+ #:alg alg
+ #: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)
(write response)
(exit 4))
diff --git a/tests/token-endpoint-refresh.scm b/tests/token-endpoint-refresh.scm
index 2b5be1f..f3d9b52 100644
--- a/tests/token-endpoint-refresh.scm
+++ b/tests/token-endpoint-refresh.scm
@@ -23,6 +23,7 @@
(webid-oidc jti)
(webid-oidc testing)
((webid-oidc stubs) #:prefix stubs:)
+ ((webid-oidc parameters) #:prefix p:)
(web uri)
(web request)
(web response)
@@ -41,47 +42,22 @@
(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))
+ issuer alg key validity))
(receive (response response-body user error)
;; 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 user error)
- (let ((dpop
+ (parameterize ((p:current-date 0))
(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)
+ "https://token-endpoint-issue.scm/token")))))
+ (parameterize ((p:current-date 0))
(endpoint
(build-request (string->uri
"http://localhost:8080/token")
@@ -89,7 +65,27 @@
(dpop . ,dpop))
#:method 'POST
#:port #t)
- (string-append "grant_type=refresh_token&refresh_token=" refresh-code)))
+ "refresh_token=fake")))
+ (unless (eq? (response-code response) 400)
+ (exit 3))
+ (receive (response response-body user error)
+ (let ((dpop
+ (parameterize ((p:current-date 10))
+ (issue-dpop-proof
+ client-key
+ #:alg alg
+ #: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=refresh_token&refresh_token=" refresh-code))))
(unless (eq? (response-code response) 200)
(exit 4))
(unless (eq? (car (response-content-type response)) 'application/json)
generated by cgit v1.2.3 (git 2.44.0) at 2024-05-18 20:30:03 +0000