1 files changed, 58 insertions, 6 deletions
diff --git a/src/scm/webid-oidc/server/endpoint.scm b/src/scm/webid-oidc/server/endpoint.scm
index d327139..9a19ceb 100644
--- a/src/scm/webid-oidc/server/endpoint.scm
+++ b/src/scm/webid-oidc/server/endpoint.scm
@@ -48,8 +48,62 @@
    routed
 
    handle
+
+   &web-exception
+   make-web-exception
+   web-exception?
+   web-exception-code
+   web-exception-reason-phrase
+
+   &caused-by-user
+   make-caused-by-user
+   caused-by-user?
+   caused-by-user-webid
+
+   &user-message
+   make-user-message
+   user-message?
+   user-message-sxml
    ))
 
+(define-exception-type
+  &web-exception
+  &external-error
+  make-web-exception
+  web-exception?
+  (code web-exception-code)
+  (reason-phrase web-exception-reason-phrase))
+
+(define-exception-type
+  &caused-by-user
+  &external-error
+  make-caused-by-user
+  caused-by-user?
+  (webid caused-by-user-webid))
+
+(define-exception-type
+  &user-message
+  &external-error
+  make-user-message
+  user-message?
+  (sxml user-message-one-sxml))
+
+(define (user-message-sxml exn)
+  (let loop ((components (simple-exceptions exn))
+             (gathered '()))
+    (match components
+      (()
+       (match gathered
+         (()
+          `(div ,(W_ "No information available.")))
+         ((= reverse gathered)
+          `(div ,@gathered))))
+      (((? user-message? (= user-message-one-sxml next))
+        components ...)
+       (loop components `(,next ,@gathered)))
+      ((_ components ...)
+       (loop components gathered)))))
+
 (define-class <endpoint> ()
   (host #:init-keyword #:host #:getter host #:init-value #f)
   (path #:init-keyword #:path #:getter path  #:init-value "/"))
@@ -122,12 +176,10 @@
   (let find-router ((routed (routed endpoint)))
     (match routed
       (()
-       (values
-        (build-response
-         #:code 404
-         #:reason-phrase (W_ "Not Found"))
-        #f
-        '()))
+       (raise-exception
+        (make-exception
+         (make-web-exception 404 (W_ "Not Found"))
+         (make-user-message (W_ "The resource could not be found.")))))
       (((and router
              (? (cute relevant? <> request)))
         _ ...)