From 28b67c85acefc578536bf849cb748bd9345ee3b9 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 29 Dec 2021 22:11:59 +0000
Subject: Regularly update the database dump and delete recent changes

---
 nar-herder/database.scm | 58 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)

(limited to 'nar-herder/database.scm')

diff --git a/nar-herder/database.scm b/nar-herder/database.scm
index 399d527..e30c82a 100644
--- a/nar-herder/database.scm
+++ b/nar-herder/database.scm
@@ -44,6 +44,8 @@
 
             database-select-recent-changes
             database-select-latest-recent-change-datetime
+            database-get-recent-changes-id-for-deletion
+            database-delete-recent-changes-with-id-below
 
             database-select-narinfo-for-file
             database-select-narinfo-files
@@ -308,6 +310,20 @@ PRAGMA optimize;")))
 
       id)))
 
+(define (changes db)
+  (let ((statement
+         (sqlite-prepare
+          db
+          "SELECT changes()"
+          #:cache? #t)))
+    (let ((id
+           (vector-ref (sqlite-step statement)
+                       0)))
+
+      (sqlite-reset statement)
+
+      id)))
+
 (define (database-insert-narinfo database narinfo)
   (define (insert-narinfo-record db)
     (let ((statement
@@ -481,6 +497,48 @@ SELECT datetime FROM recent_changes ORDER BY datetime DESC LIMIT 1"
 
          result)))))
 
+(define (database-get-recent-changes-id-for-deletion database limit)
+  (call-with-worker-thread
+   (database-reader-thread-channel database)
+   (lambda (db)
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+SELECT id FROM recent_changes ORDER BY datetime DESC LIMIT 1 OFFSET :offset"
+             #:cache? #t)))
+
+       (sqlite-bind-arguments
+        statement
+        #:offset limit)
+
+       (let ((result (match (sqlite-step statement)
+                       (#(id) id)
+                       (#f #f))))
+         (sqlite-reset statement)
+
+         result)))))
+
+(define (database-delete-recent-changes-with-id-below database id)
+  (call-with-worker-thread
+   (database-writer-thread-channel database)
+   (lambda (db)
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+DELETE FROM recent_changes WHERE id < :id"
+             #:cache? #t)))
+
+       (sqlite-bind-arguments
+        statement
+        #:id id)
+
+       (sqlite-step statement)
+       (sqlite-reset statement)
+
+       (changes db)))))
+
 (define (database-select-narinfo-for-file database narinfo-file-url)
   (call-with-worker-thread
    (database-reader-thread-channel database)
-- 
cgit v1.2.3