defined initial app class

1 files changed, 34 insertions, 419 deletions

diff --git a/lazybones.lisp b/lazybones.lisp
index 2f7dbfb..82e5fff 100644
--- a/lazybones.lisp
+++ b/lazybones.lisp
@@ -2,422 +2,37 @@
 
 (in-package #:lazybones)
 
-(clack.util:find-handler :hunchentoot) ;; temporary
-
-;;; SPECIAL VARS
-
-(defvar *handler* nil
-  "Clack handler top-level handler.")
-
-(defvar *routes* nil
-  "Datastructure that maps routes to route handlers.")
-
-(defvar *req* nil
-  "A PLIST that bound by and available to route handlers.")
-
-(defvar *body* nil
-  "Holds body of a request, decoded according to known decoders. 
-
-If no known decoder matches, holds a stream. 
-
-Bound by route handlers for POST, PUT, and PATCH requests.")
-
-(defvar *logging-p* nil
-  "Set to T if you want ot log requests to the value of *logging-stream*.")
-
-(defvar *logging-stream* t
-  "Set to T (i.e the standard output) by default.")
-
-(defvar *resp-headers* nil
-  "A PLIST bound at the beginning of every response. Can be used to
-  add additional headers to responses valid responses.")
-
-(defvar *decoders* nil
-  "An ALIST holding (mimetype . decoder) pairs. Add a decoder to this
-  to customize decoding of POST and PUT bodies.")
-
-(defvar *fallback-response-mimetype* "application/octet-stream"
-  "What to serve files as if their mimetype is unknown")
-
-(defvar *file-handler-configs* nil
-  "An ALIST holding (EXTENSION MIMETYPE READER).  
-
-EXTENSION is a  string, a file extension. 
-
-MIMETYPE is a string, used for setting the Content-Type HTTP response
-header for files with extension EXTENSION.  
-
-READER is a function designator. The function should accept a OS path
-and return either a string or a byte-vector.")
-
-(defun register-file-handler-config (ext mimetype &optional (reader 'read-file-into-string))
-  "Downcases both arguments, which are assumed to be strings. 
-
-Adds the (EXT MIMETYPE READER) to the global file handler
-registry. Used to determine the Content-Type when serving files whose
-file extension is EXT.
-
-READER is a function designator. The function should accept a path and
-read that path from disk, returning either a string or a byte-vector."
-  (if-let (entry (assoc ext *file-handler-configs* :test #'string-equal))
-    (setf (second entry) (string-downcase mimetype)
-          (third entry) reader)
-    (push (list ext (string-downcase mimetype) reader)
-          *file-handler-configs*)))
-
-;; TODO raise a condition here in case of failure?
-(defun get-file-handler-config (ext)
-  "Looks up the mimetype for the file extention EXT. Returnes the
-mimetype as a string, or NIL"
-  (assoc ext *file-handler-configs* :test #'equal))
-
-;;; UTILITY FUNCTIONS
-
-(defun clean-split-path (path)
-  (loop :for entry :in (split-sequence #\/ (namestring path))
-       :when (plusp (length entry)) :collect entry))
-
-
-;;; HANDLER UTILITIES 
-
-(defun add-header (key val)
-  "Adds a header to the response headers. Can be used within a handler
-definition."
-  (setf (getf *resp-headers* key) val))
-
-(defun add-decoder (mimetype decoder)
-  "Adds or replaces a DECODER function for supplied MIMETYPE"
-  (if-let ((decoder-pair (assoc mimetype *decoders* :test #'string-equal)))
-    (setf (cdr decoder-pair) decoder)
-    (push (cons mimetype decoder)
-          *decoders*)))
-
-(defun decode-body (stream content-type content-length)
-  "Decodes the body according to the Content-Type header.
-
-If no matching decoder is found in the *DECODERS* ALIST, then the 
-STREAM itself is returned unaltered.
-"
-  (if-let ((decoder (assoc content-type *decoders*
-                           :test (lambda (ct key) (starts-with-subseq key ct)))))
-    (funcall (cdr decoder) stream  content-type content-length)
-    stream))
-
-(defun content-length (content)
-  "Utility for determining the Content-Length header for response bodies."
-  (cond ((consp content)
-         (reduce #'+ (mapcar #'length content)))
-        (t (length content))))
-
-
-(defun http-ok (content-type &rest content)
-  "Utility function for creating an 200 HTTP response. 
-
-CONTENT-TYPE is a string, a mimetype.
-
-CONTENT is either a list of strings or a byte vector. It can be other
-stuff but CLACK has abysmal documentation.
-
-HTTP-OK will determine the content length of the content automatically.
-
-Any headers currently contained in the *RESP-HEADERS* ALIST will be
-included in the response.
-
-The function symbol HTTP-OK also has a different meaning when used
-within the body of a DEFROUTE form.  There it will early escape from
-the route handler with the value as described above. 
-
-E.G. Consider the form 
-
-(http-ok \"text/plain\" \"OK\")  
-
-Outside of a DEFROUTE this returns the list
-
-(200 (:CONTENT-TYPE \"text/plain\" :CONTENT-LENGTH 2) (\"OK\"))
-
-But inside of a DEFROUTE, the same form would be equivalent to something like
-
-(return-from #HANDERL123 
-  (apply #'http-ok \"text/plain\" (\"OK\")))
-
-where #HANDERL123 is a block label unique to the handler.
-"
-  (when (typep (car content) '(simple-array (unsigned-byte 8)))
-    (setq content (car content)))
-  (list 200
-        (list* :content-type content-type
-               :content-length (content-length content)
-               *resp-headers*)
-        content))
-
-(defun http-redirect (location)
-  (list 303 (list* :location location
-                   *resp-headers*)
-        nil))
-
-(defun serve-directory (root-path root-dir &key headers cache-p (filter #'identity))
-  "Adds handlers for every file in the directory tree with the root ROOT-DIR.
-
-The if PATH is the file pathname relative to ROOT-DIR, then the route
-added to serve the file located at PATH looks like ROOT-PATH/PATH. 
-
-HEADERS and CACHE-P are passed to MAKE-FILE-HANDLER as the keyword
-arguments of the same names.
-
-The FILTER function is used to control which paths are added. It is a
-predicate. If it is NIL the path is skipped, otherwise the path is used.
-
-If the appropriate mimetype cannot be determined for any file
-encountered under the ROOT-DIR, then an error will be
-signalled. Similarly, if a file reading function cannot be determined
-an error will be signalled. See also REGISTER-FILE-HANDLER-CONFIG."
-  (let ((prefix-len  (length (namestring root-dir)))
-        (key-prefix (path-to-route-key :get root-path)))
-    (uiop:collect-sub*directories
-     root-dir
-     (constantly t)
-     (constantly t)
-     (lambda (subdir)
-       (dolist (file (uiop:directory-files subdir))
-         (when (funcall filter file)
-           (add-route
-            (append key-prefix
-                    (clean-split-path (subseq (namestring file) prefix-len)))
-            (make-file-handler file :headers headers :cache-p cache-p))))))))
-
-(defun make-file-handler
-    (file &key
-            mimetype
-            file-reader
-            headers
-            cache-p)
-  "Given a path to a file, returns a handler function for serving that
-file.  If the file cannot be found on disk, an error will be raised
-and the server will return 500.
-
-If MIMETYPE is not specified, it will be determined from the file
-extension. If it cannot be determined from the file extension, the
-current value of *FALLBACK-RESPONSE-MIMETYPE* will be used,
-application/octet-stream  by default.
-
-FILE-READER names a function that reads file content from disk. It
-should accept a file name and return either a string or a byte
-vector. If it is not specified, it will be determined fromt he file
-extension. If it cannot be determined from the file extension,
-'ALEXANDRIA:READ-FILE-INTO-BYTE-VECTOR will be used.
-
-HEADERS is a PLIST of additional HTTP headers.  Content-Length need
-not be included as it will be determined automatically.
-
-CACHE-P determines whether or not the file is read from disk upon
-every request.  By default files are not cached."
-  (assert (probe-file file))
-  (let* ((ext (pathname-type file))
-         (config (get-file-handler-config ext))
-         (mimetype (or mimetype
-                       (second config)
-                       *fallback-response-mimetype*))
-         (file-reader (or file-reader
-                          (third config)
-                          'read-file-into-byte-vector))
-         (content (if cache-p (funcall file-reader file)
-                     (lambda () (funcall file-reader file)))))
-    (lambda (*req*)
-      (let ((*resp-headers* headers))
-        (http-ok mimetype (if cache-p content (funcall content)))))))
-
-
-(defun http-err (code text)
-  (let ((resp (format nil "~a ~a" code text)))
-    (list code
-          (list :content-type "text/plain"
-                :content-length (length resp))
-          (list resp))))
-
-
-(defun add-route (route-key route-handler)
-  "A Helper, used by DEFROUTE. Adds or replaces a handler for a route.
-
-ROUTE-KEY is of the form (METHOD . STRINGS) where METHOD is
-one of :GET :POST :PUT :HEAD etc, and where STRINGS is a list of strings.
-
-ROUTE-HANDLER is a function of several arguments. The first argument
-always binds the special variable *REQ* to the current request PLIST.
-Additional arguments are bound to variables that may appear in the
-route key.  A string in STRINGS that starts with a colon will
-correspond to a variable in the handler function.  This the value of
-this variable is extracted from a request path and passed to the
-handler function.
-
-For example: (:GET \"persons\" \":id\" \"view\") matched against the
-url path \"/persons/23/view\" would pass the value 23 to the route
-handler, bound to the variable ID.
-"
-  (let ((found (assoc route-key *routes* :test #'equal)))
-    (if found
-        (setf (cdr found) route-handler)
-        (push (cons route-key route-handler) *routes*))))
-
-(defun path-var-p (str)
-  "Returns T if STR is a string that looks like :foo, Nil otherwise."
-  (and
-   (stringp str)
-   (plusp (length str))
-   (eql #\: (aref str 0))))
-
-
-(defun path-to-arglist (path-spec)
-  "Parses a URL path and extracts any variables, returning a list of symbols.
-
-E.g.: /foo/bar/:goo/zar/:moo  would result in  (GOO MOO)"
-
-  (loop :for val :in (clean-split-path path-spec)
-       :when (path-var-p val) :collect (read-from-string (subseq val 1))))
-
-
-(defmacro with-handler-preamble ((&rest preamble) &body route-defs)
-  "Inserts PREAMBLE form into the beginning of each ROUTE-DEF, which
-must be a valid DEFROUTE form.
-
-WITH-HANDLER-PREAMBLE is useful for adding resource control or
-preparation to big blocks of routes. E.g. ensuring authorization,
-setting up variables, etc.
-"
-  (let ((transformed
-         (loop
-            :for (_ method path . handler-forms) :in route-defs
-            :collect (list* 'lazybones:defroute
-                            method
-                            path
-                            (append preamble handler-forms)))))
-    `(progn ,@transformed)))
-
-(defun path-to-route-key (method path)
-  (cons method (clean-split-path path)))
-
-
-(defmacro defroute (method path &rest body)
-  "Defines a new route handler.
-
-Method is one of :GET :POST :PUT etc... 
-
-PATH is a string representing a URL path. The PATH may contain
-variable segmets, that start with a colon.
-
-The new route is added to the currently defined routes and is
-available for use.
-
-If the METHOD has a body, then the defined route handler will
-automatically decode the body according the the request's
-Content-Length and Content-Type headers, which will then be bound to
-*BODY* for the extent of the handler.
-
-A special variable *RESP-HEADERS* is also bound to NIL at the start of
-the handler, and can be used to add headers to a successful response. 
-
-The request PLIST is boudn to *REQ* for the extent of the handler.
-
-A handler is wrapped in an implicit block called
-CURRENT-HANDLER, allowing for non-local exits via (RETURN-FROM CURRENT-HANDLER ...)
-"
-  (let* ((arglist (path-to-arglist path))
-         (key (path-to-route-key method path))
-         (block-label (gensym "HANDLER"))
-         (body-block `(block ,block-label
-                        (flet ((http-ok (content-type &rest content)
-                                 (return-from ,block-label
-                                   (apply #'http-ok content-type content)))
-                               (http-err (code text)
-                                 (return-from ,block-label
-                                   (funcall #'http-err code text))))
-                         ,@body))))
-    
-    (if (member method '(:post :put :patch))
-        `(add-route ',key
-                    (lambda (*req* ,@arglist)
-                      (let ((*body* (decode-body (getf *req* :raw-body)
-                                                 (getf *req* :content-type)
-                                                 (getf *req* :content-length)))
-                            (*resp-headers*))
-                        ,body-block)))
-        `(add-route ',key
-                    (lambda (*req* ,@arglist)
-                      (let (*resp-headers*)
-                        ,body-block))))))
-
-
-(defun route-part-match-p (word1 word2)
-  "A utility function, returns T if word1 and word2 unify as
-non-variable URL path segments."
-  (or (eql word1 word2)
-      (and (stringp word1)
-           (stringp word2)
-           (string-equal word1 word2))))
-
-
-(defun match-route-key (req-key route-key)
-  "Compares a route keys extracted from an HTTP request path with an
-already extant route key.  
-
-Returns two values, a possible argument list to pass to the route
-handler and a boolean indicating success"
-  (if (not (= (length req-key) (length route-key)))
-      (values nil nil)
-      (let (args)
-        (loop
-           :for req-part :in req-key
-           :for route-part :in route-key
-           :do (cond
-                 ((path-var-p route-part)
-                  (push req-part args))
-
-                 ((not (route-part-match-p req-part route-part))
-                  (return-from match-route-key (values nil nil)))))
-
-        (values (reverse  args) t))))
-
-
-(defun lookup-route (req)
-  "Looks up a route and returns two values. The first is a list of
-arguments extracted from the request path. The second is the handler
-function itself.  Both are NIL if the lookup failed to find a handler
-for the request's path."
-  (when-let* ((path   (getf req :path-info))
-              (method (getf req :request-method))
-              (key    (path-to-route-key method path)))
-    (loop :for (route-key . handler) :in *routes*
-       :do (multiple-value-bind (args match-p) (match-route-key key route-key)
-             (when match-p (return-from lookup-route (values args handler)))))
-    ;; otherwise
-    (values nil nil)))
-
-(defvar *debugging* nil
-  "Set to T to allow the main thread to drop into the debugger when
-  errors are encountered")
-
-(defun main-handler (*req*)
-  (when *logging-p*
-    (format *logging-stream* "~a~%" *req*))
-  (handler-case
-      (multiple-value-bind (args handler) (lookup-route *req*)
-        (if handler
-            (apply handler *req* args)
-            (http-err 404 "Not Found")))
-    (error (e)
-      (if *debugging*
-          (invoke-debugger e)
-          (print e *error-output* ))
-      (http-err 500 (format nil "Internal Server Error:~%~a" e)))))
-
-
-
-(defun start (&key (port 5000))
-  (setf *handler* (clack:clackup 'main-handler :port port)))
-
-(defun stop ()
-  (when *handler*
-    (clack:stop *handler*)))
-
-(defun reload (&key (port 5000))
-  (stop)
-  (start :port port))
+(defclass app ()
+  ((name
+    :reader app-name
+    :initarg :name
+    :initform (error "Appname is required")
+    :type symbol)
+   (version
+    :reader app-version
+    :initarg :vsn :initarg :version
+    :initform "0.0.1"
+            :type string)
+   (root
+    :reader app-root
+    :initarg :root
+    :initform "/"
+    :type string)
+   (default-request-authorizer
+    :initarg :default-authorizier :initarg :auth-with
+    :initform nil)
+   (default-http-responders
+    :initarg :default-responders
+    :initform nil
+    :documentation "A PLIST with keys being integers that represent
+    HTTP response codes and with values that are symbols naming
+    responder functions.")
+   (routes
+    :accessor app-routes
+    :initform nil)))
+
+(defun parse-route-string-template (template)
+  )
+
+(defun add-route (method routestring handler-function)
+  )