authorization check logic; route variables

1 files changed, 96 insertions, 7 deletions

diff --git a/lazybones.lisp b/lazybones.lisp
index 3597c0e..92b07d6 100644
--- a/lazybones.lisp
+++ b/lazybones.lisp
@@ -35,10 +35,24 @@
     :initarg :vsn :initarg :version
     :initform "0.0.1"
     :type string)
+   (authorizer
+    :reader request-authorizer
+    :initarg :auth
+    :initform nil
+    :documentation "A function of zero arguments that uses the request
+    API functions in LAZYBONES.BACKEND to determine whether or not the
+    current request is authorized. This is the default authorizer, and
+    is evoked when an ENDPOINT's AUTH slot is T. Endpoints may
+    override this behavor by supplying a function in place of T. A
+    value of NIL means that there is no default authorizer.")
    (endpoints
     :accessor app-endpoints
     :initform nil)))
 
+(defmethod initialize-instance :before ((app app) &key name &allow-other-keys)
+  (when  (lazybones-boundp name)
+    (error "an app named ~s already exists" name)))
+
 (defmethod initialize-instance :after ((app app) &key)
   (setf (symbol-lazybones (app-name app)) app))
 
@@ -54,10 +68,19 @@
     :reader endpoint-template
     :initarg :template
     :initform (error "endpoint template required"))
+   (authorizer
+    :reader request-authorizer
+    :initarg :auth
+    :initform nil
+    :documentation "A function of zero arguments used to authorize the
+    request currently bound to *REQUEST*. Returns non-nil if
+    authorized, and NIL if not.")
    (dispatch-pattern
-    :reader endpoint-dispatch-pattern)
+    :reader endpoint-dispatch-pattern
+    :initarg :pattern)
    (handler-function
-    :reader endpoint-request-handler)
+    :reader endpoint-request-handler
+    :initarg :function)
    (documentation
     :reader endpoint-documentation
     :initarg :doc
@@ -172,9 +195,13 @@ Returns NIL on failure."
                   (string-trim " "
                                (subseq string 2 (- (length string) 2))))
       (if decoder?
-          (list (gensym var-name) (read-from-string (first decoder?)))
-          (list (gensym var-name))))))
+          (list (string-upcase var-name) (read-from-string (first decoder?)))
+          (list (string-upcase var-name))))))
 
+(defun route-variables (route)
+  (loop for term in route
+        when (listp term)
+          collect (first term)))
 
 (defun run-endpoint (endpoint args request response app)
   "Bind dynamic variables *request* *response* and *app* before
@@ -182,11 +209,73 @@ applying HANDLER-FUNCTION slot of ENDPOINT to the ARGS list."
   (let ((*request* request)
         (*response* response)
         (*app* app))
-    (apply (endpoint-request-handler endpoint) args)))
+    (when (request-authorized-p endpoint) 
+      (apply (endpoint-request-handler endpoint) args))))
+
+(defun request-authorized-p (endpoint)
+  "Attempts to authorize an endpoint.
+
+If the endpoint's request-authorizer is NIL, then the endpoint doesn't
+require authorization, and T is returned.
+
+If the endpoint's request-authorizer is a function, call it.
+
+If the endpoint's request-authorizer is T, then the app's default
+authorizer is used.
+
+Hence, if the endpoint authorizer is T and the app doesn't have an
+authorizer, then, the endpoint wants to be authorized but there isn't
+any way to do it, hence NIL is returned."
+  (a:if-let (specific-authorizer (request-authorizer endpoint))
+    (if (functionp specific-authorizer)
+        (funcall specific-authorizer)
+        (when (request-authorizer *app*) ; perhaps this should be an if, and  
+          (funcall (request-authorizer *app*))))
+    t))
 
 ;;; ENDPOINT DEFINITION
 
-(defmacro defendpoint (appname method route-template (&key (auth nil)) &body body)
+(defmacro defendpoint
+    (appname method route-template
+     (&key
+        (auth nil)
+        (endpoint-class 'lazybones::endpoint)
+        (endpoint-initargs nil)
+        (app-class 'lazybones::app)
+        (app-initargs nil))
+     &body body)
   "Defines and installs an ENDPOINT instance to the APP instance
 indicated by APPNAME, first checking an APP called APPNAME exits,
-making a new one if not."  )
+making a new one if not."
+  (assert (and (symbolp endpoint-class) (subtypep endpoint-class 'lazybones::endpoint))
+          ()
+          "ENDPOINT-CLASS must be a literal symbol naming a subclass of LAZYBONES::ENDPOINT")
+  (assert (and (symbolp app-class) (subtypep app-class 'lazybones::app))
+          ()
+          "APP-CLASS must be a literal symbol naming a subclass of LAZYBONES::APP")
+  (assert (member method +http-methods+) ()
+          "~a is not a valid http method keyword"
+          method)
+  (a:with-gensyms (the-app auth-method)
+    (let* ((dispatch-pattern 
+             (parse-route-string-template route-template))
+           (params
+             (mapcar 'intern (route-variables  dispatch-pattern)))
+           (documentation
+             (when (stringp (first body)) (first body)))
+           (real-body
+             (if (stringp (first body)) (rest body) body)))
+      `(let* ((,the-app
+                (or (app ',appname) (make-instance ',app-class :name ',appname ,@app-initargs)))
+              (,auth-method
+                ,auth))
+         (register-endpoint
+          ,the-app
+          (make-instance
+           ,endpoint-class
+           :template ,route-template
+           :pattern ,dispatch-pattern
+           :documentation ,documentation
+           :auth ,auth-method
+           :function (lambda ,params ,@real-body)
+           ,@endpoint-initargs))))))