From 5b77a6c97198d7993eda76c763cff0fd999d94a7 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Tue, 8 Feb 2022 15:00:17 -0600 Subject: canned error resposnes moved into server api (duh), updated readme --- README.md | 37 +++++++++---- lazybones-documentation.lisp | 1 - lazybones-hunchentoot.lisp | 124 ++++++++++++++++++++++++++++--------------- lazybones.lisp | 29 +++------- package.lisp | 8 ++- 5 files changed, 120 insertions(+), 79 deletions(-) diff --git a/README.md b/README.md index 2279400..4cf2ba0 100644 --- a/README.md +++ b/README.md @@ -51,9 +51,25 @@ The following is quick example showing a few things that `lazybones` can do. (in-package :lazybones-test) +;; first make a server and add some custom error responses + +(defvar *server* (lzb:create-server :port 8888)) + +(defun custom-404 () + (format nil "~a wasn't found :(" (lzb:request-path))) ; can use request functiosn + +(defun custom-403 () + "You, in particular, can't do that. :P ") + +(lzb:set-canned-response *server* 404 'custom-404 "text/plain" ) +(lzb:set-canned-response *server* 403 'custom-403 "text/plain" ) +(lzb:set-canned-response *server* 500 #p"/path/to/500error.txt" "text/plain" ) + + + + ;; PPROVISION-APP makes an app. You can supply an optional name, a symbol. ;; In lieu of a supplied name, the name of the package is used as the app's name. - (lzb:provision-app () :title "Lazybones Demo App" :version "0.0.0" @@ -61,22 +77,17 @@ The following is quick example showing a few things that `lazybones` can do. endpoints aren't meant to accomplish anything. merely to test out the lazybones HTTP routing framework." - :content-type "text/plain" ; default content type of server responses. - :auth 'post-authorizer ; default authorizor for requests that need it - 404 'custom-404 ; custom content for error response codes. - 403 'custom-403) - -(defun custom-404 () - (format nil "~a wasn't found :(" (lzb:request-path))) - -(defun custom-403 () - "You, in particular, can't do that. :P ") + :content-type "text/plain" ; default content type of server responses. + :auth 'post-authorizer) ; default authorizor for requests that need it (defun post-authorizer () "Request is authorized if it contains the right TESTAPPSESSION cookie. Obtain such a cookie by posting to the /login endpoint." (string-equal "coolsessionbro" (lzb:request-cookie "testappsession"))) +;; now we install the app to the server +(lzb:install-app *server* (lzb:app)) ; (app) is the default app for this package + ;; DEFENDPOINT* is a macro to define an endpoint and install it into the ;; app whose name is the current package anme. DEFENDPOINT (without the *) ;; allows you to explictly specify the app where the endpoint is installed. @@ -152,6 +163,10 @@ The following is quick example showing a few things that `lazybones` can do. (http-ok (jonathan:to-json person))) +;; If you like start the server + +(lzb:start-server *server*) + ``` ## Backends diff --git a/lazybones-documentation.lisp b/lazybones-documentation.lisp index b8e1c34..c7cd591 100644 --- a/lazybones-documentation.lisp +++ b/lazybones-documentation.lisp @@ -14,7 +14,6 @@ endpoints (default-authorizer authorizer) default-content-type - app-error-response-contents description) app (with-output-to-string (*standard-output*) diff --git a/lazybones-hunchentoot.lisp b/lazybones-hunchentoot.lisp index fd437e0..9c2d108 100644 --- a/lazybones-hunchentoot.lisp +++ b/lazybones-hunchentoot.lisp @@ -8,6 +8,73 @@ (in-package :lazybones.backend/hunchentoot) +;;; Hunchentoot Acceptor Subclass + +(defvar %server nil + "unexported defvar holding the lazybones-acceptor instance.") + +(defclass lazybones-acceptor (h:acceptor) + ((installed-apps + :accessor acceptor-apps + :initform nil + :documentation "Instances of LAZYBONES:APP installed to this + acceptor. APPs are, among other things, collections of ENDPOINT + instances. The acceptor instance uses them to dispatch handlers + on requests.") + (canned-responses + :accessor canned-responses + :initarg :canned-responses + :initform nil + :documentation "an alist of (CODE CONTENT-FUNCTION CONTENT-TYPE)")) + (:default-initargs + :address "127.0.0.1")) + +(defmethod h:acceptor-dispatch-request ((%server lazybones-acceptor) request) + (loop for app in (acceptor-apps %server) + for (endpoint . args) = (lzb::find-endpoint app request) + when endpoint + return (lzb::run-endpoint endpoint args request h:*reply* app) + ;; if no endpoint was found, call next method. + finally (call-next-method))) + +;;; SERVER FUNCTIONS + +(defun create-server (&key (port 8888) (address "127.0.0.1")) + "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 :address address)) + +(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." + ;; TODO add assertsion here + (push (if (symbolp app) (lzb:app app) app) (acceptor-apps server))) + +(defun uninstall-app (server app) + (setf (acceptor-apps server) + (delete (if (symbolp app) (lzb:app app) app) (acceptor-apps server)))) + +(defun canned-response (server code) + "If a canned response is installed to the server for the HTTP +response code CODE, return it as a list (RESPONSE-SOURCE CONTENT-TYPE). + +RESPONSE-SOURCE is either a function designator for a function taking +zero arguments that is expected to return data that matches the +CONTENT-TYPE. Such a function can always make use of *REQUEST*. + +RESPONSE-SOURCE can also be a pathname to a file to serve." + (cdr (assoc code (canned-responses server)))) + +(defun set-canned-response (server code content-source content-type) + "Set a new canned response for the code CODE." + (push (list code content-source content-type) (canned-responses server))) + ;;; HTTP REQUEST FUNCTIONS (defun request-path (&optional (request lzb:*request* )) @@ -145,6 +212,20 @@ the value of the Content-Type request header." 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." + + ;; When http-err is called, the content is likely to be null. If + ;; that is the case, look for the default content for the error + ;; code, and set content and content-type appropriately + (a:when-let (data + (and (null content) + (canned-response %server code))) + (destructuring-bind (source content-type) data + (setf (response-header :content-type) content-type + content (if (or (functionp source) (symbolp source)) + (funcall source) + source)))) + + ;; set the response code and header. (setf (response-code) code (response-header :content-type) (or (response-header :content-type) (when (pathnamep content) @@ -155,46 +236,3 @@ return the 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." - ;; TODO add assertsion here - (push (if (symbolp app) (lzb:app app) 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 - -(defclass lazybones-acceptor (h:acceptor) - ((installed-apps - :accessor acceptor-apps - :initform nil - :documentation "Instances of LAZYBONES:APP installed to this - acceptor. APPs are, among other things, collections of ENDPOINT - instances. The acceptor instance uses them to dispatch handlers - on requests.")) - (:default-initargs - :address "0.0.0.0")) - -(defmethod h:acceptor-dispatch-request ((acceptor lazybones-acceptor) request) - (loop for app in (acceptor-apps acceptor) - for (endpoint . args) = (lzb::find-endpoint app request) - when endpoint - return (lzb::run-endpoint endpoint args request h:*reply* app) - ;; if no endpoint was found, call next method. - finally (call-next-method))) diff --git a/lazybones.lisp b/lazybones.lisp index 0ac07ba..3cf3bad 100644 --- a/lazybones.lisp +++ b/lazybones.lisp @@ -64,10 +64,6 @@ :accessor app-state-table :initform (make-hash-table) :documentation "A hash table with EQL comparing keys. Used for storing arbitrary application state.") - (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 @@ -83,26 +79,15 @@ (defun (setf app-state) (value key &optional (app *app*)) (setf (gethash key (app-state-table app)) value)) -(defun error-content (code &optional (app *app*)) - (cdr (assoc code (app-error-response-contents app)))) - -(defun (setf error-content) (value code &optional (app *app*)) - (a:if-let (found (assoc code (app-error-response-contents app))) - (setf (cdr found) value) - (push (cons code value) (app-error-response-contents app)))) (defun expand-provision-app-option (app option value) (list 'setf - (etypecase option - (keyword - (ecase option - ((:desc :description) `(lazybones::app-description ,app)) - (:title `(lazybones::app-title ,app)) - (:version `(lazybones::app-version ,app)) - (:content-type `(lazybones::default-content-type ,app)) - ((:auth :authorizer) `(lazybones::request-authorizer ,app)))) - (integer - `(lazybones::error-content ,option ,app))) + (ecase option + ((:desc :description) `(lazybones::app-description ,app)) + (:title `(lazybones::app-title ,app)) + (:version `(lazybones::app-version ,app)) + (:content-type `(lazybones::default-content-type ,app)) + ((:auth :authorizer) `(lazybones::request-authorizer ,app))) value)) (defmacro provision-app ((&optional name) &body body) @@ -401,6 +386,6 @@ file. CONTENT-TYPE should be a MIME type string." "*APP*, *RESPONSE* and *REQUEST* should all be defined here." (http-respond code - (or content (error-content code)))) + content)) diff --git a/package.lisp b/package.lisp index a2bcfac..22de31b 100644 --- a/package.lisp +++ b/package.lisp @@ -22,12 +22,14 @@ #:response-code #:response-cookie #:http-respond - ;; lifecycle functions + ;; server functions #:install-app #:uninstall-app #:create-server #:start-server - #:stop-server)) + #:stop-server + #:canned-response + #:set-canned-response)) ;; the symbols exported here are available for end users to use in the ;; building of their apps @@ -43,6 +45,8 @@ #:provision-app #:app #:app-state + #:canned-response + #:set-canned-response #:create-server #:defendpoint #:defendpoint* -- cgit v1.2.3