From 1f7dbf33c03a171b6d7d1198b66c024f5299092e Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Wed, 2 Dec 2020 09:58:55 +0100
Subject: Parse and issue OIDC ID tokens

---
 src/scm/webid-oidc/errors.scm | 95 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 95 insertions(+)

(limited to 'src/scm/webid-oidc/errors.scm')

diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm
index e8ab5af..b0e9a19 100644
--- a/src/scm/webid-oidc/errors.scm
+++ b/src/scm/webid-oidc/errors.scm
@@ -249,6 +249,16 @@
   (raise-exception
    ((record-constructor &incorrect-webid-field) value)))
 
+(define-public &incorrect-sub-field
+  (make-exception-type
+   '&incorrect-sub-field
+   &external-error
+   '(value)))
+
+(define-public (raise-incorrect-sub-field value)
+  (raise-exception
+   ((record-constructor &incorrect-sub-field) value)))
+
 (define-public &incorrect-iss-field
   (make-exception-type
    '&incorrect-iss-field
@@ -349,6 +359,16 @@
   (raise-exception
    ((record-constructor &incorrect-jti-field) value)))
 
+(define-public &incorrect-nonce-field
+  (make-exception-type
+   '&incorrect-nonce-field
+   &external-error
+   '(value)))
+
+(define-public (raise-incorrect-nonce-field value)
+  (raise-exception
+   ((record-constructor &incorrect-nonce-field) value)))
+
 (define-public &incorrect-htm-field
   (make-exception-type
    '&incorrect-htm-field
@@ -707,6 +727,56 @@
   (raise-exception
    ((record-constructor &invalid-key-for-refresh-token) key jkt)))
 
+(define-public &not-an-id-token
+  (make-exception-type
+   '&not-an-id-token
+   &external-error
+   '(value cause)))
+
+(define-public (raise-not-an-id-token value cause)
+  (raise-exception
+   ((record-constructor &not-an-id-token) value cause)))
+
+(define-public &not-an-id-token-header
+  (make-exception-type
+   '&not-an-id-token-header
+   &external-error
+   '(value cause)))
+
+(define-public (raise-not-an-id-token-header value cause)
+  (raise-exception
+   ((record-constructor &not-an-id-token-header) value cause)))
+
+(define-public &not-an-id-token-payload
+  (make-exception-type
+   '&not-an-id-token-payload
+   &external-error
+   '(value cause)))
+
+(define-public (raise-not-an-id-token-payload value cause)
+  (raise-exception
+   ((record-constructor &not-an-id-token-payload) value cause)))
+
+(define-public &cannot-decode-id-token
+  (make-exception-type
+   '&cannot-decode-id-token
+   &external-error
+   '(value cause)))
+
+(define-public (raise-cannot-decode-id-token value cause)
+  (raise-exception
+   ((record-constructor &cannot-decode-id-token) value cause)))
+
+(define-public &cannot-encode-id-token
+  (make-exception-type
+   '&cannot-encode-id-token
+   &external-error
+   '(id-token key cause)))
+
+(define-public (raise-cannot-encode-id-token id-token key cause)
+  (raise-exception
+   ((record-constructor &cannot-encode-id-token) id-token key cause)))
+
 (define*-public (error->str err #:key (max-depth #f))
   (if (record? err)
       (let* ((type (record-type-descriptor err))
@@ -810,6 +880,11 @@
              (if value
                  (format #f (G_ "the webid field is incorrect: ~s") value)
                  (format #f (G_ "the webid field is missing")))))
+          ((&incorrect-sub-field)
+           (let ((value (get 'value)))
+             (if value
+                 (format #f (G_ "the sub field is incorrect: ~s") value)
+                 (format #f (G_ "the sub field is missing")))))
           ((&incorrect-iss-field)
            (let ((value (get 'value)))
              (if value
@@ -861,6 +936,11 @@
              (if value
                  (format #f (G_ "the jti field is incorrect: ~s") value)
                  (format #f (G_ "the jti field is missing")))))
+          ((&incorrect-nonce-field)
+           (let ((value (get 'value)))
+             (if value
+                 (format #f (G_ "the nonce field is incorrect: ~s") value)
+                 (format #f (G_ "the nonce field is missing")))))
           ((&incorrect-htm-field)
            (let ((value (get 'value)))
              (if value
@@ -992,6 +1072,21 @@
           ((&invalid-key-for-refresh-token)
            (format #f (G_ "the refresh token is bound to a key confirmed as ~s, but it is used with key ~s")
                    (get 'jkt) (get 'key)))
+          ((&cannot-decode-id-token)
+           (format #f (G_ "I cannot decode ~s as an ID token (because ~a)")
+                   (get 'value) (recurse (get 'cause))))
+          ((&cannot-encode-id-token)
+           (format #f (G_ "I cannot encode ~s as an ID token (because ~a)")
+                   (get 'value) (recurse (get 'cause))))
+          ((&not-an-id-token)
+           (format #f (G_ "~s is not an ID token (because ~a)")
+                   (get 'value) (recurse (get 'cause))))
+          ((&not-an-id-token-header)
+           (format #f (G_ "~s is not an ID token header (because ~a)")
+                   (get 'value) (recurse (get 'cause))))
+          ((&not-an-id-token-payload)
+           (format #f (G_ "~s is not an ID token payload (because ~a)")
+                   (get 'value) (recurse (get 'cause))))
           ((&compound-exception)
            (let ((components (get 'components)))
              (if (null? components)
-- 
cgit v1.2.3