Saturday Pair Session

8 files changed, 115 insertions, 40 deletions

diff --git a/dnd.asd b/dnd.asd
index a0bb68a..90dacf9 100644
--- a/dnd.asd
+++ b/dnd.asd
@@ -19,7 +19,8 @@
                #:ironclad
                #:jonathan
 	       #:quri
-               #:bordeaux-threads)
+               #:bordeaux-threads
+               #:testiere)
   :components ((:file "package")
                (:file "utilities")
                (:file "init")
@@ -27,5 +28,6 @@
                (:file "flash")
                (:file "endpoints")
                (:file "pages")
+               (:file "queries")
 	       (:file "transactions")
                (:file "dnd")))
diff --git a/endpoints.lisp b/endpoints.lisp
index 87fc51e..c9a8612 100644
--- a/endpoints.lisp
+++ b/endpoints.lisp
@@ -25,38 +25,54 @@ 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+ )))
 
-(defmacro with-hero-session ((hero &key session (redirect "/tavern-door")) &body body)
+(defmacro with-session ((player &key session (redirect "/game-room")) &body body)
   (let ((session (or session (gensym "SESSION"))))
     `(a:if-let (,session (current-session))
-       (let ((,hero (session-hero ,session)))
+       (let ((,player (session-player ,session)))
          ,@body)
        (redirect-to ,redirect))))
 
 
 ;;; OPEN ENDPOINTS
 
+
 (defendpoint* :get "/" () ()
   (redirect-to "/tavern-door"))
 
 (defendpoint* :get "/tavern-door" () ()
-  (a:if-let (name (flashed-value :tavern-door))
-    (doorkeeper :message (format nil "M'fraid I've n'er 'eard o' ~a." name))
+  (a:if-let (name (flashed-value :game-room))
+    (doorkeeper :message (format nil "Ne'er 'erd of ye ~a" name))
     (doorkeeper)))
 
 (defendpoint* :post "/tavern-door" () ()
-  (with-plist ((name :name)) (lzb:request-body)
-    (a:if-let ((hero (hero-known-as name)))
-      (a:when-let ((sesh (new-sesh hero)))
+  (with-plist ((nick :nick)) (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 name)
-        (redirect-to (format nil "/tavern-door"))))))
+        (flash :game-room nick)
+        (redirect-to "/tavern-door"))))  )
+
+(defendpoint* :get "/register" () ()
+  (register))
+
+(defun check-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"))))
+
+(defendpoint* :post "/register" () ()
+  (with-plist ((nick :nick)) (lzb:request-body)
+    (check-valid-nick nick)
+    (register-player nick)
+    (redirect-to "/tavern-door")))
 
 (defendpoint* :get "/godess-shrine" () ()
   (godess-shrine))
 
+
 (defendpoint* :post "/godess-shrine" () ()
   (with-plist ((name :name)) (lzb:request-body)
     (birth-from-the-goddess-loins name)
@@ -65,5 +81,5 @@ I.e. It should be called within the scope of a request handler."
 ;;; SESSION ENDPOINTS
 
 (defendpoint* :get "/tavern" () ()
-  (with-hero-session (hero)
-    (tavern hero)))
+  (with-session (player)
+    (tavern player)))
diff --git a/model.lisp b/model.lisp
index 9bcaadb..e4c8943 100644
--- a/model.lisp
+++ b/model.lisp
@@ -31,7 +31,7 @@
 (defclass can-equip ()
   ((equipment-table
     :initform nil
-    :type cons
+    :type list
     :documentation "A PLIST mapping 'equipment slots' to instances of LOOT. Equipment slots are things like :head, :torso, :left-ring, etc")
    (equipment-slot-names
     :initform +standard-humanoid-equipment+
@@ -40,6 +40,13 @@
     :documentation "The list of slots available to this entity."))
   (:metaclass db:persistent-class))
 
+(defclass has-bag ()
+  ((bag
+    :reader bag
+    :initform nil
+    :type list
+    :documentation "A list of items that this entity is carrying."))
+  (:metaclass db:persistent-class))
 
 (defclass has-chronicle ()
   ((chronicle :accessor chronicle :initform nil))
@@ -56,19 +63,14 @@
   ()
   (:metaclass db:persistent-class))
 
-;; a user
-(defclass hero (game-object can-equip)
-  ((name
-    :accessor hero-name
-    :initarg :name
-    :initform (error "Heroes must be named")
+(defclass player (db:store-object has-uid)
+  ((nick
+    :reader user-nick
+    :initarg :nick
+    :initform (error "Players must have a nick")
     :type string
     :index-type idx:string-unique-index
-    :index-reader hero-known-as)
-   (experience
-    :accessor experience
-    :initform 0
-    :type integer)
+    :index-reader player-with-nick)
    (pwhash
     :accessor pwhash
     :type string
@@ -81,13 +83,34 @@
     :documentation "Salt for this hero's password hash."))
   (:metaclass db:persistent-class))
 
-(defun all-heroes ()
-  (db:store-objects-with-class 'hero))
+;; a user
+(defclass hero (game-object has-bag can-equip)
+  ((name
+    :accessor hero-name
+    :initarg :name
+    :initform (error "Heroes must be named")
+    :type string
+    :index-type idx:string-unique-index
+    :index-reader hero-known-as)
+   (player
+    :reader hero-player
+    :initarg :player
+    :type player
+    :index-type idx:hash-index
+    :index-reader player-heroes
+    )
+   (campaign
+    :accessor hero-campaign
+    :initarg :campaign
+    :initform nil
+    :type campaign
+    :documentation "A hero may be in at mostk one campaign at a time."))
+  (:metaclass db:persistent-class))
 
 ;; TODO expiration?
 (defclass session (db:store-object)
-  ((hero :reader session-hero
-         :initarg :hero)
+  ((player :reader session-player
+         :initarg :player)
    (id :reader session-id
        :initform (nuid)
        :index-type idx:string-unique-index
@@ -121,7 +144,7 @@
     :reader quest-campaign
     :initarg :campaign
     :initform (error "No quest can fall outside the scope of a campaign.")
-    :index-type idx:hash-list-index
+    :index-type idx:hash-index 
     :index-reader quests-in-campaign
     :documentation "The campaign to which this quest belongs")
    (name
@@ -148,7 +171,7 @@
 (defclass hazard (game-object)
   ((quest
     :accessor quest-of
-    :index-type idx:hash-list-index
+    :index-type idx:hash-index
     :index-reader hazards-in-quest
     :documentation "The quest to which this hazard belongs. Initially it is unbound. It becomes boudn when the hazard is added to a quest.")
    (overcomep
diff --git a/package.lisp b/package.lisp
index 582e854..8cc0a0b 100644
--- a/package.lisp
+++ b/package.lisp
@@ -8,6 +8,8 @@
                     (#:re #:cl-ppcre)
                     (#:json #:jonathan)
 		    (#:a #:alexandria-2))
+  (:import-from #:testiere
+                #:defun/t)
   (:import-from #:lazybones
                 #:defendpoint*)
   (:import-from #:derrida
diff --git a/pages.lisp b/pages.lisp
index fb4026b..c435e8f 100644
--- a/pages.lisp
+++ b/pages.lisp
@@ -19,20 +19,28 @@
 	   (:input :name "NAME")
 	   (:button :type "submit" "Pray To The Goddess"))))
 
-(defun doorkeeper (&key (message "Wot's yer name 'ero?"))
+(defun doorkeeper (&key (message "Come ye player, Wot's yer name?"))
   (with-page (:title "Tavern Door")
     (:h1 message)
     (:form :method "POST" :action "/tavern-door"
-	   (:label :for "NAME" "Thy Hero's Appelation:")
-	   (:input :name "NAME")
+	   (:label :for "NICK" "Wut's yer handle?:")
+	   (:input :name "NICK")
 	   (:button :type "submit" "Announce Thyself"))
-    (:h2 "Eh? Ye need to birth a new hero?")
-    (:a :href "/godess-shrine" "Follow me...")))
+    (:h2 "Eh? Ye need to announce thyeself?")
+    (:a :href "/register" "Follow me...")))
+
+(defun register ()
+  (with-page (:title "Register Player")
+    (:header
+     (:h1 "Choose a Nickname Player"))
+    (:form :method "POST" :action "/register"
+           (:label  :for "NICK" "Choose a nickname. No spaces. Letters, Numbers, and -._")
+           (:input :name "NICK" :placeholder "superbob")
+           (:button :type "submit" "Register"))))
 
-(defun tavern (hero)
+(defun tavern (player)
   (with-page (:title "A Bustling Tavern")
     (navbar)
-    (:h1 "Aye! Welcome " (hero-name hero))
     (:div
      :class "heroes-container"
      (:h2 "Heroes of rampant renown:")
diff --git a/queries.lisp b/queries.lisp
new file mode 100644
index 0000000..329ecb2
--- /dev/null
+++ b/queries.lisp
@@ -0,0 +1,7 @@
+;;;; queries.lisp -- query the database
+
+(in-package :dnd)
+
+(defun all-heroes ()
+  (db:store-objects-with-class 'hero))
+
diff --git a/transactions.lisp b/transactions.lisp
index 6a50fc1..2c65434 100644
--- a/transactions.lisp
+++ b/transactions.lisp
@@ -6,8 +6,13 @@
   (db:with-transaction ()
     (make-instance 'hero :name name)))
 
-(defun new-sesh (hero)
-  (db:with-transaction () (make-instance 'session :hero hero)))
+(defun new-sesh (player)
+  (db:with-transaction () (make-instance 'session :player player)))
 
 (defun destroy-sesh (session)
-  (db:delete-object session))
+  (db:with-transaction () 
+    (db:delete-object session)))
+
+(defun register-player (nick)
+  (db:with-transaction ()
+    (make-instance 'player :nick nick)))
diff --git a/utilities.lisp b/utilities.lisp
index b6cf16a..5644f2e 100644
--- a/utilities.lisp
+++ b/utilities.lisp
@@ -23,3 +23,15 @@
                                     :external-format :utf-8))
    :external-format :latin1))
 
+(defparameter +user-nick-chars+ "0123456789abcdefghijklmnopqrstuvwxyz-._")
+
+(defun/t valid-nick-p (nick)
+  :tests
+  (eql ("??????") nil)
+  (eql ("⚔") nil)
+  (eql ("cool_beans") t)
+  (eql ("COOOL_BEANS") t)
+  (eql ("COOL beans") nil)
+  :end 
+  (unless (zerop (length nick))
+    (every (lambda (char) (find char +user-nick-chars+)) (string-downcase nick))))