From 448320e12237a835b830a3da5154944cce2b80eb Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Mon, 7 Feb 2022 14:18:38 -0600 Subject: huzzah! all the parts are in place. --- lazybones-hunchentoot.lisp | 69 +++++++++++++++++++++++++++++++--------------- lazybones.lisp | 10 +++---- package.lisp | 2 ++ 3 files changed, 54 insertions(+), 27 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 diff --git a/lazybones.lisp b/lazybones.lisp index 785afb0..9b767bf 100644 --- a/lazybones.lisp +++ b/lazybones.lisp @@ -59,7 +59,7 @@ :initform nil))) (defmethod initialize-instance :before ((app app) &key name &allow-other-keys) - (when (lazybones-boundp name) + (when (app name) (error "an app named ~s already exists" name))) (defmethod initialize-instance :after ((app app) &key) @@ -90,7 +90,7 @@ (handler-function :reader endpoint-request-handler :initarg :function) - (documentation + (endpoint-documentation :reader endpoint-documentation :initarg :doc :initform ""))) @@ -300,10 +300,10 @@ making a new one if not." (register-endpoint ,the-app (make-instance - ,endpoint-class + ',endpoint-class :route ,route - :pattern ,dispatch-pattern - :documentation ,documentation + :pattern ',dispatch-pattern + :doc ,documentation :auth ,auth-method :function (lambda ,params ,@real-body) ,@endpoint-initargs)))))) diff --git a/package.lisp b/package.lisp index 4c56fd2..e03ce20 100644 --- a/package.lisp +++ b/package.lisp @@ -23,6 +23,7 @@ ;; lifecycle functions #:install-app #:uninstall-app + #:create-server #:start-server #:stop-server)) @@ -39,6 +40,7 @@ #:http-ok #:http-err #:defendpoint + #:create-server #:install-app #:uninstall-app #:start-server -- cgit v1.2.3