remote: add deleteSpecific

- add the gcDeleteSpecific action of the CollectGarbage operation.
- add deleteSpecific test

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

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)
+

hnix-store-remote/tests-io/NixDaemon.hs

@@ -5,16 +5,17 @@ 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)
 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
+