From 59c98410fcc7576681b605b3cce95335f6bf9b28 Mon Sep 17 00:00:00 2001
From: Colin Okay <okay@toyful.space>
Date: Tue, 15 Feb 2022 16:03:07 -0600
Subject: removed paging logic and data; add invite cleanup routines

---
 src/main.lisp | 76 +++++++++++++----------------------------------------------
 1 file changed, 17 insertions(+), 59 deletions(-)

(limited to 'src')

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
-- 
cgit v1.2.3