Fix and test removing nars

1 files changed, 32 insertions, 0 deletions

diff --git a/nar-herder/database.scm b/nar-herder/database.scm
index 31fe5e7..060d2ba 100644
--- a/nar-herder/database.scm
+++ b/nar-herder/database.scm
@@ -45,6 +45,7 @@
             database-select-recent-changes
             database-select-latest-recent-change-datetime
 
+            database-select-narinfo-for-file
             database-select-narinfo-files
 
             database-map-all-narinfo-files))
@@ -479,6 +480,37 @@ SELECT datetime FROM recent_changes ORDER BY datetime DESC LIMIT 1"
 
          result)))))
 
+(define (database-select-narinfo-for-file database narinfo-file-url)
+  (call-with-worker-thread
+   (database-reader-thread-channel database)
+   (lambda (db)
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+SELECT narinfos.store_path, narinfos.nar_hash, narinfos.nar_size,
+       narinfos.deriver, narinfos.system, narinfos.contents
+FROM narinfos
+INNER JOIN narinfo_files
+  ON narinfos.id = narinfo_files.narinfo_id
+WHERE narinfo_files.url = :url"
+             #:cache? #t)))
+
+       (sqlite-bind-arguments
+        statement
+        #:url narinfo-file-url)
+
+       (match (sqlite-step statement)
+         (#(store-path nar-hash nar-size deriver system contents)
+          (sqlite-reset statement)
+
+          `((store-path . ,store-path)
+            (nar-hash   . ,nar-hash)
+            (nar-size   . ,nar-size)
+            (deriver    . ,deriver)
+            (system     . ,system)
+            (contents   . ,contents))))))))
+
 (define (database-select-narinfo-files database hash)
   (call-with-worker-thread
    (database-reader-thread-channel database)