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.

1 files changed, 45 insertions, 45 deletions

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))