summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-10-27 16:00:26 -0500
committerColin Okay <colin@cicadas.surf>2022-10-27 16:00:26 -0500
commit4384b353d9df4d9ab7b958b8081fccf3d9f5aacb (patch)
tree0818a9e5270dce92086c4e66d93ed045d4e9b92c
parentf94d232ffbbb40c67925313dbb8025286035ee06 (diff)
Add: user invite features
-rw-r--r--home.lisp55
-rw-r--r--model.lisp14
2 files changed, 57 insertions, 12 deletions
diff --git a/home.lisp b/home.lisp
index c0ec8a6..d1de0c0 100644
--- a/home.lisp
+++ b/home.lisp
@@ -2,14 +2,6 @@
(in-package :vampire)
-;;; CLIENT STATE
-
-(defclass/std user-ctl ()
- ())
-
-
-;;; CLIENT CONTROL
-
;;; CLIENT UI
(defun create-new-playlist-form (parent &rest args)
@@ -30,8 +22,7 @@
(format nil "/playlist/~a"
(key pl)))
-(defun create-playlist-listing (parent &rest args)
- (declare (ignorable args))
+(defun create-playlist-listing (parent)
(dolist (pl (user-playlists (session-user parent)))
(let ((url
(url-to-playlist pl)))
@@ -45,12 +36,54 @@
(setf (url (location (connection-body parent)))
url)))))))
+(defun create-invite-list-item (invite-list invite)
+ (with-clog-create invite-list
+ (list-item (:bind item)
+ (button (:bind delbtn :content "delete"))
+ (p ()
+ (span (:content "Code: "))
+ (span (:content (key invite))))
+ (p ()
+ (span (:content "Uses Remaining: "))
+ (span (:content
+ (format nil "~a"
+ (or (uses-remaining invite) "unlimited"))))))
+ (set-on-click delbtn (thunk*
+ (destroy-invite invite)
+ (destroy item)))) )
+
+(defun create-invite-control (parent)
+ (let* ((user (session-user parent))
+ (container (create-div parent))
+ (invite-list (create-unordered-list parent)))
+ (place-after (create-section container :h3 :content "Your Invites")
+ invite-list)
+ ;; list invites
+ (dolist (invite (invites-by-maker user))
+ (create-invite-list-item invite-list invite))
+
+ (with-clog-create container
+ (form ()
+ (button (:bind createbtn :content "Create Invite"))
+ (form-element (:number :bind count))
+ (p (:content "Uses are optional. Blank or Zero means unlimited use.")))
+ (setf (minimum count) 0
+ (place-holder count) "Uses"
+ (width count) 70)
+ (set-on-click
+ createbtn
+ (thunk*
+ (let ((invite (make-invite user (parse-integer (value count) :junk-allowed t))))
+ (create-invite-list-item invite-list invite)))))))
+
+
(defun user-home-page (body)
(with-clog-create body
(div ()
(navigation-header ())
(p (:content (format nil "Welcome ~a" (user-name (session-user body)))))
(new-playlist-form ())
- (playlist-listing ()))))
+ (playlist-listing ())
+ (invite-control ()))))
diff --git a/model.lisp b/model.lisp
index 42142ed..a866088 100644
--- a/model.lisp
+++ b/model.lisp
@@ -2,6 +2,8 @@
(in-package :vampire)
+;;; CLASSES
+
(defclass/bknr keyed ()
((key :r :std (nuid)
:index-type string-unique-index
@@ -16,7 +18,9 @@
(pwhash :with)))
(defclass/bknr invite (keyed)
- ((maker :r :std nil)
+ ((maker :ri :std nil
+ :index-type hash-index
+ :index-reader invites-by-maker)
(uses-remaining :std nil)))
(defclass/bknr playlist (keyed)
@@ -106,6 +110,14 @@
(hash-string pw (user-pwsalt user)))
user))))
+(defun destroy-invite (invite)
+ (with-transaction ()
+ (bknr.datastore:delete-object invite)))
+
+(defun make-invite (user &optional uses)
+ (with-transaction ()
+ (make-instance 'invite :maker user :uses-remaining uses)))
+
(defun append-track (pl tr)
(with-transaction ()
(add-track tr pl)))