Switch to a more sensible error reporting system

1 files changed, 98 insertions, 14 deletions

diff --git a/src/scm/webid-oidc/server/resource/path.scm b/src/scm/webid-oidc/server/resource/path.scm
index 55c4274..b8a9472 100644
--- a/src/scm/webid-oidc/server/resource/path.scm
+++ b/src/scm/webid-oidc/server/resource/path.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
@@ -18,6 +18,7 @@
   #:use-module (webid-oidc errors)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module (webid-oidc rdf-index)
+  #:use-module (webid-oidc web-i18n)
   #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
   #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web uri)
@@ -31,9 +32,35 @@
   #:use-module (ice-9 threads)
   #:use-module (rnrs bytevectors)
   #:use-module (oop goops)
+  #:declarative? #t
   #:export
   (
 
+   &path-not-found
+   make-path-not-found
+   path-not-found?
+   path-not-found-path
+
+   &uri-slash-semantics-error
+   make-uri-slash-semantics-error
+   uri-slash-semantics-error?
+   uri-slash-semantics-error-requested
+   uri-slash-semantics-error-existing
+
+   &container-not-empty
+   make-container-not-empty
+   container-not-empty?
+   container-not-empty-path
+
+   &cannot-delete-root
+   make-cannot-delete-root
+   cannot-delete-root?
+
+   &path-is-auxiliary
+   make-path-is-auxiliary
+   path-is-auxiliary?
+   path-is-auxiliary-path
+
    read-path
    update-path
 
@@ -48,6 +75,41 @@
 
    ))
 
+(define-exception-type
+  &path-not-found
+  &external-error
+  make-path-not-found
+  path-not-found?
+  (path path-not-found-path))
+
+(define-exception-type
+  &uri-slash-semantics-error
+  &external-error
+  make-uri-slash-semantics-error
+  uri-slash-semantics-error?
+  (requested uri-slash-semantics-error-requested)
+  (existing uri-slash-semantics-error-existing))
+
+(define-exception-type
+  &container-not-empty
+  &external-error
+  make-container-not-empty
+  container-not-empty?
+  (path container-not-empty-path))
+
+(define-exception-type
+  &cannot-delete-root
+  &external-error
+  make-cannot-delete-root
+  cannot-delete-root?)
+
+(define-exception-type
+  &path-is-auxiliary
+  &external-error
+  make-path-is-auxiliary
+  path-is-auxiliary?
+  (path path-is-auxiliary-path))
+
 (define (hash-path/lock path)
   (let ((h (stubs:hash 'SHA-256 path))
         (dir (p:data-home)))
@@ -78,17 +140,30 @@
                   (without-slash-exists (file-exists? (hash-path without-slash))))
               (cond
                (with-slash-exists
-                (raise-exception
-                 (make-exception
-                  (make-path-not-found path)
-                  (make-uri-slash-semantics-error path with-slash))))
+                (let ((final-message
+                       (format #f (G_ "incorrect slash semantics: path ~s should have a slash")
+                               path)))
+                  (raise-exception
+                   (make-exception
+                    (make-path-not-found path)
+                    (make-uri-slash-semantics-error path with-slash)
+                    (make-exception-with-message final-message)))))
                (without-slash-exists
-                (raise-exception
-                 (make-exception
-                  (make-path-not-found path)
-                  (make-uri-slash-semantics-error path with-slash))))
+                (let ((final-message
+                       (format #f (G_ "incorrect slash semantics: path ~s should not have a slash")
+                               path)))
+                  (raise-exception
+                   (make-exception
+                    (make-path-not-found path)
+                    (make-uri-slash-semantics-error path without-slash)
+                    (make-exception-with-message final-message)))))
                (else
-                (raise-exception (make-path-not-found path)))))))
+                (let ((final-message
+                       (format #f (G_ "path ~s does not exist") path)))
+                  (raise-exception
+                   (make-exception
+                    (make-path-not-found path)
+                    (make-exception-with-message final-message)))))))))
       (lambda ()
         (call-with-input-file h
           (lambda (port)
@@ -152,19 +227,28 @@
            (case-lambda
              ((false)
               (when false
-                (error "You’re using the API wrong."))
+                (fail (G_ "You’re using the API wrong.")))
               ;; Delete the resource
               (unless (or (not etag)
                           (not (contained etag))
                           (null? (contained etag)))
-                (raise-exception (make-container-not-empty path)))
+                (raise-exception
+                 (make-exception
+                  (make-container-not-empty path)
+                  (make-exception-with-message
+                   (format #f (G_ "the path ~s exists, it has contained paths, and it is not empty")
+                           path)))))
               (when (equal? path "/")
-                (raise-exception (make-cannot-delete-root)))
+                (raise-exception
+                 (make-exception
+                  (make-cannot-delete-root)
+                  (make-exception-with-message
+                   (format #f (G_ "you cannot delete the root"))))))
               (set! has-been-deleted? #t)
               #f)
              ((new-etag new-auxiliary)
               (unless (and (string? new-etag) (list? new-auxiliary))
-                (error "You’re using the API wrong."))
+                (fail (G_ "You’re using the API wrong.")))
               (hash-remove! garbage new-etag)
               (when new-auxiliary
                 (for-each