Route handling logic written (untested)

4 files changed, 171 insertions, 70 deletions

diff --git a/lazybones-hunchentoot.asd b/lazybones-hunchentoot.asd
new file mode 100644
index 0000000..98b094c
--- /dev/null
+++ b/lazybones-hunchentoot.asd
@@ -0,0 +1,10 @@
+;;;; lazybones-hunchentoot.asd
+
+(asdf:defsystem #:lazybones-hunchentoot
+  :description "hunchentoot backend for lazybones"
+  :author "Colin Okay <okay@toyful.space>"
+  :license  "AGPLv3"
+  :version "0.0.1"
+  :serial t
+  :depends-on (#:hunchentoot #:lazybones)
+  :components ((:file "lazybones-hunchentoot")))
diff --git a/lazybones-hunchentoot.lisp b/lazybones-hunchentoot.lisp
index 9d91b54..2b84ac1 100644
--- a/lazybones-hunchentoot.lisp
+++ b/lazybones-hunchentoot.lisp
@@ -2,58 +2,62 @@
 
 (defpackage #:lazybones.backend/hunchentoot
   (:use #:cl #:lazybones.backend)
-  (:local-nicknames (#:h #:hunchentoot )))
+  (:local-nicknames (#:h #:hunchentoot)
+                    (#:lzb #:lazybones)
+                    (#:a #:alexandria)))
 
 (in-package :lazybones.backend/hunchentoot)
 
-(defun request-path (request)
+;;; HTTP REQUEST READERS
+
+(defun request-path (&optional (request *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 (request)
+(defun request-host (&optional (request *request*))
   "Returns the HOST part of the REQUEST URL. 
 
 See Also: https://en.wikipedia.org/wiki/URL#Syntax"
   (h:host request))
 
-(defun request-url (request)
+(defun request-url (&optional (request *request*))
   "Returns the full url of  REQUST"
   (h:request-uri* request))
 
-(defun request-port (request)
+(defun request-port (&optional (request *request*))
   "The port associated with REQUEST."
   (h:local-port* request))
 
-(defun request-query-string (request)
+(defun request-query-string (&optional (request *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 request)
+(defun request-parameter  (name &optional (request *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 (request)
+(defun request-parameters (&optional (request *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 (request)
+(defun request-headers (&optional (request *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 request)
+(defun request-header (header-name &optional (request *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-method (request)
+(defun request-method (&optional (request *request*))
   "Returns a keyword representing the http method of the request."
   (h:request-method request))
 
@@ -68,7 +72,7 @@ HEADER-NAME can be a keyword or a string."
 (defparameter +hunchentoot-methods-with-body+
   '(:post :put :patch))
 
-(defun request-body (request &key (want-stream-p nil))
+(defun request-body (&key (request *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+)
@@ -104,4 +108,25 @@ the value of the Content-Type request header."
         collect (alexandria:make-keyword k)
         collect value))
 
-
+;;; 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)
+  (let ((lzb:*request* request)
+        (lzb:*response* h:*reply*)) 
+    (loop for app in (acceptor-apps acceptor)
+          for (endpoint . args) = (lzb:find-endpoint app request)
+          when endpoint
+            return (lzb:run-endpoint endpoint args request)
+          ;; if no endpoint was found, call next method. 
+          finally (call-next-method))))
diff --git a/lazybones.lisp b/lazybones.lisp
index d72189b..593328e 100644
--- a/lazybones.lisp
+++ b/lazybones.lisp
@@ -2,17 +2,17 @@
 
 (in-package #:lazybones)
 
-;;; DYNAMIC VARIABLES 
+;;; DYNAMIC VARIABLES
 
-(defgeneric handle-request (what request)
-  (:documentation "Implemented for APP and ENDPOINT instances."))
-
-(defgeneric dispatch-handler-p (endpoint request)
-  (:documentation "T if ENDPOINT should handle REQUEST, NIL otherwise"))
-
-(defgeneric request-authorized-p (endpoint request)
-  (:documentation "Returns T if the REQUEST has authorization to dispatch the handler for ENDPOINT"))
+(defvar *request* nil
+  "Dynamic Variable holding the current request object. Dynamically
+  bound and available to each handler.  The exact object bound to
+  *request* varies according to the current backend.")
 
+(defvar *response* nil
+  "Dynamic variable holding the current response object. Dynamically
+  bound and available to each handler. The exact object bound
+  *response* varies according to the current backend. ")
 
 ;;; LAZYBONES CLASSES
 
@@ -27,43 +27,90 @@
     :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.")
    (endpoints
     :accessor app-endpoints
     :initform nil)))
 
-(defmethod handle-request ((app app) request)
-  (a:if-let (endpoint (lookup-endpoint-for app request))
-    (handle-request endpoint request)
-    (error-response ))
-
-)
-
 (defclass endpoint ()
-  ((method :reader endpoint-method :initarg :method :initform :get)
-   (template :reader endpoint-template :initarg :template :initform (error "endpoint template required"))
-   (dispatch-pattern :reader endpoint-dispatch-pattern)
-   (handler-function :reader endpoint-request-handler)
-   (app :reader endpoint-app :initarg :app :initform (error "every endpoint must have backlink to an app")
-        :documentation "backlink to the app that this endpoint is a part of.")
-   (documentation :reader endpoint-documentation :initarg :doc :initform "")))
+  ((method
+    :reader endpoint-method
+    :initarg :method
+    :initform :get)
+   (template
+    :reader endpoint-template
+    :initarg :template
+    :initform (error "endpoint template required"))
+   (dispatch-pattern
+    :reader endpoint-dispatch-pattern)
+   (handler-function
+    :reader endpoint-request-handler)
+   (documentation
+    :reader endpoint-documentation
+    :initarg :doc
+    :initform "")))
+
+(defun routekey-term-match-p (pattern-term routekey-term)
+  "Internal helper function. Returns T if both arguments are strings
+and they compare with STRING-EQUAL.  Otherwise, PATTERN-TERM is
+assumed to be a route variable representation, in which case T is
+returned, indicating that the variable should bind to anything."
+  (if (stringp pattern-term)
+      (string-equal pattern-term routekey-term)
+      t))
+
+(defun matches-routekey-p (pattern key)
+  "PATTERN is a list, each member of which is a string or a variable
+representation. PATTERN will have been generated by
+PARSE-ROUTE-STRING-TEMPLATE.
+
+If there are no variables in PATTERN, MATCHES-ROUTEKEY-P returns T
+or NIL.
+
+If there are variables in the pattern, MATCHES-ROUTEKEY-P returns a
+list of values, in the case of success, or NIL in the case of failure."
+  (when  (= (length pattern) (length key))
+    (loop for pterm in pattern
+          for rterm in key
+          for matchp = (routekey-term-match-p pterm rterm)
+          unless matchp
+            return nil
+          when (listp pterm)           ; looks like (var) or (var value-parser)
+            collect (if (second pterm)
+                        (funcall (second pterm) rterm)  ; parse value from rterm if we can
+                        rterm)                          ; otherwise use rterm string
+              into arguments
+          finally (return (or arguments t)))))
+
+(defun find-endpoint (app &optional (request *request*))
+  (find-endpoint-matching-key
+   app
+   (request-method request)
+   (request-routekey request)))
+
+
+(defun find-endpoint-matching-key (app method key)
+  "Returns a list. NIL represents failure to find match.
+
+Otherwise the result is (ENDPOINT . ARGS) where ENDPOINT is an
+endpoint instanceq and ARGS is a list of arguments to pass to
+ENDPOINT's handler function."
+  (loop for endpoint in (app-endpoints app)
+        for match =  (and (eql method (endpoint-method endpoint))
+                          (matches-routekey-p endpoint key))
+        when match 
+          return (cons endpoint (when (listp match) match))))
 
 (defparameter +http-methods+
   (list :get :head :put :post :delete :patch))
 
+(defun url-path->request-routekey (path)
+  "A routekey is used to match urls to endpoints that handle them."
+  (str:split #\/ path))
+
+(defun request-routekey (request)
+  (url-path->request-routekey
+   (request-path request)))
+
 (defun parse-route-string-template (template)
   "Routes are of the form 
 
@@ -77,15 +124,23 @@ On success returns things like:
 (\"foo\" \"bar\" (VAR PARSE-INTEGER) \"blah\")
 
 Returns NIL on failure"
-  (when (stringp template)
-    (cond ((equal "" template) nil)
-          (t
-           (loop for field in (str:split #\/ template)
-                 for var? = (parse-route-variable-string field)
-                 when var?
-                   collect var?
-                 else
-                   collect (string-downcase field))))))
+  (cond ((equal "" template) nil)
+        (t
+         (when (search "//" template)
+           (warn "The proposed route ~s contains a double forward-slash (//), is this intended?"
+                 template))
+         (when (a:ends-with #\/ template)
+           (warn "The proposed route ~s ends with a forward-slash (/), is this intended?"
+                 template))
+         (unless (eql #\/ (elt template 0))
+           (warn "The proposed route ~s does not begin with a forward-slash, is this intended?"
+                 template))
+         (loop for field in (str:split #\/ template)
+               for var? = (parse-route-variable-string field)
+               when var?
+                 collect var?
+               else
+                 collect (string-downcase field)))))
 
 (defun parse-route-variable-string (string)
   "A route variable string looks like <<foo>> or <<foo bar>>
@@ -100,13 +155,13 @@ Returns NIL on failure."
     (destructuring-bind
         (var-name . decoder?)
         (re:split " +"
-                  (string-trim " " (subseq string 2 (- (length string) 2))))
+                  (string-trim " "
+                               (subseq string 2 (- (length string) 2))))
       (if decoder?
-          (list (read-from-string var-name) (read-from-string (first decoder?)))
-          (list (read-from-string var-name))))))
-
-;; (defun add-route (method routestring handler-function)
-;;   (assert (member method +http-methods+) nil
-;;           "~a is not a valid HTTP method indicator."
-;;           method)
-;;   )
+          (list (gensym var-name) (read-from-string (first decoder?)))
+          (list (gensym var-name))))))
+
+
+(defun run-endpoint (endpoint args &optional (request *request*))
+  (let ((*request* request))
+    (apply (endpoint-request-handler endpoint) args)))
diff --git a/package.lisp b/package.lisp
index 436eb7f..3217d59 100644
--- a/package.lisp
+++ b/package.lisp
@@ -12,10 +12,21 @@
    #:request-headers 
    #:request-header
    #:request-method
-   #:request-body))
+   #:request-body
+
+   #:install-app
+   #:start-server
+   #:stop-server
+   ))
 
 (defpackage #:lazybones
   (:use #:cl #:lazybones.backend)
   (:local-nicknames (#:a #:alexandria)
-                    (#:re #:cl-ppcre)))
+                    (#:re #:cl-ppcre))
+  (:export
+   #:*request*
+   #:*response*
+   #:*app*
+   #:run-endpoint
+   #:find-endpoint))