initial commit

1 files changed, 144 insertions, 0 deletions

diff --git a/src/protocol.lisp b/src/protocol.lisp
new file mode 100644
index 0000000..19a4791
--- /dev/null
+++ b/src/protocol.lisp
@@ -0,0 +1,144 @@
+(in-package #:weekend)
+
+;;; CONDITIONS
+
+(defvar *debugging* nil
+  "If T, the debugger will be evoked.")
+
+(define-condition protocol-error (error)
+  ((raw-request
+    :reader raw-request
+    :initarg :raw-request
+    :documentation "The server backend's request object, if available")
+   (class
+    :reader endpoint-class
+    :initarg :class
+    :documentation "The class registered to handle the raw-request.")
+   (note
+    :reader note
+    :initform nil
+    :initarg :note
+    :type (or null string))
+   (status-code
+    :reader status-code
+    :initform nil
+    :initarg :status-code
+    :type (or nil (integer 100 599))))
+  (:documentation "Conditions signalled during the request handling protocol."))
+
+(define-condition cannot-authenticate (protocol-error) ()
+  (:default-initargs :status-code 401)
+  (:documentation "Signalled when a endpoint's AUTHENTICATE method returns NIL,
+indicating that the user's identity is required but cannot be determined."))
+
+(define-condition not-authorized (protocol-error) ()
+  (:default-initargs :status-code 403)
+  (:documentation "Signalled when an endpoint's AUTHORIZE method returns NIL, indiating
+that the request has insufficient permissions to evoke the endpoint handler. "))
+
+(define-condition bad-body-error (protocol-error)
+  ((wrapped
+    :reader wrapped
+    :initarg :error
+    :documentation "A root error that may have caused this error to be signalled."))
+  (:default-initargs :status-code 400)
+  (:documentation "Signalled when the body of a request cannot be deserialized."))
+
+(define-condition slot-required (protocol-error)
+  ((mising-slot
+    :reader missing-slot
+    :initarg :slot))
+  (:default-initargs :status-code 400)
+  (:documentation "Signalled whenever a required slot is missing from a endpoint
+   instance object."))
+
+(define-condition not-found (protocol-error)
+  (:default-initargs :status-code 404))
+
+(defgeneric protocol-error-result (err)
+  (:documentation "The content and mimetype to returned to the client having encountered
+    an error.")
+  (:method ((err protocol-error)) (values nil nil)))
+
+(defun abort-on-error (err)
+  "Assign a return code based on the type of error encountered and
+   immediately reply."
+  (setf (http:return-code*) (status-code err))
+  (multiple-value-bind (content type) (protocol-error-result err) 
+    (cond ((and content type)
+           (setf (http:content-type*) type)
+           (http:abort-request-handler content))
+          (t
+           (http:abort-request-handler)))))
+
+(defvar *debugging* nil
+  "If T, conditions signalled during request handling will invoke the
+  debugger.")
+
+(defmethod http:acceptor-dispatch-request :around ((acceptor http:acceptor) request)
+  (handler-case (call-next-method)
+
+    (protocol-error (err)
+      (if *debugging*
+          (invoke-debugger err)
+          (abort-on-error err)))
+
+    (error (err)
+      (if *debugging*
+          (invoke-debugger err)
+          (http:abort-request-handler)))))
+
+(defun protocol-error (error-class req &rest kwargs)
+  (apply #'error
+         error-class
+         :raw-request http:*request*
+         :class (class-of req)
+         kwargs))
+
+(defun not-found (req)
+  (protocol-error 'not-found req))
+
+;;; HANDLER PROTOCOL
+
+(defgeneric authenticate (endpoint)
+  (:documentation "Returns a boolean. Any protected endpoint should implement
+this. Called before handling, should be used to supply
+user-identifying data to the endpoint instance that might be needed by
+the handle function.")
+  (:method ((req t)) t))
+
+(defgeneric authorize (endpoint)
+  (:documentation "Returns a boolean. Any endpoint requiring special ownership
+permissions should implement this.  Called before handling and after
+authenticate.")
+  (:method ((req t)) t))
+
+(defgeneric handle (endpoint)
+  (:documentation "The beef of the endpoint handling protocol.
+
+
+                           _(__)_        V
+                          '-e e -'__,--.__)
+                           (o_o)        ) 
+                              \. /___.  |
+                              ||| _)/_)/
+                             //_(/_(/_( 
+
+By the time this has been called, both AUTHENTICATE and AUTHORIZE have
+been called. This method can be defined with the assumption that any
+work done by AUTHORIZE and AUTHENTICATE has been accomplished
+successfully.
+
+This method should return data to be sent back to the client and
+MUST be implemented for every endpoint class.")
+  (:method :before ((endpoint t))
+    ;; The default before method checks that the endpoint is
+    ;; authenticated, authorized, default, each of these is T.
+    (unless (authenticate endpoint)
+      (protocol-error 'cannot-authenticate endpoint))
+    (unless (authorize endpoint)
+      (protocol-error 'not-authorized endpoint))))
+
+
+
+