From 9bf073c54f6a6dc70e01aa032fc53e2f06532275 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Sat, 17 Aug 2024 08:05:25 -0700
Subject: Add: general http error for use in user applications

---
 src/endpoint.lisp |  7 ++++++-
 src/package.lisp  |  1 +
 src/protocol.lisp | 15 ++++++++++++++-
 3 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/src/endpoint.lisp b/src/endpoint.lisp
index 52bce27..5c2a386 100644
--- a/src/endpoint.lisp
+++ b/src/endpoint.lisp
@@ -348,7 +348,12 @@ the ;."
           post-data :when= (http:raw-post-data
                             :external-format :utf8
                             :want-stream (want-body-stream class))
-          (funcall parser post-data)))))
+          (handler-case
+              (funcall parser post-data)
+            (error (e)
+              (protocol-error 'bad-body-error class
+                              :wrapped e
+                              :note "Error during the parsing of the body.")))))))
 
 
 (defun instantiate-endpoint (class args)
diff --git a/src/package.lisp b/src/package.lisp
index d6d29d0..1d12ea4 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -23,6 +23,7 @@
    #:endpoint-redirect
    #:route-to
    #:get-cookie
+   #:err
 
    ;; re-exports
    #:mime-type
diff --git a/src/protocol.lisp b/src/protocol.lisp
index 51c7211..f94364a 100644
--- a/src/protocol.lisp
+++ b/src/protocol.lisp
@@ -42,9 +42,10 @@ that the request has insufficient permissions to evoke the endpoint handler. "))
   ((wrapped
     :reader wrapped
     :initarg :error
+    :initform nil
     :documentation "A root error that may have caused this error to be signalled."))
   (:default-initargs :status-code 400)
-  (:documentation "Signalled when the body of a request cannot be deserialized."))
+  (:documentation "Signalled when the body of a request cannot be deserialized, for any reason.."))
 
 (define-condition slot-required (protocol-error)
   ((mising-slot
@@ -159,3 +160,15 @@ AUTHORIZE while handling endpoint-class instance EP."
 (defun get-cookie (name)
   "Returns the cookie with name NAME the actively"
   (http:cookie-in name))
+
+(define-condition request-error (error)
+  ((content :reader error-content :initarg :content :initform "Bad Request")
+   (mimetype :reader error-content-mimetype :initarg :mimetype :initform "text/plain")
+   (code :reader status-code :initarg :code :initform 400)))
+
+(defmethod protocol-error-result ((err request-error))
+  (values (error-content err) (error-content-mimetype err)))
+
+(defun err (&key (code 400) (content "Bad Request") (mimetype "text/plain")) 
+  "Signal an error and abort request."
+  (error 'request-error :code code :content content :mimetype mimetype))
-- 
cgit v1.2.3