diff options
| -rw-r--r-- | src/main.lisp | 47 | ||||
| -rw-r--r-- | src/util.lisp | 40 |
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)))) + |