;;;; player.lisp

(in-package :dnd)

;;; MODEL CLASSES 

(defclass has-uid ()
  ((nuid :reader uid
         :initform (nuid)
         :index-type idx:string-unique-index
         :index-reader object-with-uid))
  (:metaclass db:persistent-class))

(defclass player (db:store-object has-uid)
  ((nick
    :reader nickname
    :initarg :nickname
    :initform (error "Players must have a nick")
    :type string
    :index-type idx:string-unique-index
    :index-reader player-with-nick)
   (pwhash
    :accessor pwhash
    :type string
    :initarg :pwhash
    :documentation "A hash of the password, hashed with the value of the pwsalt slot.")
   (pwsalt
    :reader pwsalt
    :initform (nuid)
    :type string
    :documentation "Salt for this hero's password hash."))
  (:metaclass db:persistent-class))

(defclass session (db:store-object)
  ((player :reader session-player
         :initarg :player)
   (id :reader session-id
       :initform (nuid)
       :index-type idx:string-unique-index
       :index-reader session-with-id))
  (:metaclass db:persistent-class))

;;; HELPERS


(defmethod unique-name ((player player))
  (nickname player))


;;; QUERIES

(defun all-players ()
  (db:store-objects-with-class 'player))

(defun all-other-players (player)
  (remove-if (lambda (p) (eq player p)) (all-players)))

;;; TRANSACTIONS 

(defun new-sesh (player)
  (db:with-transaction () (make-instance 'session :player player)))

(defun destroy-sesh (session)
  (db:with-transaction () 
    (db:delete-object session)))

(defun register-player (nick)
  (db:with-transaction ()
    (make-instance 'player :nickname nick)))



;;; MODEL VIEWS

(defrender :details ((player player))
  (with-html
    (:div :class "player details"
          (:h3 "Welcome " (nickname player)))))

(defrender :option ((player player))
  (with-html
    (:option :value (uid player) (nickname player))))

(defrender :checkbox ((player player) (name "PLAYER"))
  (with-html
    (:input :type "checkbox" :id (uid player) :name name :value (uid player))
    (:label :for (uid player) (nickname player))))

(defrender :list-item ((player player))
  (with-html
    (nickname player)))

(defrender :link-to ((player player))
  (render :inline player))

(defrender :inline ((player player))
  (with-html (:a :href (urlpath player) (nickname player))))

;;; PAGES & PAGE CLASSES

(defclass/std doorkeeper ()
  ((message)))

;; the t specialization works for all render targets 
(defrender t ((page doorkeeper))
  (with-page (:title "Tavern Door")
    (:h1 (message page))
    (:form :method "POST" :action "/tavern-door"
	   (:label :for "NICKNAME" "Wut's yer handle?:")
	   (:input :name "NICKNAME") (:br)
	   (:button :type "submit" "Announce Thyself"))
    (:h2 "Eh? Ye need to register for admission?")
    (:a :href "/join" "Follow me...")))


(defrender t ((page (eql :join)))
  (with-page (:title "Register Player")
    (:header
     (:h1 "Choose a Player Nickname"))
    (:form :method "POST" :action "/join"
           (:label :for "NICKNAME"
                   "Choose a nickname using only letters, numbers, and -._ (no spaces)") (:br)
           (:input :name "NICKNAME" :placeholder "superbob")
           (:button :type "submit" "Register"))))


;;; ENDPOINT HELPERS

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

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


;;; ENDPOINT DEFINITIONS

(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 (host *config*))
	(redirect-to "/tavern"))
      (progn
        (flash :tavern-door (format nil "Hrmm... ~a you say? It ain't on the register." 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")))