From 0402a9147f726124ed79a892ce69587b0d7f8c71 Mon Sep 17 00:00:00 2001
From: Colin Okay <okay@toyful.space>
Date: Mon, 7 Feb 2022 13:46:10 -0600
Subject: supporting responses

---
 lazybones.lisp | 44 ++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 40 insertions(+), 4 deletions(-)

(limited to 'lazybones.lisp')

diff --git a/lazybones.lisp b/lazybones.lisp
index d19afd2..785afb0 100644
--- a/lazybones.lisp
+++ b/lazybones.lisp
@@ -45,6 +45,15 @@
     is evoked when an ENDPOINT's AUTH slot is T. Endpoints may
     override this behavor by supplying a function in place of T. A
     value of NIL means that there is no default authorizer.")
+   (app-error-response-contents
+    :accessor app-error-response-contents
+    :initform nil
+    :documentation "an alist of (CODE CONTENT)")
+   (default-content-type
+    :accessor default-content-type
+    :initarg :content-type
+    :initform "text/html"
+    :documentation "Default content type sent back to clients.")
    (endpoints
     :accessor app-endpoints
     :initform nil)))
@@ -258,18 +267,18 @@ any way to do it, hence NIL is returned."
     (appname method route
      (&key
         (auth nil)
-        (endpoint-class 'lazybones::endpoint)
+        (endpoint-class 'lazybones:endpoint)
         (endpoint-initargs nil)
-        (app-class 'lazybones::app)
+        (app-class 'lazybones:app)
         (app-initargs nil))
      &body body)
   "Defines and installs an ENDPOINT instance to the APP instance
 indicated by APPNAME, first checking an APP called APPNAME exits,
 making a new one if not."
-  (assert (and (symbolp endpoint-class) (subtypep endpoint-class 'lazybones::endpoint))
+  (assert (and (symbolp endpoint-class) (subtypep endpoint-class 'lazybones:endpoint))
           ()
           "ENDPOINT-CLASS must be a literal symbol naming a subclass of LAZYBONES::ENDPOINT")
-  (assert (and (symbolp app-class) (subtypep app-class 'lazybones::app))
+  (assert (and (symbolp app-class) (subtypep app-class 'lazybones:app))
           ()
           "APP-CLASS must be a literal symbol naming a subclass of LAZYBONES::APP")
   (assert (member method +http-methods+) ()
@@ -300,3 +309,30 @@ making a new one if not."
            ,@endpoint-initargs))))))
 
 
+
+;;; utilities
+
+(defun set-response-headers (&rest headers)
+  "Sets response headers for *RESPONSE*. Handy for setting many headers at once.
+
+E.g.
+(set-response-headers 
+  :content-type \"text/html\"
+  :content-length (length html-bytes))"
+  (loop for (name value . more) on headers by #'cddr
+        do (setf (response-header name *response*) value)))
+
+
+(defun http-ok (content)
+  "Content should be a string, a byte-vector, or a pathname to a local
+file.  CONTENT-TYPE should be a MIME type string."
+  (http-respond 200 content))
+
+(defun http-err (code &optional content)
+  "*APP*, *RESPONSE* and *REQUEST* should all be defined here."
+  (http-respond
+   code
+   (or content (default-error-response code))))
+
+(defun default-error-response (code &optional (app *app*))
+  (cdr  (assoc code (app-error-response-contents app))))
-- 
cgit v1.2.3