diff options
| -rw-r--r-- | endpoints.lisp | 48 | ||||
| -rw-r--r-- | transactions.lisp | 4 | ||||
| -rw-r--r-- | utilities.lisp | 29 |
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))))) |