diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/main.lisp | 98 |
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) |