From 073afeac0fe1edc305195398c8893605b1f08ff0 Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Fri, 18 Jun 2021 15:39:58 +0200
Subject: Implement the POST method for the server

---
 src/scm/webid-oidc/errors.scm | 67 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 67 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 c6802d7..76ce8af 100644
--- a/src/scm/webid-oidc/errors.scm
+++ b/src/scm/webid-oidc/errors.scm
@@ -934,6 +934,60 @@
         cannot-fetch-group-group-uri
         cannot-fetch-group-cause)
 
+(define-exception-type
+  &incorrect-containment-triples
+  &external-error
+  make-incorrect-containment-triples
+  incorrect-containment-triples?
+  (path incorrect-containment-triples-path))
+
+(export &incorrect-containment-triples
+        make-incorrect-containment-triples
+        incorrect-containment-triples?
+        incorrect-containment-triples-path)
+
+(define-exception-type
+  &unsupported-media-type
+  &external-error
+  make-unsupported-media-type
+  unsupported-media-type?
+  (content-type unsupported-media-type-content-type))
+
+(export &unsupported-media-type
+        make-unsupported-media-type
+        unsupported-media-type?
+        unsupported-media-type-content-type)
+
+(define-exception-type
+  &path-is-auxiliary
+  &external-error
+  make-path-is-auxiliary
+  path-is-auxiliary?
+  (path path-is-auxiliary-path))
+
+(export &path-is-auxiliary
+        make-path-is-auxiliary
+        path-is-auxiliary?
+        path-is-auxiliary-path)
+
+(define-exception-type
+  &forbidden
+  &external-error
+  make-forbidden
+  forbidden?
+  (path forbidden-path)
+  (user forbidden-user)
+  (owner forbidden-owner)
+  (mode forbidden-mode))
+
+(export &forbidden
+        make-forbidden
+        forbidden?
+        forbidden-path
+        forbidden-user
+        forbidden-owner
+        forbidden-mode)
+
 (define*-public (error->str err #:key (max-depth #f))
   (if (record? err)
       (let* ((type (record-type-descriptor err))
@@ -1294,6 +1348,19 @@
            (format #f (G_ "the group ~s cannot be fetched (because ~a)"
                           (uri->string (get 'group-uri))
                           (recurse (get 'cause)))))
+          ((&incorrect-containment-triples)
+           (format #f (G_ "the containment triples in the request to update ~s are not up to date")
+                   (get 'path)))
+          ((&unsupported-media-type)
+           (format #f (G_ "the server cannot process resources with the ~s content-type")
+                   (get 'content-type)))
+          ((&path-is-auxiliary)
+           (format #f (G_ "the client wants to create a resource at ~s, which is reserved for an auxiliary resource")
+                   (get 'path)))
+          ((&forbidden)
+           (format #f (G_ "the operation on ~s by ~s is refused, because it’s not by ~s and the access control forbids the following mode of operation: ~s")
+                   (get 'path) (uri->string (get 'user)) (uri->string (get 'owner))
+                   (uri->string (get 'mode))))
           ((&compound-exception)
            (let ((components (get 'components)))
              (if (null? components)
-- 
cgit v1.2.3