Use guile parameters

With parameters, the API does not need to care about the directory
where to load files and how to get the time.

21 files changed, 777 insertions, 861 deletions

diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am
index acd9ec9..3e92bd3 100644
--- a/src/scm/webid-oidc/Makefile.am
+++ b/src/scm/webid-oidc/Makefile.am
@@ -46,7 +46,8 @@ dist_webidoidcmod_DATA += \
   %reldir%/rdf-index.scm \
   %reldir%/http-link.scm \
   %reldir%/offloading.scm \
-  %reldir%/catalog.scm
+  %reldir%/catalog.scm \
+  %reldir%/parameters.scm
 
 webidoidcgo_DATA += \
   %reldir%/errors.go \
@@ -80,7 +81,8 @@ webidoidcgo_DATA += \
   %reldir%/rdf-index.go \
   %reldir%/http-link.go \
   %reldir%/offloading.go \
-  %reldir%/catalog.go
+  %reldir%/catalog.go \
+  %reldir%/parameters.go
 
 EXTRA_DIST += %reldir%/ChangeLog
 
diff --git a/src/scm/webid-oidc/access-token.scm b/src/scm/webid-oidc/access-token.scm
index 9c57326..acdc56f 100644
--- a/src/scm/webid-oidc/access-token.scm
+++ b/src/scm/webid-oidc/access-token.scm
@@ -20,6 +20,7 @@
   #:use-module (webid-oidc jwk)
   #:use-module (webid-oidc oidc-configuration)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web uri)
   #:use-module (web client)
   #:use-module (ice-9 optargs)
@@ -206,8 +207,7 @@
                  (alg #f)
                  (webid #f)
                  (iss #f)
-                 (iat #f)
-                 (exp #f)
+                 (validity 3600)
                  (client-key #f)
                  (cnf/jkt #f)
                  (client-id #f))
@@ -216,6 +216,7 @@
   (access-token-encode
    (make-access-token
     `((alg . ,(if (symbol? alg) (symbol->string alg) alg)))
-    (make-access-token-payload
-     webid iss iat exp cnf/jkt client-id))
+    (let ((iat (time-second (date->time-utc ((p:current-date))))))
+      (make-access-token-payload
+       webid iss iat (+ iat validity) cnf/jkt client-id)))
    issuer-key))
diff --git a/src/scm/webid-oidc/authorization-code.scm b/src/scm/webid-oidc/authorization-code.scm
index 3a0da3b..267d67a 100644
--- a/src/scm/webid-oidc/authorization-code.scm
+++ b/src/scm/webid-oidc/authorization-code.scm
@@ -19,6 +19,7 @@
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module (webid-oidc jws)
   #:use-module (webid-oidc jti)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web uri)
   #:use-module (srfi srfi-19))
 
@@ -129,28 +130,26 @@
   (string->uri
    (assq-ref (the-authorization-code-payload code) 'client_id)))
 
-(define-public (authorization-code-decode current-time jti-list str jwk)
-  (when (date? current-time)
-    (set! current-time (date->time-utc current-time)))
-  (when (time? current-time)
-    (set! current-time (time-second current-time)))
-  (with-exception-handler
-      (lambda (error)
-        (raise-cannot-decode-authorization-code str error))
-    (lambda ()
-      (let ((code (the-authorization-code (jws-decode str (lambda (x) jwk)))))
-        (let ((exp (time-second (date->time-utc (authorization-code-exp code)))))
-          (unless (<= current-time exp)
-            (raise-authorization-code-expired exp current-time))
-          (unless (jti-check current-time (authorization-code-jti code)
-                             jti-list
-                             (- exp current-time))
-            (with-exception-handler
-                (lambda (error)
-                  (raise-jti-found (authorization-code-jti code) error))
-              (lambda ()
-                (error "the jti-check function returned #f"))))
-          code)))))
+(define-public (authorization-code-decode str jwk)
+  (parameterize ((p:current-date
+                  (time-second (date->time-utc ((p:current-date))))))
+    (with-exception-handler
+        (lambda (error)
+          (raise-cannot-decode-authorization-code str error))
+      (lambda ()
+        (let ((code (the-authorization-code (jws-decode str (lambda (x) jwk)))))
+          (let ((exp (time-second (date->time-utc (authorization-code-exp code))))
+                (current-time (time-second (date->time-utc ((p:current-date))))))
+            (unless (<= current-time exp)
+              (raise-authorization-code-expired exp current-time))
+            (unless (jti-check (authorization-code-jti code)
+                               (- exp current-time))
+              (with-exception-handler
+                  (lambda (error)
+                    (raise-jti-found (authorization-code-jti code) error))
+                (lambda ()
+                  (error "the jti-check function returned #f"))))
+            code))))))
 
 (define-public (authorization-code-encode authorization-code key)
   (with-exception-handler
diff --git a/src/scm/webid-oidc/authorization-endpoint.scm b/src/scm/webid-oidc/authorization-endpoint.scm
index 9ff994c..d5591b7 100644
--- a/src/scm/webid-oidc/authorization-endpoint.scm
+++ b/src/scm/webid-oidc/authorization-endpoint.scm
@@ -20,6 +20,7 @@
   #:use-module (webid-oidc jwk)
   #:use-module (webid-oidc authorization-code)
   #:use-module (webid-oidc client-manifest)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web uri)
   #:use-module (web client)
   #:use-module (web request)
@@ -35,8 +36,7 @@
 
 (define*-public (make-authorization-endpoint subject encrypted-password alg jwk validity
                                              #:key
-                                             (http-get http-get)
-                                             (current-time current-time))
+                                             (http-get http-get))
   (define (parse-arg x decode-plus-to-space?)
     (map (lambda (x) (uri-decode
                       x
@@ -90,16 +90,9 @@
               (lambda (error)
                 (error-application locale error))
             (lambda ()
-              (let* ((current-time (if (thunk? current-time)
-                                       (current-time)
-                                       current-time))
+              (let* ((current-time ((p:current-date))) ;; current-date is a thunk parameter
                      (current-sec
-                      (cond ((date? current-time)
-                             (time-second (date->time-utc current-time)))
-                            ((time? current-time)
-                             (time-second current-time))
-                            ((integer? current-time)
-                             current-time)))
+                      (time-second (date->time-utc current-time)))
                      (exp-sec (+ current-sec validity))
                      (exp (time-utc->date (make-time time-utc 0 exp-sec)))
                      (code (issue-authorization-code alg jwk exp subject client-id)))
diff --git a/src/scm/webid-oidc/cache.scm b/src/scm/webid-oidc/cache.scm
index dbf0112..e98f87f 100644
--- a/src/scm/webid-oidc/cache.scm
+++ b/src/scm/webid-oidc/cache.scm
@@ -16,6 +16,7 @@
 
 (define-module (webid-oidc cache)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web client)
   #:use-module (web request)
   #:use-module (web response)
@@ -24,7 +25,17 @@
   #:use-module (ice-9 receive)
   #:use-module (ice-9 optargs)
   #:use-module (srfi srfi-19)
-  #:use-module (rnrs bytevectors))
+  #:use-module (rnrs bytevectors)
+  #:export
+  (
+   clean-cache
+   add
+   read
+   varies?
+   valid?
+   revalidate
+   with-cache
+   ))
 
 ;; The cache follows the recommendations of
 ;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Caching
@@ -48,36 +59,26 @@
 ;; There is a global lock file at the root of the cache, which serves
 ;; for region locking. Do not remove it!
 
-(define (default-cache-dir)
-  (let ((xdg-cache-home
-         (or (getenv "XDG_CACHE_HOME")
-             (format #f "~a/.cache" (getenv "HOME")))))
-    (format #f "~a/disfluid" xdg-cache-home)))
+(define (web-cache-dir)
+  (string-append (p:cache-home) "/web-cache/"))
 
-(define (web-cache-dir dir)
-  (when (thunk? dir)
-    (set! dir (dir)))
-  (string-append dir
-                 "/web-cache/"))
-
-(define (file-name uri dir)
+(define (file-name uri)
   (when (string? uri)
     (set! uri (string->uri uri)))
-  (string-append (web-cache-dir dir)
+  (string-append (web-cache-dir)
                  (stubs:hash 'SHA-256 (uri->string uri))))
 
-(define (lock-file-name dir)
-  (string-append (web-cache-dir dir) ".lock"))
+(define (lock-file-name)
+  (string-append (web-cache-dir) ".lock"))
 
 (define (event? percents)
   (<= (* (random:uniform) 100)
       percents))
 
-(define*-public (clean-cache
-                 #:key
-                 (percents 5)
-                 (dir default-cache-dir))
-  (define lock-file (lock-file-name dir))
+(define* (clean-cache
+          #:key
+          (percents 5))
+  (define lock-file (lock-file-name))
   (define (survives?)
     (not (event? percents)))
   (define (enter? name stat result)
@@ -104,14 +105,13 @@
             name (strerror errno))
     result)
   (file-system-fold enter? leaf down up skip error 0
-                    (web-cache-dir dir)))
+                    (web-cache-dir)))
 
 (define (maybe-clean-cache
          pc-happen
-         pc-cleaned
-         dir)
+         pc-cleaned)
   (when (event? pc-happen)
-    (clean-cache #:percents pc-cleaned #:dir dir)))
+    (clean-cache #:percents pc-cleaned)))
 
 (define (remove-uncacheable-headers response)
   (let ((headers (response-headers response)))
@@ -129,16 +129,15 @@
        #:headers filtered
        #:port #f))))
 
-(define*-public (add request response response-body
-                     #:key (dir default-cache-dir))
+(define (add request response response-body)
   ;; Don’t store it if there’s a cache-control no-store
   (unless
       (let ((cc (response-cache-control response '())))
         (assq-ref cc 'no-store))
     (set! response (remove-uncacheable-headers response))
-    (let ((final-file-name (file-name (request-uri request) dir))
-          (lock-file (lock-file-name dir)))
-      (maybe-clean-cache 5 5 dir)
+    (let ((final-file-name (file-name (request-uri request)))
+          (lock-file (lock-file-name)))
+      (maybe-clean-cache 5 5)
       (stubs:atomically-update-file
        final-file-name
        lock-file
@@ -152,14 +151,8 @@
              (write-response-body file-response response-body))
            #t))))))
 
-(define (the-current-time)
-  (time-utc->date
-   (current-time)))
-
-(define*-public (read uri
-                      #:key
-                      (dir default-cache-dir))
-  (let ((final-file-name (file-name uri dir)))
+(define (read uri)
+  (let ((final-file-name (file-name uri)))
     (catch 'system-error
       (lambda ()
         (call-with-input-file final-file-name
@@ -183,60 +176,46 @@
        (or (varies-header? request-a request-b (car headers))
            (varies-any-header? request-a request-b (cdr headers)))))
 
-(define-public (varies? request-a request-b response)
+(define (varies? request-a request-b response)
   (let ((vary (response-vary response)))
     (or (eq? vary '*)
         (varies-any-header? request-a request-b vary))))
 
-(define*-public (valid? response
-                        #:key
-                        (current-time the-current-time))
-  (when (thunk? current-time)
-    (set! current-time (current-time)))
-  (when (integer? current-time)
-    (set! current-time
-          (make-time time-utc 0 current-time)))
-  (when (time? current-time)
-    (set! current-time (time-utc->date current-time)))
-  (set! current-time
-        (date->time-utc current-time))
-  (set! current-time
-        (time-second current-time))
-  (let ((cc (response-cache-control response #f))
-        (date (response-date response
-                             (time-utc->date
-                              (make-time time-utc 0 current-time))))
-        (last-modified (response-last-modified response)))
-    (set! date (date->time-utc date))
-    (set! date (time-second date))
-    (when last-modified
-      (set! last-modified (date->time-utc last-modified))
-      (set! last-modified (time-second last-modified)))
-    (if cc
-        ;; Use cache-control
-        (let ((cc-no-cache (assq-ref cc 'no-cache))
-              (cc-no-store (assq-ref cc 'no-store))
-              (cc-max-age
-               (or (assq-ref cc 'max-age)
-                   ;; Heuristic freshness
-                   (and last-modified
-                        (/ (- date last-modified) 10)))))
-          (and (not cc-no-cache)
-               (not cc-no-store)
-               cc-max-age
-               (>= (+ date cc-max-age) current-time)))
-        ;; Use expires
-        (let ((exp (response-expires response)))
-          (when exp
-            (set! exp (date->time-utc exp))
-            (set! exp (time-second exp)))
-          (and exp
-               (>= exp current-time))))))
+(define (valid? response)
+  ;; current-date is a thunk parameter
+  (let* ((current-date ((p:current-date)))
+         (current-time (time-second (date->time-utc current-date))))
+    (let ((cc (response-cache-control response #f))
+          (date (time-second (date->time-utc (response-date response current-date))))
+          (last-modified
+           (let ((as-date (response-last-modified response)))
+             (and as-date
+                  (time-second (date->time-utc as-date))))))
+      (if cc
+          ;; Use cache-control
+          (let ((cc-no-cache (assq-ref cc 'no-cache))
+                (cc-no-store (assq-ref cc 'no-store))
+                (cc-max-age
+                 (or (assq-ref cc 'max-age)
+                     ;; Heuristic freshness
+                     (and last-modified
+                          (/ (- date last-modified) 10)))))
+            (and (not cc-no-cache)
+                 (not cc-no-store)
+                 cc-max-age
+                 (>= (+ date cc-max-age) current-time)))
+          ;; Use expires
+          (let ((exp
+                 (let ((as-date (response-expires response)))
+                   (and as-date
+                        (time-second (date->time-utc as-date))))))
+            (and exp
+                 (>= exp current-time)))))))
 
-(define*-public (revalidate uri response body
-                            #:key
-                            (headers '())
-                            (http-get http-get))
+(define* (revalidate uri response body
+                     #:key
+                     (headers '())
+                     (http-get http-get))
   (define (keep-header? h)
     (case (car h)
       ((if-none-match if-unmodified-since) #f)
@@ -266,20 +245,14 @@
               (values new-response new-response-body)))
         (http-get uri #:headers headers))))
 
-(define*-public (with-cache
-                 #:key
-                 (current-time the-current-time)
-                 (http-get http-get)
-                 (dir default-cache-dir))
+(define* (with-cache #:key (http-get http-get))
   (lambda* (uri #:key (headers '()))
     (when (string? uri)
       (set! uri (string->uri uri)))
-    (let ((dir (if (thunk? dir) (dir) dir))
-          (request (build-request uri #:headers headers)))
-      (receive (stored-request stored-response body)
-          (read uri #:dir dir)
+    (let ((request (build-request uri #:headers headers)))
+      (receive (stored-request stored-response body) (read uri)
         (if stored-response
-            (let ((valid (valid? stored-response #:current-time the-current-time))
+            (let ((valid (valid? stored-response))
                   (invariant (not (varies? request stored-request stored-response))))
               (unless invariant
                 (format (current-error-port) "Cache entry for ~a varies.\n" (uri->string uri)))
@@ -289,9 +262,9 @@
                       (revalidate uri stored-response body
                                   #:headers headers
                                   #:http-get http-get)
-                    (add request final-response final-body #:dir dir)
+                    (add request final-response final-body)
                     (values final-response final-body))))
             (receive (final-response final-body)
                 (http-get uri #:headers headers)
-              (add request final-response final-body #:dir dir)
+              (add request final-response final-body)
               (values final-response final-body)))))))
diff --git a/src/scm/webid-oidc/client.scm b/src/scm/webid-oidc/client.scm
index e8796c0..67928db 100644
--- a/src/scm/webid-oidc/client.scm
+++ b/src/scm/webid-oidc/client.scm
@@ -21,8 +21,8 @@
   #:use-module (webid-oidc oidc-id-token)
   #:use-module (webid-oidc dpop-proof)
   #:use-module (webid-oidc jwk)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
-  #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
   #:use-module ((webid-oidc config) #:prefix cfg:)
   #:use-module (web uri)
   #:use-module (web client)
@@ -174,28 +174,17 @@
                 (raise-no-provider-candidates host-or-webid candidate-errors))
               final-candidates))))))
 
-(define the-current-time current-time)
-
 (define*-public (token host client-key
                        #:key
                        (authorization-code #f)
                        (refresh-token #f)
                        (http-get http-get)
-                       (http-post http-post)
-                       (current-time #f))
+                       (http-post http-post))
   (unless (or authorization-code refresh-token)
     (scm-error 'wrong-type-arg "token"
                "You need to either set #:authorization-code or #:refresh-token."
                '()
                (list authorization-code)))
-  (unless current-time
-    (set! current-time the-current-time))
-  (when (thunk? current-time)
-    (set! current-time (current-time)))
-  (when (integer? current-time)
-    (set! current-time (make-time time-utc 0 current-time)))
-  (when (time? current-time)
-    (set! current-time (time-utc->date current-time)))
   (let ((token-endpoint
          (oidc-configuration-token-endpoint
           (get-oidc-configuration host #:http-get http-get)))
@@ -212,8 +201,7 @@
                     (else
                      (error "Unknown key type of ~S." client-key)))
             #:htm 'POST
-            #:htu token-endpoint
-            #:iat current-time)))
+            #:htu token-endpoint)))
       (receive (response response-body)
           (http-post token-endpoint
                      #:body
@@ -253,17 +241,7 @@
                   (raise-unexpected-header-value 'content-type (response-content-type response)))
                 (stubs:json-string->scm response-body)))))))))
 
-(define (default-dir)
-  (let ((xdg-data-home
-         (or
-          (getenv "XDG_DATA_HOME")
-          (format #f "~a/.local/share"
-                  (getenv "HOME")))))
-    (format #f "~a/disfluid" xdg-data-home)))
-
-(define*-public (list-profiles #:key (dir default-dir))
-  (when (thunk? dir)
-    (set! dir (dir)))
+(define-public (list-profiles)
   (map (lambda (profile)
          (list
           (string->uri (car profile)) ;; webid
@@ -272,20 +250,17 @@
           (cadddr profile))) ;; key
        (catch #t
          (lambda ()
-           (call-with-input-file (string-append dir "/profiles")
+           (call-with-input-file (string-append (p:data-home) "/profiles")
              read))
          (lambda error
            (format (current-error-port) "Could not read profiles: ~s\n" error)
            '()))))
 
-(define* (add-profile webid issuer refresh-token key
-                      #:key (dir default-dir))
-  (when (thunk? dir)
-    (set! dir (dir)))
-  (let ((other-profiles (list-profiles #:dir dir)))
+(define (add-profile webid issuer refresh-token key)
+  (let ((other-profiles (list-profiles)))
     (stubs:atomically-update-file
-     (string-append dir "/profiles")
-     (string-append dir "/profiles.lock")
+     (string-append (p:data-home) "/profiles")
+     (string-append (p:data-home) "/profiles.lock")
      (lambda (port)
        (write
         (map (lambda (profile)
@@ -304,12 +279,8 @@
                        #:key
                        (client-id #f)
                        (redirect-uri #f)
-                       (dir default-dir)
                        (http-get http-get)
-                       (http-post http-post)
-                       (current-time #f))
-  (when (thunk? dir)
-    (set! dir (dir)))
+                       (http-post http-post))
   (let ((host/webid (get-host/webid)))
     (let ((authorization-uris
            (authorize host/webid
@@ -324,8 +295,7 @@
                    (token host/webid key
                           #:authorization-code authz-code
                           #:http-get http-get
-                          #:http-post http-post
-                          #:current-time current-time)))
+                          #:http-post http-post)))
               (let ((id-token (id-token-decode (assq-ref params 'id_token)
                                                #:http-get http-get))
                     (access-token (assq-ref params 'access_token))
@@ -335,16 +305,13 @@
                   (add-profile (id-token-webid id-token)
                                (id-token-iss id-token)
                                refresh-token
-                               key
-                               #:dir dir))
+                               key))
                 (values (cdr id-token) access-token key)))))))))
 
 (define*-public (login webid issuer refresh-token key
                        #:key
-                       (dir default-dir)
                        (http-get http-get)
-                       (http-post http-post)
-                       (current-time #f))
+                       (http-post http-post))
   (when (string? webid)
     (set! webid (string->uri webid)))
   (when (string? issuer)
@@ -354,8 +321,7 @@
            (token iss-host key
                   #:refresh-token refresh-token
                   #:http-get http-get
-                  #:http-post http-post
-                  #:current-time current-time)))
+                  #:http-post http-post)))
       (let ((id-token (id-token-decode (assq-ref params 'id_token)
                                        #:http-get http-get))
             (access-token (assq-ref params 'access_token))
@@ -366,30 +332,25 @@
           (add-profile (id-token-webid id-token)
                        (id-token-iss id-token)
                        refresh-token
-                       key
-                       #:dir dir))
+                       key))
         (values (cdr id-token) access-token key)))))
 
 (define*-public (refresh id-token
                          key
                          #:key
-                         (dir default-dir)
                          (http-get http-get)
-                         (http-post http-post)
-                         (current-time #f))
-  (when (thunk? dir)
-    (set! dir (dir)))
+                         (http-post http-post))
   (when (id-token-payload? id-token)
     ;; For convenience, we’d like a full ID token to use the ID token
     ;; API.
     (set! id-token (cons `((alg . "HS256")) id-token)))
-  (let ((profiles (list-profiles #:dir dir)))
+  (let ((profiles (list-profiles)))
     (letrec ((find-refresh-token
               (lambda (profiles)
                 (when (null? profiles)
                   (raise-profile-not-found (id-token-webid id-token)
                                            (id-token-iss id-token)
-                                           dir))
+                                           (p:data-home)))
                 (let ((prof (car profiles))
                       (others (cdr profiles)))
                   (let ((webid (car prof))
@@ -403,15 +364,12 @@
              (id-token-iss id-token)
              (find-refresh-token (profiles))
              key
-             #:dir dir
              #:http-get http-get
-             #:http-post http-post
-             #:current-time current-time))))
+             #:http-post http-post))))
 
 (define* (renew-if-expired id-token access-token key
                            date
                            #:key
-                           (dir default-dir)
                            (http-get http-get)
                            (http-post http-post))
   ;; Since we’re not supposed to decode the access token, we’re
@@ -427,25 +385,22 @@
     (set! exp (date->time-utc exp))
     (set! exp (time-second exp))
     (if (>= date exp)
-        (refresh id-token key
-                 #:dir dir
-                 #:http-get http-get
-                 #:http-post http-post
-                 #:current-time date)
+        (parameterize ((p:current-date (lambda () date)))
+          (refresh id-token key
+                   #:http-get http-get
+                   #:http-post http-post))
         (values id-token access-token key))))
 
 (define*-public (make-client id-token access-token key
                              #:key
-                             (dir default-dir)
                              (http-get http-get)
                              (http-post http-post)
-                             (http-request http-request)
-                             (current-time the-current-time))
+                             (http-request http-request))
   ;; HACK: guile does not support other authentication schemes in
   ;; WWW-Authenticate than Basic, so it will crash when a response
   ;; containing that header will be issued.
   (declare-header! "WWW-Authenticate" string->symbol symbol? write)
-  (define (handler uri method headers other-args current-time retry?)
+  (define (handler uri method headers other-args retry?)
     (let ((proof (issue-dpop-proof
                   key
                   #:alg (case (kty key)
@@ -455,7 +410,6 @@
                            (error "Unknown key type of ~S." key)))
                   #:htm method
                   #:htu uri
-                  #:iat current-time
                   #:access-token access-token)))
       (receive (response response-body)
           (apply http-request uri
@@ -470,7 +424,6 @@
               ;; Maybe the access token has expired?
               (receive (new-id-token new-access-token new-key)
                   (renew-if-expired id-token access-token key server-date
-                                    #:dir dir
                                     #:http-get http-get
                                     #:http-post http-post)
                 (if (equal? access-token new-access-token)
@@ -481,18 +434,11 @@
                       (set! id-token new-id-token)
                       (set! access-token new-access-token)
                       (set! key new-key)
-                      (handler uri method headers other-args current-time #f))))
+                      (handler uri method headers other-args #f))))
               (values response response-body))))))
   (define (parse-args uri method headers other-args-rev rest)
     (if (null? rest)
-        (let ((the-current-time current-time))
-          (when (thunk? the-current-time)
-            (set! the-current-time (the-current-time)))
-          (when (integer? the-current-time)
-            (set! the-current-time (make-time time-utc 0 the-current-time)))
-          (when (time? the-current-time)
-            (set! the-current-time (time-utc->date the-current-time)))
-          (handler uri method headers (reverse other-args-rev) the-current-time #t))
+        (handler uri method headers (reverse other-args-rev) #t)
         (let ((kw (car rest)))
           (case kw
             ((#:method)
@@ -618,5 +564,3 @@
                          (title "Not Found"))
                         (body
                          (p "This page does not exist on the server."))))))))))))))
-
-
diff --git a/src/scm/webid-oidc/dpop-proof.scm b/src/scm/webid-oidc/dpop-proof.scm
index 54b338b..2ccbddc 100644
--- a/src/scm/webid-oidc/dpop-proof.scm
+++ b/src/scm/webid-oidc/dpop-proof.scm
@@ -20,6 +20,7 @@
   #:use-module (webid-oidc jwk)
   #:use-module (webid-oidc jti)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web uri)
   #:use-module (ice-9 optargs)
   #:use-module (srfi srfi-19))
@@ -186,51 +187,51 @@
                     (uri-path b))))
     (raise-dpop-uri-mismatch a b)))
 
-(define*-public (dpop-proof-decode current-time jti-list method uri str cnf/check
+(define*-public (dpop-proof-decode method uri str cnf/check
                                    #:key
                                    (access-token #f))
-  (when (date? current-time)
-    (set! current-time (date->time-utc current-time)))
-  (when (time? current-time)
-    (set! current-time (time-second current-time)))
-  (with-exception-handler
-      (lambda (error)
-        (raise-cannot-decode-dpop-proof str error))
-    (lambda ()
-      (let ((decoded (the-dpop-proof (jws-decode str dpop-proof-jwk))))
-        (unless (eq? method (dpop-proof-htm decoded))
-          (raise-dpop-method-mismatch (dpop-proof-htm decoded) method))
-        (uris-compatible (dpop-proof-htu decoded)
-                         (if (string? uri)
-                             (string->uri uri)
-                             uri))
-        (let ((iat (time-second (date->time-utc (dpop-proof-iat decoded)))))
-          (unless (>= current-time (- iat 5))
-            (raise-dpop-signed-in-future iat current-time))
-          (unless (<= current-time (+ iat 120)) ;; Valid for 2 min
-            (raise-dpop-too-old iat current-time)))
-        (when access-token
-          (let ((h (stubs:hash 'SHA-256 access-token)))
-            (unless (equal? (dpop-proof-ath decoded) h)
-              (raise-exception
-               (make-dpop-invalid-access-token-hash (dpop-proof-ath decoded) access-token)))))
-        (if (string? cnf/check)
-            (unless (equal? cnf/check (stubs:jkt (dpop-proof-jwk decoded)))
-              (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) cnf/check #f))
-            (with-exception-handler
-                (lambda (error)
-                  (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) #f error))
-              (lambda ()
-                (unless (cnf/check (stubs:jkt (dpop-proof-jwk decoded)))
-                  ;; deprecated; throw an error instead!
-                  (error "the cnf/check function returned #f")))))
-        (unless (jti-check current-time (dpop-proof-jti decoded) jti-list 120)
-          (with-exception-handler
-              (lambda (error)
-                (raise-jti-found (dpop-proof-jti decoded) error))
-            (lambda ()
-              (error "the jti-check function returned #f"))))
-        decoded))))
+  (let ((current-time
+         (time-second (date->time-utc ((p:current-date))))))
+    (with-exception-handler
+        (lambda (error)
+          (raise-cannot-decode-dpop-proof str error))
+      (lambda ()
+        (let ((decoded (the-dpop-proof (jws-decode str dpop-proof-jwk))))
+          (unless (eq? method (dpop-proof-htm decoded))
+            (raise-dpop-method-mismatch (dpop-proof-htm decoded) method))
+          (uris-compatible (dpop-proof-htu decoded)
+                           (if (string? uri)
+                               (string->uri uri)
+                               uri))
+          (let ((iat (time-second (date->time-utc (dpop-proof-iat decoded)))))
+            (unless (>= current-time (- iat 5))
+              (raise-dpop-signed-in-future iat current-time))
+            (unless (<= current-time (+ iat 120)) ;; Valid for 2 min
+              (raise-dpop-too-old iat current-time)))
+          (when access-token
+            (let ((h (stubs:hash 'SHA-256 access-token)))
+              (unless (equal? (dpop-proof-ath decoded) h)
+                (raise-exception
+                 (make-dpop-invalid-access-token-hash (dpop-proof-ath decoded) access-token)))))
+          (if (string? cnf/check)
+              (unless (equal? cnf/check (stubs:jkt (dpop-proof-jwk decoded)))
+                (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) cnf/check #f))
+              (with-exception-handler
+                  (lambda (error)
+                    (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) #f error))
+                (lambda ()
+                  (unless (cnf/check (stubs:jkt (dpop-proof-jwk decoded)))
+                    ;; deprecated; throw an error instead!
+                    (error "the cnf/check function returned #f")))))
+          (parameterize ((p:current-date current-time))
+            ;; jti-check should use the same date.
+            (unless (jti-check (dpop-proof-jti decoded) 120)
+              (with-exception-handler
+                  (lambda (error)
+                    (raise-jti-found (dpop-proof-jti decoded) error))
+                (lambda ()
+                  (error "the jti-check function returned #f"))))
+            decoded))))))
 
 (define-public (dpop-proof-encode dpop-proof key)
   (with-exception-handler
@@ -245,11 +246,10 @@
                  (alg #f)
                  (htm #f)
                  (htu #f)
-                 (iat #f)
                  (access-token #f))
   (dpop-proof-encode
    (make-dpop-proof (make-dpop-proof-header alg client-key)
-                    (make-dpop-proof-payload (stubs:random 12) htm htu iat
+                    (make-dpop-proof-payload (stubs:random 12) htm htu ((p:current-date))
                                              (and access-token
                                                   (stubs:hash 'SHA-256 access-token))))
    client-key))
diff --git a/src/scm/webid-oidc/hello-world.scm b/src/scm/webid-oidc/hello-world.scm
index 8e68359..d752aae 100644
--- a/src/scm/webid-oidc/hello-world.scm
+++ b/src/scm/webid-oidc/hello-world.scm
@@ -17,7 +17,6 @@
 (define-module (webid-oidc hello-world)
   #:use-module (webid-oidc resource-server)
   #:use-module (webid-oidc server log)
-  #:use-module (webid-oidc jti)
   #:use-module ((webid-oidc config) #:prefix cfg:)
   #:use-module (web request)
   #:use-module (web response)
@@ -112,7 +111,6 @@ Options:
                            (G_ "You are legally required to link to the complete corresponding source code.\n"))
                    (exit 1))
                  str))
-              (jti-list (make-jti-list))
               (log-file (option-ref options log-file-sym #f))
               (error-file (option-ref options error-file-sym #f)))
           (unless (and (string->number port-string)
diff --git a/src/scm/webid-oidc/identity-provider.scm b/src/scm/webid-oidc/identity-provider.scm
index 8bd3e5b..e22f1ef 100644
--- a/src/scm/webid-oidc/identity-provider.scm
+++ b/src/scm/webid-oidc/identity-provider.scm
@@ -57,9 +57,7 @@
                  jwks-uri
                  authorization-endpoint-uri
                  token-endpoint-uri
-                 jti-list
                  #:key
-                 (current-time current-time)
                  (http-get http-get))
   (let ((key
          (catch #t
@@ -80,11 +78,9 @@
                'ES256)))
       (let ((authorization-endpoint
              (make-authorization-endpoint subject encrypted-password alg key 120
-                                          #:current-time current-time
                                           #:http-get http-get))
             (token-endpoint
-             (make-token-endpoint token-endpoint-uri issuer alg key 3600 jti-list
-                                  #:current-time current-time))
+             (make-token-endpoint token-endpoint-uri issuer alg key 3600))
             (openid-configuration
              (make-oidc-configuration jwks-uri
                                       authorization-endpoint-uri
diff --git a/src/scm/webid-oidc/jti.scm b/src/scm/webid-oidc/jti.scm
index 4713d7d..cf05bbb 100644
--- a/src/scm/webid-oidc/jti.scm
+++ b/src/scm/webid-oidc/jti.scm
@@ -15,36 +15,42 @@
 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 (define-module (webid-oidc jti)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (ice-9 atomic)
   #:use-module (ice-9 threads)
-  #:use-module (srfi srfi-19))
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-19)
+  #:export (jti-check))
 
-(define-public (make-jti-list)
+(define jti-list
   (make-atomic-box '()))
 
-(define-public (lookup list jti)
-  (if (null? list)
-      #f
-      (or (string=? (assq-ref (car list) 'jti) jti)
-          (lookup (cdr list) jti))))
-
-(define-public (jti-check current-time jti list valid-time)
-  (when (date? current-time)
-    (set! current-time (date->time-utc current-time)))
-  (when (time? current-time)
-    (set! current-time (time-second current-time)))
-  (let* ((old (atomic-box-ref list))
-         (new-entry `((exp . ,(+ current-time valid-time))
-                      (jti . ,jti)))
+(define-record-type <jti-item>
+  (make-jti-item exp jti)
+  jti-item?
+  (exp jti-item-exp)
+  (jti jti-item-jti))
+
+(define lookup
+  (match-lambda*
+    ((() item) #f)
+    (((($ <jti-item> exp jti) other ...) item)
+     (or (string=? jti item)
+         (lookup other item)))))
+
+(define (jti-check jti valid-time)
+  (let* ((current-time
+          (time-second (date->time-utc ((p:current-date)))))
+         (old (atomic-box-ref jti-list))
+         (new-entry (make-jti-item (+ current-time valid-time) jti))
          (new (filter
-               (lambda (entry)
-                 (let ((exp (assq-ref entry 'exp)))
-                   (>= exp current-time)))
+               (match-lambda
+                 (($ <jti-item> exp other-jti)
+                  (>= exp current-time)))
                (cons new-entry old))))
-    (let ((present? (lookup old jti)))
-      (if present?
-          #f
-          (let ((discarded (atomic-box-compare-and-swap! list old new)))
-            (if (eq? discarded old)
-                #t
-                (jti-check current-time jti list valid-time)))))))
+    (and (not (lookup old jti))
+         (let ((discarded (atomic-box-compare-and-swap! jti-list old new)))
+           (if (eq? discarded old)
+               #t
+               (jti-check jti valid-time))))))
diff --git a/src/scm/webid-oidc/oidc-id-token.scm b/src/scm/webid-oidc/oidc-id-token.scm
index 9fe276c..e95efaf 100644
--- a/src/scm/webid-oidc/oidc-id-token.scm
+++ b/src/scm/webid-oidc/oidc-id-token.scm
@@ -20,6 +20,7 @@
   #:use-module (webid-oidc jws)
   #:use-module (webid-oidc jti)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web uri)
   #:use-module (web client)
   #:use-module (ice-9 optargs)
@@ -206,12 +207,13 @@
                  (iss #f)
                  (sub #f)
                  (aud #f)
-                 (exp #f)
-                 (iat #f))
+                 (validity 3600))
   (unless sub
     (set! sub webid))
   (id-token-encode
    (make-id-token
     `((alg . ,(symbol->string alg)))
-    (make-id-token-payload webid iss sub aud (stubs:random 12) exp iat))
+    (let ((iat (time-second (date->time-utc ((p:current-date))))))
+      (make-id-token-payload webid iss sub aud (stubs:random 12)
+                             (+ iat validity) iat)))
    issuer-key))
diff --git a/src/scm/webid-oidc/parameters.scm b/src/scm/webid-oidc/parameters.scm
new file mode 100644
index 0000000..3b24361
--- /dev/null
+++ b/src/scm/webid-oidc/parameters.scm
@@ -0,0 +1,34 @@
+(define-module (webid-oidc parameters)
+  #:use-module (srfi srfi-19)
+  #:use-module (webid-oidc jti)
+  #:export (data-home cache-home current-date))
+
+(define data-home
+  (make-parameter
+   (format #f "~a/disfluid"
+           (or (getenv "XDG_DATA_HOME")
+               (format #f "~a/.local/share"
+                       (getenv "HOME"))))))
+
+(define cache-home
+  (make-parameter
+   (format #f "~a/disfluid"
+           (or (getenv "XDG_CACHE_HOME")
+               (format #f "~a/.cache"
+                       (getenv "HOME"))))))
+
+(define current-date
+  ;; This parameter is a thunk!
+  (make-parameter
+   (lambda ()
+     (time-utc->date (current-time)))
+   (lambda (thunk)
+     (lambda ()
+       (let ((date (if (thunk? thunk)
+                       (thunk)
+                       thunk)))
+         (when (integer? date)
+           (set! date (make-time time-utc 0 date)))
+         (when (time? date)
+           (set! date (time-utc->date date)))
+         date)))))
diff --git a/src/scm/webid-oidc/program.scm b/src/scm/webid-oidc/program.scm
index 2eda34c..9d65b70 100644
--- a/src/scm/webid-oidc/program.scm
+++ b/src/scm/webid-oidc/program.scm
@@ -25,6 +25,7 @@
   #:use-module (webid-oidc jti)
   #:use-module (webid-oidc offloading)
   #:use-module (webid-oidc catalog)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module ((webid-oidc config) #:prefix cfg:)
   #:use-module (ice-9 optargs)
@@ -103,81 +104,95 @@
       (prepare-log-file log-file))
     (when error-file
       (prepare-error-file error-file))
-    (call/ec
-     (lambda (return)
-       (with-exception-handler
-           (lambda (error)
-             (with-mutex logging-mutex
-               (format (current-error-port)
-                       (G_ "~a: ~a: Internal server error: ~a\n")
-                       (date->string (time-utc->date (current-time)))
-                       (request-ip-address request)
-                       (error->str error)))
-             (return
-              (build-response #:code 500
-                              #:reason-phrase "Internal Server Error"
-                              #:headers `((source . ,complete-corresponding-source)))
-              "Sorry, there was an error."))
-         (lambda ()
-           (with-exception-handler
-               (lambda (error)
-                 (with-mutex logging-mutex
-                   (format (current-error-port)
-                           (G_ "The client locale ~s can’t be approximated by system locale ~s (because ~a), using C.\n")
-                           ((record-accessor &unknown-client-locale 'web-locale) error)
-                           ((record-accessor &unknown-client-locale 'c-locale) error)
-                           (error->str error))))
-             (lambda ()
-               (receive (response response-body user cause)
-                   (call-with-values
-                       (lambda ()
-                         (handler request request-body))
-                     (case-lambda
-                       ((response response-body)
-                        (values response response-body #f #f))
-                       ((response response-body user)
-                        (values response response-body user #f))
-                       ((response response-body user cause)
-                        (values response response-body user cause))))
-                 (let ((logging-port
-                        (let ((response-code (response-code response)))
-                          (if (>= response-code 400)
-                              ;; That’s an error
-                              (current-error-port)
-                              (current-output-port)))))
+    (parameterize ((p:data-home
+                    (string-append
+                     (or (getenv "XDG_DATA_HOME")
+                         (string-append (getenv "HOME") "/.local/share"))
+                     "/disfluid"))
+                   (p:cache-home
+                    (string-append
+                     (or (getenv "XDG_CACHE_HOME")
+                         (string-append (getenv "HOME") "/.cache"))
+                     "/disfluid"))
+                   ;; Fix the date
+                   (p:current-date ((p:current-date))))
+      (call/ec
+       (lambda (return)
+         (with-exception-handler
+             (lambda (error)
+               (with-mutex logging-mutex
+                 (format (current-error-port)
+                         (G_ "~a: ~a: Internal server error: ~a\n")
+                         (date->string ((p:current-date)))
+                         (request-ip-address request)
+                         (error->str error)))
+               (return
+                (build-response #:code 500
+                                #:reason-phrase "Internal Server Error"
+                                #:headers `((source . ,complete-corresponding-source)
+                                            (date . ,((p:current-date)))))
+                "Sorry, there was an error."))
+           (lambda ()
+             (with-exception-handler
+                 (lambda (error)
                    (with-mutex logging-mutex
-                     (format logging-port
-                             (G_ "~a: ~s ~a ~s ~a\n")
-                             (if user
-                                 (format #f (G_ "~a: ~a (~a)")
-                                         (date->string (time-utc->date (current-time)))
-                                         (uri->string user)
-                                         (request-ip-address request))
-                                 (format #f (G_ "~a: ~a")
-                                         (date->string (time-utc->date (current-time)))
-                                         (request-ip-address request)))
-                             (request-method request)
-                             (uri-path (request-uri request))
-                             (response-code response)
-                             (if cause
-                                 (string-append
-                                  (response-reason-phrase response)
-                                  " "
-                                  (format #f (G_ "(there was an error: ~a)")
-                                          (error->str cause)))
-                                 (response-reason-phrase response)))))
-                 (return
-                  (build-response
-                   #:version (response-version response)
-                   #:code (response-code response)
-                   #:reason-phrase (response-reason-phrase response)
-                   #:headers (cons `(source . ,complete-corresponding-source)
-                                   (response-headers response))
-                   #:port (response-port response)
-                   #:validate-headers? #t)
-                  response-body)))
-             #:unwind? #t
-             #:unwind-for-type &unknown-client-locale)))))))
+                     (format (current-error-port)
+                             (G_ "The client locale ~s can’t be approximated by system locale ~s (because ~a), using C.\n")
+                             ((record-accessor &unknown-client-locale 'web-locale) error)
+                             ((record-accessor &unknown-client-locale 'c-locale) error)
+                             (error->str error))))
+               (lambda ()
+                 (receive (response response-body user cause)
+                     (call-with-values
+                         (lambda ()
+                           (handler request request-body))
+                       (case-lambda
+                         ((response response-body)
+                          (values response response-body #f #f))
+                         ((response response-body user)
+                          (values response response-body user #f))
+                         ((response response-body user cause)
+                          (values response response-body user cause))))
+                   (let ((logging-port
+                          (let ((response-code (response-code response)))
+                            (if (>= response-code 400)
+                                ;; That’s an error
+                                (current-error-port)
+                                (current-output-port)))))
+                     (with-mutex logging-mutex
+                       (format logging-port
+                               (G_ "~a: ~s ~a ~s ~a\n")
+                               (if user
+                                   (format #f (G_ "~a: ~a (~a)")
+                                           (date->string (time-utc->date (current-time)))
+                                           (uri->string user)
+                                           (request-ip-address request))
+                                   (format #f (G_ "~a: ~a")
+                                           (date->string (time-utc->date (current-time)))
+                                           (request-ip-address request)))
+                               (request-method request)
+                               (uri-path (request-uri request))
+                               (response-code response)
+                               (if cause
+                                   (string-append
+                                    (response-reason-phrase response)
+                                    " "
+                                    (format #f (G_ "(there was an error: ~a)")
+                                            (error->str cause)))
+                                   (response-reason-phrase response)))))
+                   (return
+                    (build-response
+                     #:version (response-version response)
+                     #:code (response-code response)
+                     #:reason-phrase (response-reason-phrase response)
+                     #:headers `((source . ,complete-corresponding-source)
+                                 (date . ,((p:current-date)))
+                                 ,@(response-headers response))
+                     #:port (response-port response)
+                     #:validate-headers? #t)
+                    response-body)))
+               #:unwind? #t
+               #:unwind-for-type &unknown-client-locale))))))))
 
 (define (serve-one-client* handler implementation server state)
   ;; Same as serve-one-client, except it is served in a promise.
@@ -753,8 +768,6 @@ Rreleased ~a\n")
                        (make-identity-provider
                         server-name key-file subject encrypted-password jwks-uri
                         authorization-endpoint-uri token-endpoint-uri
-                        (make-jti-list)
-                        #:current-time current-time
                         #:http-get cache-http-get)))
                   (run-server*
                    (handler-with-log
@@ -821,49 +834,45 @@ Rreleased ~a\n")
                 (format (current-error-port) (G_ "You must pass --~a to set the token endpoint URI.\n")
                         token-endpoint-uri-sym)
                 (exit 1))
-              (let ((jti-list (make-jti-list)))
-                (let ((resource-handler
-                       (make-resource-server
-                        #:server-uri server-name
-                        #:owner subject
-                        #:authenticator
-                        (if header
-                            (begin
-                              (set! header
-                                    (string->symbol
-                                     (string-downcase
-                                      (symbol->string header))))
-                              (lambda (request request-body)
-                                (let ((value (assq-ref (request-headers request) header)))
-                                  (and value (string->uri value)))))
-                            (make-authenticator
-                             jti-list
-                             #:server-uri server-name
-                             #:http-get cache-http-get))
-                        #:http-get cache-http-get))
-                      (identity-provider-handler
-                       (make-identity-provider
-                        server-name key-file subject encrypted-password jwks-uri
-                        authorization-endpoint-uri token-endpoint-uri
-                        jti-list
-                        #:current-time current-time
-                        #:http-get cache-http-get)))
-                  (create-root server-name subject)
-                  (run-server*
-                   (handler-with-log
-                    (option-ref options log-file-sym #f)
-                    (option-ref options error-file-sym #f)
-                    complete-corresponding-source
-                    (lambda (request request-body)
-                      (let ((path (uri-path (request-uri request))))
-                        (if (or (equal? path "/.well-known/openid-configuration")
-                                (equal? path (uri-path jwks-uri))
-                                (equal? path (uri-path authorization-endpoint-uri))
-                                (equal? path (uri-path token-endpoint-uri)))
-                            (identity-provider-handler request request-body)
-                            (resource-handler request request-body)))))
-                   'http
-                   (list #:port port)))))
+              (let ((resource-handler
+                     (make-resource-server
+                      #:server-uri server-name
+                      #:owner subject
+                      #:authenticator
+                      (if header
+                          (begin
+                            (set! header
+                                  (string->symbol
+                                   (string-downcase
+                                    (symbol->string header))))
+                            (lambda (request request-body)
+                              (let ((value (assq-ref (request-headers request) header)))
+                                (and value (string->uri value)))))
+                          (make-authenticator
+                           #:server-uri server-name
+                           #:http-get cache-http-get))
+                      #:http-get cache-http-get))
+                    (identity-provider-handler
+                     (make-identity-provider
+                      server-name key-file subject encrypted-password jwks-uri
+                      authorization-endpoint-uri token-endpoint-uri
+                      #:http-get cache-http-get)))
+                (create-root server-name subject)
+                (run-server*
+                 (handler-with-log
+                  (option-ref options log-file-sym #f)
+                  (option-ref options error-file-sym #f)
+                  complete-corresponding-source
+                  (lambda (request request-body)
+                    (let ((path (uri-path (request-uri request))))
+                      (if (or (equal? path "/.well-known/openid-configuration")
+                              (equal? path (uri-path jwks-uri))
+                              (equal? path (uri-path authorization-endpoint-uri))
+                              (equal? path (uri-path token-endpoint-uri)))
+                          (identity-provider-handler request request-body)
+                          (resource-handler request request-body)))))
+                 'http
+                 (list #:port port))))
              (else
               (format (current-error-port) (G_ "Unknown command ~s\n")
                       command)
diff --git a/src/scm/webid-oidc/refresh-token.scm b/src/scm/webid-oidc/refresh-token.scm
index 34b2f1b..e3fbf7c 100644
--- a/src/scm/webid-oidc/refresh-token.scm
+++ b/src/scm/webid-oidc/refresh-token.scm
@@ -18,36 +18,33 @@
   #:use-module (webid-oidc errors)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module (webid-oidc jwk)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web uri)
   #:use-module (ice-9 optargs)
   #:use-module (ice-9 threads)
-  #:use-module (srfi srfi-19))
+  #:use-module (srfi srfi-19)
+  #:export
+  (
+   list-refresh-tokens
+   update-refresh-token-list
+   issue-refresh-token
+   with-refresh-token
+   remove-refresh-token
+   ))
 
-(define-public (default-dir)
-  (let ((xdg-data-home (or
-                        (getenv "XDG_DATA_HOME")
-                        (format #f "~a/.local/share"
-                                (getenv "HOME")))))
-    (format #f "~a/disfluid" xdg-data-home)))
-
-(define*-public (list-refresh-tokens
-                 #:key
-                 (dir default-dir))
-  (when (thunk? dir)
-    (set! dir (dir)))
+(define (list-refresh-tokens)
   (catch #t
     (lambda ()
-      (with-input-from-file (format #f "~a/refresh-tokens.scm" dir)
+      (with-input-from-file (format #f "~a/refresh-tokens.scm" (p:data-home))
         read))
     (lambda errors
       '())))
 
+;; TODO: use stubs:atomically-update-file and remove that mutex.
 (define mutex (make-mutex))
 
-(define* (set-refresh-token-list list
-                                 #:key (dir default-dir))
-  (when (thunk? dir)
-    (set! dir (dir)))
+(define (set-refresh-token-list list)
+  (define dir (p:data-home))
   (define old-file (format #f "~a/refresh-tokens.scm" dir))
   (define new-file (format #f "~a/refresh-tokens.scm~" dir))
   (stubs:call-with-output-file*
@@ -57,12 +54,11 @@
      (close-port port)))
   (rename-file new-file old-file))
 
-(define*-public (update-refresh-token-list f
-                                           #:key (dir default-dir))
+(define (update-refresh-token-list f)
   (with-mutex mutex
-    (let ((old (list-refresh-tokens #:dir dir)))
+    (let ((old (list-refresh-tokens)))
       (let ((new (f old)))
-        (set-refresh-token-list new #:dir dir)))))
+        (set-refresh-token-list new)))))
 
 (define (remove sub aud)
   (lambda (old)
@@ -90,20 +86,13 @@
              (refresh_token . ,jti))
            (remover old)))))
 
-(define*-public (issue-refresh-token sub aud jkt
-                                     #:key
-                                     (dir default-dir))
+(define (issue-refresh-token sub aud jkt)
   (define jti (stubs:random 12))
-  (update-refresh-token-list (insert sub aud jkt jti)
-                             #:dir dir)
+  (update-refresh-token-list (insert sub aud jkt jti))
   jti)
 
-(define*-public (with-refresh-token refresh-token
-                                    key
-                                    f
-                                    #:key
-                                    (dir default-dir))
-  (let ((list (list-refresh-tokens #:dir dir)))
+(define (with-refresh-token refresh-token key f)
+  (let ((list (list-refresh-tokens)))
     (define (check list)
       (if (null? list)
           (raise-invalid-refresh-token refresh-token)
@@ -121,7 +110,5 @@
                   (check tl))))))
     (check list)))
 
-(define*-public (remove-refresh-token sub aud
-                                      #:key
-                                      (dir default-dir))
-  (update-refresh-token-list (remove sub aud) #:dir dir))
+(define (remove-refresh-token sub aud)
+  (update-refresh-token-list (remove sub aud)))
diff --git a/src/scm/webid-oidc/resource-server.scm b/src/scm/webid-oidc/resource-server.scm
index a6c111e..14d8b81 100644
--- a/src/scm/webid-oidc/resource-server.scm
+++ b/src/scm/webid-oidc/resource-server.scm
@@ -21,12 +21,13 @@
   #:use-module (webid-oidc jwk)
   #:use-module (webid-oidc dpop-proof)
   #:use-module (webid-oidc serve)
-  #:use-module (webid-oidc server create)
-  #:use-module (webid-oidc server read)
-  #:use-module (webid-oidc server update)
-  #:use-module (webid-oidc server delete)
+  #:use-module ((webid-oidc server create) #:prefix ldp:)
+  #:use-module ((webid-oidc server read) #:prefix ldp:)
+  #:use-module ((webid-oidc server update) #:prefix ldp:)
+  #:use-module ((webid-oidc server delete) #:prefix ldp:)
   #:use-module (webid-oidc server precondition)
   #:use-module (webid-oidc http-link)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module ((webid-oidc config) #:prefix cfg:)
   #:use-module (webid-oidc jti)
   #:use-module (webid-oidc access-token)
@@ -51,8 +52,7 @@
         (car (reverse (string-split text #\|)))
         out)))
 
-(define*-public (make-authenticator jti-list
-                                    #:key
+(define*-public (make-authenticator #:key
                                     (server-uri #f)
                                     (current-time current-time)
                                     (http-get http-get))
@@ -62,52 +62,45 @@
     (let ((headers (request-headers request))
           (uri (request-uri request))
           (method (request-method request))
-          (current-time
-           (let ((t current-time))
-             (when (thunk? t)
-               (set! t (t)))
-             (when (integer? t)
-               (set! t (make-time time-utc 0 t)))
-             (when (time? t)
-               (set! t (time-utc->date t)))
-             t)))
-      (let ((authz (assoc-ref headers 'authorization))
-            (dpop (assoc-ref headers 'dpop))
-            (full-uri (build-uri (uri-scheme server-uri)
-                                 #:userinfo (uri-userinfo server-uri)
-                                 #:host (uri-host server-uri)
-                                 #:port (uri-port server-uri)
-                                 #:path (string-append
-                                         "/"
-                                         (encode-and-join-uri-path
-                                          (append
-                                           (split-and-decode-uri-path (uri-path server-uri))
-                                           (split-and-decode-uri-path
-                                            (uri-path uri))))))))
-        (and authz dpop
-             (eq? (car authz) 'dpop)
-             (with-exception-handler
-                 (lambda (error)
-                   (format (current-error-port)
-                           (G_ "~a: authentication failure: ~a\n")
-                           (date->string current-time)
-                           (error->str error))
-                   #f)
-               (lambda ()
-                 (let* ((lit-access-token (symbol->string (cadr authz)))
-                        (access-token
-                         (access-token-decode lit-access-token
-                                              #:http-get http-get))
-                        (cnf/jkt (access-token-cnf/jkt access-token))
-                        (dpop-proof
-                         (dpop-proof-decode
-                          current-time jti-list method full-uri
-                          dpop cnf/jkt #:access-token lit-access-token)))
-                   (let ((subject (access-token-webid access-token))
-                         (issuer (access-token-iss access-token)))
-                     (confirm-provider subject issuer #:http-get http-get)
-                     subject)))
-               #:unwind? #t))))))
+          (current-time ((p:current-date))))
+      (parameterize ((p:current-date current-time)) ;; fix the date
+        (let ((authz (assoc-ref headers 'authorization))
+              (dpop (assoc-ref headers 'dpop))
+              (full-uri (build-uri (uri-scheme server-uri)
+                                   #:userinfo (uri-userinfo server-uri)
+                                   #:host (uri-host server-uri)
+                                   #:port (uri-port server-uri)
+                                   #:path (string-append
+                                           "/"
+                                           (encode-and-join-uri-path
+                                            (append
+                                             (split-and-decode-uri-path (uri-path server-uri))
+                                             (split-and-decode-uri-path
+                                              (uri-path uri))))))))
+          (and authz dpop
+               (eq? (car authz) 'dpop)
+               (with-exception-handler
+                   (lambda (error)
+                     (format (current-error-port)
+                             (G_ "~a: authentication failure: ~a\n")
+                             (date->string current-time)
+                             (error->str error))
+                     #f)
+                 (lambda ()
+                   (let* ((lit-access-token (symbol->string (cadr authz)))
+                          (access-token
+                           (access-token-decode lit-access-token
+                                                #:http-get http-get))
+                          (cnf/jkt (access-token-cnf/jkt access-token))
+                          (dpop-proof
+                           (dpop-proof-decode
+                            method full-uri
+                            dpop cnf/jkt #:access-token lit-access-token)))
+                     (let ((subject (access-token-webid access-token))
+                           (issuer (access-token-iss access-token)))
+                       (confirm-provider subject issuer #:http-get http-get)
+                       subject)))
+                 #:unwind? #t)))))))
 
 (define (handle-errors f g)
   (call/ec
@@ -175,171 +168,170 @@
                  (server-uri #f)
                  (owner #f)
                  (authenticator #f)
-                 (current-time current-time)
                  (http-get http-get))
   (unless owner
     (error "The owner is not defined."))
   (declare-link-header!)
   (unless authenticator
     (set! authenticator
-          (make-authenticator (make-jti-list)
-                              #:server-uri server-uri
-                              #:current-time current-time
-                              #:http-get http-get)))
+          (make-authenticator
+           #:server-uri server-uri
+           #:http-get http-get)))
   (lambda (request request-body)
-    (let ((user (authenticator request request-body)))
-      (handle-errors
-       (lambda (return)
-         (let ((method (request-method request)))
-           (case method
-             ((GET HEAD OPTIONS)
-              (receive (headers content)
-                  (read server-uri owner user
-                        (uri-path (request-uri request))
-                        #:http-get http-get)
-                (let ((true-content-type
-                       (car (assq-ref headers 'content-type)))
-                      (other-headers
-                       (filter
-                        (lambda (h)
-                          (not (eq? (car h) 'content-type)))
-                        headers)))
-                  (receive (negociated-content-type
-                            negociated-content)
-                      (convert (request-accept request #f)
-                               server-uri
-                               (uri-path (request-uri request))
-                               true-content-type
-                               content)
-                    (serve-get
-                     return
-                     (uri-path (request-uri request))
-                     (request-if-match request)
-                     (request-if-none-match request)
-                     negociated-content-type
-                     negociated-content
-                     (car (assq-ref headers 'etag))
-                     (cons `(content-type ,negociated-content-type)
-                           other-headers)
-                     user)))))
-             ((PUT)
-              (receive (content-type content)
-                  (nonrdf-or-turtle server-uri request request-body)
-                (return
-                 (build-response
-                  #:headers
-                  `((etag . (,(update server-uri owner user
-                                      (uri-path (request-uri request))
-                                      (request-if-match request)
-                                      (request-if-none-match request)
-                                      content-type
-                                      content
-                                      #:http-get http-get)
-                             . #f))))
-                 ""
-                 user)))
-             ((POST)
-              (receive (content-type content)
-                  (nonrdf-or-turtle server-uri request request-body)
-                (let ((types
-                       (map car
-                            (filter
-                             (lambda (link)
-                               (equal? (assq-ref link 'rel) "type"))
-                             (request-links request)))))
+    (parameterize ((p:current-date ((p:current-date)))) ;; Fix the date
+      (let ((user (authenticator request request-body)))
+        (handle-errors
+         (lambda (return)
+           (let ((method (request-method request)))
+             (case method
+               ((GET HEAD OPTIONS)
+                (receive (headers content)
+                    (ldp:read server-uri owner user
+                              (uri-path (request-uri request))
+                              #:http-get http-get)
+                  (let ((true-content-type
+                         (car (assq-ref headers 'content-type)))
+                        (other-headers
+                         (filter
+                          (lambda (h)
+                            (not (eq? (car h) 'content-type)))
+                          headers)))
+                    (receive (negociated-content-type
+                              negociated-content)
+                        (convert (request-accept request #f)
+                                 server-uri
+                                 (uri-path (request-uri request))
+                                 true-content-type
+                                 content)
+                      (serve-get
+                       return
+                       (uri-path (request-uri request))
+                       (request-if-match request)
+                       (request-if-none-match request)
+                       negociated-content-type
+                       negociated-content
+                       (car (assq-ref headers 'etag))
+                       (cons `(content-type ,negociated-content-type)
+                             other-headers)
+                       user)))))
+               ((PUT)
+                (receive (content-type content)
+                    (nonrdf-or-turtle server-uri request request-body)
                   (return
                    (build-response
-                    #:code 201 #:reason-phrase "Created"
                     #:headers
-                    `((location . ,(create server-uri owner user
-                                           (uri-path (request-uri request))
-                                           types
-                                           (assq-ref (request-headers request) 'slug)
-                                           content-type
-                                           content
-                                           #:http-get http-get))))
+                    `((etag . (,(ldp:update server-uri owner user
+                                            (uri-path (request-uri request))
+                                            (request-if-match request)
+                                            (request-if-none-match request)
+                                            content-type
+                                            content
+                                            #:http-get http-get)
+                               . #f))))
                    ""
-                   user))))
-             ((DELETE)
-              (delete server-uri owner user
-                      (uri-path (request-uri request))
-                      (request-if-match request)
-                      (request-if-none-match request)
-                      #:http-get http-get)
-              (return
-               (build-response)
-               ""
-               user)))))
-       (lambda (return error)
-         (if (cannot-fetch-group? error)
-             (format (current-error-port) (G_ "Warning: ~a\n")
-                     (error->str error))
-             (cond
-              ((uri-slash-semantics-error? error)
-               (return
-                (build-response
-                 #:code 301
-                 #:reason-phrase "Found"
-                 #:headers
-                 `((location
-                    . ,(build-uri
-                        (uri-scheme server-uri)
-                        #:userinfo (uri-userinfo server-uri)
-                        #:host (uri-host server-uri)
-                        #:port (uri-port server-uri)
-                        #:path (uri-slash-semantics-error-expected-path error)))))
-                #f
-                user))
-              ((or (path-not-found? error)
-                   (auxiliary-resource-absent? error)
-                   (forbidden? error))
-               (if user
-                   ;; That’s a forbidden
-                   (return
-                    (build-response #:code 403 #:reason-phrase "Forbidden")
-                    #f
-                    user)
-                   (return
-                    (build-response #:code 401 #:reason-phrase "Unauthorized"
-                                    #:headers `((www-authenticate . ((DPoP)))))
-                    #f
-                    user)))
-              ((or (cannot-delete-root? error))
-               (return
-                (build-response
-                 #:code 405
-                 #:reason-phrase "Method Not Allowed")
-                #f
-                user))
-              ((or (container-not-empty? error)
-                   (incorrect-containment-triples? error)
-                   (path-is-auxiliary? error))
-               (return
-                (build-response
-                 #:code 409
-                 #:reason-phrase "Conflict")
-                #f
-                user))
-              ((unsupported-media-type? error)
-               (return
-                (build-response
-                 #:code 415
-                 #:reason-phrase "Unsupported Media Type")
-                #f
-                user))
-              ((precondition-failed? error)
-               (return
-                (build-response
-                 #:code 412
-                 #:reason-phrase "Precondition Failed")
-                #f
-                user))
-              ((not-acceptable? error)
-               (return
-                (build-response
-                 #:code 406
-                 #:reason-phrase "Not Acceptable")
-                #f
-                user))
-              (else
-               (raise-exception error)))))))))
+                   user)))
+               ((POST)
+                (receive (content-type content)
+                    (nonrdf-or-turtle server-uri request request-body)
+                  (let ((types
+                         (map car
+                              (filter
+                               (lambda (link)
+                                 (equal? (assq-ref link 'rel) "type"))
+                               (request-links request)))))
+                    (return
+                     (build-response
+                      #:code 201 #:reason-phrase "Created"
+                      #:headers
+                      `((location . ,(ldp:create server-uri owner user
+                                                 (uri-path (request-uri request))
+                                                 types
+                                                 (assq-ref (request-headers request) 'slug)
+                                                 content-type
+                                                 content
+                                                 #:http-get http-get))))
+                     ""
+                     user))))
+               ((DELETE)
+                (ldp:delete server-uri owner user
+                            (uri-path (request-uri request))
+                            (request-if-match request)
+                            (request-if-none-match request)
+                            #:http-get http-get)
+                (return
+                 (build-response)
+                 ""
+                 user)))))
+         (lambda (return error)
+           (if (cannot-fetch-group? error)
+               (format (current-error-port) (G_ "Warning: ~a\n")
+                       (error->str error))
+               (cond
+                ((uri-slash-semantics-error? error)
+                 (return
+                  (build-response
+                   #:code 301
+                   #:reason-phrase "Found"
+                   #:headers
+                   `((location
+                      . ,(build-uri
+                          (uri-scheme server-uri)
+                          #:userinfo (uri-userinfo server-uri)
+                          #:host (uri-host server-uri)
+                          #:port (uri-port server-uri)
+                          #:path (uri-slash-semantics-error-expected-path error)))))
+                  #f
+                  user))
+                ((or (path-not-found? error)
+                     (auxiliary-resource-absent? error)
+                     (forbidden? error))
+                 (if user
+                     ;; That’s a forbidden
+                     (return
+                      (build-response #:code 403 #:reason-phrase "Forbidden")
+                      #f
+                      user)
+                     (return
+                      (build-response #:code 401 #:reason-phrase "Unauthorized"
+                                      #:headers `((www-authenticate . ((DPoP)))))
+                      #f
+                      user)))
+                ((or (cannot-delete-root? error))
+                 (return
+                  (build-response
+                   #:code 405
+                   #:reason-phrase "Method Not Allowed")
+                  #f
+                  user))
+                ((or (container-not-empty? error)
+                     (incorrect-containment-triples? error)
+                     (path-is-auxiliary? error))
+                 (return
+                  (build-response
+                   #:code 409
+                   #:reason-phrase "Conflict")
+                  #f
+                  user))
+                ((unsupported-media-type? error)
+                 (return
+                  (build-response
+                   #:code 415
+                   #:reason-phrase "Unsupported Media Type")
+                  #f
+                  user))
+                ((precondition-failed? error)
+                 (return
+                  (build-response
+                   #:code 412
+                   #:reason-phrase "Precondition Failed")
+                  #f
+                  user))
+                ((not-acceptable? error)
+                 (return
+                  (build-response
+                   #:code 406
+                   #:reason-phrase "Not Acceptable")
+                  #f
+                  user))
+                (else
+                 (raise-exception error))))))))))
diff --git a/src/scm/webid-oidc/reverse-proxy.scm b/src/scm/webid-oidc/reverse-proxy.scm
index f9caba6..a1b05e3 100644
--- a/src/scm/webid-oidc/reverse-proxy.scm
+++ b/src/scm/webid-oidc/reverse-proxy.scm
@@ -18,8 +18,8 @@
   #:use-module (webid-oidc errors)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module (webid-oidc resource-server)
-  #:use-module (webid-oidc jti)
   #:use-module ((webid-oidc config) #:prefix cfg:)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (ice-9 optargs)
   #:use-module (ice-9 receive)
   #:use-module (ice-9 i18n)
@@ -36,9 +36,7 @@
 
 (define*-public (make-reverse-proxy
                  #:key
-                 (jti-list #f)
                  (server-uri #f)
-                 (current-time current-time)
                  (http-get http-get)
                  (endpoint #f)
                  (auth-header 'XXX-Agent))
@@ -50,9 +48,7 @@
           (symbol->string auth-header))))
   (define authenticate
     (make-authenticator
-     (or jti-list (make-jti-list))
      #:server-uri server-uri
-     #:current-time current-time
      #:http-get http-get))
   (unless (and endpoint (uri? endpoint))
     (error "#:endpoint argument is not present or not an URI."))
@@ -68,43 +64,46 @@
                    unconfirmed-issuer)
                   #f)
                  (else
-                  (apply throw key args)))))))
-      (let ((raw-headers (request-headers request)))
-        (let ((modified-headers
-               (append
-                (if agent
-                    (list (cons auth-header (uri->string agent)))
-                    '())
-                (filter
-                 (lambda (h)
-                   (not (eq? (car h) auth-header)))
-                 raw-headers))))
-          (let ((modified-request
-                 (build-request
-                  (request-uri request)
-                  #:method (request-method request)
-                  #:headers modified-headers)))
-            (let ((port (open-socket-for-uri endpoint)))
-              (let ((request-with-port
-                     (write-request modified-request port)))
-                (when request-body
-                  (unless (bytevector? request-body)
-                    (set! request-body (string->utf8 request-body)))
-                  (write-request-body request-with-port request-body))
-                (force-output (request-port request-with-port))
-                (let ((response (read-response port)))
-                  (let ((response-body
-                         (or (response-must-not-include-body? response)
-                             (read-response-body response))))
-                    (let ((adapted-response
-                           (build-response
-                            #:code (response-code response)
-                            #:reason-phrase (response-reason-phrase response)
-                            #:headers
-                            (append
-                             (if (eqv? (response-code response) 401)
-                                 (list (cons 'www-authenticate '((DPoP))))
-                                 '())
-                             (response-headers response)))))
-                      (close-port port)
-                      (values adapted-response response-body))))))))))))
+                  (apply throw key args))))))
+          (request-time ((p:current-date))))
+      (parameterize ((p:current-date request-time))
+        ;; The time is now set for the duration of the request
+        (let ((raw-headers (request-headers request)))
+          (let ((modified-headers
+                 (append
+                  (if agent
+                      (list (cons auth-header (uri->string agent)))
+                      '())
+                  (filter
+                   (lambda (h)
+                     (not (eq? (car h) auth-header)))
+                   raw-headers))))
+            (let ((modified-request
+                   (build-request
+                    (request-uri request)
+                    #:method (request-method request)
+                    #:headers modified-headers)))
+              (let ((port (open-socket-for-uri endpoint)))
+                (let ((request-with-port
+                       (write-request modified-request port)))
+                  (when request-body
+                    (unless (bytevector? request-body)
+                      (set! request-body (string->utf8 request-body)))
+                    (write-request-body request-with-port request-body))
+                  (force-output (request-port request-with-port))
+                  (let ((response (read-response port)))
+                    (let ((response-body
+                           (or (response-must-not-include-body? response)
+                               (read-response-body response))))
+                      (let ((adapted-response
+                             (build-response
+                              #:code (response-code response)
+                              #:reason-phrase (response-reason-phrase response)
+                              #:headers
+                              (append
+                               (if (eqv? (response-code response) 401)
+                                   (list (cons 'www-authenticate '((DPoP))))
+                                   '())
+                               (response-headers response)))))
+                        (close-port port)
+                        (values adapted-response response-body)))))))))))))
diff --git a/src/scm/webid-oidc/server/resource/content.scm b/src/scm/webid-oidc/server/resource/content.scm
index 29d8889..57c51dd 100644
--- a/src/scm/webid-oidc/server/resource/content.scm
+++ b/src/scm/webid-oidc/server/resource/content.scm
@@ -19,6 +19,7 @@
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module (webid-oidc rdf-index)
   #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web uri)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 exceptions)
@@ -36,18 +37,18 @@
 
    ))
 
-(define (default-dir)
-  (string-append (refresh:default-dir) "/server"))
-
 (define-class <content> ()
   (content-type #:init-keyword #:content-type #:getter content-type)
   (contained #:init-keyword #:contained #:getter contained)
   (static-content #:init-keyword #:static-content #:getter static-content))
 
-(define (load-content session dir etag)
+(define (load-content session etag)
   (let ((first-char (substring etag 0 1))
         (rest (substring etag 1)))
-    (call-with-input-file (format #f "~a/content/~a/~a" dir first-char rest)
+    (call-with-input-file (format #f "~a/server/content/~a/~a"
+                                  (p:data-home)
+                                  first-char
+                                  rest)
       (lambda (port)
         (let ((properties (read port)))
           (set-port-encoding! port "ISO-8859-1")
@@ -60,14 +61,14 @@
             (hash-set! session etag ret)
             ret))))))
 
-(define (new-content session dir content-type contained static-content)
+(define (new-content session content-type contained static-content)
   (when (string? static-content)
     (set! static-content (string->utf8 static-content)))
   (let ((etag (stubs:random 12)))
     (let ((first-char (substring etag 0 1))
           (rest (substring etag 1)))
-      (stubs:mkdir-p (format #f "~a/content/~a" dir first-char))
-      (let ((port (open (format #f "~a/content/~a/~a" dir first-char rest)
+      (stubs:mkdir-p (format #f "~a/server/content/~a" (p:data-home) first-char))
+      (let ((port (open (format #f "~a/server/content/~a/~a" (p:data-home) first-char rest)
                         (logior O_WRONLY O_CREAT O_EXCL))))
         (write `((content-type . ,content-type)
                  (contained . ,contained)) port)
@@ -82,18 +83,16 @@
                      #:static-content static-content))
         etag))))
 
-(define (delete-content dir etag)
+(define (delete-content etag)
   (let ((first-char (substring etag 0 1))
         (rest (substring etag 1)))
-    (delete-file (format #f "~a/content/~a/~a" dir first-char rest))))
+    (delete-file (format #f "~a/server/content/~a/~a" (p:data-home) first-char rest))))
 
-(define* (with-session f #:key (dir default-dir))
-  (when (thunk? dir)
-    (set! dir (dir)))
+(define (with-session f)
   (let ((session (make-hash-table)))
     (define (do-load etag)
       (or (hash-ref session etag)
-          (load-content session dir etag)))
+          (load-content session etag)))
     (define (get-content-type etag)
       (content-type (do-load etag)))
     (define (get-contained etag)
@@ -101,7 +100,7 @@
     (define (get-static-content etag)
       (static-content (do-load etag)))
     (define (do-create content-type contained static-content)
-      (new-content session dir content-type contained static-content))
+      (new-content session content-type contained static-content))
     (define (do-delete etag)
-      (delete-content dir etag))
+      (delete-content etag))
     (f get-content-type get-contained get-static-content do-create do-delete)))
diff --git a/src/scm/webid-oidc/server/resource/path.scm b/src/scm/webid-oidc/server/resource/path.scm
index f1594bc..55c4274 100644
--- a/src/scm/webid-oidc/server/resource/path.scm
+++ b/src/scm/webid-oidc/server/resource/path.scm
@@ -19,6 +19,7 @@
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module (webid-oidc rdf-index)
   #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web uri)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 exceptions)
@@ -47,17 +48,14 @@
 
    ))
 
-(define (default-dir)
-  (string-append (refresh:default-dir) "/server"))
-
 (define (hash-path/lock path)
   (let ((h (stubs:hash 'SHA-256 path))
-        (dir (default-dir)))
+        (dir (p:data-home)))
     (let ((first-char (substring h 0 1))
           (rest (substring h 1)))
       (values
-       (format #f "~a/path/~a/~a" dir first-char rest)
-       (format #f "~a/path/~a/.lock" dir first-char)))))
+       (format #f "~a/server/path/~a/~a" dir first-char rest)
+       (format #f "~a/server/path/~a/.lock" dir first-char)))))
 
 (define (hash-path path)
   (receive (h lock) (hash-path/lock path)
diff --git a/src/scm/webid-oidc/stubs.scm b/src/scm/webid-oidc/stubs.scm
index 0c6f0bc..08d15aa 100644
--- a/src/scm/webid-oidc/stubs.scm
+++ b/src/scm/webid-oidc/stubs.scm
@@ -17,6 +17,7 @@
 (define-module (webid-oidc stubs)
   #:use-module (webid-oidc config)
   #:use-module (webid-oidc errors)
+  #:use-module (webid-oidc parameters)
   #:use-module (json))
 
 (load-extension
@@ -71,11 +72,16 @@
     (lambda error
       (raise-unsupported-alg (cadr error)))))
 
+(define (fix-random-init!)
+  (setenv "XDG_CACHE_HOME" (cache-home))
+  (setenv "DISFLUID_APPLICATION_NAME" ".")
+  (random-init!))
+
 (export
  base64-encode
  (fix-base64-decode . base64-decode)
  random
- random-init!
+ (fix-random-init! . random-init!)
  (fix-generate-key . generate-key)
  (fix-kty . kty)
  strip-key
diff --git a/src/scm/webid-oidc/testing.scm b/src/scm/webid-oidc/testing.scm
index 0aec4b8..aec9504 100644
--- a/src/scm/webid-oidc/testing.scm
+++ b/src/scm/webid-oidc/testing.scm
@@ -16,31 +16,23 @@
 
 (define-module (webid-oidc testing)
   #:use-module (webid-oidc stubs)
-  #:use-module (webid-oidc errors))
+  #:use-module (webid-oidc errors)
+  #:use-module (webid-oidc parameters))
 
 ;; This module is used only when running tests.
 
 (define-public (with-test-environment test-name f)
-  (let ((cache-dir (format #f "tests/~a.cache" test-name))
-        (data-dir (format #f "tests/~a.home" test-name)))
-    (setenv "XDG_CACHE_HOME" cache-dir)
-    (setenv "XDG_DATA_HOME" data-dir)
-    (catch #t
-      (lambda () (mkdir cache-dir))
-      (lambda err #t))
-    (let ((pkg-cache-dir (format #f "~a/disfluid" cache-dir)))
-      (catch #t
-        (lambda () (mkdir pkg-cache-dir))
-        (lambda err #t))
-      (let ((seed-file-name (format #f "~a/seed" pkg-cache-dir)))
-        (with-output-to-file seed-file-name
-          (lambda ()
-            (format #t "This is the initial seed for the random number generator"))))))
   (with-exception-handler
       (lambda (error)
         (format (current-error-port) "The test failed, because ~a.\n"
                 (error->str error))
         (raise-exception error))
     (lambda ()
-      (random-init!)
-      (f))))
+      (parameterize ((data-home (format #f "tests/~a.home/disfluid" test-name))
+                     (cache-home (format #f "tests/~a.cache/disfluid" test-name)))
+        (call-with-output-file*
+         (format #f "~a/seed" (cache-home))
+         (lambda (port)
+           (format port "This is the initial seed for the random number generator")))
+        (random-init!)
+        (f)))))
diff --git a/src/scm/webid-oidc/token-endpoint.scm b/src/scm/webid-oidc/token-endpoint.scm
index 5a05945..7c4d41c 100644
--- a/src/scm/webid-oidc/token-endpoint.scm
+++ b/src/scm/webid-oidc/token-endpoint.scm
@@ -22,6 +22,7 @@
   #:use-module (webid-oidc jwk)
   #:use-module (webid-oidc oidc-id-token)
   #:use-module (webid-oidc access-token)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
   #:use-module (web client)
@@ -76,116 +77,101 @@
        thunk
        #:unwind? #t))))
 
-(define*-public (make-token-endpoint token-endpoint-uri iss alg jwk validity jti-list
-                                     #:key
-                                     (refresh-token-dir refresh:default-dir)
-                                     (current-time current-time))
+(define*-public (make-token-endpoint token-endpoint-uri iss alg jwk validity)
   (lambda* (request request-body)
     (try-handle-web-failure
      (lambda ()
        (when (bytevector? request-body)
          (set! request-body (utf8->string request-body)))
-       (let ((current-time
-              (let ((t current-time))
-                (when (thunk? t)
-                  (set! t (t)))
-                (when (integer? t)
-                  (set! t (make-time time-utc 0 t)))
-                (when (time? t)
-                  (set! t (time-utc->date t)))
-                t))
-             (form-args
-              (if (and (request-content-type request)
-                       (eq? (car (request-content-type request))
-                            'application/x-www-form-urlencoded))
-                  (filter
-                   (lambda (x) x)
-                   (map (lambda (kv)
-                          (let ((parsed
-                                 (list->vector
-                                  (map (lambda (x)
-                                         (uri-decode x #:decode-plus-to-space? #t))
-                                       (string-split kv #\=)))))
-                            (if (eq? (vector-length parsed) 2)
-                                `(,(vector-ref parsed 0) . ,(vector-ref parsed 1))
-                                #f)))
-                        (string-split request-body #\&)))
-                  '()))
-             (method (request-method request))
-             ;; Maybe we’re behind a reverse proxy, so the authority of
-             ;; (request-uri request) is meaningless.
-             (uri (build-uri (uri-scheme token-endpoint-uri)
-                             #:userinfo (uri-userinfo token-endpoint-uri)
-                             #:host (uri-host token-endpoint-uri)
-                             #:port (uri-port token-endpoint-uri)
-                             #:path (uri-path (request-uri request))
-                             #:query (uri-query (request-uri request)))))
-         (let ((grant-type (assoc-ref form-args "grant_type"))
-               (dpop (dpop-proof-decode
-                      current-time jti-list method uri
-                      (assq-ref (request-headers request) 'dpop)
-                      (lambda (jkt) #t))))
-           (unless (and grant-type (string? grant-type))
-             (raise-unsupported-grant-type #f))
-           (receive (webid client-id)
-               (case (string->symbol grant-type)
-                 ((authorization_code)
-                  (let ((code
-                         (let ((str (assoc-ref form-args "code")))
-                           (unless str
-                             (raise-no-authorization-code))
-                           (authorization-code-decode
-                            current-time jti-list str jwk))))
-                    (values (authorization-code-webid code)
-                            (authorization-code-client-id code))))
-                 ((refresh_token)
-                  (let ((refresh-token (assoc-ref form-args "refresh_token")))
-                    (unless refresh-token
-                      (raise-no-refresh-token))
-                    (refresh:with-refresh-token
-                     refresh-token
-                     (dpop-proof-jwk dpop)
-                     values
-                     #:dir refresh-token-dir)))
-                 (else
-                  (raise-unsupported-grant-type grant-type)))
-             (let* ((iat (time-second (date->time-utc current-time)))
-                    (exp (+ iat validity)))
-               (let ((id-token
-                      (issue-id-token
-                       jwk
-                       #:alg alg
-                       #:webid (uri->string webid)
-                       #:sub (uri->string webid)
-                       #:iss (uri->string iss)
-                       #:aud (uri->string client-id)
-                       #:exp exp
-                       #:iat iat))
-                     (access-token
-                      (issue-access-token
-                       jwk
-                       #:alg alg
-                       #:webid (uri->string webid)
-                       #:iss (uri->string iss)
-                       #:exp exp
-                       #:iat iat
-                       #:client-key (dpop-proof-jwk dpop)
-                       #:client-id (uri->string client-id)))
-                     (refresh-token
-                      (if (equal? grant-type "refresh_token")
-                          (assoc-ref form-args "refresh_token")
-                          (refresh:issue-refresh-token webid client-id
-                                                       (jkt (dpop-proof-jwk dpop))
-                                                       #:dir refresh-token-dir))))
-                 (values
-                  (build-response #:headers '((content-type application/json)
-                                              (cache-control (no-cache no-store)))
-                                  #:port #f)
-                  (stubs:scm->json-string
-                   `((id_token . ,id-token)
-                     (access_token . ,access-token)
-                     (token_type . "DPoP")
-                     (expires_in . ,validity)
-                     (refresh_token . ,refresh-token)))
-                  client-id
-                  #f))))))))))
+       (parameterize ((p:current-date ((p:current-date))))
+         (let ((current-time ((p:current-date))) ;; thunk parameter
+               (form-args
+                (if (and (request-content-type request)
+                         (eq? (car (request-content-type request))
+                              'application/x-www-form-urlencoded))
+                    (filter
+                     (lambda (x) x)
+                     (map (lambda (kv)
+                            (let ((parsed
+                                   (list->vector
+                                    (map (lambda (x)
+                                           (uri-decode x #:decode-plus-to-space? #t))
+                                         (string-split kv #\=)))))
+                              (if (eq? (vector-length parsed) 2)
+                                  `(,(vector-ref parsed 0) . ,(vector-ref parsed 1))
+                                  #f)))
+                          (string-split request-body #\&)))
+                    '()))
+               (method (request-method request))
+               ;; Maybe we’re behind a reverse proxy, so the authority of
+               ;; (request-uri request) is meaningless.
+               (uri (build-uri (uri-scheme token-endpoint-uri)
+                               #:userinfo (uri-userinfo token-endpoint-uri)
+                               #:host (uri-host token-endpoint-uri)
+                               #:port (uri-port token-endpoint-uri)
+                               #:path (uri-path (request-uri request))
+                               #:query (uri-query (request-uri request)))))
+           (let ((grant-type (assoc-ref form-args "grant_type"))
+                 (dpop (dpop-proof-decode
+                        method uri
+                        (assq-ref (request-headers request) 'dpop)
+                        (lambda (jkt) #t))))
+             (unless (and grant-type (string? grant-type))
+               (raise-unsupported-grant-type #f))
+             (receive (webid client-id)
+                 (case (string->symbol grant-type)
+                   ((authorization_code)
+                    (let ((code
+                           (let ((str (assoc-ref form-args "code")))
+                             (unless str
+                               (raise-no-authorization-code))
+                             (authorization-code-decode str jwk))))
+                      (values (authorization-code-webid code)
+                              (authorization-code-client-id code))))
+                   ((refresh_token)
+                    (let ((refresh-token (assoc-ref form-args "refresh_token")))
+                      (unless refresh-token
+                        (raise-no-refresh-token))
+                      (refresh:with-refresh-token
+                       refresh-token
+                       (dpop-proof-jwk dpop)
+                       values)))
+                   (else
+                    (raise-unsupported-grant-type grant-type)))
+               (let* ((iat (time-second (date->time-utc current-time)))
+                      (exp (+ iat validity)))
+                 (let ((id-token
+                        (issue-id-token
+                         jwk
+                         #:alg alg
+                         #:webid (uri->string webid)
+                         #:sub (uri->string webid)
+                         #:iss (uri->string iss)
+                         #:aud (uri->string client-id)
+                         #:validity 3600))
+                       (access-token
+                        (issue-access-token
+                         jwk
+                         #:alg alg
+                         #:webid (uri->string webid)
+                         #:iss (uri->string iss)
+                         #:validity 3600
+                         #:client-key (dpop-proof-jwk dpop)
+                         #:client-id (uri->string client-id)))
+                       (refresh-token
+                        (if (equal? grant-type "refresh_token")
+                            (assoc-ref form-args "refresh_token")
+                            (refresh:issue-refresh-token webid client-id
+                                                         (jkt (dpop-proof-jwk dpop))))))
+                   (values
+                    (build-response #:headers '((content-type application/json)
+                                                (cache-control (no-cache no-store)))
+                                    #:port #f)
+                    (stubs:scm->json-string
+                     `((id_token . ,id-token)
+                       (access_token . ,access-token)
+                       (token_type . "DPoP")
+                       (expires_in . ,validity)
+                       (refresh_token . ,refresh-token)))
+                    client-id
+                    #f)))))))))))