Reorganized codebase

25 files changed, 846 insertions, 0 deletions

diff --git a/src/build.lisp b/src/build.lisp
new file mode 100644
index 0000000..8bb5ec5
--- /dev/null
+++ b/src/build.lisp
@@ -0,0 +1,16 @@
+(ql:quickload :dnd)
+
+(swank:swank-require 
+ '(SWANK-IO-PACKAGE::SWANK-INDENTATION
+   SWANK-IO-PACKAGE::SWANK-TRACE-DIALOG
+   SWANK-IO-PACKAGE::SWANK-PACKAGE-FU
+   SWANK-IO-PACKAGE::SWANK-PRESENTATIONS
+   SWANK-IO-PACKAGE::SWANK-MACROSTEP
+   SWANK-IO-PACKAGE::SWANK-FUZZY
+   SWANK-IO-PACKAGE::SWANK-FANCY-INSPECTOR
+   SWANK-IO-PACKAGE::SWANK-C-P-C
+   SWANK-IO-PACKAGE::SWANK-ARGLISTS
+   SWANK-IO-PACKAGE::SWANK-REPL))
+
+(ensure-directories-exist #P"./bin/")
+(sb-ext:save-lisp-and-die "./bin/dnd" :toplevel #'dnd:boot :executable t)
diff --git a/src/dnd.lisp b/src/dnd.lisp
new file mode 100644
index 0000000..ae5ae86
--- /dev/null
+++ b/src/dnd.lisp
@@ -0,0 +1,17 @@
+;;;; dnd.lisp
+
+(in-package #:dnd)
+
+(defvar *dnd-arena* nil
+  "The instance of the HTTP server")
+
+(defun start ()
+  (init-db)
+  (setf *dnd-arena* (lzb:create-server))
+  (lzb:install-app *dnd-arena* (lzb:app 'dnd))
+  (lzb:start-server *dnd-arena*))
+
+(defun boot ()
+  (swank:create-server :port 9876 :dont-close t)
+  (conjure-arena)
+  (loop (sleep 1)))
diff --git a/src/endpoints.lisp b/src/endpoints.lisp
new file mode 100644
index 0000000..e33682b
--- /dev/null
+++ b/src/endpoints.lisp
@@ -0,0 +1,139 @@
+;;;; 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
+
+(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 "/godess-shrine" () ()
+  (with-session (player)
+    (render (page-render-mode) :goddess-shrine)))
+
+(defendpoint* :post "/godess-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* :post "/new-campaign" () ()
+  (with-session (creator)
+    (with-checked-plist ((title :title 'a-short-string)) (lzb:request-body)
+      (let ((campaign
+              (create-campaign creator title)))
+        (redirect-to (urlpath campaign))))))
+
diff --git a/src/flash.lisp b/src/flash.lisp
new file mode 100644
index 0000000..b655fa0
--- /dev/null
+++ b/src/flash.lisp
@@ -0,0 +1,71 @@
+;;;; flash.lisp -- communicating between page loads
+
+(in-package :dnd)
+
+(defvar *flashes*
+  (make-hash-table :test #'equal :synchronized t))
+(defvar *flash-lock*
+  (bt:make-lock "flash lock"))
+
+(defparameter +flash-cookie-name+ "DNDFLASHKEY")
+(defparameter +flash-value-lifetime+ 10
+  "Number of seconds a flashed value lives.")
+
+(defstruct flash-entry
+  "TABLE is a PLIST"
+  (timestamp (get-universal-time))
+  (table nil))
+
+(defun flash-entry-alive-p (entry)
+  "Returns T if ENTRY has not expired."
+  (<= (get-universal-time)
+      (+ (flash-entry-timestamp entry) +flash-value-lifetime+)))
+
+(defun flash (label value)
+  "A flash is a one-time inter-request value. Once stored, it can only
+be retrieved once. And if not retrieved in a short period of time, it
+expires."
+  (check-type label keyword)
+  (let* ((key
+           (or (lzb:request-cookie +flash-cookie-name+) (nuid)))
+         (now
+           (get-universal-time)))
+    ;; holding a lock here b/c I do stuff in between getting an entry
+    ;; and writing to it.
+    (bt:with-lock-held (*flash-lock*)
+      (let ((entry
+              (or (gethash key *flashes*)
+                  (make-flash-entry))))
+        ;; update the entry
+        (setf (flash-entry-timestamp entry) now
+              (getf (flash-entry-table entry) label) value
+              (gethash key *flashes*) entry)))
+    ;; set the cookie, updating its expiration if necessary 
+    (lzb:set-response-cookie
+     +flash-cookie-name+ key
+     ;; TODO: generalize domain
+     :path "/" :domain "localhost" 
+     :expires (+ +flash-value-lifetime+ now))))
+
+
+(defun flashed-value (label)
+  "Retrieves and deletes the flashed value with label LABEL associated
+with this request. If the value exists, return it. Otherwise return
+NIL."
+  (bt:with-lock-held (*flash-lock*) 
+    (a:when-let* ((key (lzb:request-cookie +flash-cookie-name+))
+                  (entry (gethash key *flashes*)))
+      (cond
+        ((flash-entry-alive-p entry)
+         (let ((val (getf (flash-entry-table entry) label)))
+           ;; can only retrieve once
+           (remf (flash-entry-table entry) label)
+           ;; might as well delete the entry if its table is empty.
+           (when (null (flash-entry-table entry))
+             (remhash key *flashes*))
+           val))
+        (t
+         ;; drop expired entries and return nil
+         (remhash key *flashes*)
+         nil)))))
+
diff --git a/src/init.lisp b/src/init.lisp
new file mode 100644
index 0000000..68b2a16
--- /dev/null
+++ b/src/init.lisp
@@ -0,0 +1,12 @@
+;;;; init.lisp
+
+(in-package #:dnd)
+
+(defun init-db (&optional config)
+  (unless (boundp 'db:*store*)
+    (unless config
+        nil                             ; TODO: handle the case where we have a config
+        (make-instance
+         'db:mp-store
+         :directory (merge-pathnames "dnd-store/" (user-homedir-pathname))
+         :subsystems (list (make-instance 'db:store-object-subsystem))))))
diff --git a/src/model.lisp b/src/model.lisp
new file mode 100644
index 0000000..49cd03a
--- /dev/null
+++ b/src/model.lisp
@@ -0,0 +1,228 @@
+;;;; model.lisp -- bknr.datastore class definitions for dnd
+
+(in-package :dnd)
+
+(deftype title ()
+  `(member :noob))
+
+(deftype character-class ()
+  `(member :hero))
+
+(deftype priority ()
+  `(member :low :medium :high))
+
+(defun hero-class (h)
+  "barGaryan")                          ; TODO: real implementation
+
+(defun hero-title (h)
+  "Scouse Chef")                        ; TODO: real implementation
+
+(defun renown (hero)
+  (experience hero))                    ; TODO: real implementaiton
+
+
+;;; PERSISTENT MIXINS
+(defclass has-uid ()
+  ((nuid :reader uid
+         :initform (nuid)
+         :index-type idx:string-unique-index
+         :index-reader object-with-uid))
+  (:metaclass db:persistent-class))
+
+(defclass can-equip ()
+  ((equipment-table
+    :initform nil
+    :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+
+    :initarg :slot-names
+    :type (list keyword)
+    :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))
+  (:metaclass db:persistent-class)
+  (:documentation "A chronicle is a general purpose log of events."))
+
+(defparameter +standard-humanoid-equipment+
+  '(:head :neck :torso :waist :legs :feet :arms :left-fingers :right-fingers
+    :left-holding :right-holding :cloak)
+  "The equipment slots for standard humanoids")
+
+;;; ABSTRACT CLASSES
+(defclass game-object (db:store-object has-uid has-chronicle)
+  ()
+  (:metaclass db:persistent-class))
+
+;;; SYSTEM CLASSES
+
+(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))
+
+
+;; TODO expiration?
+(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))
+
+;;; GAME CLASSES
+
+(defclass hero (game-object has-bag can-equip)
+  ((name
+    :accessor name
+    :initarg :name
+    :initform (error "Heroes must be named")
+    :type string
+    :index-type idx:string-unique-index
+    :index-reader hero-known-as)
+   (player
+    :reader player
+    :initarg :player
+    :type player
+    :index-type idx:hash-index
+    :index-reader player-heroes)
+   (quest
+    :accessor quest
+    :initarg :quest
+    :initform nil
+    :type (or nil quest)
+    :documentation "The quest that this hero is on. A hero may be on only one quest at a time."))
+  (:metaclass db:persistent-class))
+
+
+(defmethod campaign ((hero hero))
+  (a:when-let (quest (quest hero))
+    (campaign quest)))
+
+(defclass campaign (game-object)
+  ((creator
+    :reader creator
+    :initarg :creator
+    :initform (error "campaigns must have a creator")
+    :type player
+    :documentation "The player instance of the user who made this campaign.")
+   (seers
+    :accessor seers
+    :initarg :seers
+    :initform nil
+    :type (or nil (cons player))
+    :documentation "Seers are the people who peer out into their instruments of divination that heroes may go on quests.")
+   (title
+    :accessor title
+    :initarg :title
+    :initform (error "A campaign needs a title")
+    :type string)
+   (rumors
+    :accessor rumors
+    :initform nil
+    :type (or nil (cons rumor))
+    :documentation "Beasts, Monsters, and Hazards rumored to be lurking about."))
+  (:metaclass db:persistent-class)
+  (:documentation "A campaign is a container of quests. Campaigns are expected to be engaged with on a particular schedule, and are run by particular people."))
+
+(defclass rumor (db:store-object)
+  ((reporter
+    :reader reporter
+    :initarg :reporter
+    :type player
+    :documentation "The player who hast reported the vile rumor.")
+   (reported
+    :accessor reported 
+    :initform (error "A rumor must contain some reported matter")
+    :initarg :reported
+    :type string
+    :documentation "A description of the supposed peril that awaits heroes in a particular campaign."))
+  (:metaclass db:persistent-class)
+  (:documentation "Transcript of a rumor reported by some player related to a Campaign."))
+
+(defclass quest (game-object)
+  ((campaign
+    :reader campaign
+    :initarg :campaign
+    :initform (error "No quest can fall outside the scope of a campaign.")
+    :type campaign
+    :index-type idx:hash-index 
+    :index-reader quests-in-campaign
+    :documentation "The campaign to which this quest belongs")
+   (name
+    :accessor name
+    :initarg :name
+    :type string
+    :initform (format nil "~a" (gensym "QUEST")))
+   (horizon-of-hope
+    :accessor horizon-of-hope
+    :initarg :deadline
+    :type integer
+    :initform nil
+    :documentation "When all hope becomes lost.")
+   (inception
+    :accessor quest-inception
+    :initform nil
+    :type (or nil integer)
+    :documentation "Time at which the quest began."))
+  (:metaclass db:persistent-class)
+  (:documentation "A collection of hazards with a deadline and start date which heroes will attack."))
+
+(defclass hazard (game-object)
+  ((quest
+    :accessor quest-of
+    :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.")
+   (description
+    :accessor description
+    :initarg :description
+    :initform ""
+    :type string
+    :documentation "")
+   (overcomep
+    :accessor is-overcome
+    :initform nil
+    :documentation "indicates whether or not this hazard has been overcome.")
+   (imminence
+    :accessor imminence-of
+    :type priority
+    :documentation "")
+   (menace ;; difficulty
+    :accessor menace-of
+    :type integer
+    :documentation "How dangerous the hazard is." ))
+  (:metaclass db:persistent-class)
+  (:documentation "Hazard is a superclass for all hazards encountered in a quest.  It's chronicle includes data about which heroes fought and which overcame."))
+
+
+
+
+
diff --git a/src/names.lisp b/src/names.lisp
new file mode 100644
index 0000000..8cc64af
--- /dev/null
+++ b/src/names.lisp
@@ -0,0 +1,25 @@
+;;;; names.lisp -- a protocol for getting the names of things, and
+;;;; generally referring to objects with strings.
+
+(in-package :dnd)
+
+(defgeneric unique-name (object)
+  (:documentation "Returns a unique name for an object, or NIL if it does not have one.")
+  (:method ((ob t)) nil))
+
+(defmethod unique-name ((campaign campaign))
+  (campaign-title campaign))
+
+(defmethod unique-name ((hero hero))
+  (hero-name hero))
+
+(defgeneric urlpath (object)
+  (:documentation "Return the path to the object given a particular")
+  (:method ((object has-uid))
+    "If the object has a unique human readable name, urlify that name and
+incorporate it into the urlpath. Otherwise use the object's uid.  
+
+Returns /inflection/class/identifier."
+    (format nil "/~a/~a"
+            (urlify (class-name (class-of object)))
+            (urlify (or (unique-name object) (uid object))))))
diff --git a/src/package.lisp b/src/package.lisp
new file mode 100644
index 0000000..20a16d0
--- /dev/null
+++ b/src/package.lisp
@@ -0,0 +1,24 @@
+;;;; package.lisp
+
+(defpackage #:dnd
+  (:use #:cl)
+  (:local-nicknames (#:db #:bknr.datastore)
+                    (#:idx #:bknr.indices)
+                    (#:lzb #:lazybones)
+                    (#:re #:cl-ppcre)
+                    (#:json #:jonathan)
+		    (#:a #:alexandria-2))
+  (:import-from #:testiere
+                #:defun/t)
+  (:import-from #:lazybones
+                #:defendpoint*)
+  (:import-from #:derrida
+                #:with-plist)
+  (:import-from #:spinneret
+		#:with-html
+		#:with-html-string)
+  (:import-from #:defclass-std
+                #:defclass/std)
+  (:export :boot))
+
+
diff --git a/src/pages.lisp b/src/pages.lisp
new file mode 100644
index 0000000..e7e5673
--- /dev/null
+++ b/src/pages.lisp
@@ -0,0 +1,17 @@
+;;;; pages.lisp -- html generation functions for dnd
+
+(in-package :dnd)
+
+
+;;; PAGES
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/pages/doorkeeper.lisp b/src/pages/doorkeeper.lisp
new file mode 100644
index 0000000..560637d
--- /dev/null
+++ b/src/pages/doorkeeper.lisp
@@ -0,0 +1,19 @@
+;;;; pages/doorkeeper.lisp -- announce yourself and enter the hero's tavern
+
+(in-package :dnd)
+
+;;; DOORKEEPER CLASS
+(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")
+	   (:button :type "submit" "Announce Thyself"))
+    (:h2 "Eh? Ye need to announce thyeself?")
+    (:a :href "/join" "Follow me...")))
+
diff --git a/src/pages/goddess-shrine.lisp b/src/pages/goddess-shrine.lisp
new file mode 100644
index 0000000..3b25e5a
--- /dev/null
+++ b/src/pages/goddess-shrine.lisp
@@ -0,0 +1,13 @@
+;;;; pages/goddess-shrine.lisp
+
+(in-package :dnd)
+
+(defrender t ((page (eql :goddess-shrine))) 
+  (with-page (:title "A Sacred Shrine")
+    (:header
+     (:h1 "Pray and become a hero..."))
+    (:form :method "POST" :action "/godess-shrine"
+	   (:label :for "NAME" "Enter the epithet by which the ages shall know thy hero:")
+	   (:input :name "NAME")
+	   (:button :type "submit" "Pray To The Goddess"))))
+
diff --git a/src/pages/join-gaming-group.lisp b/src/pages/join-gaming-group.lisp
new file mode 100644
index 0000000..e758ec7
--- /dev/null
+++ b/src/pages/join-gaming-group.lisp
@@ -0,0 +1,13 @@
+;;;; pages/join-gaming-group.lisp
+
+(in-package :dnd)
+
+(defrender t ((page (eql :join-gaming-group)))
+  (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"))))
+
diff --git a/src/pages/join.lisp b/src/pages/join.lisp
new file mode 100644
index 0000000..b48d102
--- /dev/null
+++ b/src/pages/join.lisp
@@ -0,0 +1,13 @@
+;;;; pages/join-gaming-group.lisp
+
+(in-package :dnd)
+
+(defrender t ((page (eql :join)))
+  (with-page (:title "Register Player")
+    (:header
+     (:h1 "Choose a Nickname Player"))
+    (:form :method "POST" :action "/join"
+           (:label  :for "NICKNAME" "Choose a nickname. No spaces. Letters, Numbers, and -._")
+           (:input :name "NICKNAME" :placeholder "superbob")
+           (:button :type "submit" "Register"))))
+
diff --git a/src/pages/tavern.lisp b/src/pages/tavern.lisp
new file mode 100644
index 0000000..79b0e58
--- /dev/null
+++ b/src/pages/tavern.lisp
@@ -0,0 +1,20 @@
+;;;; pages/tavern.lisp -- enter the tavern 
+
+(in-package :dnd)
+
+(defclass/std tavern ()
+  ((player)))
+
+(defrender t ((tavern tavern))
+  (let ((player (player tavern)))
+    (with-html
+      (render :details player)
+      (render :list (player-heroes player))
+      (:a :href "/spymaster" "Report a Roguish Rumour...")
+      ;; (:table
+      ;;  (:tr (:td (:h4 "Your Heroes"))
+      ;; 	    (:td (:h4 "Your Campaigns")))
+      ;;  (:tr (:td (:h4 "Gossip & Gab"))
+      ;; 	    (:td (:h4 "Comrades in Arms"))))
+
+      )))
diff --git a/src/queries.lisp b/src/queries.lisp
new file mode 100644
index 0000000..c657979
--- /dev/null
+++ b/src/queries.lisp
@@ -0,0 +1,34 @@
+;;;; queries.lisp -- query the database
+
+(in-package :dnd)
+
+(defun all-heroes ()
+  (db:store-objects-with-class 'hero))
+
+(defun player-quests (player)
+  "Return all quests in which one of player's heroes is engaged."
+  (remove nil (mapcar #'quest (player-heroes player))))
+
+(defun player-campaigns (player)
+  "Return a list of campaigns one of the players' heroes is involved in."
+  (mapcar #'campaign (player-quests player) ))
+
+(defun campaign-heroes (campaign)
+  ""
+  )
+
+(defun campaign-heros (campaign &key (activep t))
+  "All the heros actively involved in this CAMPAIGN. If ACTIVEP, then
+only the active quest(s) are considered, otherwise all quests are considered."
+  (remove-duplicates
+   (mapcan #'heroes-on-quest
+           (if activep
+               (remove-if-not #'quest-startedp (quests-in-campaign campaign))
+               (quests-in-campaign campaign)))))
+
+(defun fetch-comrades (player &key (activep t))
+  "Returns all the heroes in any one of the player's campaigns. If
+ACTIVEP, then only heroes involved in active quests are returned."
+  (remove-duplicates
+   (loop :for campaign :in (player-campaigns player)
+         :nconc (campaign-heros campaign :activep activep))))
diff --git a/src/render.lisp b/src/render.lisp
new file mode 100644
index 0000000..140e1ec
--- /dev/null
+++ b/src/render.lisp
@@ -0,0 +1,23 @@
+;;;; render.lisp -- render protocol and tools
+
+(in-package :dnd)
+
+(defgeneric render (view object &key)
+  (:documentation "Render OBJECT as VIEW. VIEW could be anything, but it is intended to
+be a keyword for usin in EQL method specializers."))
+
+(defmacro defrender (view (spec &rest kwargs) &body body)
+  "A helper macro for defining specializations of render."
+  (let ((viewvar (gensym)))
+    `(defmethod render  ((,viewvar ,(if (eq t view) t `(eql ,view))) ,spec &key ,@kwargs)
+       ,@body)))
+
+(defmacro with-page ((&key title) &body body)
+  "A helper macro fordefining some standard page boilerplate."
+  `(with-html-string
+     (:doctype)
+     (:html
+      (:head
+       (:title ,title))
+      (:body
+       ,@body))))
diff --git a/src/transactions.lisp b/src/transactions.lisp
new file mode 100644
index 0000000..ad9c9e8
--- /dev/null
+++ b/src/transactions.lisp
@@ -0,0 +1,22 @@
+;;;; transactions.lisp -- data store transactions for dnd
+
+(in-package :dnd)
+
+(defun birth-from-the-goddess-loins (player name)
+  (db:with-transaction ()
+    (make-instance 'hero :name name :player player)))
+
+(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)))
+
+(defun create-campaign (player title)
+  (db:with-transaction ()
+    (make-instance 'campaign :title title :creator player)))
diff --git a/src/utilities.lisp b/src/utilities.lisp
new file mode 100644
index 0000000..1e16931
--- /dev/null
+++ b/src/utilities.lisp
@@ -0,0 +1,68 @@
+;;;; utilities -- nuff said
+
+(in-package :dnd)
+
+
+(let ((host (uiop:hostname))
+      (count 0))
+  (defun nuid ()
+    "Generates a Nearly Universal ID"
+    (format nil "~36r"
+            (sxhash
+             (list
+              (incf count)
+              host
+              (get-universal-time))))))
+
+(defun hash-string (plaintext salt)
+  "Hash plaintext using SALT"
+  (flexi-streams:octets-to-string 
+   (ironclad:digest-sequence
+    :sha3
+    (flexi-streams:string-to-octets (concatenate 'string salt plaintext)
+                                    :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))
+    (loop :for char :across nick
+          :always (find char +user-nick-chars+
+                        :test #'char-equal))))
+
+(defun/t asciip (thing)
+  "T if THING is an ASCII character, NIL otherwise."
+  :tests
+  (eql (#\x) t)
+  (eql (#\ö) nil)
+  (eql (#\nul) t)
+  (eql (#\return) t)
+  (eql (nil) nil)
+  (eql ("foo") nil)
+  :end
+  (and (characterp thing)
+       (<= 0 (char-code thing) 127)))
+
+(defun/t urlify (string &optional (sub #\-))
+  "Canonical transformation for strings that makes them appropriate for urls."
+  :tests
+  (equal ("THIS IS COOL") "this-is-cool")
+  (equal ("This      is cool") "this-is-cool")
+  (equal ("Mc'this is κoöl   ") "mc-this-is-o-l")
+  :end
+  (str:join
+   sub
+   (str:split-omit-nulls
+    #\space
+    (substitute-if-not
+     #\space
+     (a:conjoin #'asciip #'alphanumericp)
+     (string-downcase string)))))
diff --git a/src/views/campaign.lisp b/src/views/campaign.lisp
new file mode 100644
index 0000000..5e1498a
--- /dev/null
+++ b/src/views/campaign.lisp
@@ -0,0 +1,8 @@
+;;;; views/campaign.lisp -- views of for campaign instances
+
+(in-package :dnd)
+
+
+(defrender :inline ((campaign campaign))
+  (with-html
+      (:a :href (urlpath campaign) (title campaign))))
diff --git a/src/views/components.lisp b/src/views/components.lisp
new file mode 100644
index 0000000..95ed062
--- /dev/null
+++ b/src/views/components.lisp
@@ -0,0 +1,33 @@
+;;;; views/components.lisp -- reusable components
+
+(in-package :dnd)
+
+;;; LIST DATA 
+
+(defrender :list ((data list) (class "listview") (item-class "listitem"))
+  "A catch all for rendering lists of renderable data items as unordered
+lists. CLASS is the lass string for the containing list. ITEM-CLASS is
+the class string for the contained list items."
+  (with-html
+    (:ol :class class
+         (dolist (item data)
+           (:li :class item-class (render :list-item item))))))
+
+(defrender :horiz-list ((data list) (class "hlistview") (item-class "listitem"))
+  (with-html
+    (:ol :class class
+         (dolist (item data)
+           (:li :calss item-class (render :list-item item))))))
+
+;;;; PAGE ELEMENTS
+
+(defun navbar ()
+  (with-html
+      (:nav :class "navbar" :aria-label "Navigation"
+	    (:div :class "logo" :aria-label "DND logo" "DND")
+	    (:ul :class "nav-links" :aria-label "Nav links"
+	         (:li (:a :href "/hero" :aria-label "Hero profile" "🧝"))
+	         (:li (:a :href "/inventory" :aria-label "Inventory" "🎒"))
+	         (:li (:a :href "/quests" :aria-label "Quests" "📜"))
+	         (:li (:a :href "/tavern" :aria-label "Tavern" "🍺"))))))
+
diff --git a/src/views/hazard.lisp b/src/views/hazard.lisp
new file mode 100644
index 0000000..a842c6f
--- /dev/null
+++ b/src/views/hazard.lisp
@@ -0,0 +1,4 @@
+;;;; hazard.lisp -- views of hazard insances
+
+(in-package :dnd)
+
diff --git a/src/views/hero.lisp b/src/views/hero.lisp
new file mode 100644
index 0000000..7387901
--- /dev/null
+++ b/src/views/hero.lisp
@@ -0,0 +1,11 @@
+;;;; views/hero.lisp 
+
+(in-package :dnd)
+
+(defrender :list-item ((hero hero))
+  (with-html
+    (with-slots ((name campaign) hero)
+	(:p name "the" (hero-class hero) (hero-title hero)
+            (when campaign
+              (:span  "who is off in the campaign")
+              (:span (render :inline campaign)))))))
diff --git a/src/views/player.lisp b/src/views/player.lisp
new file mode 100644
index 0000000..087848e
--- /dev/null
+++ b/src/views/player.lisp
@@ -0,0 +1,8 @@
+;;;; views/player.lisp
+
+(in-package :dnd)
+
+(defrender :details ((player player))
+  (with-html
+    (:div :class "player details"
+          (:h3 "Welcome " (nickname player)))))
diff --git a/src/views/quest.lisp b/src/views/quest.lisp
new file mode 100644
index 0000000..0312dba
--- /dev/null
+++ b/src/views/quest.lisp
@@ -0,0 +1,4 @@
+;;;; views/quest.lisp
+
+(in-package :dnd)
+
diff --git a/src/views/rumor.lisp b/src/views/rumor.lisp
new file mode 100644
index 0000000..90f56ae
--- /dev/null
+++ b/src/views/rumor.lisp
@@ -0,0 +1,4 @@
+;;;; views/rumor.lisp
+
+(in-package :dnd)
+