add RepairMode to System.Nix.Store.Types

Author: sorki

hnix-store-core/src/System/Nix/ReadonlyStore.hs

@@ -13,7 +13,7 @@ import Crypto.Hash (Context, Digest, SHA256)
 import Data.ByteString (ByteString)
 import Data.HashSet (HashSet)
 import System.Nix.Hash (BaseEncoding(Base16), NamedAlgo(algoName))
-import System.Nix.Store.Types (FileIngestionMethod(..))
+import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode)
 import System.Nix.StorePath (StoreDir, StorePath(StorePath), StorePathName)
 
 import qualified Crypto.Hash
@@ -100,7 +100,7 @@ computeStorePathForPath
   -> FilePath             -- ^ Local `FilePath` to add
   -> FileIngestionMethod  -- ^ Add target directory recursively
   -> (FilePath -> Bool)   -- ^ Path filter function
-  -> Bool                 -- ^ Only used by local store backend
+  -> RepairMode           -- ^ Only used by local store backend
   -> IO StorePath
 computeStorePathForPath storeDir name pth recursive _pathFilter _repair = do
   selectedHash <-

hnix-store-core/src/System/Nix/Store/Types.hs

@@ -1,5 +1,6 @@
 module System.Nix.Store.Types
   ( FileIngestionMethod(..)
+  , RepairMode(..)
   ) where
 
 import GHC.Generics (Generic)
@@ -9,3 +10,9 @@ data FileIngestionMethod
   = FileIngestionMethod_Flat
   | FileIngestionMethod_FileRecursive
   deriving (Bounded, Eq, Generic, Enum, Ord, Show)
+
+-- | Repair mode
+data RepairMode
+  = RepairMode_DoRepair
+  | RepairMode_DontRepair
+  deriving (Bounded, Eq, Generic, Enum, Ord, Show)

hnix-store-remote/README.md

@@ -25,6 +25,6 @@ main = do
     roots <- findRoots
     liftIO $ print roots
 
-    res <- addTextToStore "hnix-store" "test" mempty dontRepair
+    res <- addTextToStore "hnix-store" "test" mempty RepairMode_DontRepair
     liftIO $ print res
 ```

hnix-store-remote/src/System/Nix/Store/Remote.hs

@@ -27,6 +27,7 @@ module System.Nix.Store.Remote
   , runStore
   , syncWithGC
   , verifyStore
+  , module System.Nix.Store.Types
   , module System.Nix.Store.Remote.Types
   ) where
 
@@ -43,7 +44,7 @@ import qualified System.Nix.Hash
 import qualified Data.ByteString.Lazy          as BSL
 
 import System.Nix.Derivation (Derivation)
-import System.Nix.Store.Types (FileIngestionMethod(..))
+import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
 import           System.Nix.Build               ( BuildMode
                                                 , BuildResult
                                                 )
@@ -82,10 +83,10 @@ addToStore
   => StorePathName        -- ^ Name part of the newly created `StorePath`
   -> NarSource MonadStore -- ^ provide nar stream
   -> FileIngestionMethod  -- ^ Add target directory recursively
-  -> RepairFlag           -- ^ Only used by local store backend
+  -> RepairMode           -- ^ Only used by local store backend
   -> MonadStore StorePath
 addToStore name source recursive repair = do
-  Control.Monad.when (unRepairFlag repair)
+  Control.Monad.when (repair == RepairMode_DoRepair)
     $ error "repairing is not supported when building through the Nix daemon"
 
   runOpArgsIO AddToStore $ \yield -> do
@@ -108,10 +109,11 @@ addTextToStore
   :: Text              -- ^ Name of the text
   -> Text              -- ^ Actual text to add
   -> HashSet StorePath -- ^ Set of `StorePath`s that the added text references
-  -> RepairFlag        -- ^ Repair flag, must be `False` in case of remote backend
+  -> RepairMode        -- ^ Repair mode, must be `RepairMode_DontRepair` for remote backend
+                       --   (only valid for local store)
   -> MonadStore StorePath
 addTextToStore name text references' repair = do
-  Control.Monad.when (unRepairFlag repair)
+  Control.Monad.when (repair == RepairMode_DoRepair)
     $ error "repairing is not supported when building through the Nix daemon"
 
   storeDir <- getStoreDir
@@ -329,7 +331,7 @@ syncWithGC :: MonadStore ()
 syncWithGC = Control.Monad.void $ simpleOp SyncWithGC
 
 -- returns True on errors
-verifyStore :: CheckFlag -> RepairFlag -> MonadStore Bool
+verifyStore :: CheckFlag -> RepairMode -> MonadStore Bool
 verifyStore check repair = simpleOpArgs VerifyStore $ do
   putBool $ unCheckFlag check
-  putBool $ unRepairFlag repair
+  putBool $ repair == RepairMode_DoRepair

hnix-store-remote/src/System/Nix/Store/Remote/Types.hs

@@ -5,10 +5,6 @@ module System.Nix.Store.Remote.Types
   , doCheck
   , dontCheck
   , unCheckFlag
-  , RepairFlag
-  , doRepair
-  , dontRepair
-  , unRepairFlag
   , SubstituteFlag
   , doSubstitute
   , dontSubstitute
@@ -53,15 +49,6 @@ doCheck, dontCheck :: CheckFlag
 doCheck = CheckFlag True
 dontCheck = CheckFlag False
 
--- | Repair flag, used by @addToStore@, @addTextToStore@
--- and @verifyStore@
-newtype RepairFlag = RepairFlag { unRepairFlag :: Bool }
-  deriving (Eq, Ord, Show)
-
-doRepair, dontRepair :: RepairFlag
-doRepair = RepairFlag True
-dontRepair = RepairFlag False
-
 -- | Substitute flag, used by @queryValidPaths@
 newtype SubstituteFlag = SubstituteFlag { unSubstituteFlag :: Bool }
   deriving (Eq, Ord, Show)

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

@@ -162,14 +162,14 @@ itLefts name action = it name action isLeft
 
 withPath :: (StorePath -> MonadStore a) -> MonadStore a
 withPath action = do
-  path <- addTextToStore "hnix-store" "test" mempty dontRepair
+  path <- addTextToStore "hnix-store" "test" mempty RepairMode_DontRepair
   action path
 
 -- | dummy path, adds <tmp>/dummpy with "Hello World" contents
 dummy :: MonadStore StorePath
 dummy = do
   let name = Data.Either.fromRight (error "impossible") $ makeStorePathName "dummy"
-  addToStore @SHA256 name (dumpPath "dummy") addNonRecursive dontRepair
+  addToStore @SHA256 name (dumpPath "dummy") FileIngestionMethod_Flat RepairMode_DontRepair
 
 invalidPath :: StorePath
 invalidPath =
@@ -178,7 +178,7 @@ invalidPath =
 
 withBuilder :: (StorePath -> MonadStore a) -> MonadStore a
 withBuilder action = do
-  path <- addTextToStore "builder" builderSh mempty dontRepair
+  path <- addTextToStore "builder" builderSh mempty RepairMode_DontRepair
   action path
 
 builderSh :: Text
@@ -194,14 +194,14 @@ spec_protocol = Hspec.around withNixDaemon $
 
     context "verifyStore" $ do
       itRights "check=False repair=False" $
-        verifyStore dontCheck dontRepair `shouldReturn` False
+        verifyStore dontCheck RepairMode_DontRepair `shouldReturn` False
 
       itRights "check=True repair=False" $
-        verifyStore doCheck dontRepair `shouldReturn` False
+        verifyStore doCheck RepairMode_DontRepair `shouldReturn` False
 
       --privileged
       itRights "check=True repair=True" $
-        verifyStore doCheck doRepair `shouldReturn` False
+        verifyStore doCheck RepairMode_DoRepair `shouldReturn` False
 
     context "addTextToStore" $
       itRights "adds text to store" $ withPath pure
@@ -262,7 +262,7 @@ spec_protocol = Hspec.around withNixDaemon $
       itRights "adds file to store" $ do
         fp <- liftIO $ writeSystemTempFile "addition" "lal"
         let name = Data.Either.fromRight (error "impossible") $ makeStorePathName "tmp-addition"
-        res <- addToStore @SHA256 name (dumpPath fp) FileIngestionMethod_Flat dontRepair
+        res <- addToStore @SHA256 name (dumpPath fp) FileIngestionMethod_Flat RepairMode_DontRepair
         liftIO $ print res
 
     context "with dummy" $ do

hnix-store-tests/src/System/Nix/Arbitrary/Store/Types.hs

@@ -10,3 +10,6 @@ import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
 
 deriving via GenericArbitrary FileIngestionMethod
   instance Arbitrary FileIngestionMethod
+
+deriving via GenericArbitrary RepairMode
+  instance Arbitrary RepairMode