remote: add deleteSpecific

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
@@ -35,6 +36,7 @@ import Data.Dependent.Sum (DSum((:=>)))
 import Data.HashSet (HashSet)
 import Data.Map (Map)
 import Data.Text (Text)
+import Data.Word
 import qualified Data.Text
 import qualified Control.Monad
 import qualified Data.Attoparsec.Text
@@ -173,6 +175,26 @@ buildDerivation p drv buildMode = do
 
   getSocketIncremental getBuildResult
 
+-- | 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 <- getPaths 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,6 +11,7 @@ module System.Nix.Store.Remote.Protocol
   , runStoreOpts
   , runStoreOptsTCP
   , runStoreOpts'
+  , GCAction(..)
   ) where
 
 import qualified Control.Monad
@@ -216,3 +217,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

@@ -7,7 +7,7 @@ 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
@@ -17,6 +17,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                     as Text
+import qualified Data.Text.Encoding            as Text
 import           System.Directory
 import           System.IO.Temp
 import qualified System.Process                as P
@@ -272,3 +274,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 = Text.unpack $ mconcat [ Text.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
+