diff options
Diffstat (limited to 'lazybones-hunchentoot.lisp')
-rw-r--r-- | lazybones-hunchentoot.lisp | 69 |
1 files changed, 47 insertions, 22 deletions
diff --git a/lazybones-hunchentoot.lisp b/lazybones-hunchentoot.lisp index e60ebc5..ed29b57 100644 --- a/lazybones-hunchentoot.lisp +++ b/lazybones-hunchentoot.lisp @@ -8,60 +8,60 @@ (in-package :lazybones.backend/hunchentoot) -;;; HTTP REQUEST READERS +;;; HTTP REQUEST FUNCTIONS -(defun request-path (&optional (request *request* )) +(defun request-path (&optional (request lzb:*request* )) "Returns the PATH part of the REQUEST URL. See Also: https://en.wikipedia.org/wiki/URL#Syntax." (h:script-name request)) -(defun request-host (&optional (request *request*)) +(defun request-host (&optional (request lzb:*request*)) "Returns the HOST part of the REQUEST URL. See Also: https://en.wikipedia.org/wiki/URL#Syntax" (h:host request)) -(defun request-url (&optional (request *request*)) +(defun request-url (&optional (request lzb:*request*)) "Returns the full url of REQUST" (h:request-uri* request)) -(defun request-port (&optional (request *request*)) +(defun request-port (&optional (request lzb:*request*)) "The port associated with REQUEST." (h:local-port* request)) -(defun request-query-string (&optional (request *request*)) +(defun request-query-string (&optional (request lzb:*request*)) "Returns the full query string of the URL associated with REQUEST See Also: https://en.wikipedia.org/wiki/URL#Syntax" (h:query-string request)) -(defun request-parameter (name &optional (request *request*)) +(defun request-parameter (name &optional (request lzb:*request*)) "Returns the the value of the query parameter named NAME, or NIL if there there is none." (h:get-parameter name request)) -(defun request-parameters (&optional (request *request*)) +(defun request-parameters (&optional (request lzb:*request*)) "Returns an alist of parameters associated with REQUEST. Each member of the list looks like (NAME . VALUE) where both are strings." (h:get-parameters request)) -(defun request-headers (&optional (request *request*)) +(defun request-headers (&optional (request lzb:*request*)) "Returns an alist of headers associated with REQUEST. Each member of the list looks like (HEADER-NAME . VALUE) where HEADER-NAME is a keyword or a string and VALUE is a string." (h:headers-in request)) -(defun request-header (header-name &optional (request *request*)) +(defun request-header (header-name &optional (request lzb:*request*)) "Returns the string value of the REQUEST header named HEADER-NAME. HEADER-NAME can be a keyword or a string." (h:header-in header-name request)) -(defun request-cookie (name &optional (request *request*)) +(defun request-cookie (name &optional (request lzb:*request*)) "Returns the cookie with NAME sent with the REQUEST" (h:cookie-in name request)) -(defun request-method (&optional (request *request*)) +(defun request-method (&optional (request lzb:*request*)) "Returns a keyword representing the http method of the request." (h:request-method request)) @@ -77,7 +77,7 @@ HEADER-NAME can be a keyword or a string." (defparameter +hunchentoot-methods-with-body+ '(:post :put :patch)) -(defun request-body (&key (request *request*) (want-stream-p nil)) +(defun request-body (&key (request lzb:*request*) (want-stream-p nil)) "Returns the decoded request body. The value returned depends upon the value of the Content-Type request header." (when (member (request-method request) +hunchentoot-methods-with-body+) @@ -113,43 +113,68 @@ the value of the Content-Type request header." collect (alexandria:make-keyword k) collect value)) -;;; HTTP RESPONSE ACCESSORS +;;; HTTP RESPONSE FUNCTIONS -(defun response-code (&optional (response *response*)) +(defun response-code (&optional (response lzb:*response*)) "Access the return code of the resposne. Return code should be an integer." (h:return-code response)) -(defun (setf response-code) (code &optional (response *response*)) +(defun (setf response-code) (code &optional (response lzb:*response*)) (setf (h:return-code response) code)) -(defun resonse-header (name &optional (response *response*)) +(defun response-header (name &optional (response lzb:*response*)) "Access the response header that has NAME, which can be a keyword (recommended) or a string." (h:header-out name response)) -(defun (setf response-header) (value name &optional (response *response*)) +(defun (setf response-header) (value name &optional (response lzb:*response*)) (setf (h:header-out name response) value)) -(defun response-cookie (name &optional (response *response*)) +(defun response-cookie (name &optional (response lzb:*response*)) "Access the cookie with NAME in the response object." (h:cookie-out name response)) -(defun (setf response-cookie) (value name &optional (response *response*)) +(defun (setf response-cookie) (value name &optional (response lzb:*response*)) (a:if-let (extant-cookie (assoc name (h:cookies-out response) :test #'string=)) (setf (cdr extant-cookie) value) (cadar (setf (h:cookies-out response) (cons (cons name value) (h:cookies-out response)))))) (defun http-respond (code content) + "Final step preparing response before backend does the rest. For +Hunchentoot, set the response code and a few headers. If content is a +pathname, pass off to HUNCHENTOOT:HANDLE-STATIC-FILE, otherwise just +return the content." (setf (response-code) code - (response-header :content-type) (or (response-header :content-type content-type) + (response-header :content-type) (or (response-header :content-type) (when (pathnamep content) (h:mime-type content)) - (default-content-type *app*) + (lzb::default-content-type lzb:*app*) (error "Content Type Not Set"))) (if (pathnamep content) (h:handle-static-file content) content)) +;;; LIFECYCLE FUNCTIONS + +(defun create-server (port) + "Creates an opaque server on port PORT, and returns it. Servers are +backend specific, but each may be passed in to INSTALL-APP, +UNINSTALL-APP, START-SERVER, and STOP-SERVER." + (make-instance 'lazybones-acceptor :port port)) + +(defun start-server (server) + (h:start server)) + +(defun stop-server (server) + (h:stop server)) + +(defun install-app (server app) + "Installs a LAZYBONES:APP instance to SERVER." + (push app (acceptor-apps server))) + +(defun uninstall-app (server app) + (setf (acceptor-apps server) + (delete (if (symbolp app) (lzb:app app) app) (acceptor-apps server)))) ;;; Hunchentoot Acceptor Subclass |