diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,19 @@ # ChangeLog +## [0.7.0.0](https://github.com/haskell-nix/hnix-store/compare/core-0.6.1.0...core-0.7.0.0) 2023-11-15 + +* Breaking: + * [(link)](https://github.com/haskell-nix/hnix-store/pull/216) `StorePath` no longer carries `storePathRoot` field and we + have a stand-alone `StoreDir` type instead to be used instead of `FilePath` + when store root directory is needed as a context. + +* Additional: + * [(link)](https://github.com/haskell-nix/hnix-store/pull/218) NAR encoding and decoding now supports case-insensitive filesystems. + * The "case hack" replicates the behavior of the `use-case-hack` option in Nix, which adds a suffix to conflicting filenames. + This feature is enabled by default on macOS (darwin). + * `data NarOptions` has been added to configure NAR encoding and decoding. The `optUseCaseHack` field can be used to enable or disable the case hack. + * New `streamNarIOWithOptions` and `runParserWithOptions` functions have been added to `System.Nix.Nar` to support the new configurable options. + ## [0.6.1.0](https://github.com/haskell-nix/hnix-store/compare/core-0.6.0.0...core-0.6.1.0) 2023-01-02 * Fixed: diff --git a/hnix-store-core.cabal b/hnix-store-core.cabal --- a/hnix-store-core.cabal +++ b/hnix-store-core.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hnix-store-core -version: 0.6.1.0 +version: 0.7.0.0 synopsis: Core effects for interacting with the Nix store. description: This package contains types and functions needed to describe @@ -19,6 +19,7 @@ , README.md , tests/samples/example0.drv , tests/samples/example1.drv + , tests/fixtures/case-conflict.nar Common commons if impl(ghc >= 8.10) @@ -40,6 +41,7 @@ , System.Nix.Internal.Nar.Parser , System.Nix.Internal.Nar.Streamer , System.Nix.Internal.Nar.Effects + , System.Nix.Internal.Nar.Options , System.Nix.Internal.Signature , System.Nix.Internal.StorePath , System.Nix.Nar @@ -51,10 +53,11 @@ base >=4.12 && <5 , relude >= 1.0 , attoparsec - , algebraic-graphs >= 0.5 && < 0.7 + , algebraic-graphs >= 0.5 && < 0.8 , base16-bytestring , base64-bytestring , bytestring + , case-insensitive , cereal , containers -- Required for cryptonite low-level type convertion diff --git a/src/System/Nix/Derivation.hs b/src/System/Nix/Derivation.hs --- a/src/System/Nix/Derivation.hs +++ b/src/System/Nix/Derivation.hs @@ -11,19 +11,22 @@ ( Parser ) import Nix.Derivation ( Derivation ) import qualified Nix.Derivation as Derivation -import System.Nix.StorePath ( StorePath ) +import System.Nix.StorePath ( StoreDir + , StorePath + , storePathToFilePath + ) import qualified System.Nix.StorePath as StorePath -parseDerivation :: FilePath -> Text.Lazy.Parser (Derivation StorePath Text) +parseDerivation :: StoreDir -> Text.Lazy.Parser (Derivation StorePath Text) parseDerivation expectedRoot = Derivation.parseDerivationWith ("\"" *> StorePath.pathParser expectedRoot <* "\"") Derivation.textParser -buildDerivation :: Derivation StorePath Text -> Text.Lazy.Builder -buildDerivation = +buildDerivation :: StoreDir -> Derivation StorePath Text -> Text.Lazy.Builder +buildDerivation storeDir = Derivation.buildDerivationWith - (show . show) + (show . storePathToFilePath storeDir) show diff --git a/src/System/Nix/Internal/Nar/Effects.hs b/src/System/Nix/Internal/Nar/Effects.hs --- a/src/System/Nix/Internal/Nar/Effects.hs +++ b/src/System/Nix/Internal/Nar/Effects.hs @@ -7,6 +7,7 @@ , narEffectsIO ) where +import Data.Kind () import qualified Data.ByteString as Bytes import qualified Data.ByteString.Lazy as Bytes.Lazy import qualified System.Directory as Directory @@ -22,7 +23,7 @@ import qualified Control.Exception.Lifted as Exception.Lifted import qualified Control.Monad.Fail as MonadFail -data NarEffects (m :: * -> *) = NarEffects { +data NarEffects (m :: Type -> Type) = NarEffects { narReadFile :: FilePath -> m Bytes.Lazy.ByteString , narWriteFile :: FilePath -> Bytes.Lazy.ByteString -> m () , narStreamFile :: FilePath -> m (Maybe Bytes.ByteString) -> m () diff --git a/src/System/Nix/Internal/Nar/Options.hs b/src/System/Nix/Internal/Nar/Options.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Internal/Nar/Options.hs @@ -0,0 +1,28 @@ +module System.Nix.Internal.Nar.Options + ( NarOptions(..) + , defaultNarOptions + , caseHackSuffix + ) where + +import qualified System.Info + +-- | Options for configuring how NAR files are encoded and decoded. +data NarOptions = NarOptions { + optUseCaseHack :: Bool + -- ^ Whether to enable a case hack to support case-insensitive filesystems. + -- Equivalent to the 'use-case-hack' option in the Nix client. + -- + -- The case hack rewrites file names to avoid collisions on case-insensitive file systems, e.g. APFS and HFS+ on macOS. + -- Enabled by default on macOS (Darwin). +} + +defaultNarOptions :: NarOptions +defaultNarOptions = NarOptions { + optUseCaseHack = + if System.Info.os == "darwin" + then True + else False +} + +caseHackSuffix :: Text +caseHackSuffix = "~nix~case~hack~" diff --git a/src/System/Nix/Internal/Nar/Parser.hs b/src/System/Nix/Internal/Nar/Parser.hs --- a/src/System/Nix/Internal/Nar/Parser.hs +++ b/src/System/Nix/Internal/Nar/Parser.hs @@ -3,9 +3,11 @@ {-# language GeneralizedNewtypeDeriving #-} {-# language ScopedTypeVariables #-} {-# language TypeFamilies #-} +{-# language TypeOperators #-} module System.Nix.Internal.Nar.Parser ( runParser + , runParserWithOptions , parseNar , testParser , testParser' @@ -25,6 +27,8 @@ import qualified Control.Monad.Trans as Trans import qualified Control.Monad.Trans.Control as Base import qualified Data.ByteString as Bytes +import qualified Data.CaseInsensitive as CI +import qualified Data.HashMap.Strict as HashMap import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Serialize as Serialize @@ -34,6 +38,7 @@ import qualified System.IO as IO import qualified System.Nix.Internal.Nar.Effects as Nar +import qualified System.Nix.Internal.Nar.Options as Nar -- | NarParser is a monad for parsing a Nar file as a byte stream @@ -47,19 +52,34 @@ ParserState (Except.ExceptT String - (Reader.ReaderT - (Nar.NarEffects m) - m - ) + (Reader.ReaderT (ParserEnv m) m) ) a } deriving ( Functor, Applicative, Monad, Fail.MonadFail , Trans.MonadIO, State.MonadState ParserState , Except.MonadError String - , Reader.MonadReader (Nar.NarEffects m) + , Reader.MonadReader (ParserEnv m) ) + +data ParserEnv m = ParserEnv + { envNarEffects :: Nar.NarEffects m + , envNarOptions :: Nar.NarOptions + } + + +getNarEffects :: Monad m => NarParser m (Nar.NarEffects m) +getNarEffects = fmap envNarEffects ask + + +getNarEffect :: Monad m => (Nar.NarEffects m -> a) -> NarParser m a +getNarEffect eff = fmap eff getNarEffects + + +getNarOptions :: Monad m => NarParser m Nar.NarOptions +getNarOptions = fmap envNarOptions ask + -- | Run a @NarParser@ over a byte stream -- This is suitable for testing the top-level NAR parser, or any of the -- smaller utilities parsers, if you have bytes appropriate for them @@ -76,9 +96,26 @@ -> FilePath -- ^ The root file system object to be created by the NAR -> m (Either String a) -runParser effs (NarParser action) h target = do +runParser effs parser h target = do + runParserWithOptions Nar.defaultNarOptions effs parser h target + +runParserWithOptions + :: forall m a + . (IO.MonadIO m, Base.MonadBaseControl IO m) + => Nar.NarOptions + -> Nar.NarEffects m + -- ^ Provide the effects set, usually @narEffectsIO@ + -> NarParser m a + -- ^ A parser to run, such as @parseNar@ + -> IO.Handle + -- ^ A handle the stream containg the NAR. It should already be + -- open and in @ReadMode@ + -> FilePath + -- ^ The root file system object to be created by the NAR + -> m (Either String a) +runParserWithOptions opts effs (NarParser action) h target = do unpackResult <- - runReaderT (runExceptT $ State.evalStateT action state0) effs + runReaderT (runExceptT $ State.evalStateT action state0) (ParserEnv effs opts) `Exception.Lifted.catch` exceptionHandler when (isLeft unpackResult) cleanup pure unpackResult @@ -91,6 +128,7 @@ , handle = h , directoryStack = [target] , links = [] + , filePaths = HashMap.empty } exceptionHandler :: Exception.Lifted.SomeException -> m (Either String a) @@ -125,6 +163,9 @@ , links :: [LinkInfo] -- ^ Unlike with files and directories, we collect symlinks -- from the NAR on + , filePaths :: HashMap.HashMap (CI.CI FilePath) Int + -- ^ A map of case-insensitive files paths to the number of collisions encountered. + -- See @Nar.NarOptions.optUseCaseHack@ for details. } @@ -229,11 +270,11 @@ pure $ Just chunk target <- currentFile - streamFile <- asks Nar.narStreamFile + streamFile <- getNarEffect Nar.narStreamFile lift (streamFile target getChunk) when (s == "executable") $ do - effs :: Nar.NarEffects m <- ask + effs :: Nar.NarEffects m <- getNarEffects lift $ do p <- Nar.narGetPerms effs target Nar.narSetPerms effs target (p { Directory.executable = True }) @@ -245,37 +286,53 @@ -- handles for target files longer than needed parseDirectory :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseDirectory = do - createDirectory <- asks Nar.narCreateDir + createDirectory <- getNarEffect Nar.narCreateDir target <- currentFile lift $ createDirectory target - parseEntryOrFinish + parseEntryOrFinish target where - parseEntryOrFinish :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () - parseEntryOrFinish = + parseEntryOrFinish :: (IO.MonadIO m, Fail.MonadFail m) => FilePath -> NarParser m () + parseEntryOrFinish path = -- If we reach a ")", we finished the directory's entries, and we have -- to put ")" back into the stream, because the outer call to @parens@ -- expects to consume it. -- Otherwise, parse an entry as a fresh file system object matchStr [ ( ")" , pushStr ")" ) - , ("entry", parseEntry ) + , ("entry", parseEntry path ) ] - parseEntry :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () - parseEntry = do + parseEntry :: (IO.MonadIO m, Fail.MonadFail m) => FilePath -> NarParser m () + parseEntry path = do + opts <- getNarOptions parens $ do expectStr "name" - fName <- parseStr + fName <- + if Nar.optUseCaseHack opts then + addCaseHack path =<< parseStr + else + parseStr pushFileName (toString fName) expectStr "node" parens parseFSO popFileName - parseEntryOrFinish + parseEntryOrFinish path + addCaseHack :: (IO.MonadIO m, Fail.MonadFail m) => FilePath -> Text -> NarParser m Text + addCaseHack path fName = do + let key = path Text.unpack fName + recordFilePath key + conflictCount <- getFilePathConflictCount key + pure $ + if conflictCount > 0 then + fName <> Nar.caseHackSuffix <> show conflictCount + else + fName + ------------------------------------------------------------------------------ -- * Utility parsers @@ -372,7 +429,7 @@ -- (Targets must be created before the links that target them) createLinks :: IO.MonadIO m => NarParser m () createLinks = do - createLink <- asks Nar.narCreateLink + createLink <- getNarEffect Nar.narCreateLink allLinks <- State.gets links sortedLinks <- IO.liftIO $ sortLinksIO allLinks forM_ sortedLinks $ \li -> do @@ -421,7 +478,7 @@ consume 0 = pure "" consume n = do state0 <- State.get - newBytes <- IO.liftIO $ Bytes.hGetSome (handle state0) (max 0 n) + newBytes <- IO.liftIO $ Bytes.hGet (handle state0) (max 0 n) when (Bytes.length newBytes < n) $ Fail.fail $ "consume: Not enough bytes in handle. Wanted " @@ -471,6 +528,16 @@ pushLink :: Monad m => LinkInfo -> NarParser m () pushLink linkInfo = State.modify (\s -> s { links = linkInfo : links s }) + +-- | Add a file path to the collection of encountered file paths +recordFilePath :: Monad m => FilePath -> NarParser m () +recordFilePath fPath = + State.modify (\s -> s { filePaths = HashMap.insertWith (\_ v -> v + 1) (CI.mk fPath) 0 (filePaths s) }) + +getFilePathConflictCount :: Monad m => FilePath -> NarParser m Int +getFilePathConflictCount fPath = do + fileMap <- State.gets filePaths + pure $ HashMap.findWithDefault 0 (CI.mk fPath) fileMap ------------------------------------------------------------------------------ -- * Utilities diff --git a/src/System/Nix/Internal/Nar/Streamer.hs b/src/System/Nix/Internal/Nar/Streamer.hs --- a/src/System/Nix/Internal/Nar/Streamer.hs +++ b/src/System/Nix/Internal/Nar/Streamer.hs @@ -7,21 +7,22 @@ , dumpString , dumpPath , streamNarIO + , streamNarIOWithOptions , IsExecutable(..) ) where import qualified Control.Monad.IO.Class as IO import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Char8 as Bytes.Char8 import qualified Data.ByteString.Lazy as Bytes.Lazy import qualified Data.Serialize as Serial -import qualified Data.Text as T (pack) +import qualified Data.Text as T (pack, breakOn) import qualified Data.Text.Encoding as TE (encodeUtf8) import qualified System.Directory as Directory import System.FilePath (()) import qualified System.Nix.Internal.Nar.Effects as Nar +import qualified System.Nix.Internal.Nar.Options as Nar -- | NarSource @@ -57,7 +58,11 @@ -- function from any streaming library, and repeatedly calls -- it while traversing the filesystem object to Nar encode streamNarIO :: forall m . IO.MonadIO m => Nar.NarEffects IO -> FilePath -> NarSource m -streamNarIO effs basePath yield = do +streamNarIO effs basePath yield = + streamNarIOWithOptions Nar.defaultNarOptions effs basePath yield + +streamNarIOWithOptions :: forall m . IO.MonadIO m => Nar.NarOptions -> Nar.NarEffects IO -> FilePath -> NarSource m +streamNarIOWithOptions opts effs basePath yield = do yield $ str "nix-archive-1" parens $ go basePath where @@ -77,7 +82,12 @@ yield $ str "entry" parens $ do let fullName = path f - yield $ strs ["name", filePathToBS f, "node"] + let serializedPath = + if Nar.optUseCaseHack opts then + filePathToBSWithCaseHack f + else + filePathToBS f + yield $ strs ["name", serializedPath, "node"] parens $ go fullName else do isExec <- IO.liftIO $ isExecutable effs path @@ -88,8 +98,6 @@ yield $ int fSize yieldFile path fSize - filePathToBS = TE.encodeUtf8 . T.pack - parens act = do yield $ str "(" r <- act @@ -99,7 +107,7 @@ -- Read, yield, and pad the file yieldFile :: FilePath -> Int64 -> m () yieldFile path fsize = do - mapM_ yield . Bytes.Lazy.toChunks =<< IO.liftIO (Bytes.Lazy.readFile path) + mapM_ yield . Bytes.Lazy.toChunks =<< IO.liftIO (Nar.narReadFile effs path) yield $ Bytes.replicate (padLen $ fromIntegral fsize) 0 data IsExecutable = NonExecutable | Executable @@ -131,3 +139,12 @@ strs :: [ByteString] -> ByteString strs xs = Bytes.concat $ str <$> xs + +filePathToBS :: FilePath -> ByteString +filePathToBS = TE.encodeUtf8 . T.pack + +filePathToBSWithCaseHack :: FilePath -> ByteString +filePathToBSWithCaseHack = TE.encodeUtf8 . undoCaseHack . T.pack + +undoCaseHack :: Text -> Text +undoCaseHack = fst . T.breakOn Nar.caseHackSuffix diff --git a/src/System/Nix/Internal/StorePath.hs b/src/System/Nix/Internal/StorePath.hs --- a/src/System/Nix/Internal/StorePath.hs +++ b/src/System/Nix/Internal/StorePath.hs @@ -10,7 +10,8 @@ module System.Nix.Internal.StorePath ( -- * Basic store path types - StorePath(..) + StoreDir(..) + , StorePath(..) , StorePathName(..) , StorePathSet , mkStorePathHashPart @@ -32,7 +33,6 @@ where import qualified Relude.Unsafe as Unsafe -import qualified Text.Show import System.Nix.Internal.Hash import System.Nix.Internal.Base import qualified System.Nix.Internal.Base32 as Nix.Base32 @@ -54,10 +54,9 @@ -- From the Nix thesis: A store path is the full path of a store -- object. It has the following anatomy: storeDir/hashPart-name. -- --- @storeDir@: The root of the Nix store (e.g. \/nix\/store). --- --- See the 'StoreDir' haddocks for details on why we represent this at --- the type level. +-- The store directory is *not* included, and must be known from the +-- context. This matches modern C++ Nix, and also represents the fact +-- that store paths for different store directories cannot be mixed. data StorePath = StorePath { -- | The 160-bit hash digest reflecting the "address" of the name. -- Currently, this is a truncated SHA256 hash. @@ -66,18 +65,13 @@ -- this is typically the package name and version (e.g. -- hello-1.2.3). storePathName :: !StorePathName - , -- | Root of the store - storePathRoot :: !FilePath } - deriving (Eq, Ord) + deriving (Eq, Ord, Show) instance Hashable StorePath where hashWithSalt s StorePath{..} = s `hashWithSalt` storePathHash `hashWithSalt` storePathName -instance Show StorePath where - show p = Bytes.Char8.unpack $ storePathToRawFilePath p - -- | The name portion of a Nix path. -- -- 'unStorePathName' must only contain a-zA-Z0-9+._?=-, can't start @@ -86,7 +80,7 @@ newtype StorePathName = StorePathName { -- | Extract the contents of the name. unStorePathName :: Text - } deriving (Eq, Hashable, Ord) + } deriving (Eq, Hashable, Ord, Show) -- | The hash algorithm used for store path hashes. newtype StorePathHashPart = StorePathHashPart ByteString @@ -161,22 +155,29 @@ -- to avoid the dependency. type RawFilePath = ByteString +-- | The path to the store dir +-- +-- Many operations need to be parameterized with this, since store paths +-- do not know their own store dir by design. +newtype StoreDir = StoreDir { + unStoreDir :: RawFilePath + } deriving (Eq, Hashable, Ord, Show) + -- | Render a 'StorePath' as a 'RawFilePath'. -storePathToRawFilePath :: StorePath -> RawFilePath -storePathToRawFilePath StorePath{..} = - root <> "/" <> hashPart <> "-" <> name +storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath +storePathToRawFilePath storeDir StorePath{..} = + unStoreDir storeDir <> "/" <> hashPart <> "-" <> name where - root = Bytes.Char8.pack storePathRoot hashPart = encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash name = encodeUtf8 $ unStorePathName storePathName -- | Render a 'StorePath' as a 'FilePath'. -storePathToFilePath :: StorePath -> FilePath -storePathToFilePath = Bytes.Char8.unpack . storePathToRawFilePath +storePathToFilePath :: StoreDir -> StorePath -> FilePath +storePathToFilePath storeDir = Bytes.Char8.unpack . storePathToRawFilePath storeDir -- | Render a 'StorePath' as a 'Text'. -storePathToText :: StorePath -> Text -storePathToText = toText . Bytes.Char8.unpack . storePathToRawFilePath +storePathToText :: StoreDir -> StorePath -> Text +storePathToText storeDir = toText . Bytes.Char8.unpack . storePathToRawFilePath storeDir -- | Build `narinfo` suffix from `StorePath` which -- can be used to query binary caches. @@ -186,7 +187,7 @@ -- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking -- that store directory matches `expectedRoot`. -parsePath :: FilePath -> Bytes.Char8.ByteString -> Either String StorePath +parsePath :: StoreDir -> Bytes.Char8.ByteString -> Either String StorePath parsePath expectedRoot x = let (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x @@ -196,17 +197,20 @@ --rootDir' = dropTrailingPathSeparator rootDir -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b rootDir' = Unsafe.init rootDir + expectedRootS = Bytes.Char8.unpack (unStoreDir expectedRoot) storeDir = - if expectedRoot == rootDir' + if expectedRootS == rootDir' then pure rootDir' - else Left $ "Root store dir mismatch, expected" <> expectedRoot <> "got" <> rootDir' + else Left $ "Root store dir mismatch, expected" <> expectedRootS <> "got" <> rootDir' in - StorePath <$> coerce storeHash <*> name <*> storeDir + either Left (pure $ StorePath <$> coerce storeHash <*> name) storeDir -pathParser :: FilePath -> Parser StorePath +pathParser :: StoreDir -> Parser StorePath pathParser expectedRoot = do + let expectedRootS = Bytes.Char8.unpack (unStoreDir expectedRoot) + _ <- - Parser.Text.Lazy.string (toText expectedRoot) + Parser.Text.Lazy.string (toText expectedRootS) "Store root mismatch" -- e.g. /nix/store _ <- Parser.Text.Lazy.char '/' @@ -232,4 +236,4 @@ either fail pure - (StorePath <$> coerce digest <*> name <*> pure expectedRoot) + (StorePath <$> coerce digest <*> name) diff --git a/src/System/Nix/Nar.hs b/src/System/Nix/Nar.hs --- a/src/System/Nix/Nar.hs +++ b/src/System/Nix/Nar.hs @@ -23,9 +23,14 @@ , Nar.NarEffects(..) , Nar.narEffectsIO + , Nar.NarOptions(..) + , Nar.defaultNarOptions + -- * Internal , Nar.streamNarIO + , Nar.streamNarIOWithOptions , Nar.runParser + , Nar.runParserWithOptions , Nar.dumpString , Nar.dumpPath @@ -39,6 +44,7 @@ import qualified System.IO as IO import qualified System.Nix.Internal.Nar.Effects as Nar +import qualified System.Nix.Internal.Nar.Options as Nar import qualified System.Nix.Internal.Nar.Parser as Nar import qualified System.Nix.Internal.Nar.Streamer as Nar diff --git a/src/System/Nix/ReadonlyStore.hs b/src/System/Nix/ReadonlyStore.hs --- a/src/System/Nix/ReadonlyStore.hs +++ b/src/System/Nix/ReadonlyStore.hs @@ -4,6 +4,7 @@ module System.Nix.ReadonlyStore where +import qualified Data.ByteString.Char8 as Bytes.Char8 import qualified Data.ByteString as BS import qualified Data.HashSet as HS import System.Nix.Hash @@ -23,43 +24,42 @@ makeStorePath :: forall h . (NamedAlgo h) - => FilePath + => StoreDir -> ByteString -> Digest h -> StorePathName -> StorePath -makeStorePath fp ty h nm = StorePath (coerce storeHash) nm fp +makeStorePath storeDir ty h nm = StorePath (coerce storeHash) nm where storeHash = mkStorePathHash @h s - s = BS.intercalate ":" $ ty:fmap encodeUtf8 [ algoName @h , encodeDigestWith Base16 h - , toText fp + , toText . Bytes.Char8.unpack $ unStoreDir storeDir , coerce nm ] makeTextPath - :: FilePath -> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath -makeTextPath fp nm h refs = makeStorePath fp ty h nm + :: StoreDir -> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath +makeTextPath storeDir nm h refs = makeStorePath storeDir ty h nm where ty = - BS.intercalate ":" $ "text" : sort (storePathToRawFilePath <$> HS.toList refs) + BS.intercalate ":" $ "text" : sort (storePathToRawFilePath storeDir <$> HS.toList refs) makeFixedOutputPath :: forall hashAlgo . NamedAlgo hashAlgo - => FilePath + => StoreDir -> Bool -> Digest hashAlgo -> StorePathName -> StorePath -makeFixedOutputPath fp recursive h = +makeFixedOutputPath storeDir recursive h = if recursive && (algoName @hashAlgo) == "sha256" - then makeStorePath fp "source" h - else makeStorePath fp "output:out" h' + then makeStorePath storeDir "source" h + else makeStorePath storeDir "output:out" h' where h' = hash @ByteString @SHA256 @@ -70,19 +70,20 @@ <> ":" computeStorePathForText - :: FilePath -> StorePathName -> ByteString -> (StorePathSet -> StorePath) -computeStorePathForText fp nm = makeTextPath fp nm . hash + :: StoreDir -> StorePathName -> ByteString -> (StorePathSet -> StorePath) +computeStorePathForText storeDir nm = makeTextPath storeDir nm . hash computeStorePathForPath - :: StorePathName -- ^ Name part of the newly created `StorePath` + :: StoreDir + -> StorePathName -- ^ Name part of the newly created `StorePath` -> FilePath -- ^ Local `FilePath` to add -> Bool -- ^ Add target directory recursively -> (FilePath -> Bool) -- ^ Path filter function -> Bool -- ^ Only used by local store backend -> IO StorePath -computeStorePathForPath name pth recursive _pathFilter _repair = do +computeStorePathForPath storeDir name pth recursive _pathFilter _repair = do selectedHash <- if recursive then recursiveContentHash else flatContentHash - pure $ makeFixedOutputPath "/nix/store" recursive selectedHash name + pure $ makeFixedOutputPath storeDir recursive selectedHash name where recursiveContentHash :: IO (Digest SHA256) recursiveContentHash = hashFinalize <$> execStateT streamNarUpdate (hashInit @SHA256) diff --git a/src/System/Nix/StorePath.hs b/src/System/Nix/StorePath.hs --- a/src/System/Nix/StorePath.hs +++ b/src/System/Nix/StorePath.hs @@ -3,7 +3,8 @@ -} module System.Nix.StorePath ( -- * Basic store path types - StorePath(..) + StoreDir(..) + , StorePath(..) , StorePathName(..) , StorePathSet , mkStorePathHashPart diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs --- a/tests/Arbitrary.hs +++ b/tests/Arbitrary.hs @@ -35,23 +35,24 @@ instance Arbitrary (Digest SHA256) where arbitrary = hash . BSC.pack <$> arbitrary +instance Arbitrary StoreDir where + arbitrary = StoreDir . ("/" <>) . BSC.pack <$> arbitrary + newtype NixLike = NixLike {getNixLike :: StorePath} deriving (Eq, Ord, Show) instance Arbitrary NixLike where arbitrary = NixLike <$> - liftA3 StorePath + liftA2 StorePath arbitraryTruncatedDigest arbitrary - (pure "/nix/store") where -- 160-bit hash, 20 bytes, 32 chars in base32 arbitraryTruncatedDigest = coerce . BSC.pack <$> replicateM 20 genSafeChar instance Arbitrary StorePath where arbitrary = - liftA3 StorePath + liftA2 StorePath arbitrary arbitrary - dir diff --git a/tests/Derivation.hs b/tests/Derivation.hs --- a/tests/Derivation.hs +++ b/tests/Derivation.hs @@ -6,6 +6,7 @@ ) import Test.Tasty.Golden ( goldenVsFile ) +import System.Nix.StorePath ( StoreDir(..) ) import System.Nix.Derivation ( parseDerivation , buildDerivation ) @@ -23,10 +24,10 @@ (Data.Text.IO.writeFile dest . toText . Data.Text.Lazy.Builder.toLazyText - . buildDerivation + . buildDerivation (StoreDir "/nix/store") ) (Data.Attoparsec.Text.parseOnly - (parseDerivation "/nix/store") + (parseDerivation $ StoreDir "/nix/store") contents ) diff --git a/tests/NarFormat.hs b/tests/NarFormat.hs --- a/tests/NarFormat.hs +++ b/tests/NarFormat.hs @@ -5,6 +5,7 @@ import qualified Control.Concurrent as Concurrent import Control.Exception (try) +import Data.Binary (Binary(..), decodeFile) import Data.Binary.Get (Get, getByteString, getInt64le, getLazyByteString, runGet) @@ -100,6 +101,10 @@ it "roundtrips directory" $ do roundTrip "sampleDirectory" (Nar sampleDirectory) + it "roundtrips case conflicts" $ do + nar <- decodeFile "tests/fixtures/case-conflict.nar" + roundTrip "caseConflict" nar + describe "matches-nix-store fixture" $ do it "matches regular" $ do encEqualsNixStore (Nar sampleRegular) sampleRegularBaseline @@ -115,6 +120,7 @@ it "matches directory" $ do encEqualsNixStore (Nar sampleDirectory) sampleDirectoryBaseline + it "matches symlink to directory" $ do encEqualsNixStore (Nar sampleLinkToDirectory) sampleLinkToDirectoryBaseline @@ -578,7 +584,7 @@ filePathPart p = if BSC.any (`elem` ['/', '\NUL']) p then Nothing else Just $ FilePathPart p newtype Nar = Nar { narFile :: FileSystemObject } - deriving (Eq, Show) + deriving (Eq, Show, Generic) -- | A FileSystemObject (FSO) is an anonymous entity that can be NAR archived data FileSystemObject = @@ -594,6 +600,9 @@ newtype FilePathPart = FilePathPart { unFilePathPart :: BSC.ByteString } deriving (Eq, Ord, Show) +instance Binary Nar where + get = getNar + put = putNar instance Arbitrary Nar where arbitrary = Nar <$> resize 10 arbitrary diff --git a/tests/StorePath.hs b/tests/StorePath.hs --- a/tests/StorePath.hs +++ b/tests/StorePath.hs @@ -1,5 +1,6 @@ {-# language DataKinds #-} {-# language ScopedTypeVariables #-} +{-# language OverloadedStrings #-} module StorePath where @@ -11,19 +12,19 @@ import Arbitrary -- | Test that Nix(OS) like paths roundtrip -prop_storePathRoundtrip :: NixLike -> NixLike -> Property -prop_storePathRoundtrip (_ :: NixLike) (NixLike x) = - parsePath "/nix/store" (storePathToRawFilePath x) === pure x +prop_storePathRoundtrip :: StoreDir -> NixLike -> NixLike -> Property +prop_storePathRoundtrip storeDir (_ :: NixLike) (NixLike x) = + parsePath storeDir (storePathToRawFilePath storeDir x) === pure x -- | Test that any `StorePath` roundtrips -prop_storePathRoundtrip' :: StorePath -> Property -prop_storePathRoundtrip' x = - parsePath (storePathRoot x) (storePathToRawFilePath x) === pure x +prop_storePathRoundtrip' :: StoreDir -> StorePath -> Property +prop_storePathRoundtrip' storeDir x = + parsePath storeDir (storePathToRawFilePath storeDir x) === pure x -prop_storePathRoundtripParser :: NixLike -> NixLike -> Property -prop_storePathRoundtripParser (_ :: NixLike) (NixLike x) = - Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) (storePathToText x) === pure x +prop_storePathRoundtripParser :: StoreDir -> NixLike -> NixLike -> Property +prop_storePathRoundtripParser storeDir (_ :: NixLike) (NixLike x) = + Data.Attoparsec.Text.parseOnly (pathParser storeDir) (storePathToText storeDir x) === pure x -prop_storePathRoundtripParser' :: StorePath -> Property -prop_storePathRoundtripParser' x = - Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) (storePathToText x) === pure x +prop_storePathRoundtripParser' :: StoreDir -> StorePath -> Property +prop_storePathRoundtripParser' storeDir x = + Data.Attoparsec.Text.parseOnly (pathParser storeDir) (storePathToText storeDir x) === pure x diff --git a/tests/fixtures/case-conflict.nar b/tests/fixtures/case-conflict.nar new file mode 100644 Binary files /dev/null and b/tests/fixtures/case-conflict.nar differ