From b3e6b285bb39df9855f36be49f2fc416623c8414 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Sun, 6 Feb 2022 08:09:34 -0600 Subject: Route handling logic written (untested) --- lazybones-hunchentoot.asd | 10 +++ lazybones-hunchentoot.lisp | 51 ++++++++++---- lazybones.lisp | 165 ++++++++++++++++++++++++++++++--------------- package.lisp | 15 ++++- 4 files changed, 171 insertions(+), 70 deletions(-) create mode 100644 lazybones-hunchentoot.asd 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 " + :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 <> or <> @@ -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)) -- cgit v1.2.3