diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/endpoint.lisp | 21 | ||||
| -rw-r--r-- | src/package.lisp | 18 | ||||
| -rw-r--r-- | src/protocol.lisp | 6 |
3 files changed, 34 insertions, 11 deletions
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)) diff --git a/src/package.lisp b/src/package.lisp index a9ab69f..e8f56b3 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -2,17 +2,33 @@ (defpackage #:weekend (:use #:cl #:flatbind) + (:import-from + #:hunchentoot + #:mime-type + #:handle-static-file + #:set-cookie) (:local-nicknames (#:http #:hunchentoot) (#:a #:alexandria-2) (#:mop #:closer-mop)) (:export ;; HANDLER PROTOCOL - #:authenticate + #:authenticate #:authorize #:handle #:not-found #:slot-required + #:not-found + #:redirect + #:endpoint-redirect + #:route-to + #:get-cookie + + ;; re-exports + #:mime-type + #:handle-static-file + #:set-cookie + ;; METACLASS #:endpoint diff --git a/src/protocol.lisp b/src/protocol.lisp index d25aa22..300195f 100644 --- a/src/protocol.lisp +++ b/src/protocol.lisp @@ -153,8 +153,12 @@ AUTHORIZE while handling endpoint-class instance EP." "Redirect to URL." (http:redirect url :code http:+http-see-other+)) -(defun redirect-to (class &rest kwargs) +(defun endpoint-redirect (class &rest kwargs) "Redirect to another endpoint. CLASS can be either a symbol or a class. KWARGS is a PLIST of keyword arguments supplied to the CLASS' route builder function." (redirect (apply #'route-to class kwargs))) + +(defun get-cookie (name) + "Returns the cookie with name NAME the actively" + (http:cookie-in name)) |