mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
remote: move and rename (CheckFlag|SubstituteFlag) to Types.(Check|Substitude)Mode
This commit is contained in:
parent
7cd4adde40
commit
4f40e0574a
@ -69,8 +69,10 @@ library
|
||||
, System.Nix.Store.Remote.Protocol
|
||||
, System.Nix.Store.Remote.Socket
|
||||
, System.Nix.Store.Remote.Types
|
||||
, System.Nix.Store.Remote.Types.CheckMode
|
||||
, System.Nix.Store.Remote.Types.ProtoVersion
|
||||
, System.Nix.Store.Remote.Types.StoreConfig
|
||||
, System.Nix.Store.Remote.Types.SubstituteMode
|
||||
, System.Nix.Store.Remote.Types.WorkerOp
|
||||
|
||||
build-depends:
|
||||
|
@ -63,10 +63,11 @@ import Crypto.Hash (SHA256)
|
||||
import System.Nix.Nar (NarSource)
|
||||
|
||||
import Data.Serialize (get)
|
||||
import qualified Data.Serialize.Put
|
||||
import System.Nix.Store.Remote.Serialize
|
||||
import System.Nix.Store.Remote.Serialize.Prim
|
||||
|
||||
import qualified Data.Serialize.Put
|
||||
|
||||
-- | Pack `Nar` and add it to the store.
|
||||
addToStore
|
||||
:: forall a
|
||||
@ -198,13 +199,13 @@ isValidPathUncached p = do
|
||||
-- | Query valid paths from set, optionally try to use substitutes.
|
||||
queryValidPaths
|
||||
:: HashSet StorePath -- ^ Set of `StorePath`s to query
|
||||
-> SubstituteFlag -- ^ Try substituting missing paths when `True`
|
||||
-> SubstituteMode -- ^ Try substituting missing paths when `True`
|
||||
-> MonadStore (HashSet StorePath)
|
||||
queryValidPaths ps substitute = do
|
||||
storeDir <- getStoreDir
|
||||
runOpArgs QueryValidPaths $ do
|
||||
putPaths storeDir ps
|
||||
putBool (unSubstituteFlag substitute)
|
||||
putBool $ substitute == SubstituteMode_DoSubstitute
|
||||
sockGetPaths
|
||||
|
||||
queryAllValidPaths :: MonadStore (HashSet StorePath)
|
||||
@ -325,7 +326,7 @@ syncWithGC :: MonadStore ()
|
||||
syncWithGC = Control.Monad.void $ simpleOp SyncWithGC
|
||||
|
||||
-- returns True on errors
|
||||
verifyStore :: CheckFlag -> RepairMode -> MonadStore Bool
|
||||
verifyStore :: CheckMode -> RepairMode -> MonadStore Bool
|
||||
verifyStore check repair = simpleOpArgs VerifyStore $ do
|
||||
putBool $ unCheckFlag check
|
||||
putBool $ check == CheckMode_DoCheck
|
||||
putBool $ repair == RepairMode_DoRepair
|
||||
|
@ -1,14 +1,6 @@
|
||||
module System.Nix.Store.Remote.Types
|
||||
( MonadStore
|
||||
, StoreConfig(..)
|
||||
, CheckFlag
|
||||
, doCheck
|
||||
, dontCheck
|
||||
, unCheckFlag
|
||||
, SubstituteFlag
|
||||
, doSubstitute
|
||||
, dontSubstitute
|
||||
, unSubstituteFlag
|
||||
, Logger(..)
|
||||
, Field(..)
|
||||
, mapStoreDir
|
||||
@ -20,7 +12,9 @@ module System.Nix.Store.Remote.Types
|
||||
, getError
|
||||
, setData
|
||||
, clearData
|
||||
, module System.Nix.Store.Remote.Types.CheckMode
|
||||
, module System.Nix.Store.Remote.Types.ProtoVersion
|
||||
, module System.Nix.Store.Remote.Types.SubstituteMode
|
||||
, module System.Nix.Store.Remote.Types.WorkerOp
|
||||
) where
|
||||
|
||||
@ -34,27 +28,13 @@ import Control.Monad.Trans.State.Strict (mapStateT)
|
||||
import Control.Monad.Trans.Except (mapExceptT)
|
||||
import Control.Monad.Trans.Reader (withReaderT)
|
||||
|
||||
import System.Nix.Store.Remote.Types.CheckMode
|
||||
import System.Nix.Store.Remote.Types.ProtoVersion
|
||||
import System.Nix.Store.Remote.Types.StoreConfig
|
||||
import System.Nix.Store.Remote.Types.SubstituteMode
|
||||
import System.Nix.Store.Remote.Types.WorkerOp
|
||||
import System.Nix.StorePath (HasStoreDir(..), StoreDir)
|
||||
|
||||
-- | Check flag, used by @verifyStore@
|
||||
newtype CheckFlag = CheckFlag { unCheckFlag :: Bool }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
doCheck, dontCheck :: CheckFlag
|
||||
doCheck = CheckFlag True
|
||||
dontCheck = CheckFlag False
|
||||
|
||||
-- | Substitute flag, used by @queryValidPaths@
|
||||
newtype SubstituteFlag = SubstituteFlag { unSubstituteFlag :: Bool }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
doSubstitute, dontSubstitute :: SubstituteFlag
|
||||
doSubstitute = SubstituteFlag True
|
||||
dontSubstitute = SubstituteFlag False
|
||||
|
||||
-- | Ask for a @StoreDir@
|
||||
getStoreDir' :: (HasStoreDir r, MonadReader r m) => m StoreDir
|
||||
getStoreDir' = asks hasStoreDir
|
||||
|
@ -0,0 +1,11 @@
|
||||
module System.Nix.Store.Remote.Types.CheckMode
|
||||
( CheckMode(..)
|
||||
) where
|
||||
|
||||
import GHC.Generics
|
||||
|
||||
-- | Check mode, used by @verifyStore@
|
||||
data CheckMode
|
||||
= CheckMode_DoCheck
|
||||
| CheckMode_DontCheck
|
||||
deriving (Bounded, Eq, Generic, Enum, Ord, Show)
|
@ -0,0 +1,11 @@
|
||||
module System.Nix.Store.Remote.Types.SubstituteMode
|
||||
( SubstituteMode(..)
|
||||
) where
|
||||
|
||||
import GHC.Generics
|
||||
|
||||
-- | Path substitution mode, used by @queryValidPaths@
|
||||
data SubstituteMode
|
||||
= SubstituteMode_DoSubstitute
|
||||
| SubstituteMode_DontSubstitute
|
||||
deriving (Bounded, Eq, Generic, Enum, Ord, Show)
|
@ -187,14 +187,23 @@ spec_protocol = Hspec.around withNixDaemon $
|
||||
|
||||
context "verifyStore" $ do
|
||||
itRights "check=False repair=False" $
|
||||
verifyStore dontCheck RepairMode_DontRepair `shouldReturn` False
|
||||
verifyStore
|
||||
CheckMode_DontCheck
|
||||
RepairMode_DontRepair
|
||||
`shouldReturn` False
|
||||
|
||||
itRights "check=True repair=False" $
|
||||
verifyStore doCheck RepairMode_DontRepair `shouldReturn` False
|
||||
verifyStore
|
||||
CheckMode_DoCheck
|
||||
RepairMode_DontRepair
|
||||
`shouldReturn` False
|
||||
|
||||
--privileged
|
||||
itRights "check=True repair=True" $
|
||||
verifyStore doCheck RepairMode_DoRepair `shouldReturn` False
|
||||
verifyStore
|
||||
CheckMode_DoCheck
|
||||
RepairMode_DoRepair
|
||||
`shouldReturn` False
|
||||
|
||||
context "addTextToStore" $
|
||||
itRights "adds text to store" $ withPath pure
|
||||
|
Loading…
Reference in New Issue
Block a user