;;;; endpoints.lisp -- http endpoints for dnd

(in-package :dnd)

(lzb:provision-app ()
 :title "Dungeons & Deadlines"
 :version "0.1.0"
 :content-type "text/html")

(defparameter +session-cookie-name+ "dnd-session")


;;; UTILITIES

(defun redirect-to (location)
  "Set the lazybones response header and response code for redirecting to LOCATION.
This procedure will error if lazybones:*request* is not currently bound."
  (setf (lzb:response-header :location) location
	(lzb:response-code) "303"))

(defun current-session ()
  "Get the session associated with the current request. Will throw an
error if lazybones:*request* is not currently bound. It will return
NIL if there is no session for the current request.

I.e. It should be called within the scope of a request handler."
  (session-with-id (lzb:request-cookie +session-cookie-name+ )))

(defun text-browser-p (user-agent)
  "Returns T if user agent string matches on a list of known text browsers."
  (some (lambda (s) (search s user-agent)) '("Emacs" "Lynx" "w3m")))

(defun page-render-mode (&optional user-agent)
  "Given the USER-AGENT string from request headers, returns a symbol which
indicates which render mode to use. For example if Emacs is the user-agent,
return :text-12mode."
  (let ((user-agent
          (or user-agent
              (lzb:request-header :user-agent))))
    (cond ((text-browser-p user-agent) :text-page)
          (t :page))))

(defmacro with-session ((player &key session (redirect "/tavern-door")) &body body)
  (let ((session (or session (gensym "SESSION"))))
    `(a:if-let (,session (current-session))
       (let ((,player (session-player ,session)))
         (declare (ignorable ,player))
       ,@body)
       (redirect-to ,redirect))))

(defmacro with-checked-plist (typed-keys plist &rest body)
  "Like WITH-PLIST, but allows you to pass a checking function to
automatically tansform plist values into something you actually
want. This is modelled after the way LAZYBONES allows for similar
functions in url parameters in endpoint definitions."
  (let* ((plist-var
           (gensym))
         (bindings
           (loop :for (var key . pred) :in typed-keys
                 :when pred
                   :collect `(,var (funcall ,(first pred) (getf ,plist-var ',key)))
                 :else
                   :collect `(,var (getf ,plist-var ',key)))))
    `(let ((,plist-var ,plist))
       (let ,bindings ,@body))))

;;; VALIDATOR TRANSFORMS

(defmacro define-id-plucker (class)
  (let ((function-name
          (intern (format nil "~a-~a-WITH-ID"
                          (if (starts-with-vowel-p (symbol-name class))
                              "AN" "A")
                          class)
                  :dnd)))
    `(defun ,function-name (id)
       (let ((object (object-with-uid (string-upcase id))))
         (unless (typep object ',class)
           (lzb:http-err 404))
         object))))

(define-id-plucker adventure)

(define-id-plucker hero)

(define-id-plucker quest)

(defun a-valid-nick (name)
  "Errors with 400 if the name is not a valid hero name."
  (unless (valid-nick-p name) 
    (lzb:http-err 400 (format nil "Player Nick Invalid")))
  name)

(defun a-short-string (str)
  (unless (and (stringp str) (< (length str) 50))
    (lzb:http-err 400 "The value must be a string at most 50 characters long."))
  str)


;;; OPEN ENDPOINTS

(defendpoint* :get "/" () ()
  (redirect-to "/tavern"))

(defendpoint* :get "/tavern-door" () ()
  "Tavern door is where the player logs into the system."
  (let ((doorkeeper
          (make-instance 'doorkeeper :message (or (flashed-value :tavern-door) ""))))
    (render (page-render-mode)
            doorkeeper)))

(defendpoint* :post "/tavern-door" () ()
  (with-plist ((nick :nickname)) (lzb:request-body)
    (a:if-let ((player
                (player-with-nick (string-trim " " nick))))
      (a:when-let ((sesh
                    (new-sesh player)))
	(lzb:set-response-cookie
         +session-cookie-name+ (session-id sesh)
	 :path "/" :domain "localhost")  ; TODO: generalize domain
	(redirect-to "/tavern"))
      (progn
        (flash :tavern-door nick)
        (redirect-to "/tavern-door"))))  )

(defendpoint* :get "/join" () ()
  (render (page-render-mode) :join))

(defendpoint* :post "/join" () ()
  "Registers a new player"
  (with-checked-plist ((nick :nickname 'a-valid-nick)) (lzb:request-body)
    (register-player nick)
    (redirect-to "/tavern-door")))

;;; SESSION ENDPOINTS

(defendpoint* :get "/tavern" () ()
  (with-session (me)
    (render (page-render-mode)
            (make-instance 'tavern :player me))))

(defendpoint* :get "/goddess-shrine" () ()
  (with-session (player)
    (render (page-render-mode) :goddess-shrine)))

(defendpoint* :post "/goddess-shrine" () ()
  (with-session (player)
    (with-checked-plist ((name :name 'a-short-string)) (lzb:request-body)
      (birth-from-the-goddess-loins player name)
      (redirect-to "/tavern"))))

(defendpoint* :get "/adventure-awaits" () ()
  (with-session (player)
    (render (page-render-mode)
            (make-instance 'adventure-awaits
                           :possible-seers (remove player (all-players))))))

(defendpoint* :post "/adventure-awaits" () ()
  (with-session (creator)
    (with-plist ((title :title) (description :description)) (lzb:request-body)
      (let ((possible-seers
              (loop :for (key val) :on (lzb:request-body) :by #'cddr
                    :when (string-equal key "POSSIBLE-SEER")
                      :collect (object-with-uid val))))
        (redirect-to
         (urlpath
          (create-adventure creator title
                            :description description
                            :seers possible-seers)))))))


(defendpoint* :get "/adventure/:adventure an-adventure-with-id:/:title:" () ()
  (with-session (player)
    (render (page-render-mode)
            (make-instance 'adventure-page
                           :player player
                           :adventure adventure)))) ;; for now, render raw adventure.

(defendpoint* :get "/hero/:hero a-hero-with-id:/:name:" () ()
  (with-session (player)
    (render (page-render-mode)
            (make-instance 'hero-page
                           :player player
                           :hero hero))))

(defendpoint* :get "/quest/:quest a-quest-with-id:/:name:" () ()
  (with-session (player)
    (render (page-render-mode)
            (make-instance 'quest-page
                           :player player
                           :hero quest))))