diff options
Diffstat (limited to 'lazybones.lisp')
| -rw-r--r-- | lazybones.lisp | 165 |
1 files changed, 110 insertions, 55 deletions
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))) |