From 4384b353d9df4d9ab7b958b8081fccf3d9f5aacb Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Thu, 27 Oct 2022 16:00:26 -0500
Subject: Add: user invite features

---
 home.lisp  | 55 ++++++++++++++++++++++++++++++++++++++++++++-----------
 model.lisp | 14 +++++++++++++-
 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)))
-- 
cgit v1.2.3