diff options
author | Grant Shangreaux <grant@unabridgedsoftware.com> | 2024-06-19 12:01:29 -0500 |
---|---|---|
committer | Grant Shangreaux <grant@unabridgedsoftware.com> | 2024-06-19 12:01:29 -0500 |
commit | 5a586d369c823a040989283a3650444a2b0c0913 (patch) | |
tree | a617035409c3c076c10bcd1449cf5ad70ef8127a /site | |
parent | 132bb57d594894f7c9bdfea23e17971028acaedf (diff) |
[87] Add: invite creation, listing, and deletion when used up
Diffstat (limited to 'site')
-rw-r--r-- | site/home.lisp | 10 | ||||
-rw-r--r-- | site/invites.lisp | 14 | ||||
-rw-r--r-- | site/login.lisp | 6 |
3 files changed, 27 insertions, 3 deletions
diff --git a/site/home.lisp b/site/home.lisp index dcf929a..f84700e 100644 --- a/site/home.lisp +++ b/site/home.lisp @@ -5,4 +5,12 @@ :get :route "" :returns "text/html" :handle (page (:title "V A M P I R E") - (:p "hey " (user-name user)))) + (:p "hey " (user-name user)) + (:div + (:form :method "POST" :action "/invites" + (:p "Initiate an invitation...") + (:button :type "submit" "Bite Someone"))) + (:br) + (:h2 "Outstanding inBites:") + (:ul (dolist (i (invites-by-maker user)) + (:li (key i)))))) diff --git a/site/invites.lisp b/site/invites.lisp new file mode 100644 index 0000000..b463a4d --- /dev/null +++ b/site/invites.lisp @@ -0,0 +1,14 @@ +(in-package #:vampire) + +(wknd:defendpoint invites + :using user-known + :post :to "invites" + :handle + (progn + (db:with-transaction () + (make-instance 'invite :maker user :uses-remaining 1)) + (wknd:endpoint-redirect 'home.html))) + +(defun invite-validp (invite) + (let ((uses (uses-remaining invite))) + (or (< 0 uses) (null uses)))) diff --git a/site/login.lisp b/site/login.lisp index 0310fe8..ef4ba26 100644 --- a/site/login.lisp +++ b/site/login.lisp @@ -40,11 +40,13 @@ :authenticate (and (equal password password2) (setf invite (object-with-key invite-code))) - :authorize (or (null (uses-remaining invite)) (plusp (uses-remaining invite))) + :authorize (invite-validp invite) :handle (progn (db:with-transaction () (when (uses-remaining invite) - (decf (uses-remaining invite))) + (decf (uses-remaining invite)) + (when (zerop (uses-remaining invite)) + (db:delete-object invite))) (let ((user (make-instance 'user :name username))) (setf (user-pwhash user) (hash-string password (user-pwsalt user))))) (wknd:endpoint-redirect 'login.html))) |