aboutsummaryrefslogtreecommitdiff
path: root/src/main.lisp
diff options
context:
space:
mode:
authorColin Okay <okay@toyful.space>2022-02-15 16:03:07 -0600
committerColin Okay <okay@toyful.space>2022-02-15 16:03:07 -0600
commit59c98410fcc7576681b605b3cce95335f6bf9b28 (patch)
tree2d7ede1505a54ccec76c400824e087931835c0a5 /src/main.lisp
parent23e428950a8846882df7365cf40ddd2220b3d594 (diff)
removed paging logic and data; add invite cleanup routines
Diffstat (limited to 'src/main.lisp')
-rw-r--r--src/main.lisp76
1 files changed, 17 insertions, 59 deletions
diff --git a/src/main.lisp b/src/main.lisp
index 4097ee5..ca44e96 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -10,7 +10,10 @@
:index-reader invite-by-code)
(from
:reader invite-from
- :initarg :from))
+ :initarg :from)
+ (created-at
+ :reader created-at
+ :initform (get-universal-time)))
(:metaclass db:persistent-class))
(defclass contributor (db:store-object)
@@ -130,59 +133,6 @@
(json:write-key-value "isFlagged" (if (not (null flagged-by)) t :false))
(json:write-key-value "isLocked" (if lockedp t :false)))))
-(defclass query-results-page (db:store-object)
- ((limit
- :initarg :limit)
- (to-page
- :initarg :to-page)
- (remaining
- :initarg :remaining)
- (last-access
- :initarg :last-access)
- (key
- :initarg key
- :index-type bknr.indices:string-unique-index
- :index-reader page-by-key))
- (:metaclass db:persistent-class))
-
-(defun make-next-page (limit to-page)
- (if to-page ;; only make a page if there are results to paginate
- (let ((key (uuid)))
- (db:with-transaction ()
- (make-instance 'query-results-page
- :key key
- :limit limit
- :to-page to-page
- :remaining (length to-page)
- :last-access (get-universal-time)))
- key)
- :null)) ;; return the value that to-json will encode as null
-
-(defun fetch-next-page (pagekey &key (attrib-name :oneliners))
- "Return next page in a search query, or throw an error if there is
- no such page / the page has expired."
- (a:if-let (qrp (page-by-key pagekey))
- (db:with-transaction ()
- (with-slots (limit to-page remaining last-access) qrp
- (let* ((n-to-send (min limit remaining))
- (to-return (subseq to-page 0 n-to-send)))
- (decf remaining n-to-send)
- (if (plusp remaining)
- (setf to-page (nthcdr n-to-send to-page)
- last-access (get-universal-time))
- (db:delete-object qrp))
- (list :page (if (plusp remaining) pagekey :null)
- attrib-name to-return))))
- (error "No page for key ~a" pagekey)))
-
-(defparameter +qrp-lifetime+ 300 ; five minutes
- "Number of seconds query-results-page instances live in the
- application state.")
-
-(defun expired-page-p (qrp &optional (current-time (get-universal-time)))
- (when (typep qrp 'query-results-page)
- (> (- current-time (slot-value qrp 'last-access))
- +qrp-lifetime+)))
;;; SERVICE CONTROL
@@ -238,7 +188,8 @@
(setf *runningp* t)
(start-cleaning-thread))
-(defun start-cleaning-thread (&key (run-period 45))
+
+(defun start-cleaning-thread (&key (run-period 3600))
;; when the thread was stopped properly.
(when (and *cleaning-thread* (bt:thread-alive-p *cleaning-thread*))
(bt:destroy-thread *cleaning-thread*))
@@ -255,12 +206,19 @@
(when *server*
(lzb:stop-server *server*)))
+(defparameter +invite-lifetime+ (* 60 60 24)
+ "Invites expire after 24 hours")
+
+(defun expired-invite-p (invite &optional (current-time (get-universal-time)))
+ (> (- current-time (created-at invite))
+ +invite-lifetime+))
+
(defun routine-cleaning ()
(let ((now (get-universal-time)))
- (db:with-transaction ()
- (dolist (qrp (db:store-objects-with-class 'query-results-page))
- (when (expired-page-p qrp now)
- (db:delete-object qrp))))))
+ (a:when-let (expired-invites
+ (remove-if-not #$(expired-invite-p $invite now) (db:store-objects-with-class 'invite)))
+ (db:with-transaction ()
+ (mapc #'db:delete-object expired-invites)))))
;;; API DEFINITION AND PROVISIONING