deletion endpoint, newest endpoint, queue implementation

2 files changed, 79 insertions, 8 deletions

diff --git a/src/main.lisp b/src/main.lisp
index 72b06e0..c623336 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -345,6 +345,14 @@ started, this will allow remote live debugging of the system.
         (mapc #'db:delete-object expired-invites)))))
 
 
+;;; EXTERNAL CACHES
+
+(defparameter +newest-queue-size+ 10)
+(defvar *newest-queue-lock*
+  (bt:make-lock "newest-queue-lock"))
+(defvar *newest-queue*
+  (make-qb +newest-queue-size+))
+
 ;;; API DEFINITION AND PROVISIONING
 
 (defparameter +oneliners-description+
@@ -367,6 +375,10 @@ started, this will allow remote live debugging of the system.
 
 ;;; DATABASE TRANSACTIONS
 
+(defun delete-oneliner (oneliner)
+  (db:with-transaction ()
+    (db:delete-object oneliner)))
+
 (defun update-password (contributor new-password)
   (db:with-transaction () 
     (with-slots (salt hashed-pw) contributor
@@ -426,14 +438,17 @@ started, this will allow remote live debugging of the system.
       (revoke-access access))))
 
 (defun make-new-oneliner (contributor &key oneliner tags brief explanation runstyle)
-  (db:with-transaction ()
-    (make-instance 'oneliner
-                   :created-by contributor
-                   :explanation (or explanation "")
-                   :tags tags
-                   :oneliner oneliner
-                   :brief brief
-                   :runstyle (if runstyle (a:make-keyword runstyle) :auto))))
+  (let ((ol 
+          (db:with-transaction ()
+            (make-instance 'oneliner
+                           :created-by contributor
+                           :explanation (or explanation "")
+                           :tags tags
+                           :oneliner oneliner
+                           :brief brief
+                           :runstyle (if runstyle (a:make-keyword runstyle) :auto)))))
+    (bt:with-lock-held (*newest-queue-lock*)
+      (enqueue-qb  *newest-queue* ol))))
 
 
 (defun unflag-oneliner (oneliner)
@@ -474,6 +489,10 @@ started, this will allow remote live debugging of the system.
 
 ;;; NONTRANSACTIONAL DATABASE QUERIES
 
+(defun newest-oneliners (&optional limit)
+  (bt:with-lock-held (*newest-queue-lock*)
+    (qb-look *newest-queue*)))
+
 (defun flagged-oneliners (&optional limit)
   (loop
     for idx from 0
@@ -645,6 +664,13 @@ have exceeded the invite limit."
         (unless (typep runstyle 'runstyle)
           (http-err 400 "Invalid runstyle. Must be AUTO or MANUAL")))))
 
+(defendpoint* :delete "/oneliner/:oneliner a-oneliner-id:" ((token an-api-token))
+  (:auth t)
+  "Delete a oneliner."
+  (delete-oneliner oneliner)
+  "true")
+
+
 (defendpoint* :post "/oneliner" ((token an-api-token))
   (:auth t)
   "Make a new [oneliner](#oneliner)."
@@ -702,6 +728,11 @@ admin privileges are allowed to perform this action."
           (http-err 403)))
   "true")
 
+(defendpoint* :get "/oneliners/newest" ((limit an-int))
+  ()
+  "A search endpoint returning the LIMIT newest oneliners."
+  (to-json (list :oneliners (newest-oneliners limit))))
+
 (defendpoint* :get "/oneliners/all-flagged" ((limit an-int))
   ()
   "A search endpoint returning all of the flagged oneliners. If LIMIT
diff --git a/src/util.lisp b/src/util.lisp
index 2fc079b..ad312eb 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -18,3 +18,43 @@
                                              :key #'symbol-name)))
          ,@body))))
 
+
+(defclass queue-buffer ()
+  ((front :initform (list))  
+   (back :initform (list))   
+   (size :initform 0)
+   (capacity :initarg capacity)))
+
+(defun make-qb (capacity)
+  (make-instance 'queue-buffer :capacity capacity))
+
+(defun qb-empty-p (q)
+  (zerop (slot-value q 'size)))
+
+(defun qb-full-p (q)
+  (= (slot-value q 'size) (slot-value q 'capacity)))
+
+(defun enqueue-qb (q x)
+  (when (qb-full-p q) (dequeue-qb q))
+  (with-slots (size back) q
+    (push x back)
+    (incf size)))
+
+(defun dequeue-qb (q &optional default)
+  (with-slots (front back size) q
+    (cond
+      ((plusp size) 
+       (when (null front)
+         (setf front (nreverse back)
+               back nil))
+       (decf size)
+       (pop front))
+
+      (t  default))))
+
+(defun qb-look (q)
+  "get a list of the queue, but don't remove items from it"
+  (with-slots (front back) q
+    (nconc (copy-seq front)
+           (reverse back))))
+