From aa009075d6757ced963250e849b0cdf5764a2f52 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 11 Sep 2023 09:52:31 +0100
Subject: Use recent changes to trigger nar mirroring and removal

As this should be more efficient than repeatedly looking through all
the nars in the database.
---
 scripts/nar-herder.in | 66 ++++++++++++++++++++++++++++-----------------------
 1 file changed, 36 insertions(+), 30 deletions(-)

(limited to 'scripts')

diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in
index 0736592..5991d02 100644
--- a/scripts/nar-herder.in
+++ b/scripts/nar-herder.in
@@ -629,37 +629,43 @@
                 (* 24 3600)                     ; 24 hours
                 (assq-ref opts 'recent-changes-limit))
 
-               (and=> (assq-ref opts 'mirror)
-                      (lambda (mirror)
-                        (start-fetch-changes-fiber database
+               (let ((mirror-channel
+                      (and=>
+                       (assq-ref opts 'mirror)
+                       (lambda (mirror)
+                         (start-fetch-changes-fiber database
+                                                    canonical-storage
+                                                    mirror
+                                                    metrics-registry)
+
+                         (when (assq-ref opts 'storage)
+                           (start-mirroring-fiber database
+                                                  mirror
+                                                  (assq-ref opts 'storage-limit)
+                                                  canonical-storage
+                                                  metrics-registry)))))
+                     (removal-channel
+                      (let ((nar-removal-criteria
+                             (filter-map
+                              (match-lambda
+                                ((key . val)
+                                 (if (eq? key 'storage-nar-removal-criteria)
+                                     val
+                                     #f)))
+                              opts)))
+                        (when (and (assq-ref opts 'storage)
+                                   (number? (assq-ref opts 'storage-limit))
+                                   (not (null? nar-removal-criteria)))
+                          (start-nar-removal-fiber database
                                                    canonical-storage
-                                                   mirror
-                                                   metrics-registry)
-
-                        (when (assq-ref opts 'storage)
-                          (start-mirroring-fiber database
-                                                 mirror
-                                                 (assq-ref opts 'storage-limit)
-                                                 canonical-storage
-                                                 metrics-registry))))
-
-
-               (let ((nar-removal-criteria
-                      (filter-map
-                       (match-lambda
-                         ((key . val)
-                          (if (eq? key 'storage-nar-removal-criteria)
-                              val
-                              #f)))
-                       opts)))
-                 (when (and (assq-ref opts 'storage)
-                            (number? (assq-ref opts 'storage-limit))
-                            (not (null? nar-removal-criteria)))
-                   (start-nar-removal-fiber database
-                                            canonical-storage
-                                            (assq-ref opts 'storage-limit)
-                                            metrics-registry
-                                            nar-removal-criteria)))
+                                                   (assq-ref opts 'storage-limit)
+                                                   metrics-registry
+                                                   nar-removal-criteria)))))
+
+                 (start-recent-change-listener-fiber
+                  database
+                  mirror-channel
+                  removal-channel))
 
                (wait finished?))
              #:hz 0
-- 
cgit v1.2.3