From 887818ec9bcfcf288ed932a566ed6219f5b9f212 Mon Sep 17 00:00:00 2001 From: colin Date: Sat, 11 May 2024 12:05:54 -0700 Subject: Add: kitchensink example --- src/endpoint.lisp | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) (limited to 'src/endpoint.lisp') diff --git a/src/endpoint.lisp b/src/endpoint.lisp index 73aaa6f..9064c9f 100644 --- a/src/endpoint.lisp +++ b/src/endpoint.lisp @@ -93,8 +93,8 @@ keyword arguments to make-instance for CLASS." (content-type :reader content-type :initarg :content-type - :initform (error "CONTENT-TYPE required") - :type string + :initform nil + :type (or null string) :documentation "The content-type the handling of this request returns to the requesting client.")) (:documentation "Metaclass for all request types.")) @@ -153,8 +153,8 @@ and application/x-www-form-urlencoded and stores them as an alist in the request's POST-PARAMETERS slot." (let ((header (or type (http:header-in* :content-type)))) (when (stringp header) - (loop for prefix in +hunchentoot-pre-decoded-content-types+ - thereis (a:starts-with-subseq prefix header))))) + (loop :for prefix :in +hunchentoot-pre-decoded-content-types+ + :thereis (a:starts-with-subseq prefix header))))) (defvar *mimetype-parsers* (make-hash-table :test #'equal)) @@ -234,15 +234,14 @@ extractors." part)))) (defun check-endpoint-class (class) "Signals an error if any slot values are malformed. -Good for indicating that you've got a bonkers class option syntax" +Good for indicating that you've got a bonkers class option syntax" (assert (slot-boundp class 'route) (class) "ROUTE must be bound") - (with-slots - (route extractors method want-body-stream content-type) + (with-slots (route extractors method want-body-stream content-type) class (check-type route string "a regex STRING.") (check-type method http-method "an HTTP-METHOD keyword") (check-type want-body-stream boolean "a BOOLEAN") - (check-type content-type string "a STRING mimetype") + (check-type content-type (or null string) "a STRING mimetype") (loop :with initargs := (class-initargs class) :for ex :in extractors @@ -367,7 +366,7 @@ the ;." (content-type (content-type class))) (lambda () - (setf (http:content-type*) (concatenate 'string content-type "; charset=utf-8")) + (setf (http:content-type*) content-type) (handle (instantiate-endpoint class init-slots))))) (defun create-class-dispatcher (class) @@ -408,6 +407,10 @@ the ;." ;;; TOOLS (defun route-to (class &rest kwargs) + "Build a route to the endpoint CLASS using keyword argument +constructors KWARGS for that class. CLASS must be either a symbol or +a class instance, and the named class must (obviously) be a subclass +of ENDPOINT." (funcall (route-builder (if (symbolp class) (find-class class) class)) kwargs)) -- cgit v1.2.3