(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 ep &rest kwargs)
  (apply #'error
         error-class
         :raw-request http:*request*
         :class (class-of ep)
         kwargs))


(defun slot-required (ep slot)
  "Signals a SLOT-REQUIRED condition"
  (protocol-error 'slot-required ep :missing-slot slot))


;;; 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 ((ep 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 ((ep 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))))

;;; HANDLER TOOLS

(defun not-found (ep)
  "Signals a NOT-FOUND condition. Usually called within HANDLE or
AUTHORIZE while handling endpoint-class instance EP."
  (protocol-error 'not-found ep))

(defun redirect (url)
  "Redirect to URL."
  (http:redirect url :code http:+http-see-other+))

(defun redirect-to (class &rest kwargs)
  "Redirect to another endpoint. CLASS can be either a symbol or a
   class. KWARGS is a PLIST of keyword arguments supplied to the
   CLASS' route builder function."
  (redirect (apply #'route-to class kwargs)))