From 0b642994e766a638ab5136113c32f0bddbdb4773 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 4 May 2022 18:02:36 +0100
Subject: Expose the nar files stats via a new nar_files_total metric

---
 nar-herder/storage.scm | 53 +++++++++++++++++++++++++++++++++++---------------
 1 file changed, 37 insertions(+), 16 deletions(-)

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

diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm
index 97fd334..565037c 100644
--- a/nar-herder/storage.scm
+++ b/nar-herder/storage.scm
@@ -27,6 +27,7 @@
   #:use-module (web response)
   #:use-module (logging logger)
   #:use-module (logging port-log)
+  #:use-module (prometheus)
   #:use-module (json)
   #:use-module ((guix build utils) #:select (dump-port mkdir-p))
   #:use-module ((guix store) #:select (store-path-hash-part))
@@ -124,8 +125,39 @@
       (unrecognised-files . ,(hash-map->list (lambda (key _) key)
                                              files-hash)))))
 
+(define* (get-nar-files database storage-root metrics-registry
+                        #:key stored?)
+  (define nar-files-metric
+    (or (metrics-registry-fetch-metric metrics-registry
+                                       "nar_files_total")
+        (make-gauge-metric metrics-registry
+                           "nar_files_total"
+                           #:labels '(stored))))
+
+  (let* ((index (index-storage database storage-root))
+         (selected-files
+          (filter
+           (lambda (file)
+             (eq? (assq-ref file 'stored?) stored?))
+           (assq-ref index 'narinfo-files))))
+
+    (let ((selected-files-count
+           (length selected-files))
+          (all-files-count
+           (length (assq-ref index 'narinfo-files))))
+
+      (metric-set nar-files-metric
+                  selected-files-count
+                  #:label-values `((stored . ,(if stored? "true" "false"))))
+      (metric-set nar-files-metric
+                  (- all-files-count selected-files-count)
+                  #:label-values `((stored . ,(if stored? "false" "true")))))
+
+    selected-files))
+
 (define (start-nar-removal-thread database
                                   storage-root storage-limit
+                                  metrics-registry
                                   nar-removal-criteria)
 
   (define (check-removal-criteria nar criteria)
@@ -163,13 +195,6 @@
            (check-removal-criteria nar criteria))
          nar-removal-criteria))
 
-  (define (get-stored-nar-files)
-    (let ((index (index-storage database storage-root)))
-      (filter
-       (lambda (file)
-         (assq-ref file 'stored?))
-       (assq-ref index 'narinfo-files))))
-
   (define (run-removal-pass)
     (log-msg 'INFO "looking for nars to remove")
     (let ((initial-storage-size
@@ -181,7 +206,8 @@
                   initial-storage-size)
                  (stored-nar-files
                   (with-time-logging "getting stored nar files"
-                    (get-stored-nar-files))))
+                    (get-nar-files database storage-root metrics-registry
+                                   #:stored? #t))))
         ;; Look through items in local storage, check if the removal
         ;; criteria have been met, and if so, delete it
 
@@ -221,13 +247,6 @@
     (make-gauge-metric metrics-registry
                        "storage_size_bytes"))
 
-  (define (get-missing-nar-files)
-    (let ((index (index-storage database storage-root)))
-      (filter
-       (lambda (file)
-         (not (assq-ref file 'stored?)))
-       (assq-ref index 'narinfo-files))))
-
   (define (fetch-file file)
     (let* ((string-url
             (string-append mirror file))
@@ -274,7 +293,9 @@
       (when (or no-storage-limit?
                 (< initial-storage-size storage-limit))
         (let loop ((storage-size initial-storage-size)
-                   (missing-nar-files (get-missing-nar-files)))
+                   (missing-nar-files (get-nar-files
+                                       database storage-root metrics-registry
+                                       #:stored? #f)))
           (unless (null? missing-nar-files)
             (let ((file (car missing-nar-files)))
               (log-msg 'DEBUG "considering "
-- 
cgit v1.2.3