From 9bcb1fe00ba47081393ab64faa548efe9f6bac16 Mon Sep 17 00:00:00 2001
From: squalus <squalus@squalus.net>
Date: Tue, 28 Nov 2023 23:18:53 -0800
Subject: [PATCH] remote: add deleteSpecific

- add the gcDeleteSpecific action of the CollectGarbage operation.
- add deleteSpecific test
---
 .../src/System/Nix/Store/Remote.hs            | 22 +++++++++++++++++++
 .../src/System/Nix/Store/Remote/Protocol.hs   | 10 ++++++++-
 hnix-store-remote/tests-io/NixDaemon.hs       | 19 ++++++++++++++--
 3 files changed, 48 insertions(+), 3 deletions(-)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs
index f9d42bbb..bcede193 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs
@@ -10,6 +10,7 @@ module System.Nix.Store.Remote
   , addTempRoot
   , buildPaths
   , buildDerivation
+  , deleteSpecific
   , ensurePath
   , findRoots
   , isValidPathUncached
@@ -38,6 +39,7 @@ import Data.Dependent.Sum (DSum((:=>)))
 import Data.HashSet (HashSet)
 import Data.Map (Map)
 import Data.Text (Text)
+import Data.Word (Word64)
 import System.Nix.Nar (NarSource)
 import System.Nix.Derivation (Derivation)
 import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
@@ -164,6 +166,26 @@ buildDerivation p drv buildMode = do
 
   getSocketIncremental get
 
+-- | Delete store paths
+deleteSpecific
+ :: HashSet StorePath -- ^ Paths to delete
+ -> MonadStore (HashSet StorePath, Word64) -- ^ (Paths deleted, Bytes freed)
+deleteSpecific paths = do
+  storeDir <- getStoreDir
+  runOpArgs CollectGarbage $ do
+    putEnum GCDeleteSpecific
+    putPaths storeDir paths
+    putBool False -- ignoreLiveness
+    putInt (maxBound :: Word64) -- maxFreedBytes
+    putInt (0::Int)
+    putInt (0::Int)
+    putInt (0::Int)
+  getSocketIncremental $ do
+    deletedPaths <- getPathsOrFail storeDir
+    bytesFreed <- getInt
+    _ :: Int <- getInt
+    pure (deletedPaths, bytesFreed)
+
 ensurePath :: StorePath -> MonadStore ()
 ensurePath pn = do
   storeDir <- getStoreDir
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs
index 2a9e1ab4..50f2b24b 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs
@@ -11,8 +11,8 @@ module System.Nix.Store.Remote.Protocol
   , runStoreOpts
   , runStoreOptsTCP
   , runStoreOpts'
-
   , ourProtoVersion
+  , GCAction(..)
   ) where
 
 import qualified Control.Monad
@@ -155,3 +155,11 @@ runStoreOpts' sockFamily sockAddr storeRootDir code =
       $ (`runReaderT` sock)
       $ (`runStateT` (Nothing, []))
       $ runExceptT (greet >> code)
+
+data GCAction
+  = GCReturnLive
+  | GCReturnDead
+  | GCDeleteDead
+  | GCDeleteSpecific
+  deriving (Eq, Show, Enum)
+
diff --git a/hnix-store-remote/tests-io/NixDaemon.hs b/hnix-store-remote/tests-io/NixDaemon.hs
index 3d9cc708..df5ec852 100644
--- a/hnix-store-remote/tests-io/NixDaemon.hs
+++ b/hnix-store-remote/tests-io/NixDaemon.hs
@@ -5,9 +5,8 @@ module NixDaemon where
 import Data.Text (Text)
 import Data.Either (isRight, isLeft)
 import Data.Bool (bool)
-import Control.Monad (void)
+import Control.Monad (forM_, void)
 import Control.Monad.IO.Class (liftIO)
-
 import qualified System.Environment
 import Control.Exception (bracket)
 import Control.Concurrent (threadDelay)
@@ -15,6 +14,8 @@ import qualified Data.ByteString.Char8 as BSC
 import qualified Data.Either
 import qualified Data.HashSet as HS
 import qualified Data.Map.Strict as M
+import qualified Data.Text
+import qualified Data.Text.Encoding
 import System.Directory
 import System.IO.Temp
 import qualified System.Process as P
@@ -274,3 +275,17 @@ spec_protocol = Hspec.around withNixDaemon $
         path <- dummy
         liftIO $ print path
         isValidPathUncached path `shouldReturn` True
+
+    context "deleteSpecific" $
+      itRights "delete a path from the store" $ withPath $ \path -> do
+          -- clear temp gc roots so the delete works. restarting the nix daemon should also do this...
+          storeDir <- getStoreDir
+          let tempRootsDir = Data.Text.unpack $ mconcat [ Data.Text.Encoding.decodeUtf8 (unStoreDir storeDir), "/../var/nix/temproots/" ]
+          tempRootList <- liftIO $ listDirectory tempRootsDir
+          liftIO $ forM_ tempRootList $ \entry -> do
+            removeFile $ mconcat [ tempRootsDir, "/", entry ]
+
+          (deletedPaths, deletedBytes) <- deleteSpecific (HS.fromList [path])
+          deletedPaths `shouldBe` HS.fromList [path]
+          deletedBytes `shouldBe` 4
+