Implement the DPoP proof

1 files changed, 34 insertions, 0 deletions

diff --git a/src/scm/webid-oidc/jti.scm b/src/scm/webid-oidc/jti.scm
new file mode 100644
index 0000000..423382a
--- /dev/null
+++ b/src/scm/webid-oidc/jti.scm
@@ -0,0 +1,34 @@
+(define-module (webid-oidc jti)
+  #:use-module (ice-9 atomic)
+  #:use-module (ice-9 threads)
+  #:use-module (srfi srfi-19))
+
+(define-public (make-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)))
+         (new (filter
+               (lambda (entry)
+                 (let ((exp (assq-ref entry 'exp)))
+                   (>= 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)))))))