invitation logic.

1 files changed, 77 insertions, 21 deletions

diff --git a/src/main.lisp b/src/main.lisp
index 1804267..13d0d57 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -7,22 +7,42 @@
     :reader invite-code
     :initform (uuid)
     :index-type bknr.indices:string-unique-index
-    :index-reader invite-by-code)
+    :index-reader invite-by-code
+    :documentation "An invite code.")
    (from
     :reader invite-from
-    :initarg :from)
+    :initarg :from
+    :initform nil
+    :index-type bknr.indices:hash-index
+    :index-reader invites-by-contributor
+    :documentation "Who created this invite.")
    (created-at
     :reader created-at
-    :initform (get-universal-time)))
+    :initform (get-universal-time)
+    :documentation "When the invite was created. Used to determine invite expiration."))
+  (:documentation "An invitation to create a new contributor on this server.")
   (:metaclass db:persistent-class))
 
+(defun invite-expiration (invite)
+  (+ +invite-lifetime+
+     (created-at invite)))
+
+(defmethod json:%to-json ((invite invite))
+  (json:with-object
+    (json:write-key-value :code (invite-code invite))
+    (when (invite-from invite)
+      (json:write-key-value :from (contributor-handle (invite-from invite))))
+    (json:write-key-value :expires (invite-expiration invite))))
+
 (defclass contributor (db:store-object)
   ((handle
     :accessor contributor-handle
     :initarg :handle
     :initform (error "Contributors must have a name.")
     :index-type bknr.indices:string-unique-index
-    :index-reader contributor-by-handle)
+    :index-reader contributor-by-handle
+    :documentation "The contributor's name. Must be unique among all
+    other contributor names.")
    (salt
     :reader contributor-salt
     :initform (uuid)
@@ -34,12 +54,21 @@
     :type string
     :documentation "Hashed password for this contributor. Note, this
     value is hashed with the server salt and the contributor-salt.")
+   (invites
+    :accessor contributor-invites
+    :initform (list :made 0  :redeemed 0 :limit 1)
+    :documentation "A pair of integers (Invites Made . Invites Redeemed)")
    (adminp
     :accessor adminp
     :initform nil
     :documentation "indicates whether or not this contributor has admin privileges."))
   (:metaclass db:persistent-class))
 
+(defun can-invite-p (contributor)
+  "Returns T if the contributor is currently allowed to make more invites."
+  (with-plist (limit made) (contributor-invites contributor)
+              (< made limit)))
+
 (defparameter +auth-cookie-name+ "olauthtoken")
 
 (defclass api-access (db:store-object)
@@ -133,8 +162,6 @@
       (json:write-key-value :isFlagged (if (not (null flagged-by)) t :false))
       (json:write-key-value :isLocked (if lockedp t :false)))))
 
-
-
 ;;; SERVICE CONTROL
 
 (defvar *server* nil)
@@ -240,10 +267,30 @@
 
 ;;; DATABASE TRANSACTIONS
 
+(defun make-new-invite (&optional contributor)
+  "Make and  return a new invite object. "
+  (db:with-transaction ()
+    (if contributor
+      (let ((invites (contributor-invites contributor)))
+        (incf (getf invites :made))
+        (setf (contributor-invites contributor) invites)
+        (make-instance 'invite :from contributor))
+      (make-instance 'invite))))
+
 (defun redeem-invite (invite handle password)
   (db:with-transaction ()
+    ;; make new user
     (with-slots (salt hashed-pw)  (make-instance 'contributor :handle handle)
       (setf hashed-pw (pw-hash password salt)))
+    ;; increment the redeemed invite count on the contributor who made
+    ;; it, if exists.
+    (a:when-let (contributor (invite-from invite))
+      ;; doing it this way b/c i'm not sure if the transaction log
+      ;; would see (incf (getf (contributor-invites contributor) :redeemed))
+      (let ((invites (contributor-invites contributor)))
+        (incf (getf invites :redeemed))
+        (setf (contributor-invites contributor) invites)))
+    ;; finally, delete the invite.
     (db:delete-object invite)))
 
 
@@ -255,10 +302,9 @@
   (with-plist
       (oneliner tags brief description) plist
       (unless brief
-        (http-err 400 "Oneliner requires a breif description"))
+        (http-err 400 "Oneliner requires a brief description"))
       (unless oneliner
         (http-err 400 "Oneliner cannot be blank"))
-
       (db:with-transaction ()
         (make-instance 'oneliner
                        :created-by contributor
@@ -301,16 +347,18 @@
           (setf (oneliner-description ol) description))))))
 
 
-;;; DATABASE QUERIES
+;;; NONTRANSACTIONAL DATABASE QUERIES
 
+(defun oneliners-with-all-tags (tags)
+  (reduce #'intersection (mapcar #'oneliners-by-tag tags)))
 
-(defun query-oneliners (&key tags notflagged limit)
+(defun query-oneliners (&key tags notflagged (limit 10))
   ;; inefficient but easy to express 
   (let ((ols (oneliners-with-all-tags tags)))
     (a:subseq* (if notflagged
                    (remove-if #'flagged-by ols)
                    ols)
-               0 (or limit 10))))
+               0 limit)))
 
 
 ;;; ROUTE VARIABLE AND PARAMATER PARSERS
@@ -333,10 +381,6 @@
         ((string-equal s "false") nil)
         (t (error "String ~s is neither 'true' nor 'false'" s))))
 
-(defun a-page-key (key)
-  "A page key"
-  key)
-
 (defun an-invite-code (code)
   "An invite code."
   (a:if-let (invite (invite-by-code code))
@@ -357,7 +401,7 @@
 
 
 (defun a-oneliner-id (string)
-  "An id of a oneliner instance "
+  "An id of a oneliner entry "
   (a:if-let (oneliner (db:store-object-with-id (parse-integer string)))
     oneliner
     (http-err 404)))
@@ -369,7 +413,7 @@
    (password1 a-string)
    (password2 a-string))
   ()
-  "Redeem an invite code"
+  "Redeem an [invite code](#invite-code) and create a new [contributor](#new-contributor-post-body)"
   (unless (equal password1 password2)
     (http-err 400 "Passwords dont match"))
   (when (contributor-by-handle username)
@@ -377,10 +421,10 @@
   (redeem-invite invite username password1)
   "true")
 
-(defendpoint* :post "/request-token/:contributor a-user-handle:"
+(defendpoint* :post "/token/:contributor a-user-handle:"
   ((password a-string))
   ()
-  "Authenticate a user and reply with an api token"
+  "Authenticate a contributor and reply with an [api token](#access-token)"
   (cond ((equal (pw-hash password (contributor-salt contributor))
                 (hashed-pw contributor))
          (to-json 
@@ -390,8 +434,21 @@
         (t
          (http-err 401))))
 
+(defun authorized-to-invite ()
+  "To make a new invite, a contributor must be either authorized,
+having not exceeded their invite limit, or must be an admin."
+  (a:when-let (contributor (and (api-token-authorization) (request-contributor)))
+    (or (adminp contributor)
+        (can-invite-p contributor))))
+
+(defendpoint* :post "/make-invite" ()
+  (:auth 'authorized-to-invite)
+  "On success, return an object containing a new [invite token](#invite-token)."
+  (to-json (make-new-invite (request-contributor))))
+
 (defendpoint* :post "/add-oneliner" ()
   (:auth t)
+  "Make a new [oneliner](#oneliner-post-body)."
   (make-new-oneliner (request-contributor)  (lzb:request-body))
   "true")
 
@@ -524,8 +581,7 @@ names.  NAME must be a symbol or a string."
       thereis (search word description :test #'char-equal))))
 
 
-(defun oneliners-with-all-tags (tags)
-  (reduce #'intersection (mapcar #'oneliners-by-tag tags)))
+
 
 
 (defun to-json (thing)