Switch to a more sensible error reporting system

1 files changed, 48 insertions, 5 deletions

diff --git a/src/scm/webid-oidc/server/create.scm b/src/scm/webid-oidc/server/create.scm
index b7b208d..dc9651e 100644
--- a/src/scm/webid-oidc/server/create.scm
+++ b/src/scm/webid-oidc/server/create.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
@@ -21,6 +21,7 @@
   #:use-module (webid-oidc server read)
   #:use-module (webid-oidc cache)
   #:use-module (webid-oidc fetch)
+  #:use-module (webid-oidc web-i18n)
   #:use-module (webid-oidc rdf-index)
   #:use-module (webid-oidc server resource wac)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
@@ -42,20 +43,51 @@
   #:use-module (ice-9 threads)
   #:use-module (rnrs bytevectors)
   #:use-module (oop goops)
+  #:declarative? #t
   #:export
   (
 
+   &incorrect-containment-triples
+   make-incorrect-containment-triples
+   incorrect-containment-triples?
+   incorrect-containment-triples-path
+
+   &unsupported-media-type
+   make-unsupported-media-type
+   unsupported-media-type?
+   unsupported-media-type-content-type
+
    create
    create-root
 
    ))
 
+(define-exception-type
+  &incorrect-containment-triples
+  &external-error
+  make-incorrect-containment-triples
+  incorrect-containment-triples?
+  (path 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))
+
 (define (without-containment-triples doc-uri content-type content)
   (case content-type
     ((text/turtle)
      #t)
     (else
-     (raise-exception (make-unsupported-media-type content-type))))
+     (let ((final-message
+            (format #f (G_ "only text/turtle is allowed for the target of a POST request, not ~s")
+                    content-type)))
+       (raise-exception
+        (make-exception
+         (make-unsupported-media-type content-type)
+         (make-exception-with-message final-message))))))
   (let ((graph (fetch
                 doc-uri
                 #:http-get
@@ -69,8 +101,13 @@
        (unless (null? (rdf-match (uri->string doc-uri)
                                  "http://www.w3.org/ns/auth/acl#contains"
                                  #f))
-         (raise-exception (make-incorrect-containment-triples
-                           (uri-path doc-uri))))))))
+         (let ((final-message
+                (format #f (G_ "the created resource cannot have containment triples"))))
+           (raise-exception
+            (make-exception
+             (make-incorrect-containment-triples
+              (uri-path doc-uri))
+             (make-exception-with-message final-message)))))))))
 
 (define (types-indicate-container? types)
   (and (not (null? types))
@@ -106,7 +143,13 @@
              ;; non-empty.
              (if container? "/" "")))))
       (when (auxiliary-path? (uri-path doc-uri))
-        (raise-exception (make-path-is-auxiliary (uri-path doc-uri))))
+        (let ((final-message
+               (format #f (G_ "cannot POST to an auxiliary resource path, ~s")
+                       (uri-path doc-uri))))
+          (raise-exception
+           (make-exception
+            (make-path-is-auxiliary (uri-path doc-uri))
+            (make-exception-with-message final-message)))))
       (when container?
         (without-containment-triples doc-uri content-type content))
       (with-session