From 9f102dbd39c0c317a21b2d0eb84acce2242fb41f Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 1 Aug 2023 14:13:10 +0100
Subject: Add code to delete nars entries

---
 guix-data-service/data-deletion.scm | 61 ++++++++++++++++++++++++++++++++++++-
 1 file changed, 60 insertions(+), 1 deletion(-)

diff --git a/guix-data-service/data-deletion.scm b/guix-data-service/data-deletion.scm
index 0dd4a78..c9dc631 100644
--- a/guix-data-service/data-deletion.scm
+++ b/guix-data-service/data-deletion.scm
@@ -32,7 +32,8 @@
             delete-revisions-from-branch-except-most-recent-n
             delete-revisions-for-all-branches-except-most-recent-n
             delete-data-for-all-deleted-branches
-            delete-unreferenced-derivations))
+            delete-unreferenced-derivations
+            delete-nars-for-unknown-store-paths))
 
 (define (delete-guix-revisions conn git-repository-id commits)
   (define (delete-unreferenced-package-derivations)
@@ -662,3 +663,61 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED")
                 (loop (+ total-deleted batch-deleted-count))))))))
    #:hz 0
    #:parallelism 1))
+
+(define (delete-nars-for-unknown-store-paths)
+  (define (get-nar-ids-batch conn)
+    (map
+     car
+     (exec-query
+      conn
+      "
+SELECT id
+FROM nars
+WHERE NOT EXISTS
+  (
+    SELECT 1 FROM derivation_output_details
+    WHERE derivation_output_details.path = nars.store_path
+  )
+LIMIT 50")))
+
+  (define (delete-narinfo-signature-data conn nar-ids)
+    (exec-query
+     conn
+     (string-append
+      "
+DELETE FROM narinfo_signature_data
+  WHERE id IN (
+    SELECT narinfo_signature_data_id
+    FROM narinfo_signatures
+    WHERE nar_id IN ("
+      (string-join nar-ids ",")
+      ")
+)")))
+
+  (define (delete-nars conn nar-ids)
+    (exec-query
+     conn
+     (string-append
+      "
+DELETE FROM nars WHERE id IN ("
+      (string-join nar-ids ",")
+      "
+)")))
+
+  (with-postgresql-connection
+   "data-deletion"
+   (lambda (conn)
+     (with-advisory-session-lock
+      conn
+      'delete-nars-for-unknown-store-paths
+      (lambda ()
+        (newline)
+        (let loop ((nar-ids (get-nar-ids-batch conn)))
+          (unless (null? nar-ids)
+            (delete-narinfo-signature-data conn nar-ids)
+            (delete-nars conn nar-ids)
+
+            (display ".")
+            (force-output)
+
+            (loop (get-nar-ids-batch conn)))))))))
-- 
cgit v1.2.3