Recursive -> FileIngestionMethod, remove Bools

Actually the same thing, now with prefixed constructors
for extra clarity.

Closes #238
This commit is contained in:
Richard Marko 2023-11-22 08:45:02 +01:00
parent f6b06e0005
commit 8ac46de0bd
12 changed files with 57 additions and 39 deletions

View File

@ -73,6 +73,7 @@ library
, System.Nix.Nar.Options
, System.Nix.ReadonlyStore
, System.Nix.Signature
, System.Nix.Store.Types
, System.Nix.StorePath
, System.Nix.StorePath.Metadata
build-depends:

View File

@ -18,17 +18,13 @@ import Data.Text (Text)
import Data.Text.Lazy.Builder (Builder)
import GHC.Generics (Generic)
import System.Nix.Hash (HashAlgo)
import System.Nix.Store.Types (FileIngestionMethod(..))
import qualified Data.Attoparsec.Text
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Builder
import qualified System.Nix.Hash
data FileIngestionMethod
= Flat
| FileRecursive
deriving (Eq, Bounded, Generic, Enum, Ord, Show)
data ContentAddressMethod
= FileIngestionMethod !FileIngestionMethod
-- ^ The path was added to the store via makeFixedOutputPath or
@ -74,8 +70,8 @@ contentAddressBuilder (ContentAddress method digest) = case method of
fileIngestionMethodBuilder :: FileIngestionMethod -> Builder
fileIngestionMethodBuilder = \case
Flat -> ""
FileRecursive -> "r:"
FileIngestionMethod_Flat -> ""
FileIngestionMethod_FileRecursive -> "r:"
-- | Parse `ContentAddressableAddress` from `ByteString`
parseContentAddress
@ -95,7 +91,9 @@ contentAddressParser = do
parseContentAddressMethod :: Parser ContentAddressMethod
parseContentAddressMethod =
TextIngestionMethod <$ "text:"
<|> FileIngestionMethod <$ "fixed:" <*> (FileRecursive <$ "r:" <|> pure Flat)
<|> FileIngestionMethod <$ "fixed:"
<*> (FileIngestionMethod_FileRecursive <$ "r:"
<|> pure FileIngestionMethod_Flat)
parseTypedDigest :: Parser (Either String (DSum HashAlgo Digest))
parseTypedDigest = System.Nix.Hash.mkNamedDigest <$> parseHashType <*> parseHash

View File

@ -13,6 +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.StorePath (StoreDir, StorePath(StorePath), StorePathName)
import qualified Crypto.Hash
@ -66,20 +67,21 @@ makeFixedOutputPath
:: forall hashAlgo
. NamedAlgo hashAlgo
=> StoreDir
-> Bool
-> FileIngestionMethod
-> Digest hashAlgo
-> StorePathName
-> StorePath
makeFixedOutputPath storeDir recursive h =
if recursive && (algoName @hashAlgo) == "sha256"
then makeStorePath storeDir "source" h
else makeStorePath storeDir "output:out" h'
if recursive == FileIngestionMethod_FileRecursive
&& (algoName @hashAlgo) == "sha256"
then makeStorePath storeDir "source" h
else makeStorePath storeDir "output:out" h'
where
h' =
Crypto.Hash.hash @ByteString @SHA256
$ "fixed:out:"
<> Data.Text.Encoding.encodeUtf8 (algoName @hashAlgo)
<> (if recursive then ":r:" else ":")
<> (if recursive == FileIngestionMethod_FileRecursive then ":r:" else ":")
<> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.encodeDigestWith Base16 h)
<> ":"
@ -96,12 +98,15 @@ computeStorePathForPath
:: StoreDir
-> StorePathName -- ^ Name part of the newly created `StorePath`
-> FilePath -- ^ Local `FilePath` to add
-> Bool -- ^ Add target directory recursively
-> FileIngestionMethod -- ^ Add target directory recursively
-> (FilePath -> Bool) -- ^ Path filter function
-> Bool -- ^ Only used by local store backend
-> IO StorePath
computeStorePathForPath storeDir name pth recursive _pathFilter _repair = do
selectedHash <- if recursive then recursiveContentHash else flatContentHash
selectedHash <-
if recursive == FileIngestionMethod_FileRecursive
then recursiveContentHash
else flatContentHash
pure $ makeFixedOutputPath storeDir recursive selectedHash name
where
recursiveContentHash :: IO (Digest SHA256)

View File

@ -0,0 +1,11 @@
module System.Nix.Store.Types
( FileIngestionMethod(..)
) where
import GHC.Generics (Generic)
-- | Add path recursively or not
data FileIngestionMethod
= FileIngestionMethod_Flat
| FileIngestionMethod_FileRecursive
deriving (Bounded, Eq, Generic, Enum, Ord, Show)

View File

@ -8,6 +8,7 @@ import Test.Hspec (Spec, describe, it, shouldBe)
import Crypto.Hash (hash, Digest, SHA256(..))
import Data.ByteString (ByteString)
import System.Nix.StorePath (StorePath, StorePathName)
import System.Nix.Store.Types (FileIngestionMethod(..))
import qualified Data.HashSet
import qualified System.Nix.StorePath
@ -84,7 +85,7 @@ spec_readOnly = do
(pure
$ makeFixedOutputPath
def
True
FileIngestionMethod_FileRecursive
testDigest
testName
)
@ -97,7 +98,7 @@ spec_readOnly = do
(pure
$ makeFixedOutputPath
def
False
FileIngestionMethod_Flat
testDigest
testName
)

View File

@ -43,6 +43,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.Build ( BuildMode
, BuildResult
)
@ -80,7 +81,7 @@ addToStore
. (NamedAlgo a)
=> StorePathName -- ^ Name part of the newly created `StorePath`
-> NarSource MonadStore -- ^ provide nar stream
-> Recursive -- ^ Add target directory recursively
-> FileIngestionMethod -- ^ Add target directory recursively
-> RepairFlag -- ^ Only used by local store backend
-> MonadStore StorePath
addToStore name source recursive repair = do
@ -90,8 +91,11 @@ addToStore name source recursive repair = do
runOpArgsIO AddToStore $ \yield -> do
yield $ BSL.toStrict $ Data.Binary.Put.runPut $ do
putText $ System.Nix.StorePath.unStorePathName name
putBool $ not $ System.Nix.Hash.algoName @a == "sha256" && (unRecursive recursive)
putBool (unRecursive recursive)
putBool
$ not
$ System.Nix.Hash.algoName @a == "sha256"
&& recursive == FileIngestionMethod_FileRecursive
putBool (recursive == FileIngestionMethod_FileRecursive)
putText $ System.Nix.Hash.algoName @a
source yield
sockGetPath

View File

@ -13,10 +13,6 @@ module System.Nix.Store.Remote.Types
, doSubstitute
, dontSubstitute
, unSubstituteFlag
, Recursive
, addRecursive
, addNonRecursive
, unRecursive
, Logger(..)
, Field(..)
, mapStoreDir
@ -74,16 +70,6 @@ doSubstitute, dontSubstitute :: SubstituteFlag
doSubstitute = SubstituteFlag True
dontSubstitute = SubstituteFlag False
-- | Recursive, used by @addToStore@
newtype Recursive = Recursive { unRecursive :: Bool }
deriving (Eq, Ord, Show)
addRecursive, addNonRecursive :: Recursive
-- | Add target directory recursively
addRecursive = Recursive True
-- | Add target directory non-recursively
addNonRecursive = Recursive False
type MonadStore a
= ExceptT
String

View File

@ -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) addNonRecursive dontRepair
res <- addToStore @SHA256 name (dumpPath fp) FileIngestionMethod_Flat dontRepair
liftIO $ print res
context "with dummy" $ do

View File

@ -41,6 +41,7 @@ library
, System.Nix.Arbitrary.Derivation
, System.Nix.Arbitrary.DerivedPath
, System.Nix.Arbitrary.Hash
, System.Nix.Arbitrary.Store.Types
, System.Nix.Arbitrary.StorePath
, Test.Hspec.Nix
build-depends:

View File

@ -5,4 +5,5 @@ import System.Nix.Arbitrary.ContentAddress ()
import System.Nix.Arbitrary.Derivation ()
import System.Nix.Arbitrary.DerivedPath ()
import System.Nix.Arbitrary.Hash ()
import System.Nix.Arbitrary.Store.Types ()
import System.Nix.Arbitrary.StorePath ()

View File

@ -4,14 +4,12 @@
module System.Nix.Arbitrary.ContentAddress where
import System.Nix.Arbitrary.Hash ()
import System.Nix.ContentAddress (FileIngestionMethod, ContentAddress, ContentAddressMethod)
import System.Nix.Arbitrary.Store.Types ()
import System.Nix.ContentAddress (ContentAddress, ContentAddressMethod)
import Test.QuickCheck (Arbitrary(..))
import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
deriving via GenericArbitrary FileIngestionMethod
instance Arbitrary FileIngestionMethod
deriving via GenericArbitrary ContentAddressMethod
instance Arbitrary ContentAddressMethod

View File

@ -0,0 +1,12 @@
-- due to recent generic-arbitrary
{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module System.Nix.Arbitrary.Store.Types where
import System.Nix.Store.Types
import Test.QuickCheck (Arbitrary(..))
import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
deriving via GenericArbitrary FileIngestionMethod
instance Arbitrary FileIngestionMethod