aboutsummaryrefslogtreecommitdiff
path: root/lazybones.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lazybones.lisp')
-rw-r--r--lazybones.lisp44
1 files changed, 40 insertions, 4 deletions
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))))