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, 32 insertions, 26 deletions

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