1 files changed, 96 insertions, 22 deletions

diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm
index 32423ef..bbbbc1c 100644
--- a/src/scm/webid-oidc/errors.scm
+++ b/src/scm/webid-oidc/errors.scm
@@ -870,6 +870,62 @@
   (raise-exception
    ((record-constructor &no-provider-candidates) webid causes)))
 
+;; Server-side exceptions
+
+(define-exception-type
+  &resource-not-found
+  &external-error
+  make-resource-not-found
+  resource-not-found?
+  (path resource-not-found-path)
+  (cause resource-not-found-cause))
+
+(export &resource-not-found
+        make-resource-not-found
+        resource-not-found?
+        resource-not-found-path
+        resource-not-found-cause)
+
+(define-exception-type
+  &missing-etag
+  &external-error
+  make-missing-etag
+  missing-etag?
+  (data missing-etag-data))
+
+(export &missing-etag
+        make-missing-etag
+        missing-etag?
+        missing-etag-data)
+
+(define-exception-type
+  &missing-content-type
+  &external-error
+  make-missing-content-type
+  missing-content-type?
+  (data missing-content-type-data))
+
+(export &missing-content-type
+        make-missing-content-type
+        missing-content-type?
+        missing-content-type-data)
+
+(define-exception-type
+  &precondition-failed
+  &external-error
+  make-precondition-failed
+  precondition-failed?
+  (etag precondition-failed-etag)
+  (if-match precondition-failed-if-match)
+  (if-none-match precondition-failed-if-none-match))
+
+(export &precondition-failed
+        make-precondition-failed
+        precondition-failed?
+        precondition-failed-etag
+        precondition-failed-if-match
+        precondition-failed-if-none-match)
+
 (define*-public (error->str err #:key (max-depth #f))
   (if (record? err)
       (let* ((type (record-type-descriptor err))
@@ -1193,28 +1249,44 @@
           ((&unconfirmed-provider)
            (format #f (G_ "~s does not admit ~s as an identity provider")
                    (get 'subject) (get 'provider)))
-	  ((&neither-identity-provider-nor-webid)
-	   (format #f (G_ "~a is neither an identity provider (because ~a) nor a webid (because ~a)")
-		   (uri->string (get 'uri))
-		   (recurse (get 'why-not-identity-provider))
-		   (recurse (get 'why-not-webid))))
-	  ((&token-request-failed)
-	   (format #f (G_ "the token request failed (because ~a)")
-		   (recurse (get 'cause))))
-	  ((&profile-not-found)
-	   (format #f (G_ "you don’t have a refresh token for identity ~a certified by ~a in ~s")
-		   (uri->string (get 'webid))
-		   (uri->string (get 'iss))
-		   (get 'dir)))
-	  ((&no-provider-candidates)
-	   (format #f (G_ "all identity provider candidates for ~a failed: ~a")
-		   (uri->string (get 'webid))
-		   (string-join
-		    (map (lambda (cause)
-			   (format #f (G_ "~s failed (because ~a)")
-				   (uri->string (car cause)) (recurse (cdr cause))))
-			 (get 'causes))
-		    (G_ ", "))))
+          ((&neither-identity-provider-nor-webid)
+           (format #f (G_ "~a is neither an identity provider (because ~a) nor a webid (because ~a)")
+                   (uri->string (get 'uri))
+                   (recurse (get 'why-not-identity-provider))
+                   (recurse (get 'why-not-webid))))
+          ((&token-request-failed)
+           (format #f (G_ "the token request failed (because ~a)")
+                   (recurse (get 'cause))))
+          ((&profile-not-found)
+           (format #f (G_ "you don’t have a refresh token for identity ~a certified by ~a in ~s")
+                   (uri->string (get 'webid))
+                   (uri->string (get 'iss))
+                   (get 'dir)))
+          ((&no-provider-candidates)
+           (format #f (G_ "all identity provider candidates for ~a failed: ~a")
+                   (uri->string (get 'webid))
+                   (string-join
+                    (map (lambda (cause)
+                           (format #f (G_ "~s failed (because ~a)")
+                                   (uri->string (car cause)) (recurse (cdr cause))))
+                         (get 'causes))
+                    (G_ ", "))))
+          ((&resource-not-found)
+           (format #f (G_ "the resource ~s could not be found (because ~a)")
+                   (get 'path)
+                   (recurse (get 'cause))))
+          ((&missing-etag)
+           (format #f (G_ "the resource is missing an etag (see ~s)")
+                   (get 'data)))
+          ((&missing-content-type)
+           (format #f (G_ "the resource is missing a content type (see ~s)")
+                   (get 'content-type)))
+          ((&precondition-failed)
+           (if (get 'etag)
+               (format #f (G_ "the precondition failed for etag ~s: if-match ~s and if-none-match ~s")
+                       (get 'etag) (get 'if-match) (get 'if-none-match))
+               (format #f (G_ "the precondition failed for a non-existing resource: if-match ~s and if-none-match ~s")
+                       (get 'if-match) (get 'if-none-match))))
           ((&compound-exception)
            (let ((components (get 'components)))
              (if (null? components)
@@ -1253,6 +1325,8 @@
            (format #f (G_ "the program cannot recover from this exception")))
           ((&error)
            (format #f (G_ "there is an error")))
+          ((&external-error)
+           (format #f (G_ "there is an external error")))
           (else
            (error (format #f (G_ "Unhandled exception type ~a.")
                           (record-type-name type))))))