revised api structure

2 files changed, 131 insertions, 117 deletions

diff --git a/clpmfile.lock b/clpmfile.lock
index 9002400..a47fc2c 100644
--- a/clpmfile.lock
+++ b/clpmfile.lock
@@ -38,47 +38,47 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 :releases
-("alexandria" :version "2021-12-09" :source "quicklisp" :systems ("alexandria"))
+("alexandria" :version "2022-02-20" :source "quicklisp" :systems ("alexandria"))
 ("babel" :version "2020-09-25" :source "quicklisp" :systems ("babel"))
-("bknr-datastore" :version "2019-12-27" :source "quicklisp" :systems
+("bknr-datastore" :version "2022-02-20" :source "quicklisp" :systems
  ("bknr.datastore" "bknr.indices" "bknr.skip-list" "bknr.utils"))
 ("bordeaux-threads" :version "2020-06-10" :source "quicklisp" :systems
  ("bordeaux-threads"))
 ("cffi" :version "2021-04-11" :source "quicklisp" :systems
  ("cffi" "cffi-grovel" "cffi-toolchain"))
-("chipz" :version "2021-08-07" :source "quicklisp" :systems ("chipz"))
+("chipz" :version "2022-02-20" :source "quicklisp" :systems ("chipz"))
 ("chunga" :version "2020-04-27" :source "quicklisp" :systems ("chunga"))
-("cl+ssl" :version "2021-12-30" :source "quicklisp" :systems ("cl+ssl"))
+("cl+ssl" :version "2022-02-20" :source "quicklisp" :systems ("cl+ssl"))
 ("cl-annot" :version "2015-06-08" :source "quicklisp" :systems ("cl-annot"))
 ("cl-base64" :version "2020-10-16" :source "quicklisp" :systems ("cl-base64"))
 ("cl-change-case" :version "2021-04-11" :source "quicklisp" :systems
  ("cl-change-case"))
 ("cl-cookie" :version "2019-10-07" :source "quicklisp" :systems ("cl-cookie"))
-("cl-fad" :version "2021-01-24" :source "quicklisp" :systems ("cl-fad"))
+("cl-fad" :version "2022-02-20" :source "quicklisp" :systems ("cl-fad"))
 ("cl-interpol" :version "2020-12-20" :source "quicklisp" :systems
  ("cl-interpol"))
-("cl-ppcre" :version "2019-05-21" :source "quicklisp" :systems
+("cl-ppcre" :version "2022-02-20" :source "quicklisp" :systems
  ("cl-ppcre" "cl-ppcre-unicode"))
-("cl-str" :version "2021-05-31" :source "quicklisp" :systems ("str"))
+("cl-str" :version "2022-02-20" :source "quicklisp" :systems ("str"))
 ("cl-syntax" :version "2015-04-07" :source "quicklisp" :systems
  ("cl-syntax" "cl-syntax-annot"))
 ("cl-unicode" :version "2021-02-28" :source "quicklisp" :systems ("cl-unicode"))
 ("cl-utilities" :version "2010-10-07" :source "quicklisp" :systems
  ("cl-utilities"))
-("closer-mop" :version "2021-12-30" :source "quicklisp" :systems ("closer-mop"))
-("dexador" :version "2021-12-09" :source "quicklisp" :systems ("dexador"))
+("closer-mop" :version "2022-02-20" :source "quicklisp" :systems ("closer-mop"))
+("dexador" :version "2022-02-20" :source "quicklisp" :systems ("dexador"))
 ("dissect" :version "2021-05-31" :source "quicklisp" :systems ("dissect"))
 ("fast-http" :version "2019-10-07" :source "quicklisp" :systems ("fast-http"))
 ("fast-io" :version "2020-09-25" :source "quicklisp" :systems ("fast-io"))
-("flexi-streams" :version "2021-08-07" :source "quicklisp" :systems
+("flexi-streams" :version "2022-02-20" :source "quicklisp" :systems
  ("flexi-streams"))
 ("hunchentoot" :version "2020-06-10" :source "quicklisp" :systems
  ("hunchentoot"))
-("ironclad" :version "2021-10-21" :source "quicklisp" :systems ("ironclad"))
+("ironclad" :version "2022-02-20" :source "quicklisp" :systems ("ironclad"))
 ("jonathan" :version "2020-09-25" :source "quicklisp" :systems ("jonathan"))
 ("lambda-riffs" :version (:commit "f7b3c081f2361f7370c80e7ff4a432241f34ce55")
  :source :implicit-vcs :systems ("lambda-riffs"))
-("lazybones" :version (:commit "c48ecda020797fe3fe65d55d02a8b72f6e7f19cb")
+("lazybones" :version (:commit "70def00400c88f4d872a58b2f76449077ece22ca")
  :source :implicit-vcs :systems ("lazybones" "lazybones-hunchentoot"))
 ("lazybones-client" :version
  (:commit "92fe387b39d56f94e19d412c24a0c19a792f1ad1") :source :implicit-vcs
@@ -87,7 +87,7 @@
  ("lisp-namespace"))
 ("local-time" :version "2021-01-24" :source "quicklisp" :systems ("local-time"))
 ("md5" :version "2021-06-30" :source "quicklisp" :systems ("md5"))
-("named-readtables" :version "2021-12-09" :source "quicklisp" :systems
+("named-readtables" :version "2022-02-20" :source "quicklisp" :systems
  ("named-readtables"))
 ("oneliners.api-client.asd" :version :newest :source :implicit-file :systems
  ("oneliners.api-client"))
@@ -96,7 +96,7 @@
 ("proc-parse" :version "2019-08-13" :source "quicklisp" :systems ("proc-parse"))
 ("quri" :version "2021-06-30" :source "quicklisp" :systems ("quri"))
 ("rfc2388" :version "2018-08-31" :source "quicklisp" :systems ("rfc2388"))
-("rove" :version "2021-12-09" :source "quicklisp" :systems ("rove"))
+("rove" :version "2022-02-20" :source "quicklisp" :systems ("rove"))
 ("smart-buffer" :version "2021-10-21" :source "quicklisp" :systems
  ("smart-buffer"))
 ("split-sequence" :version "2021-05-31" :source "quicklisp" :systems
@@ -117,13 +117,13 @@
  ("trivial-mimes"))
 ("trivial-types" :version "2012-04-07" :source "quicklisp" :systems
  ("trivial-types"))
-("trivial-utf-8" :version "2021-12-09" :source "quicklisp" :systems
+("trivial-utf-8" :version "2022-02-20" :source "quicklisp" :systems
  ("trivial-utf-8"))
 ("unit-test" :version "2012-05-20" :source "quicklisp" :systems ("unit-test"))
 ("usocket" :version "2019-12-27" :source "quicklisp" :systems ("usocket"))
 ("uuid" :version "2020-07-15" :source "quicklisp" :systems ("uuid"))
 ("xsubseq" :version "2017-08-30" :source "quicklisp" :systems ("xsubseq"))
-("yason" :version "2019-12-27" :source "quicklisp" :systems ("yason"))
+("yason" :version "2022-02-20" :source "quicklisp" :systems ("yason"))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -321,7 +321,9 @@
  ((:system :name "cffi") (:system :name "trivial-features"))
  ((:system :name "babel") (:system :name "trivial-features")))
 
-("trivial-garbage" ((:system :name "cl+ssl") (:system :name "trivial-garbage")))
+("trivial-garbage"
+ ((:system :name "dexador") (:system :name "trivial-garbage"))
+ ((:system :name "cl+ssl") (:system :name "trivial-garbage")))
 
 ("trivial-gray-streams"
  ((:system :name "yason") (:system :name "trivial-gray-streams"))
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))