1 files changed, 41 insertions, 7 deletions

diff --git a/endpoints.lisp b/endpoints.lisp
index 6dde37e..e33a362 100644
--- a/endpoints.lisp
+++ b/endpoints.lisp
@@ -58,6 +58,36 @@ I.e. It should be called within the scope of a request handler."
        (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
 
 
@@ -84,14 +114,11 @@ I.e. It should be called within the scope of a request handler."
 (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)
+  "Registers a new player"
+  (with-checked-plist ((nick :nick 'a-valid-nick)) (lzb:request-body)
     (register-player nick)
     (redirect-to "/tavern-door")))
 
@@ -107,6 +134,13 @@ I.e. It should be called within the scope of a request handler."
 
 (defendpoint* :post "/godess-shrine" () ()
   (with-session (player)
-    (with-plist ((name :name)) (lzb:request-body)
+    (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 :details campaign))))))