;;;; lazybones-hunchentoot.lisp -- hunchentoot backend for lazybones

(defpackage #:lazybones.backend/hunchentoot
  (:use #:cl #:lazybones.backend)
  (:local-nicknames (#:h #:hunchentoot)
                    (#:lzb #:lazybones)
                    (#:a #:alexandria)))

(in-package :lazybones.backend/hunchentoot)

;;; 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 (&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 (&optional (request *request*))
  "Returns the full url of  REQUST"
  (h:request-uri* request))

(defun request-port (&optional (request *request*))
  "The port associated with REQUEST."
  (h:local-port* 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 &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 (&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 (&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 &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 (&optional (request *request*))
  "Returns a keyword representing the http method of the request."
  (h:request-method request))

(defparameter +hunchentoot-pre-decoded-content-types+
  '("multipart/form-data" "application/x-www-form-urlencoded"))

(defun pre-decoded-body-p (request)
  (member (request-header :content-type request)
          +hunchentoot-pre-decoded-content-types+
          :test #'string-equal))

(defparameter +hunchentoot-methods-with-body+
  '(:post :put :patch))

(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+)
    (let ((pre-decoded-body-p
            (pre-decoded-body-p request))
          (content-type
            (request-header :content-type request))) 
      (cond
        ;; try to get a stream on request
        (want-stream-p                
         ;; can't do it if the body is already decoded - return nil so
         ;; that request-body can be called again
         (unless pre-decoded-body-p 
           (h:raw-post-data :request request :want-stream t)))

        (pre-decoded-body-p
         (format-as-lazybones-document
          (h:post-parameters request)))

        ((string-equal "application/json" content-type)
         (jonathan:parse
          (h:raw-post-data :request request :external-format :utf8 ))) ; TODO don't hardcode the format

        (t
         ;; default case is to return a bytevector
         (h:raw-post-data :request request :force-binary t))))))

(defun format-as-lazybones-document (post-parameters)
  "internal function. Formats all the post parmaeters (see docstring
  on hunchentoot:post-parameters) into a plist with keyword keys, as
  is the convention for lazybones."
  (loop for (k . value) in post-parameters
        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)
  (loop for app in (acceptor-apps acceptor)
        for (endpoint . args) = (lzb:find-endpoint app request)
        when endpoint
          return (lzb:run-endpoint endpoint args request h:*reply* app)
        ;; if no endpoint was found, call next method. 
        finally (call-next-method)))