summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--endpoints.lisp48
-rw-r--r--transactions.lisp4
-rw-r--r--utilities.lisp29
3 files changed, 74 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))))))
diff --git a/transactions.lisp b/transactions.lisp
index 35e817c..acfa8c2 100644
--- a/transactions.lisp
+++ b/transactions.lisp
@@ -16,3 +16,7 @@
(defun register-player (nick)
(db:with-transaction ()
(make-instance 'player :nick nick)))
+
+(defun create-campaign (player title)
+ (db:with-transaction ()
+ (make-instance 'campaign :title title :creator player)))
diff --git a/utilities.lisp b/utilities.lisp
index 7acdbca..fee21fe 100644
--- a/utilities.lisp
+++ b/utilities.lisp
@@ -37,3 +37,32 @@
(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)
+ "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
+ #\-
+ (str:split-omit-nulls
+ #\space
+ (substitute-if-not
+ #\space
+ (a:conjoin #'asciip #'alphanumericp)
+ (string-downcase string)))))