aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/main.lisp47
-rw-r--r--src/util.lisp40
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))))
+