remote: move flags to Types, wrap in newtype

Author: sorki

hnix-store-remote/README.md

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

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

@@ -71,9 +71,6 @@ import           System.Nix.Store.Remote.Util
 import           Crypto.Hash                    ( SHA256 )
 import           System.Nix.Nar                 ( NarSource )
 
-type RepairFlag = Bool
-type CheckFlag = Bool
-type SubstituteFlag = Bool
 
 -- | Pack `Nar` and add it to the store.
 addToStore
@@ -84,7 +81,10 @@ addToStore
   -> Bool                 -- ^ Add target directory recursively
   -> RepairFlag           -- ^ Only used by local store backend
   -> MonadStore StorePath
-addToStore name source recursive _repair = do
+addToStore name source recursive repair = do
+  when (unRepairFlag repair)
+    $ error "repairing is not supported when building through the Nix daemon"
+
   runOpArgsIO AddToStore $ \yield -> do
     yield $ toStrict $ Data.Binary.Put.runPut $ do
       putText $ System.Nix.StorePath.unStorePathName name
@@ -105,8 +105,9 @@ addTextToStore
   -> RepairFlag   -- ^ Repair flag, must be `False` in case of remote backend
   -> MonadStore StorePath
 addTextToStore name text references' repair = do
-  when repair
+  when (unRepairFlag repair)
     $ error "repairing is not supported when building through the Nix daemon"
+
   storeDir <- getStoreDir
   runOpArgs AddTextToStore $ do
     putText name
@@ -204,7 +205,7 @@ queryValidPaths ps substitute = do
   storeDir <- getStoreDir
   runOpArgs QueryValidPaths $ do
     putPaths storeDir ps
-    putBool substitute
+    putBool (unSubstituteFlag substitute)
   sockGetPaths
 
 queryAllValidPaths :: MonadStore StorePathSet
@@ -321,5 +322,5 @@ syncWithGC = void $ simpleOp SyncWithGC
 -- returns True on errors
 verifyStore :: CheckFlag -> RepairFlag -> MonadStore Bool
 verifyStore check repair = simpleOpArgs VerifyStore $ do
-  putBool check
-  putBool repair
+  putBool $ unCheckFlag check
+  putBool $ unRepairFlag repair

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

@@ -4,6 +4,18 @@
 module System.Nix.Store.Remote.Types
   ( MonadStore
   , StoreConfig(..)
+  , CheckFlag
+  , doCheck
+  , dontCheck
+  , unCheckFlag
+  , RepairFlag
+  , doRepair
+  , dontRepair
+  , unRepairFlag
+  , SubstituteFlag
+  , doSubstitute
+  , dontSubstitute
+  , unSubstituteFlag
   , Logger(..)
   , Field(..)
   , mapStoreDir
@@ -29,6 +41,31 @@ data StoreConfig = StoreConfig
   , storeSocket :: Socket
   }
 
+-- | Check flag, used by @verifyStore@
+newtype CheckFlag = CheckFlag { unCheckFlag :: Bool }
+  deriving (Eq, Ord, Show)
+
+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)
+
+doSubstitute, dontSubstitute :: SubstituteFlag
+doSubstitute = SubstituteFlag True
+dontSubstitute = SubstituteFlag False
+
 type MonadStore a
   = ExceptT
       String

hnix-store-remote/tests/NixDaemon.hs

@@ -154,14 +154,14 @@ itLefts name action = it name action isLeft
 
 withPath :: (StorePath -> MonadStore a) -> MonadStore a
 withPath action = do
-  path <- addTextToStore "hnix-store" "test" (HS.fromList []) False
+  path <- addTextToStore "hnix-store" "test" mempty 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") False False
+  addToStore @SHA256 name (dumpPath "dummy") False dontRepair
 
 invalidPath :: StorePath
 invalidPath =
@@ -170,7 +170,7 @@ invalidPath =
 
 withBuilder :: (StorePath -> MonadStore a) -> MonadStore a
 withBuilder action = do
-  path <- addTextToStore "builder" builderSh (HS.fromList []) False
+  path <- addTextToStore "builder" builderSh mempty dontRepair
   action path
 
 builderSh :: Text
@@ -186,14 +186,14 @@ spec_protocol = Hspec.around withNixDaemon $
 
     context "verifyStore" $ do
       itRights "check=False repair=False" $
-        verifyStore False False `shouldReturn` False
+        verifyStore dontCheck dontRepair `shouldReturn` False
 
       itRights "check=True repair=False" $
-        verifyStore True False `shouldReturn` False
+        verifyStore doCheck dontRepair `shouldReturn` False
 
       --privileged
       itRights "check=True repair=True" $
-        verifyStore True True `shouldReturn` False
+        verifyStore doCheck doRepair `shouldReturn` False
 
     context "addTextToStore" $
       itRights "adds text to store" $ withPath pure
@@ -252,7 +252,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) False False
+        res <- addToStore @SHA256 name (dumpPath fp) False dontRepair
         liftIO $ print res
 
     context "with dummy" $ do