aboutsummaryrefslogtreecommitdiff
path: root/src/main.lisp
diff options
context:
space:
mode:
authorColin Okay <okay@toyful.space>2022-02-16 09:10:42 -0600
committerColin Okay <okay@toyful.space>2022-02-16 09:10:42 -0600
commit0e51b3e28c41dba73f419424399dbadab61181bf (patch)
tree02e2afc40de88873a9de0736a079d9eef2be918e /src/main.lisp
parent23c61a347a5364159975345dcc47f095f15f326a (diff)
invitation logic.
Diffstat (limited to 'src/main.lisp')
-rw-r--r--src/main.lisp98
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)