diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index e9666a2a..3fd12e39 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -64,6 +64,7 @@ library , System.Nix.Derivation , System.Nix.DerivedPath , System.Nix.Fingerprint + , System.Nix.FileContentAddress , System.Nix.Hash , System.Nix.Hash.Truncation , System.Nix.OutputName diff --git a/hnix-store-core/src/System/Nix/ContentAddress.hs b/hnix-store-core/src/System/Nix/ContentAddress.hs index fa94671b..33541ee2 100644 --- a/hnix-store-core/src/System/Nix/ContentAddress.hs +++ b/hnix-store-core/src/System/Nix/ContentAddress.hs @@ -1,9 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module System.Nix.ContentAddress ( - ContentAddress - , ContentAddressMethod - , FileIngestionMethod + ContentAddress (..) + , ContentAddressMethod (..) , contentAddressBuilder , contentAddressParser , buildContentAddress @@ -18,7 +17,6 @@ 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 @@ -26,11 +24,9 @@ import qualified Data.Text.Lazy.Builder import qualified System.Nix.Hash data ContentAddressMethod - = FileIngestionMethod !FileIngestionMethod - -- ^ The path was added to the store via makeFixedOutputPath or - -- addToStore. It is addressed according to some hash algorithm - -- applied to the nar serialization via some 'NarHashMode'. - | TextIngestionMethod + = ContentAddressMethod_Flat + | ContentAddressMethod_NixArchive + | ContentAddressMethod_Text -- ^ The path is a plain file added via makeTextPath or -- addTextToStore. It is addressed according to a sha256sum of the -- file contents. @@ -59,19 +55,14 @@ buildContentAddress = . contentAddressBuilder contentAddressBuilder :: ContentAddress -> Builder -contentAddressBuilder (ContentAddress method digest) = case method of - TextIngestionMethod -> - "text:" - <> System.Nix.Hash.algoDigestBuilder digest - FileIngestionMethod r -> - "fixed:" - <> fileIngestionMethodBuilder r - <> System.Nix.Hash.algoDigestBuilder digest - -fileIngestionMethodBuilder :: FileIngestionMethod -> Builder -fileIngestionMethodBuilder = \case - FileIngestionMethod_Flat -> "" - FileIngestionMethod_FileRecursive -> "r:" +contentAddressBuilder (ContentAddress method digest) = + (case method of + ContentAddressMethod_Text -> "text" + ContentAddressMethod_NixArchive -> "fixed:r" + ContentAddressMethod_Flat -> "fixed" + ) + <> ":" + <> System.Nix.Hash.algoDigestBuilder digest -- | Parse `ContentAddressableAddress` from `ByteString` parseContentAddress @@ -83,6 +74,7 @@ parseContentAddress = contentAddressParser :: Parser ContentAddress contentAddressParser = do method <- parseContentAddressMethod + _ <- ":" digest <- parseTypedDigest case digest of Left e -> fail e @@ -90,10 +82,9 @@ contentAddressParser = do parseContentAddressMethod :: Parser ContentAddressMethod parseContentAddressMethod = - TextIngestionMethod <$ "text:" - <|> FileIngestionMethod <$ "fixed:" - <*> (FileIngestionMethod_FileRecursive <$ "r:" - <|> pure FileIngestionMethod_Flat) + (ContentAddressMethod_Text <$ "text") + <|> (ContentAddressMethod_NixArchive <$ "fixed:r") + <|> (ContentAddressMethod_Flat <$ "fixed") parseTypedDigest :: Parser (Either String (DSum HashAlgo Digest)) parseTypedDigest = System.Nix.Hash.mkNamedDigest <$> parseHashType <*> parseHash diff --git a/hnix-store-core/src/System/Nix/FileContentAddress.hs b/hnix-store-core/src/System/Nix/FileContentAddress.hs new file mode 100644 index 00000000..88acbc22 --- /dev/null +++ b/hnix-store-core/src/System/Nix/FileContentAddress.hs @@ -0,0 +1,10 @@ +module System.Nix.FileContentAddress + ( FileIngestionMethod(..) + ) where + +import GHC.Generics (Generic) + +data FileIngestionMethod + = FileIngestionMethod_Flat + | FileIngestionMethod_NixArchive + deriving (Bounded, Eq, Generic, Enum, Ord, Show) diff --git a/hnix-store-core/src/System/Nix/Store/Types.hs b/hnix-store-core/src/System/Nix/Store/Types.hs index e625dbb1..06aed2c6 100644 --- a/hnix-store-core/src/System/Nix/Store/Types.hs +++ b/hnix-store-core/src/System/Nix/Store/Types.hs @@ -1,17 +1,11 @@ +-- | TODO rename module module System.Nix.Store.Types - ( FileIngestionMethod(..) - , PathFilter(..) + ( PathFilter(..) , RepairMode(..) ) where import GHC.Generics (Generic) --- | Add path recursively or not -data FileIngestionMethod - = FileIngestionMethod_Flat - | FileIngestionMethod_FileRecursive - deriving (Bounded, Eq, Generic, Enum, Ord, Show) - -- | Path filtering function newtype PathFilter = PathFilter { pathFilterFunction :: FilePath -> Bool diff --git a/hnix-store-readonly/src/System/Nix/Store/ReadOnly.hs b/hnix-store-readonly/src/System/Nix/Store/ReadOnly.hs index 55de98b3..2f45efef 100644 --- a/hnix-store-readonly/src/System/Nix/Store/ReadOnly.hs +++ b/hnix-store-readonly/src/System/Nix/Store/ReadOnly.hs @@ -1,10 +1,10 @@ +{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} module System.Nix.Store.ReadOnly - ( makeStorePath - , makeTextPath + ( References(..) + , makeStorePath , makeFixedOutputPath - , computeStorePathForText , computeStorePathForPath ) where @@ -15,8 +15,9 @@ import Data.Constraint.Extras (Has(has)) import Data.Dependent.Sum (DSum((:=>))) import Data.HashSet (HashSet) import Data.Some (Some(Some)) +import System.Nix.ContentAddress (ContentAddressMethod (..)) import System.Nix.Hash (BaseEncoding(Base16), HashAlgo(..)) -import System.Nix.Store.Types (FileIngestionMethod(..), PathFilter, RepairMode) +import System.Nix.Store.Types (PathFilter, RepairMode) import System.Nix.StorePath (StoreDir, StorePath, StorePathName) import qualified Crypto.Hash @@ -30,6 +31,23 @@ import qualified System.Nix.Hash import qualified System.Nix.Nar import qualified System.Nix.StorePath +data References = References + { references_others :: HashSet StorePath + , references_self :: Bool + } + +instance Semigroup References where + a <> b = References + { references_others = references_others a <> references_others b + , references_self = references_self a || references_self b + } + +instance Monoid References where + mempty = References + { references_others = mempty + , references_self = False + } + makeStorePath :: StoreDir -> ByteString @@ -49,68 +67,64 @@ makeStorePath storeDir ty (hashAlgo :=> (digest :: Digest a)) nm = , System.Nix.StorePath.unStorePathName nm ] -makeTextPath +makeType :: StoreDir - -> StorePathName - -> Digest SHA256 - -> HashSet StorePath - -> StorePath -makeTextPath storeDir nm h refs = makeStorePath storeDir ty (HashAlgo_SHA256 :=> h) nm - where - ty = - Data.ByteString.intercalate - ":" - $ "text" - : Data.List.sort - (System.Nix.StorePath.storePathToRawFilePath storeDir - <$> Data.HashSet.toList refs) + -> ByteString + -> References + -> ByteString +makeType storeDir ty refs = + Data.ByteString.intercalate ":" $ ty : (others ++ self) + where + others = Data.List.sort + $ fmap (System.Nix.StorePath.storePathToRawFilePath storeDir) + $ Data.HashSet.toList + $ references_others refs + self = ["self" | references_self refs] makeFixedOutputPath :: StoreDir - -> FileIngestionMethod + -> ContentAddressMethod -> DSum HashAlgo Digest + -> References -> StorePathName -> StorePath -makeFixedOutputPath storeDir recursive algoDigest@(hashAlgo :=> digest) = - if recursive == FileIngestionMethod_FileRecursive - && Some hashAlgo == Some HashAlgo_SHA256 - then makeStorePath storeDir "source" algoDigest - else makeStorePath storeDir "output:out" (HashAlgo_SHA256 :=> h') +makeFixedOutputPath storeDir method digest@(hashAlgo :=> h) refs = + makeStorePath storeDir ty digest' where - h' = - Crypto.Hash.hash @ByteString @SHA256 - $ "fixed:out:" - <> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.algoToText hashAlgo) - <> (if recursive == FileIngestionMethod_FileRecursive then ":r:" else ":") - <> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.encodeDigestWith Base16 digest) - <> ":" - -computeStorePathForText - :: StoreDir - -> StorePathName - -> ByteString - -> (HashSet StorePath -> StorePath) -computeStorePathForText storeDir nm = - makeTextPath storeDir nm - . Crypto.Hash.hash + (ty, digest') = case method of + ContentAddressMethod_Text -> + case hashAlgo of + HashAlgo_SHA256 + | references_self refs == False -> (makeType storeDir "text" refs, digest) + _ -> error "unsupported" -- TODO do better; maybe we'll just remove this restriction too? + _ -> + if method == ContentAddressMethod_NixArchive + && Some hashAlgo == Some HashAlgo_SHA256 + then (makeType storeDir "source" refs, digest) + else let + h' = + Crypto.Hash.hash @ByteString @SHA256 + $ "fixed:out:" + <> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.algoToText hashAlgo) + <> (if method == ContentAddressMethod_NixArchive then ":r:" else ":") + <> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.encodeDigestWith Base16 h) + <> ":" + in ("output:out", HashAlgo_SHA256 :=> h') -computeStorePathForPath - :: StoreDir - -> StorePathName -- ^ Name part of the newly created `StorePath` - -> FilePath -- ^ Local `FilePath` to add - -> FileIngestionMethod -- ^ Add target directory recursively +digestPath + :: FilePath -- ^ Local `FilePath` to add + -> ContentAddressMethod -- ^ target directory method -> PathFilter -- ^ Path filter function -> RepairMode -- ^ Only used by local store backend - -> IO StorePath -computeStorePathForPath storeDir name pth recursive _pathFilter _repair = do - selectedHash <- - if recursive == FileIngestionMethod_FileRecursive - then recursiveContentHash - else flatContentHash - pure $ makeFixedOutputPath storeDir recursive (HashAlgo_SHA256 :=> selectedHash) name + -> IO (Digest SHA256) +digestPath pth method _pathFilter _repair = + case method of + ContentAddressMethod_Flat -> flatContentHash + ContentAddressMethod_NixArchive -> nixArchiveContentHash + ContentAddressMethod_Text -> flatContentHash where - recursiveContentHash :: IO (Digest SHA256) - recursiveContentHash = + nixArchiveContentHash :: IO (Digest SHA256) + nixArchiveContentHash = Crypto.Hash.hashFinalize <$> execStateT streamNarUpdate (Crypto.Hash.hashInit @SHA256) @@ -127,3 +141,15 @@ computeStorePathForPath storeDir name pth recursive _pathFilter _repair = do <$> System.Nix.Nar.narReadFile System.Nix.Nar.narEffectsIO pth + +computeStorePathForPath + :: StoreDir + -> StorePathName -- ^ Name part of the newly created `StorePath` + -> FilePath -- ^ Local `FilePath` to add + -> ContentAddressMethod -- ^ Add target directory methodly + -> PathFilter -- ^ Path filter function + -> RepairMode -- ^ Only used by local store backend + -> IO StorePath +computeStorePathForPath storeDir name pth method pathFilter repair = do + selectedHash <- digestPath pth method pathFilter repair + pure $ makeFixedOutputPath storeDir method (HashAlgo_SHA256 :=> selectedHash) mempty name diff --git a/hnix-store-readonly/tests/ReadOnlySpec.hs b/hnix-store-readonly/tests/ReadOnlySpec.hs index 00c302ec..ff5c9166 100644 --- a/hnix-store-readonly/tests/ReadOnlySpec.hs +++ b/hnix-store-readonly/tests/ReadOnlySpec.hs @@ -5,23 +5,20 @@ module ReadOnlySpec where import Data.Default.Class (Default(def)) import Test.Hspec (Spec, describe, it, shouldBe, pendingWith) -import Crypto.Hash (hash, Digest, SHA256(..)) +import Crypto.Hash (hash, Digest) import Data.ByteString (ByteString) import Data.Dependent.Sum (DSum(..)) import System.Nix.Hash (HashAlgo(..)) import System.Nix.StorePath (StorePath, StorePathName) -import System.Nix.Store.Types (FileIngestionMethod(..)) +import System.Nix.ContentAddress (ContentAddressMethod(..)) import qualified Data.HashSet import qualified System.Nix.StorePath import System.Nix.Store.ReadOnly -testDigest :: Digest SHA256 -testDigest = Crypto.Hash.hash @ByteString "testDigest" - -testDigest' :: DSum HashAlgo Digest -testDigest' = HashAlgo_SHA256 :=> testDigest +testDigest :: DSum HashAlgo Digest +testDigest = HashAlgo_SHA256 :=> Crypto.Hash.hash @ByteString "testDigest" testName :: StorePathName testName = @@ -50,7 +47,7 @@ spec = do $ makeStorePath def "test" - testDigest' + testDigest testName ) `shouldBe` @@ -61,11 +58,12 @@ spec = do describe "makeTextPath" $ do it "computes correct StorePath for empty refs" $ (pure - $ makeTextPath + $ makeFixedOutputPath def - testName + ContentAddressMethod_Text testDigest mempty + testName ) `shouldBe` System.Nix.StorePath.parsePathFromText @@ -74,11 +72,15 @@ spec = do it "computes correct StorePath for nonempty refs" $ (pure - $ makeTextPath + $ makeFixedOutputPath def - testName + ContentAddressMethod_Text testDigest - (Data.HashSet.fromList [ testPath, testPath2 ]) + (References + { references_others = Data.HashSet.fromList [ testPath, testPath2 ] + , references_self = False + }) + testName ) `shouldBe` System.Nix.StorePath.parsePathFromText @@ -90,8 +92,9 @@ spec = do (pure $ makeFixedOutputPath def - FileIngestionMethod_FileRecursive - testDigest' + ContentAddressMethod_NixArchive + testDigest + mempty testName ) `shouldBe` @@ -103,8 +106,9 @@ spec = do (pure $ makeFixedOutputPath def - FileIngestionMethod_Flat - testDigest' + ContentAddressMethod_Flat + testDigest + mempty testName ) `shouldBe` @@ -114,11 +118,15 @@ spec = do it "computeStorePathForText computes correct StorePath" $ (pure - $ computeStorePathForText + $ makeFixedOutputPath def + ContentAddressMethod_Text + (HashAlgo_SHA256 :=> Crypto.Hash.hash ("test" :: ByteString)) + (References + { references_others = Data.HashSet.fromList [ testPath ] + , references_self = False + }) testName - "test" - (Data.HashSet.fromList [ testPath ]) ) `shouldBe` System.Nix.StorePath.parsePathFromText diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index 53c37373..2128ca94 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -23,7 +23,7 @@ import Control.Monad.Conc.Class (MonadConc) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Default.Class (Default(def)) import Network.Socket (Family, SockAddr(SockAddrUnix)) -import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..)) +import System.Nix.Store.Types (RepairMode(..)) import System.Nix.Store.Remote.MonadStore ( runRemoteStoreT , MonadRemoteStore(..) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Client.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Client.hs index 28914c45..55933e65 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Client.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Client.hs @@ -52,7 +52,8 @@ import System.Nix.Store.Remote.Types.StoreRequest (StoreRequest(..)) import System.Nix.Store.Remote.Types.StoreText (StoreText) import System.Nix.Store.Remote.Types.SubstituteMode (SubstituteMode) import System.Nix.Store.Remote.Client.Core -import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..)) +import System.Nix.FileContentAddress (FileIngestionMethod(..)) +import System.Nix.Store.Types (RepairMode(..)) import qualified Control.Monad.IO.Class import qualified Data.Attoparsec.Text diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs index 588153df..37e7253b 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs @@ -134,7 +134,8 @@ import System.Nix.JSON () import System.Nix.OutputName (OutputName) import System.Nix.Realisation (DerivationOutputError, Realisation(..), RealisationWithId(..)) import System.Nix.Signature (Signature, NarSignature) -import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..)) +import System.Nix.FileContentAddress (FileIngestionMethod(..)) +import System.Nix.Store.Types (RepairMode(..)) import System.Nix.StorePath (HasStoreDir(..), InvalidNameError, InvalidPathError, StorePath, StorePathHashPart, StorePathName) import System.Nix.StorePath.Metadata (Metadata(..), StorePathTrust(..)) import System.Nix.Store.Remote.Types @@ -1220,9 +1221,9 @@ storeRequest = Serializer putS bool $ not $ hashAlgo == Some HashAlgo_SHA256 - && (recursive == FileIngestionMethod_FileRecursive) + && (recursive == FileIngestionMethod_NixArchive) - putS bool (recursive == FileIngestionMethod_FileRecursive) + putS bool (recursive == FileIngestionMethod_NixArchive) putS someHashAlgo hashAlgo Some (AddToStoreNar storePath' metadata repair checkSigs) -> mapPutE $ do diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreRequest.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreRequest.hs index c4aeea75..542ddcbd 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreRequest.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreRequest.hs @@ -20,7 +20,8 @@ import System.Nix.Derivation (Derivation) import System.Nix.DerivedPath (DerivedPath) import System.Nix.Hash (HashAlgo) import System.Nix.Signature (Signature) -import System.Nix.Store.Types (FileIngestionMethod, RepairMode) +import System.Nix.FileContentAddress (FileIngestionMethod) +import System.Nix.Store.Types (RepairMode) import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart) import System.Nix.StorePath.Metadata (Metadata) import System.Nix.Store.Remote.Types.GC (GCOptions, GCResult, GCRoot) diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs index c93e2fae..ef327412 100644 --- a/hnix-store-remote/tests-io/NixDaemonSpec.hs +++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs @@ -22,6 +22,7 @@ import System.Linux.Namespaces (Namespace(..), GroupMapping(..), UserMapping(..) import System.Nix.Hash (HashAlgo(HashAlgo_SHA256)) import System.Nix.Build (BuildMode(..)) import System.Nix.DerivedPath (DerivedPath(..)) +import System.Nix.FileContentAddress (FileIngestionMethod(..)) import System.Nix.StorePath (StoreDir(..), StorePath) import System.Nix.StorePath.Metadata (Metadata(..)) import System.Nix.Store.Remote diff --git a/hnix-store-tests/hnix-store-tests.cabal b/hnix-store-tests/hnix-store-tests.cabal index 2f3dfdd1..837da6b4 100644 --- a/hnix-store-tests/hnix-store-tests.cabal +++ b/hnix-store-tests/hnix-store-tests.cabal @@ -46,6 +46,7 @@ library , System.Nix.Arbitrary.ContentAddress , System.Nix.Arbitrary.Derivation , System.Nix.Arbitrary.DerivedPath + , System.Nix.Arbitrary.FileContentAddress , System.Nix.Arbitrary.Hash , System.Nix.Arbitrary.OutputName , System.Nix.Arbitrary.Realisation diff --git a/hnix-store-tests/src/System/Nix/Arbitrary.hs b/hnix-store-tests/src/System/Nix/Arbitrary.hs index ff114d77..044cfd52 100644 --- a/hnix-store-tests/src/System/Nix/Arbitrary.hs +++ b/hnix-store-tests/src/System/Nix/Arbitrary.hs @@ -10,6 +10,7 @@ import System.Nix.Arbitrary.Build () import System.Nix.Arbitrary.ContentAddress () import System.Nix.Arbitrary.Derivation () import System.Nix.Arbitrary.DerivedPath () +import System.Nix.Arbitrary.FileContentAddress () import System.Nix.Arbitrary.Hash () import System.Nix.Arbitrary.OutputName () import System.Nix.Arbitrary.Realisation () diff --git a/hnix-store-tests/src/System/Nix/Arbitrary/FileContentAddress.hs b/hnix-store-tests/src/System/Nix/Arbitrary/FileContentAddress.hs new file mode 100644 index 00000000..c5a45ddb --- /dev/null +++ b/hnix-store-tests/src/System/Nix/Arbitrary/FileContentAddress.hs @@ -0,0 +1,12 @@ +-- due to recent generic-arbitrary +{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-} +{-# OPTIONS_GHC -Wno-orphans #-} +module System.Nix.Arbitrary.FileContentAddress where + +import System.Nix.FileContentAddress + +import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..)) + +deriving via GenericArbitrary FileIngestionMethod + instance Arbitrary FileIngestionMethod diff --git a/hnix-store-tests/src/System/Nix/Arbitrary/Store/Types.hs b/hnix-store-tests/src/System/Nix/Arbitrary/Store/Types.hs index 88f7b8a1..5dbd8e97 100644 --- a/hnix-store-tests/src/System/Nix/Arbitrary/Store/Types.hs +++ b/hnix-store-tests/src/System/Nix/Arbitrary/Store/Types.hs @@ -8,8 +8,5 @@ import System.Nix.Store.Types import Test.QuickCheck (Arbitrary(..)) import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..)) -deriving via GenericArbitrary FileIngestionMethod - instance Arbitrary FileIngestionMethod - deriving via GenericArbitrary RepairMode instance Arbitrary RepairMode