Switch to a more sensible error reporting system

1 files changed, 29 insertions, 4 deletions

diff --git a/src/scm/webid-oidc/jti.scm b/src/scm/webid-oidc/jti.scm
index cf05bbb..150de0b 100644
--- a/src/scm/webid-oidc/jti.scm
+++ b/src/scm/webid-oidc/jti.scm
@@ -1,4 +1,4 @@
-;; webid-oidc, implementation of the Solid specification
+;; disfluid, implementation of the Solid specification
 ;; Copyright (C) 2020, 2021  Vivien Kraus
 
 ;; This program is free software: you can redistribute it and/or modify
@@ -16,12 +16,30 @@
 
 (define-module (webid-oidc jti)
   #:use-module ((webid-oidc parameters) #:prefix p:)
+  #:use-module (webid-oidc web-i18n)
   #:use-module (ice-9 atomic)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 exceptions)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-19)
-  #:export (jti-check))
+  #:declarative? #t
+  #:export
+  (
+   jti-check
+
+   &jti-found
+   make-jti-found
+   jti-found?
+   jti-found-jti
+   ))
+
+(define-exception-type
+  &jti-found
+  &external-error
+  make-jti-found
+  jti-found?
+  (jti jti-found-jti))
 
 (define jti-list
   (make-atomic-box '()))
@@ -36,8 +54,15 @@
   (match-lambda*
     ((() item) #f)
     (((($ <jti-item> exp jti) other ...) item)
-     (or (string=? jti item)
-         (lookup other item)))))
+     (when (string=? jti item)
+       (let ((final-message
+              (format #f (G_ "a replay has been detected with JTI ~s")
+                      jti)))
+         (raise-exception
+          (make-exception
+           (make-jti-found jti)
+           (make-exception-with-message final-message)))))
+     (lookup other item))))
 
 (define (jti-check jti valid-time)
   (let* ((current-time