canned error resposnes moved into server api (duh), updated readme

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*