diff options
| -rw-r--r-- | dnd.asd | 4 | ||||
| -rw-r--r-- | endpoints.lisp | 38 | ||||
| -rw-r--r-- | model.lisp | 59 | ||||
| -rw-r--r-- | package.lisp | 2 | ||||
| -rw-r--r-- | pages.lisp | 22 | ||||
| -rw-r--r-- | queries.lisp | 7 | ||||
| -rw-r--r-- | transactions.lisp | 11 | ||||
| -rw-r--r-- | utilities.lisp | 12 |
8 files changed, 115 insertions, 40 deletions
@@ -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))) @@ -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 @@ -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)))) |