diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/main.lisp | 212 |
1 files changed, 112 insertions, 100 deletions
diff --git a/src/main.lisp b/src/main.lisp index 979752f..9145a8a 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -24,8 +24,11 @@ (:metaclass db:persistent-class)) (defun invite-expiration (invite) - (+ +invite-lifetime+ - (created-at invite))) + "Returns a string representation of the expiration of an invite" + (multiple-value-bind (sec min hour date month year) (decode-universal-time + (+ +invite-lifetime+ + (created-at invite))) + (format nil "~2,'0d-~2,'0d-~2,'0d ~2,'0d:~2,'0d" year month date hour min))) (defmethod json:%to-json ((invite invite)) (json:with-object @@ -85,6 +88,8 @@ (deftype runstyle () `(member :auto :manual)) +(defparameter +oneliner-brief-max-length+ 72) + (defclass oneliner (db:store-object) ((oneliner :accessor oneliner @@ -313,25 +318,15 @@ (a:when-let ((access (access-by-contributor contributor))) (revoke-access access)))) -(defun make-new-oneliner (contributor plist) - (with-plist - (oneliner tags brief explanation runstyle) plist - (unless brief - (http-err 400 "Oneliner requires a brief explanation")) - (unless oneliner - (http-err 400 "Oneliner cannot be blank")) - (when runstyle - (setf runstyle (a:make-keyword runstyle)) - (unless (typep runstyle 'runstyle) - (http-err 400 "Invalid runstyle."))) - (db:with-transaction () - (make-instance 'oneliner - :created-by contributor - :explanation (or explanation "") - :tags tags - :oneliner oneliner - :brief brief - :runstyle (or runstyle :auto))))) +(defun make-new-oneliner (contributor oneliner tags brief explanation runstyle) + (db:with-transaction () + (make-instance 'oneliner + :created-by contributor + :explanation (or explanation "") + :tags tags + :oneliner oneliner + :brief brief + :runstyle (or runstyle :auto)))) (defun flag-oneliner (oneliner &optional contributor) "Flag a oneliner for review. If locked, ensure that CONTRIBUTOR is an admin. Returns T or NIL." @@ -352,25 +347,20 @@ (db:with-transaction () (setf (lockedp oneliner) nil)))) -(defun edit-oneliner (ol contributor plist) - (when (or (not (lockedp ol)) (adminp contributor)) - (with-plist - (oneliner tags brief explanation runstyle) plist - (when runstyle - (setf runstyle (a:make-keyword runstyle)) - (unless (typep runstyle 'runstyle) - (http-err 400))) - (db:with-transaction () - (when oneliner - (setf (oneliner ol) oneliner)) - (when tags - (setf (oneliner-tags ol) tags)) - (when brief - (setf (oneliner-brief ol) brief)) - (when explanation - (setf (oneliner-explanation ol) explanation)) - (when runstyle - (setf (oneliner-runstyle ol) runstyle)))))) +(defun edit-oneliner (ol contributor &key oneliner tags brief explanation runstyle) + "Assumes each param, where given, has been validated." + (db:with-transaction () + (setf (last-edited-by ol) contributor) + (when oneliner + (setf (oneliner ol) oneliner)) + (when tags + (setf (oneliner-tags ol) tags)) + (when brief + (setf (oneliner-brief ol) brief)) + (when explanation + (setf (oneliner-explanation ol) explanation)) + (when runstyle + (setf (oneliner-runstyle ol) (a:make-keyword runstyle))))) ;;; NONTRANSACTIONAL DATABASE QUERIES @@ -434,49 +424,48 @@ (defun an-api-token (token) "An api token" - token) + (a:if-let (access (access-by-token token)) + access + (http-err 404))) ;;; ENDPOINT DEFINITIONS -(defendpoint* :post "/redeem/:invite an-invite-code:" - ((username a-string) - (password1 a-string) - (password2 a-string)) - () +(defendpoint* :post "/invite/redeem/:code 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) - (http-err 403 (format nil "The name ~a is already taken." username))) - (redeem-invite invite username password1) - "true") - -(defendpoint* :post "/token/:contributor a-user-handle:" - ((password a-string)) - () - "Authenticate a contributor and reply with an [api token](#access-token)" - (cond ((equal (pw-hash password (contributor-salt contributor)) - (hashed-pw contributor)) - (let ((token (a:if-let (access (access-by-contributor contributor)) - (api-token access) - (api-token (make-api-access contributor))))) - (to-json (list :token token)))) - (t - (http-err 401)))) + (with-plist (password1 password2 handle) (lzb:request-body) + (unless (equal password1 password2) + (http-err 400 "Passwords dont match")) + (when (contributor-by-handle username) + (http-err 403 (format nil "The name ~a is already taken." username))) + (redeem-invite code username password1) + "true")) + +(defendpoint* :post "/access" () () + "Authenticate a contributor and reply with an [API token](#access-token)" + (with-plist + (password handle) (lzb:request-body) + (a:if-let ((contributor (contributor-by-handle handle))) + (if (equal (pw-hash password (contributor-salt contributor)) + (hashed-pw contributor)) + (let ((token (a:if-let (access (access-by-contributor contributor)) + (api-token access) + (api-token (make-api-access contributor))))) + (to-json (list :token token))) + (http-err 401))))) (defun can-revoke-contributor (requesting-contributor target-contributor) "A contributor can revoke their own access, or an admin can revoke anybody's." (or (eq requesting-contributor target-contributor) (adminp requesting-contributor))) -(defendpoint* :post "/revoke/:contributor a-user-handle:" ((token an-api-token)) +(defendpoint* :delete "/access/:access an-api-token:" ((token an-api-token)) (:auth t) - "A contributor can revoke their own access (if for some reason their - API key ends up out of their control), or an admin can revoke - anybody's access token, forcing the to re-authenticate." - (if (can-revoke-contributor (request-contributor) contributor) - (revoke-access contributor) - (http-err 403))) + "Revoke access of CONTRIBUTOR" + (unless (can-revoke-contributor (request-contributor) (api-contributor access)) + (http-err 403)) + (revoke-access access) + "true") + (defun authorized-to-invite () "To make a new invite, a contributor must be authorized and must not @@ -485,15 +474,30 @@ have exceeded the invite limit." (or (adminp contributor) (can-invite-p contributor)))) -(defendpoint* :post "/make-invite" ((token an-api-token)) +(defendpoint* :post "/invite" ((token an-api-token)) (:auth 'authorized-to-invite) "On success, return an object containing a new [invite token](#invite-token)." - (to-json (make-new-invite (request-contributor)))) + (to-json (make-new-invite (api-contributor token)))) -(defendpoint* :post "/add-oneliner" ((token an-api-token)) +(defendpoint* :post "/oneliner" ((token an-api-token)) (:auth t) "Make a new [oneliner](#oneliner)." - (make-new-oneliner (request-contributor) (lzb:request-body)) + (with-plist + (oneliner tags brief explanation runstyle) (lzb:request-body) + (unless brief + (http-err 400 "Oneliner requires a brief explanation")) + (unless oneliner + (http-err 400 "Oneliner cannot be blank")) + (when runstyle + (setf runstyle (a:make-keyword runstyle)) + (unless (typep runstyle 'runstyle) + (http-err 400 "Invalid runstyle."))) + (make-new-oneliner (api-contributor token) + oneliner + tags + brief + explanation + runstyle)) "true") (defun admin-only () @@ -502,35 +506,45 @@ admin privileges are allowed to perform this action." (a:when-let (contributor (request-contributor)) (adminp contributor))) -(defendpoint* :patch "/lock/:oneliner a-oneliner-id:" ((token an-api-token)) +(defendpoint* :put "/oneliner/:oneliner a-oneliner-id:/locked" ((token an-api-token) + (value a-boolean)) (:auth 'admin-only) - "Locks a oneliner. Locked oneliners cannot be edited or flagged." - (lock-oneliner oneliner (request-contributor)) + "Sets the locked value of the specified oneliner" + (if value + (lock-oneliner oneliner (api-contributor token)) + (unlock-oneliner oneliner (api-contributor token))) "true") -(defendpoint* :patch "/unlock/:oneliner a-oneliner-id:" ((token an-api-token)) - (:auth 'admin-only) - "Unlocks a oneliner." - (unlock-oneliner oneliner (request-contributor)) - "true") +(defun validate-oneliner-edit-plist (plist) + (with-plist + (brief runstyle) plist + (when brief + (unless (<= (length brief) +oneliner-brief-max-length+) + (http-err 400 (format nil "Brief too long. Must be under ~a" +oneliner-brief-max-length+)))) + (when runstyle + (unless (typep (a:make-keyword runstyle) 'runstyle) + (http-err 400 (format nil "Invalid runstyle. Must be AUTO or MANUAL")))))) -(defendpoint* :patch "/edit/:oneliner a-oneliner-id:" ((token an-api-token)) +(defendpoint* :patch "/oneliner/:entry a-oneliner-id:/edit" ((token an-api-token)) (:auth t) "Edit the fields of a oneliner." - (if (edit-oneliner oneliner (request-contributor) (lzb:request-body)) - "true" - (http-err 403))) ;; in case it is locked + (when (and (lockedp entry) (not (adminp (api-contributor token)))) + (http-err 403)) + (validate-oneliner-edit-plist (lzb:request-body)) + (apply 'edit-oneliner entry (api-contributor token) (lzb:request-body)) + "true") -(defendpoint* :patch "/flag/:oneliner a-oneliner-id:" ((token an-api-token)) - () - "Flag the oneliner for review. Open to anyone." - (if (flag-oneliner oneliner (request-contributor)) - "true" - (http-err 403))) - -(defendpoint* :get "/search" ((tags a-csl) - (limit an-int) - (notflagged a-boolean)) +(defendpoint* :put "/oneliner/:entry a-oneliner-id:/flag" ((token an-api-token)) + (:auth t) + "Flag the oneliner for review." + (when (and (lockedp entry) (not (adminp (api-contributor token)))) + (http-err 403)) + (flag-oneliner entry (api-contributor token)) + "true") + +(defendpoint* :get "/oneliners" ((tags a-csl) + (limit an-int) + (notflagged a-boolean)) () "A search endpoint returning a JSON encoded array of Oneliner Entries. TAGS cannot be empty. Returns a [Search @@ -556,7 +570,6 @@ Result](#search-result) object." (defun uuid () (format nil "~a" (uuid:make-v1-uuid))) - (defun oneliner-mentions-any (ol keywords) "A case insensitive search for the presence of any of KEYWORDS in the oneliner OL." (with-slots (text breif explanation) ol @@ -566,7 +579,6 @@ Result](#search-result) object." thereis (search word breif :test #'char-equal) thereis (search word explanation :test #'char-equal)))) - (defun to-json (thing) (let ((jonathan:*false-value* :false) (jonathan:*null-value* :null)) |