hnix-store-core 0.5.0.0 → 0.6.0.0
raw patch · 21 files changed
+328/−322 lines, 21 filesdep +reludedep ~algebraic-graphsdep ~attoparsecdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: relude
Dependency ranges changed: algebraic-graphs, attoparsec, base, base16-bytestring, base64-bytestring, bytestring, cereal, containers, cryptonite, directory, filepath, hashable, lifted-base, memory, monad-control, mtl, saltine, text, time, unix, unordered-containers, vector
API changes (from Hackage documentation)
+ System.Nix.Internal.Nar.Streamer: dumpPath :: forall m. MonadIO m => FilePath -> NarSource m
+ System.Nix.Internal.Nar.Streamer: dumpString :: forall m. MonadIO m => ByteString -> NarSource m
+ System.Nix.Internal.Nar.Streamer: type NarSource m = (ByteString -> m ()) -> m ()
+ System.Nix.Nar: dumpPath :: forall m. MonadIO m => FilePath -> NarSource m
+ System.Nix.Nar: dumpString :: forall m. MonadIO m => ByteString -> NarSource m
+ System.Nix.Nar: type NarSource m = (ByteString -> m ()) -> m ()
- System.Nix.Internal.Nar.Streamer: streamNarIO :: forall m. MonadIO m => (ByteString -> m ()) -> NarEffects IO -> FilePath -> m ()
+ System.Nix.Internal.Nar.Streamer: streamNarIO :: forall m. MonadIO m => NarEffects IO -> FilePath -> NarSource m
- System.Nix.Nar: streamNarIO :: forall m. MonadIO m => (ByteString -> m ()) -> NarEffects IO -> FilePath -> m ()
+ System.Nix.Nar: streamNarIO :: forall m. MonadIO m => NarEffects IO -> FilePath -> NarSource m
Files
- ChangeLog.md +8/−1
- hnix-store-core.cabal +51/−3
- src/System/Nix/Build.hs +1/−2
- src/System/Nix/Derivation.hs +2/−8
- src/System/Nix/Internal/Base.hs +9/−12
- src/System/Nix/Internal/Base32.hs +3/−9
- src/System/Nix/Internal/Hash.hs +11/−19
- src/System/Nix/Internal/Nar/Effects.hs +5/−7
- src/System/Nix/Internal/Nar/Parser.hs +26/−40
- src/System/Nix/Internal/Nar/Streamer.hs +53/−38
- src/System/Nix/Internal/Signature.hs +1/−4
- src/System/Nix/Internal/StorePath.hs +17/−23
- src/System/Nix/Internal/Truncation.hs +2/−7
- src/System/Nix/Nar.hs +9/−6
- src/System/Nix/ReadonlyStore.hs +4/−12
- src/System/Nix/StorePathMetadata.hs +0/−2
- tests/Arbitrary.hs +3/−10
- tests/Derivation.hs +1/−2
- tests/Hash.hs +72/−59
- tests/NarFormat.hs +42/−48
- tests/StorePath.hs +8/−10
ChangeLog.md view
@@ -1,5 +1,13 @@ # ChangeLog +## [0.6.0.0](https://github.com/haskell-nix/hnix-store/compare/core-0.5.0.0...core-0.6.0.0) 2022-06-06++* Breaking:++ * [(link)](https://github.com/haskell-nix/hnix-store/pull/177) `streamNarIO` changes type and returns `NarSource m`+ * `FilePath` can turn to `NarSource m` using `dumpPath`+ * `ByteString` can turn to `NarSource m` using `dumpString`+ ## [0.5.0.0](https://github.com/haskell-nix/hnix-store/compare/0.4.3.0...core-0.5.0.0) 2021-06-10 * Breaking:@@ -34,7 +42,6 @@ * add `mkStorePathHash` - a function to create a content into Nix storepath-style hash: `mkStorePathHash :: HashAlgorithm a => ByteString -> ByteString` but recommend to at once use `mkStorePathHashPart`.- ## [0.4.3.0](https://github.com/haskell-nix/hnix-store/compare/0.4.2.0...0.4.3.0) 2021-05-30
hnix-store-core.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: hnix-store-core-version: 0.5.0.0+version: 0.6.0.0 synopsis: Core effects for interacting with the Nix store. description: This package contains types and functions needed to describe@@ -48,9 +48,10 @@ , System.Nix.StorePath , System.Nix.StorePathMetadata build-depends:- base >=4.10 && <5+ base >=4.12 && <5+ , relude >= 1.0 , attoparsec- , algebraic-graphs >= 0.5 && < 0.6+ , algebraic-graphs >= 0.5 && < 0.7 , base16-bytestring , base64-bytestring , bytestring@@ -72,6 +73,29 @@ , unix , unordered-containers , vector+ mixins:+ base hiding (Prelude)+ , relude (Relude as Prelude)+ , relude+ default-extensions:+ OverloadedStrings+ , DeriveGeneric+ , DeriveDataTypeable+ , DeriveFunctor+ , DeriveFoldable+ , DeriveTraversable+ , DeriveLift+ , FlexibleContexts+ , FlexibleInstances+ , StandaloneDeriving+ , TypeApplications+ , TypeSynonymInstances+ , InstanceSigs+ , MultiParamTypeClasses+ , TupleSections+ , LambdaCase+ , BangPatterns+ , ViewPatterns hs-source-dirs: src default-language: Haskell2010 @@ -100,6 +124,7 @@ hnix-store-core , attoparsec , base+ , relude , base16-bytestring , base64-bytestring , binary@@ -118,4 +143,27 @@ , temporary , text , unix+ mixins:+ base hiding (Prelude)+ , relude (Relude as Prelude)+ , relude+ default-extensions:+ OverloadedStrings+ , DeriveGeneric+ , DeriveDataTypeable+ , DeriveFunctor+ , DeriveFoldable+ , DeriveTraversable+ , DeriveLift+ , FlexibleContexts+ , FlexibleInstances+ , StandaloneDeriving+ , TypeApplications+ , TypeSynonymInstances+ , InstanceSigs+ , MultiParamTypeClasses+ , TupleSections+ , LambdaCase+ , BangPatterns+ , ViewPatterns default-language: Haskell2010
src/System/Nix/Build.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards #-}+{-# language RecordWildCards #-} {-| Description : Build related types Maintainer : srk <srk@48.io>@@ -12,7 +12,6 @@ where import Data.Time ( UTCTime )-import Data.Text ( Text ) -- keep the order of these Enums to match enums from reference implementations -- src/libstore/store-api.hh
src/System/Nix/Derivation.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} module System.Nix.Derivation ( parseDerivation@@ -6,11 +5,8 @@ ) where -import Data.Text ( Text )-import qualified Data.Text as Text import qualified Data.Text.Lazy.Builder as Text.Lazy ( Builder )-import qualified Data.Text.Lazy.Builder as Text.Lazy.Builder import qualified Data.Attoparsec.Text.Lazy as Text.Lazy ( Parser ) import Nix.Derivation ( Derivation )@@ -29,7 +25,5 @@ buildDerivation :: Derivation StorePath Text -> Text.Lazy.Builder buildDerivation = Derivation.buildDerivationWith- (string . Text.pack . show)- string- where- string = Text.Lazy.Builder.fromText . Text.pack . show+ (show . show)+ show
src/System/Nix/Internal/Base.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# language CPP #-} module System.Nix.Internal.Base ( BaseEncoding(Base16,NixBase32,Base64)@@ -7,9 +7,6 @@ ) where -import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.ByteString as Bytes import qualified Data.ByteString.Base16 as Base16 import qualified System.Nix.Base32 as Base32 -- Nix has own Base32 encoding import qualified Data.ByteString.Base64 as Base64@@ -24,22 +21,22 @@ -- | Encode @ByteString@ with @Base@ encoding, produce @Text@.-encodeWith :: BaseEncoding -> Bytes.ByteString -> T.Text-encodeWith Base16 = T.decodeUtf8 . Base16.encode+encodeWith :: BaseEncoding -> ByteString -> Text+encodeWith Base16 = decodeUtf8 . Base16.encode encodeWith NixBase32 = Base32.encode-encodeWith Base64 = T.decodeUtf8 . Base64.encode+encodeWith Base64 = decodeUtf8 . Base64.encode -- | Take the input & @Base@ encoding witness -> decode into @Text@.-decodeWith :: BaseEncoding -> T.Text -> Either String Bytes.ByteString+decodeWith :: BaseEncoding -> Text -> Either String ByteString #if MIN_VERSION_base16_bytestring(1,0,0)-decodeWith Base16 = Base16.decode . T.encodeUtf8+decodeWith Base16 = Base16.decode . encodeUtf8 #else decodeWith Base16 = lDecode -- this tacit sugar simply makes GHC pleased with number of args where lDecode t =- case Base16.decode (T.encodeUtf8 t) of+ case Base16.decode (encodeUtf8 t) of (x, "") -> pure $ x- _ -> Left $ "Unable to decode base16 string" <> T.unpack t+ _ -> Left $ "Unable to decode base16 string" <> toString t #endif decodeWith NixBase32 = Base32.decode-decodeWith Base64 = Base64.decode . T.encodeUtf8+decodeWith Base64 = Base64.decode . encodeUtf8
src/System/Nix/Internal/Base32.hs view
@@ -6,18 +6,12 @@ where -import Data.Bool ( bool )-import Data.Maybe ( fromMaybe )-import Data.ByteString ( ByteString ) import qualified Data.ByteString as Bytes import qualified Data.ByteString.Char8 as Bytes.Char8 import qualified Data.Text import Data.Vector ( Vector ) import qualified Data.Vector as Vector-import Data.Text ( Text ) import Data.Bits ( shiftR )-import Data.Word ( Word8 )-import Data.List ( unfoldr ) import Numeric ( readInt ) @@ -27,7 +21,7 @@ -- | Encode a 'BS.ByteString' in Nix's base32 encoding encode :: ByteString -> Text-encode c = Data.Text.pack $ takeCharPosFromDict <$> [nChar - 1, nChar - 2 .. 0]+encode c = toText $ takeCharPosFromDict <$> [nChar - 1, nChar - 2 .. 0] where -- Each base32 character gives us 5 bits of information, while -- each byte gives is 8. Because 'div' rounds down, we need to add@@ -74,9 +68,9 @@ (\c -> fromMaybe (error "character not in digits32") $ Vector.findIndex (== c) digits32 )- (Data.Text.unpack what)+ (toString what) of- [(i, _)] -> Right $ padded $ integerToBS i+ [(i, _)] -> pure $ padded $ integerToBS i x -> Left $ "Can't decode: readInt returned " <> show x where padded x
src/System/Nix/Internal/Hash.hs view
@@ -2,15 +2,12 @@ Description : Cryptographic hashing interface for hnix-store, on top of the cryptohash family of libraries. -}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE CPP #-}+{-# language AllowAmbiguousTypes #-}+{-# language TypeFamilies #-}+{-# language ScopedTypeVariables #-}+{-# language DataKinds #-}+{-# language ExistentialQuantification #-}+{-# language CPP #-} module System.Nix.Internal.Hash ( NamedAlgo(..)@@ -22,9 +19,9 @@ ) where +import qualified Text.Show import qualified Crypto.Hash as C import qualified Data.ByteString as BS-import Data.Text (Text) import qualified Data.Text as T import System.Nix.Internal.Base import Data.ByteArray@@ -52,27 +49,27 @@ instance Show SomeNamedDigest where show sd = case sd of- SomeDigest (digest :: C.Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest+ SomeDigest (digest :: C.Digest hashType) -> toString $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest mkNamedDigest name sriHash = let (sriName, h) = T.breakOnEnd "-" sriHash in if sriName == "" || sriName == name <> "-" then mkDigest h- else Left $ T.unpack $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name+ else Left $ toString $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name where mkDigest h = case name of "md5" -> SomeDigest <$> decodeGo C.MD5 h "sha1" -> SomeDigest <$> decodeGo C.SHA1 h "sha256" -> SomeDigest <$> decodeGo C.SHA256 h "sha512" -> SomeDigest <$> decodeGo C.SHA512 h- _ -> Left $ "Unknown hash name: " <> T.unpack name+ _ -> Left $ "Unknown hash name: " <> toString name decodeGo :: forall a . NamedAlgo a => a -> Text -> Either String (C.Digest a) decodeGo a h | size == base16Len = decodeDigestWith Base16 h | size == base32Len = decodeDigestWith NixBase32 h | size == base64Len = decodeDigestWith Base64 h- | otherwise = Left $ T.unpack sriHash <> " is not a valid " <> T.unpack name <> " hash. Its length (" <> show size <> ") does not match any of " <> show [base16Len, base32Len, base64Len]+ | otherwise = Left $ toString sriHash <> " is not a valid " <> toString name <> " hash. Its length (" <> show size <> ") does not match any of " <> show [base16Len, base32Len, base64Len] where size = T.length h hsize = C.hashDigestSize a@@ -100,8 +97,3 @@ maybeToRight ("Cryptonite was not able to convert '(ByteString -> Digest a)' for: '" <> show bs <>"'.") (toEither . C.digestFromByteString) bs- where- -- To not depend on @extra@- maybeToRight :: b -> Maybe a -> Either b a- maybeToRight _ (Just r) = pure r- maybeToRight y Nothing = Left y
src/System/Nix/Internal/Nar/Effects.hs view
@@ -1,7 +1,6 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# language KindSignatures #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-} module System.Nix.Internal.Nar.Effects ( NarEffects(..)@@ -10,7 +9,6 @@ import qualified Data.ByteString as Bytes import qualified Data.ByteString.Lazy as Bytes.Lazy-import Data.Int (Int64) import qualified System.Directory as Directory import System.Posix.Files ( createSymbolicLink , fileSize@@ -79,7 +77,7 @@ -> m () streamStringOutIO f getChunk = Exception.Lifted.bracket- (IO.liftIO $ IO.openFile f IO.WriteMode)+ (IO.liftIO $ IO.openFile f WriteMode) (IO.liftIO . IO.hClose) go `Exception.Lifted.catch`@@ -89,7 +87,7 @@ go handle = do chunk <- getChunk case chunk of- Nothing -> pure ()+ Nothing -> pass Just c -> do IO.liftIO $ Bytes.hPut handle c go handle
src/System/Nix/Internal/Nar/Parser.hs view
@@ -1,11 +1,8 @@ -- | A streaming parser for the NAR format -{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language ScopedTypeVariables #-}+{-# language TypeFamilies #-} module System.Nix.Internal.Nar.Parser ( runParser@@ -15,14 +12,11 @@ ) where +import qualified Relude.Unsafe as Unsafe import qualified Algebra.Graph as Graph import qualified Algebra.Graph.ToGraph as Graph import qualified Control.Concurrent as Concurrent import qualified Control.Exception.Lifted as Exception.Lifted-import Control.Monad ( forM- , when- , forM_- ) import qualified Control.Monad.Except as Except import qualified Control.Monad.Fail as Fail import qualified Control.Monad.IO.Class as IO@@ -30,19 +24,11 @@ import qualified Control.Monad.State as State import qualified Control.Monad.Trans as Trans import qualified Control.Monad.Trans.Control as Base-import Data.ByteString ( ByteString ) import qualified Data.ByteString as Bytes-import Data.Bool ( bool )-import qualified Data.Either as Either-import Data.Int ( Int64 )-import qualified Data.IORef as IORef import qualified Data.List as List import qualified Data.Map as Map-import Data.Maybe ( catMaybes ) import qualified Data.Serialize as Serialize-import Data.Text ( Text ) import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text import qualified System.Directory as Directory import System.FilePath as FilePath import qualified System.IO as IO@@ -86,15 +72,15 @@ -- ^ A parser to run, such as @parseNar@ -> IO.Handle -- ^ A handle the stream containg the NAR. It should already be- -- open and in @IO.ReadMode@+ -- open and in @ReadMode@ -> FilePath -- ^ The root file system object to be created by the NAR -> m (Either String a) runParser effs (NarParser action) h target = do unpackResult <-- Reader.runReaderT (Except.runExceptT $ State.evalStateT action state0) effs+ runReaderT (runExceptT $ State.evalStateT action state0) effs `Exception.Lifted.catch` exceptionHandler- when (Either.isLeft unpackResult) cleanup+ when (isLeft unpackResult) cleanup pure unpackResult where@@ -123,7 +109,7 @@ instance Trans.MonadTrans NarParser where- lift act = NarParser $ (Trans.lift . Trans.lift . Trans.lift) act+ lift act = NarParser $ (lift . lift . lift) act data ParserState = ParserState@@ -177,7 +163,7 @@ (dir, file) <- currentDirectoryAndFile pushLink $ LinkInfo- { linkTarget = Text.unpack target+ { linkTarget = toString target , linkFile = file , linkPWD = dir }@@ -185,7 +171,7 @@ currentDirectoryAndFile :: Monad m => NarParser m (FilePath, FilePath) currentDirectoryAndFile = do dirStack <- State.gets directoryStack- pure (List.foldr1 (</>) (List.reverse $ drop 1 dirStack), head dirStack)+ pure (List.foldr1 (</>) (List.reverse $ drop 1 dirStack), Unsafe.head dirStack) -- | Internal data type representing symlinks encountered in the NAR@@ -220,7 +206,7 @@ -- Set up for defining `getChunk` narHandle <- State.gets handle- bytesLeftVar <- IO.liftIO $ IORef.newIORef fSize+ bytesLeftVar <- IO.liftIO $ newIORef fSize let -- getChunk tracks the number of total bytes we still need to get from the@@ -228,13 +214,13 @@ -- chunk we read) getChunk :: m (Maybe ByteString) getChunk = do- bytesLeft <- IO.liftIO $ IORef.readIORef bytesLeftVar+ bytesLeft <- IO.liftIO $ readIORef bytesLeftVar if bytesLeft == 0 then pure Nothing else do chunk <- IO.liftIO $ Bytes.hGetSome narHandle $ fromIntegral $ min 10000 bytesLeft when (Bytes.null chunk) (Fail.fail "ZERO BYTES")- IO.liftIO $ IORef.modifyIORef bytesLeftVar $ \n -> n - fromIntegral (Bytes.length chunk)+ IO.liftIO $ modifyIORef bytesLeftVar $ \n -> n - fromIntegral (Bytes.length chunk) -- This short pause is necessary for letting the garbage collector -- clean up chunks from previous runs. Without it, heap memory usage can@@ -243,12 +229,12 @@ pure $ Just chunk target <- currentFile- streamFile <- Reader.asks Nar.narStreamFile- Trans.lift (streamFile target getChunk)+ streamFile <- asks Nar.narStreamFile+ lift (streamFile target getChunk) when (s == "executable") $ do- effs :: Nar.NarEffects m <- Reader.ask- Trans.lift $ do+ effs :: Nar.NarEffects m <- ask+ lift $ do p <- Nar.narGetPerms effs target Nar.narSetPerms effs target (p { Directory.executable = True }) @@ -259,9 +245,9 @@ -- handles for target files longer than needed parseDirectory :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseDirectory = do- createDirectory <- Reader.asks Nar.narCreateDir+ createDirectory <- asks Nar.narCreateDir target <- currentFile- Trans.lift $ createDirectory target+ lift $ createDirectory target parseEntryOrFinish where@@ -282,7 +268,7 @@ parens $ do expectStr "name" fName <- parseStr- pushFileName (Text.unpack fName)+ pushFileName (toString fName) expectStr "node" parens parseFSO popFileName@@ -307,7 +293,7 @@ strBytes <- consume $ fromIntegral len expectRawString (Bytes.replicate (fromIntegral $ padLen $ fromIntegral len) 0)- pure $ Text.decodeUtf8 strBytes+ pure $ decodeUtf8 strBytes -- | Get an Int64 describing the length of the upcoming string,@@ -386,13 +372,13 @@ -- (Targets must be created before the links that target them) createLinks :: IO.MonadIO m => NarParser m () createLinks = do- createLink <- Reader.asks Nar.narCreateLink+ createLink <- asks Nar.narCreateLink allLinks <- State.gets links sortedLinks <- IO.liftIO $ sortLinksIO allLinks forM_ sortedLinks $ \li -> do pwd <- IO.liftIO Directory.getCurrentDirectory IO.liftIO $ Directory.setCurrentDirectory (linkPWD li)- Trans.lift $ createLink (linkTarget li) (linkFile li)+ lift $ createLink (linkTarget li) (linkFile li) IO.liftIO $ Directory.setCurrentDirectory pwd where@@ -447,7 +433,7 @@ popStr :: Monad m => NarParser m (Maybe Text) popStr = do s <- State.get- case List.uncons (tokenStack s) of+ case uncons (tokenStack s) of Nothing -> pure Nothing Just (x, xs) -> do State.put $ s { tokenStack = xs }@@ -492,14 +478,14 @@ testParser :: (m ~ IO) => NarParser m a -> ByteString -> m (Either String a) testParser p b = do Bytes.writeFile tmpFileName b- IO.withFile tmpFileName IO.ReadMode $ \h ->+ withFile tmpFileName ReadMode $ \h -> runParser Nar.narEffectsIO p h tmpFileName where tmpFileName = "tmp" testParser' :: (m ~ IO) => FilePath -> IO (Either String ()) testParser' fp =- IO.withFile fp IO.ReadMode $ \h -> runParser Nar.narEffectsIO parseNar h "tmp"+ withFile fp ReadMode $ \h -> runParser Nar.narEffectsIO parseNar h "tmp"
src/System/Nix/Internal/Nar/Streamer.hs view
@@ -1,48 +1,64 @@ -- | Stream out a NAR file from a regular file -{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# language ScopedTypeVariables #-} module System.Nix.Internal.Nar.Streamer- ( streamNarIO+ ( NarSource+ , dumpString+ , dumpPath+ , streamNarIO , IsExecutable(..) ) where -import Control.Monad ( forM_- , when- ) import qualified Control.Monad.IO.Class as IO-import Data.Bool ( bool )-import Data.ByteString ( ByteString ) 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.List as List import qualified Data.Serialize as Serial-import GHC.Int ( Int64 ) import qualified System.Directory as Directory import System.FilePath ( (</>) ) import qualified System.Nix.Internal.Nar.Effects as Nar +-- | NarSource+-- The source to provide nar to the handler `(ByteString -> m ())`.+-- It is isomorphic to ByteString by Yoneda lemma+-- if the result is meant to be m ().+-- It is done in CPS style so IO can be chunks.+type NarSource m = (ByteString -> m ()) -> m ()+++-- | dumpString+-- dump a string to nar in CPS style. The function takes in a `ByteString`,+-- and build a `NarSource m`.+dumpString+ :: forall m. IO.MonadIO m+ => ByteString -- ^ the string you want to dump+ -> NarSource m -- ^ The nar result in CPS style+dumpString text yield = traverse_ (yield . str)+ ["nix-archive-1", "(", "type" , "regular", "contents", text, ")"]+++-- | dumpPath+-- shorthand+-- build a Source that turn file path to nar using the default narEffectsIO.+dumpPath+ :: forall m . IO.MonadIO m+ => FilePath -- ^ path for the file you want to dump to nar+ -> NarSource m -- ^ the nar result in CPS style+dumpPath = streamNarIO Nar.narEffectsIO++ -- | This implementation of Nar encoding takes an arbitrary @yield@ -- function from any streaming library, and repeatedly calls -- it while traversing the filesystem object to Nar encode-streamNarIO- :: forall m- . (IO.MonadIO m)- => (ByteString -> m ())- -> Nar.NarEffects IO- -> FilePath- -> m ()-streamNarIO yield effs basePath = do+streamNarIO :: forall m . IO.MonadIO m => Nar.NarEffects IO -> FilePath -> NarSource m+streamNarIO effs basePath yield = do yield $ str "nix-archive-1" parens $ go basePath- where- go :: FilePath -> m () go path = do isDir <- IO.liftIO $ Nar.narIsDir effs path@@ -66,23 +82,13 @@ when isDir $ do fs <- IO.liftIO (Nar.narListDir effs path) yield $ strs ["type", "directory"]- forM_ (List.sort fs) $ \f -> do+ forM_ (sort fs) $ \f -> do yield $ str "entry" parens $ do let fullName = path </> f yield $ strs ["name", Bytes.Char8.pack f, "node"] parens $ go fullName - str :: ByteString -> ByteString- str t =- let- len = Bytes.length t- in- int len <> padBS len t-- padBS :: Int -> ByteString -> ByteString- padBS strSize bs = bs <> Bytes.replicate (padLen strSize) 0- parens act = do yield $ str "(" r <- act@@ -95,13 +101,6 @@ mapM_ yield . Bytes.Lazy.toChunks =<< IO.liftIO (Bytes.Lazy.readFile path) yield $ Bytes.replicate (padLen $ fromIntegral fsize) 0 - strs :: [ByteString] -> ByteString- strs xs = Bytes.concat $ str <$> xs-- int :: Integral a => a -> ByteString- int n = Serial.runPut $ Serial.putInt64le $ fromIntegral n-- data IsExecutable = NonExecutable | Executable deriving (Eq, Show) @@ -115,3 +114,19 @@ -- | Distance to the next multiple of 8 padLen :: Int -> Int padLen n = (8 - n) `mod` 8++int :: Integral a => a -> ByteString+int n = Serial.runPut $ Serial.putInt64le $ fromIntegral n++str :: ByteString -> ByteString+str t =+ let+ len = Bytes.length t+ in+ int len <> padBS len t++padBS :: Int -> ByteString -> ByteString+padBS strSize bs = bs <> Bytes.replicate (padLen strSize) 0++strs :: [ByteString] -> ByteString+strs xs = Bytes.concat $ str <$> xs
src/System/Nix/Internal/Signature.hs view
@@ -1,8 +1,7 @@ {-| Description : Nix-relevant interfaces to NaCl signatures. -}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE CPP #-}+{-# language CPP #-} module System.Nix.Internal.Signature ( Signature@@ -11,9 +10,7 @@ where -import Data.ByteString ( ByteString ) import qualified Data.ByteString as Bytes-import Data.Coerce ( coerce ) import Crypto.Saltine.Core.Sign ( PublicKey ) import Crypto.Saltine.Class ( IsEncoding(..) )
src/System/Nix/Internal/StorePath.hs view
@@ -1,14 +1,12 @@ {-| Description : Representation of Nix store paths. -}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DataKinds #-}+{-# language ConstraintKinds #-}+{-# language RecordWildCards #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language ScopedTypeVariables #-}+{-# language AllowAmbiguousTypes #-}+{-# language DataKinds #-} module System.Nix.Internal.StorePath ( -- * Basic store path types@@ -32,25 +30,21 @@ , pathParser ) 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 -import Data.ByteString ( ByteString ) import qualified Data.ByteString.Char8 as Bytes.Char8 import qualified Data.Char as Char-import Data.Text ( Text ) import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text- ( encodeUtf8 ) import Data.Attoparsec.Text.Lazy ( Parser , (<?>) ) import qualified Data.Attoparsec.Text.Lazy as Parser.Text.Lazy import qualified System.FilePath as FilePath-import Data.Hashable ( Hashable(..) )-import Data.HashSet ( HashSet )-import Data.Coerce ( coerce ) import Crypto.Hash ( SHA256 , Digest )@@ -173,8 +167,8 @@ root <> "/" <> hashPart <> "-" <> name where root = Bytes.Char8.pack storePathRoot- hashPart = Text.encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash- name = Text.encodeUtf8 $ unStorePathName storePathName+ hashPart = encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash+ name = encodeUtf8 $ unStorePathName storePathName -- | Render a 'StorePath' as a 'FilePath'. storePathToFilePath :: StorePath -> FilePath@@ -182,13 +176,13 @@ -- | Render a 'StorePath' as a 'Text'. storePathToText :: StorePath -> Text-storePathToText = Text.pack . Bytes.Char8.unpack . storePathToRawFilePath+storePathToText = toText . Bytes.Char8.unpack . storePathToRawFilePath -- | Build `narinfo` suffix from `StorePath` which -- can be used to query binary caches. storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString storePathToNarInfo StorePath{..} =- Text.encodeUtf8 $ encodeWith NixBase32 (coerce storePathHash) <> ".narinfo"+ encodeUtf8 $ encodeWith NixBase32 (coerce storePathHash) <> ".narinfo" -- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking -- that store directory matches `expectedRoot`.@@ -196,15 +190,15 @@ parsePath expectedRoot x = let (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x- (storeBasedHashPart, namePart) = Text.breakOn "-" $ Text.pack fname+ (storeBasedHashPart, namePart) = Text.breakOn "-" $ toText fname storeHash = decodeWith NixBase32 storeBasedHashPart name = makeStorePathName . Text.drop 1 $ namePart --rootDir' = dropTrailingPathSeparator rootDir -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b- rootDir' = init rootDir+ rootDir' = Unsafe.init rootDir storeDir = if expectedRoot == rootDir'- then Right rootDir'+ then pure rootDir' else Left $ "Root store dir mismatch, expected" <> expectedRoot <> "got" <> rootDir' in StorePath <$> coerce storeHash <*> name <*> storeDir@@ -212,7 +206,7 @@ pathParser :: FilePath -> Parser StorePath pathParser expectedRoot = do _ <-- Parser.Text.Lazy.string (Text.pack expectedRoot)+ Parser.Text.Lazy.string (toText expectedRoot) <?> "Store root mismatch" -- e.g. /nix/store _ <- Parser.Text.Lazy.char '/'
src/System/Nix/Internal/Truncation.hs view
@@ -1,6 +1,5 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE DataKinds #-}+{-# language ScopedTypeVariables #-}+{-# language DataKinds #-} module System.Nix.Internal.Truncation ( truncateInNixWay@@ -8,10 +7,6 @@ where import qualified Data.ByteString as Bytes-import Data.Bits (xor)-import Data.List (foldl')-import Data.Word (Word8)-import Data.Bool (bool) -- | Bytewise truncation of a 'Digest'. --
src/System/Nix/Nar.hs view
@@ -3,10 +3,8 @@ Maintainer : Shea Levy <shea@shealevy.com> -} -{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# language ScopedTypeVariables #-}+{-# language TypeFamilies #-} module System.Nix.Nar@@ -28,6 +26,11 @@ -- * Internal , Nar.streamNarIO , Nar.runParser+ , Nar.dumpString+ , Nar.dumpPath++ -- * Type+ , Nar.NarSource ) where @@ -46,7 +49,7 @@ -- | Pack the filesystem object at @FilePath@ into a NAR and stream it into the -- @IO.Handle@--- The handle should aleady be open and in @IO.WriteMode@.+-- The handle should aleady be open and in @WriteMode@. buildNarIO :: Nar.NarEffects IO -> FilePath@@ -54,9 +57,9 @@ -> IO () buildNarIO effs basePath outHandle = Nar.streamNarIO- (\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10) effs basePath+ (\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10) -- | Read NAR formatted bytes from the @IO.Handle@ and unpack them into
src/System/Nix/ReadonlyStore.hs view
@@ -1,22 +1,14 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# language DataKinds #-}+{-# language ScopedTypeVariables #-} module System.Nix.ReadonlyStore where -import Data.ByteString ( ByteString ) import qualified Data.ByteString as BS-import Data.List ( sort )-import qualified Data.Text as T import qualified Data.HashSet as HS-import Data.Text.Encoding import System.Nix.Hash import System.Nix.Nar import System.Nix.StorePath-import Control.Monad.State.Strict-import Data.Coerce ( coerce ) import Crypto.Hash ( Context , Digest , hash@@ -45,7 +37,7 @@ ty:fmap encodeUtf8 [ algoName @h , encodeDigestWith Base16 h- , T.pack fp+ , toText fp , coerce nm ] @@ -95,7 +87,7 @@ recursiveContentHash :: IO (Digest SHA256) recursiveContentHash = hashFinalize <$> execStateT streamNarUpdate (hashInit @SHA256) streamNarUpdate :: StateT (Context SHA256) IO ()- streamNarUpdate = streamNarIO (modify . flip (hashUpdate @ByteString @SHA256)) narEffectsIO pth+ streamNarUpdate = streamNarIO narEffectsIO pth (modify . flip (hashUpdate @ByteString @SHA256)) flatContentHash :: IO (Digest SHA256) flatContentHash = hashlazy <$> narReadFile narEffectsIO pth
src/System/Nix/StorePathMetadata.hs view
@@ -8,9 +8,7 @@ , ContentAddressableAddress ) import System.Nix.Hash ( SomeNamedDigest )-import Data.Set ( Set ) import Data.Time ( UTCTime )-import Data.Word ( Word64 ) import System.Nix.Signature ( NarSignature ) -- | Metadata about a 'StorePath'
tests/Arbitrary.hs view
@@ -1,19 +1,13 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE DataKinds #-}+{-# language DataKinds #-} {-# OPTIONS_GHC -Wno-orphans #-} module Arbitrary where -import Control.Monad ( replicateM ) import qualified Data.ByteString.Char8 as BSC-import qualified Data.Text as T import Test.Tasty.QuickCheck import System.Nix.Internal.StorePath-import Control.Applicative ( liftA3 )-import Data.Coerce ( coerce ) import Crypto.Hash ( SHA256 , Digest , hash@@ -29,7 +23,7 @@ dir = ('/':) <$> listOf1 (elements $ '/':['a'..'z']) instance Arbitrary StorePathName where- arbitrary = StorePathName . T.pack <$> ((:) <$> s1 <*> listOf sn)+ arbitrary = StorePathName . toText <$> ((:) <$> s1 <*> listOf sn) where alphanum = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'] s1 = elements $ alphanum <> "+-_?="@@ -47,11 +41,10 @@ instance Arbitrary NixLike where arbitrary = NixLike <$>- (liftA3 StorePath+ liftA3 StorePath arbitraryTruncatedDigest arbitrary (pure "/nix/store")- ) where -- 160-bit hash, 20 bytes, 32 chars in base32 arbitraryTruncatedDigest = coerce . BSC.pack <$> replicateM 20 genSafeChar
tests/Derivation.hs view
@@ -12,7 +12,6 @@ import qualified Data.Attoparsec.Text import qualified Data.Text.IO-import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Builder processDerivation :: FilePath -> FilePath -> IO ()@@ -22,7 +21,7 @@ fail -- It seems to be derivation. (Data.Text.IO.writeFile dest- . Data.Text.Lazy.toStrict+ . toText . Data.Text.Lazy.Builder.toLazyText . buildDerivation )
tests/Hash.hs view
@@ -1,18 +1,12 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE CPP #-}+{-# language DataKinds #-}+{-# language ScopedTypeVariables #-}+{-# language CPP #-} module Hash where -import Control.Monad ( forM_ )-import Data.ByteString ( ByteString )-import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Base16 as B16 import qualified System.Nix.Base32 as B32 import qualified Data.ByteString.Base64.Lazy as B64-import qualified Data.ByteString.Lazy as BSL import Test.Hspec import Test.Tasty.QuickCheck@@ -21,11 +15,11 @@ import System.Nix.StorePath import Arbitrary import System.Nix.Internal.Base-import Data.Coerce ( coerce ) import Crypto.Hash ( MD5 , SHA1 , SHA256 , hash+ , Digest ) spec_hash :: Spec@@ -33,29 +27,28 @@ describe "hashing parity with nix-store" $ do - it "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" $- shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA256 "nix-output:foo"))- "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5"- it "produces (base16 . md5) of \"Hello World\" the same as the thesis" $- shouldBe (encodeDigestWith Base16 (hash @ByteString @MD5 "Hello World"))- "b10a8db164e0754105b7a99be72e3fe5"- it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $- shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA1 "Hello World"))- "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a"+ cmp "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\""+ NixBase32 (hash @ByteString @SHA256) "nix-output:foo" "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5"+ cmp "produces (base16 . md5) of \"Hello World\" the same as the thesis"+ Base16 (hash @ByteString @MD5) "Hello World" "b10a8db164e0754105b7a99be72e3fe5"+ cmp "produces (base32 . sha1) of \"Hello World\" the same as the thesis"+ NixBase32 (hash @ByteString @SHA1) "Hello World" "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" -- The example in question: -- https://nixos.org/nixos/nix-pills/nix-store-paths.html it "produces same base32 as nix pill flat file example" $ do- let exampleStr =- "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3"- <> "c0d7b98883f9ee3:/nix/store:myfile"- shouldBe (encodeWith NixBase32 $ coerce $ mkStorePathHashPart exampleStr)+ shouldBe (encodeWith NixBase32 $ coerce $ mkStorePathHashPart "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3c0d7b98883f9ee3:/nix/store:myfile") "xv2iccirbrvklck36f1g7vldn5v58vck"+ where+ cmp :: String -> BaseEncoding -> (ByteString -> Digest a) -> ByteString -> Text -> SpecWith ()+ cmp t b f s h =+ it t $+ shouldBe (encodeDigestWith b $ f s) h -- | Test that Nix-like base32 encoding roundtrips prop_nixBase32Roundtrip :: Property prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $- \x -> pure (BSC.pack x) === (B32.decode . B32.encode . BSC.pack $ x)+ \x -> pure (encodeUtf8 x) === (B32.decode . B32.encode . encodeUtf8 $ x) -- | API variants prop_nixBase16Roundtrip :: StorePathHashPart -> Property@@ -68,48 +61,68 @@ describe "hashing parity with nix-nash" $ do - let- samples = [- ( "800d59cfcd3c05e900cb4e214be48f6b886a08df"- , "vw46m23bizj4n8afrc0fj19wrp7mj3c0"- , "gA1Zz808BekAy04hS+SPa4hqCN8="- )- , ( "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"- , "1b8m03r63zqhnjf7l5wnldhh7c134ap5vpj0850ymkq1iyzicy5s"- , "ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0="- )- , ( "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445"- , "12k9jiq29iyqm03swfsgiw5mlqs173qazm3n7daz43infy12pyrcdf30fkk3qwv4yl2ick8yipc2mqnlh48xsvvxl60lbx8vp38yji0"- , "IEqPxt2oLwoM7XvrjgikFlfBbvRosiioJ5vjMacDwzWW/RXBOxsH+aodO+pXeJygMa2Fx6cd1wNU7GMSOMo0RQ=="- )- ]-- it "b16 encoded . b32 decoded should equal original b16" $- forM_ samples $ \(b16, b32, _b64) -> shouldBe (B16.encode <$> B32.decode b32) (Right b16)+ cmp+ "b16 encoded . b32 decoded should equal original b16"+ B16.encode B32.decode b32s b16s - it "b64 encoded . b32 decoded should equal original b64" $- forM_ samples $ \(_b16, b32, b64) -> shouldBe (B64.encode . BSL.fromStrict <$> B32.decode b32) (Right b64)+ cmp+ "b64 encoded . b32 decoded should equal original b64"+ (B64.encode . fromStrict) B32.decode b32s b64s - it "b32 encoded . b64 decoded should equal original b32" $- forM_ samples $ \(_b16, b32, b64) -> shouldBe (B32.encode . BSL.toStrict <$> B64.decode b64 ) (Right b32)+ cmp+ "b32 encoded . b64 decoded should equal original b32"+ (B32.encode . toStrict) B64.decode b64s b32s - it "b16 encoded . b64 decoded should equal original b16" $- forM_ samples $ \(b16, _b32, b64) -> shouldBe (B16.encode . BSL.toStrict <$> B64.decode b64 ) (Right b16)+ cmp+ "b16 encoded . b64 decoded should equal original b16"+ (B16.encode . toStrict) B64.decode b64s b16s - it "b32 encoded . b16 decoded should equal original b32" $- forM_ samples $ \(b16, b32, _b64) -> shouldBe (B32.encode #if MIN_VERSION_base16_bytestring(1,0,0)- <$> B16.decode b16) (Right b32)-#else- $ fst $ B16.decode b16) (b32)+ cmp+ "b32 encoded . b16 decoded should equal original b32"+ B32.encode B16.decode b16s b32s -#endif+ cmp+ "b64 encoded . b16 decoded should equal original b64"+ (B64.encode . fromStrict) B16.decode b16s b64s+#else+ it "b32 encoded . b16 decoded should equal original b32" $+ traverse_ (\ b -> shouldBe (B32.encode $ fst $ B16.decode $ fst b) (snd b)) $ zip b16s b32s it "b64 encoded . b16 decoded should equal original b64" $- forM_ samples $ \(b16, _b32, b64) -> shouldBe (B64.encode . BSL.fromStrict-#if MIN_VERSION_base16_bytestring(1,0,0)- <$> B16.decode b16) (Right b64)-#else- $ fst $ B16.decode b16 ) (b64)+ traverse_ (\ b -> shouldBe (B64.encode . fromStrict $ fst $ B16.decode $ fst b) (snd b)) $ zip b16s b64s #endif + where+ cmp+ :: ( Eq b+ , Show b+ )+ => String+ -> (a -> b)+ -> (c -> Either String a)+ -> [c]+ -> [b]+ -> SpecWith ()+ cmp s f1 f2 b1 b2 = it s $ traverse_ (uncurry shouldBe . bimap (fmap f1 . f2) pure) $ zip b1 b2++ b16s = takeAxis (\(a,_,_) -> a)+ b32s = takeAxis (\(_,b,_) -> b)+ b64s = takeAxis (\(_,_,c) -> c)++ takeAxis f = fmap f samples++ samples =+ [ ( "800d59cfcd3c05e900cb4e214be48f6b886a08df"+ , "vw46m23bizj4n8afrc0fj19wrp7mj3c0"+ , "gA1Zz808BekAy04hS+SPa4hqCN8="+ )+ , ( "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"+ , "1b8m03r63zqhnjf7l5wnldhh7c134ap5vpj0850ymkq1iyzicy5s"+ , "ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0="+ )+ , ( "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445"+ , "12k9jiq29iyqm03swfsgiw5mlqs173qazm3n7daz43infy12pyrcdf30fkk3qwv4yl2ick8yipc2mqnlh48xsvvxl60lbx8vp38yji0"+ , "IEqPxt2oLwoM7XvrjgikFlfBbvRosiioJ5vjMacDwzWW/RXBOxsH+aodO+pXeJygMa2Fx6cd1wNU7GMSOMo0RQ=="+ )+ ]
tests/NarFormat.hs view
@@ -1,16 +1,10 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeApplications #-}+{-# language CPP #-}+{-# language ScopedTypeVariables #-} module NarFormat where -import Control.Applicative (many, optional, (<|>)) import qualified Control.Concurrent as Concurrent-import Control.Exception (SomeException, try)-import Control.Monad (replicateM, void,- when)+import Control.Exception (try) import Data.Binary.Get (Get, getByteString, getInt64le, getLazyByteString, runGet)@@ -21,11 +15,8 @@ import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Char8 as BSLC-import Data.Int import qualified Data.Map as Map-import Data.Maybe (fromMaybe) import qualified Data.Text as T-import qualified Data.Text.Encoding as E import System.Directory ( doesDirectoryExist , doesPathExist , removeDirectoryRecursive@@ -43,11 +34,14 @@ import qualified Test.Tasty.HUnit as HU import Test.Tasty.QuickCheck import qualified Text.Printf as Printf-import Text.Read (readMaybe) import qualified System.Nix.Internal.Nar.Streamer as Nar import System.Nix.Nar +-- Without the import, `max_live_bytes` and `getRTSStats` are undefined on some setups.+#ifdef BOUNDED_MEMORY+import GHC.Stats+#endif withBytesAsHandle :: BSLC.ByteString -> (IO.Handle -> IO a) -> IO a@@ -55,7 +49,7 @@ Temp.withSystemTempFile "nar-test-file-XXXXX" $ \tmpFile h -> do IO.hClose h BSL.writeFile tmpFile bytes- IO.withFile tmpFile IO.ReadMode act+ withFile tmpFile ReadMode act spec_narEncoding :: Spec spec_narEncoding = do@@ -74,7 +68,7 @@ res <- withBytesAsHandle (runPut (putNar n)) $ \h -> do unpackNarIO narEffectsIO h packageFilePath- res `shouldBe` Right ()+ res `shouldBe` pass e' <- doesPathExist packageFilePath e' `shouldBe` True@@ -84,7 +78,7 @@ IO.hClose h BSL.readFile tmpFile - res' `shouldBe` (runPut $ putNar n)+ res' `shouldBe` runPut (putNar n) -- For a Haskell embedded Nar, check that encoding it gives -- the same bytestring as `nix-store --dump`@@ -160,10 +154,10 @@ Right _ -> do let go dir = do srcHere <- doesDirectoryExist dir- case srcHere of- False -> pure ()- True -> do- IO.withFile narFilePath IO.WriteMode $ \h ->+ bool+ pass+ (do+ withFile narFilePath WriteMode $ \h -> buildNarIO narEffectsIO "src" h hnixNar <- BSL.readFile narFilePath nixStoreNar <- getNixStoreDump "src"@@ -171,6 +165,8 @@ "src dir serializes the same between hnix-store and nix-store" hnixNar nixStoreNar+ )+ srcHere go "src" go "hnix-store-core/src" -- ||||||| merged common ancestors@@ -182,7 +178,7 @@ -- nixStoreNar -- ======= -- let narFile = tmpDir </> "src.nar"--- IO.withFile narFile IO.WriteMode $ \h ->+-- withFile narFile WriteMode $ \h -> -- buildNarIO narEffectsIO "src" h -- hnixNar <- BSL.readFile narFile -- nixStoreNar <- getNixStoreDump "src"@@ -201,7 +197,7 @@ -- BSL.writeFile narFileName =<< buildNarIO narEffectsIO bigFileName -- step "create nar file"- IO.withFile narFileName IO.WriteMode $ \h ->+ withFile narFileName WriteMode $ \h -> buildNarIO narEffectsIO bigFileName h step "assert bounded memory"@@ -230,32 +226,32 @@ _run = do filesPrecount <- countProcessFiles- IO.withFile "hnar" IO.WriteMode $ \h ->+ withFile "hnar" WriteMode $ \h -> buildNarIO narEffectsIO narFilePath h filesPostcount <- countProcessFiles pure $ (-) <$> filesPostcount <*> filesPrecount step "create test files" Directory.createDirectory packagePath- flip mapM_ [0..1000] $ \i -> do+ forM_ [0..1000] $ \i -> do BSL.writeFile (Printf.printf (packagePath </> "%08d") (i :: Int)) "hi\n" Concurrent.threadDelay 50 filesPrecount <- countProcessFiles step "pack nar"- IO.withFile narFilePath IO.WriteMode $ \h ->+ withFile narFilePath WriteMode $ \h -> buildNarIO narEffectsIO packagePath h step "unpack nar"- r <- IO.withFile narFilePath IO.ReadMode $ \h ->+ r <- withFile narFilePath ReadMode $ \h -> unpackNarIO narEffectsIO h packagePath'- r `shouldBe` Right ()+ r `shouldBe` pass step "check constant file usage" filesPostcount <- countProcessFiles- case ((-) <$> filesPostcount <*> filesPrecount) of- Nothing -> pure ()+ case (-) <$> filesPostcount <*> filesPrecount of+ Nothing -> pass Just c -> c `shouldSatisfy` (< 50) -- step "check file exists"@@ -303,7 +299,7 @@ assertExists nixNarFile -- hnix converts those files to nar- IO.withFile hnixNarFile IO.WriteMode $ \h ->+ withFile hnixNarFile WriteMode $ \h -> buildNarIO narEffectsIO testFile h assertExists hnixNarFile @@ -320,7 +316,7 @@ bytes <- max_live_bytes <$> getRTSStats bytes < 100 * 1000 * 1000 `shouldBe` True #else- pure ()+ pass #endif @@ -353,16 +349,16 @@ step $ "Build NAR from " <> narFilePath <> " to " <> hnixNarFile -- narBS <- buildNarIO narEffectsIO narFile- IO.withFile hnixNarFile IO.WriteMode $ \h ->+ withFile hnixNarFile WriteMode $ \h -> buildNarIO narEffectsIO narFilePath h -- BSL.writeFile hnixNarFile narBS step $ "Unpack NAR to " <> outputFile- _narHandle <- IO.withFile nixNarFile IO.ReadMode $ \h ->+ _narHandle <- withFile nixNarFile ReadMode $ \h -> unpackNarIO narEffectsIO h outputFile - pure ()+ pass -- | Count file descriptors owned by the current process countProcessFiles :: IO (Maybe Int)@@ -373,7 +369,7 @@ then pure Nothing else do let fdDir = "/proc/" <> show pid <> "/fd"- fds <- P.readProcess "ls" [fdDir] ""+ fds <- toText <$> P.readProcess "ls" [fdDir] "" pure $ pure $ length $ words fds @@ -538,8 +534,8 @@ -- | Add a link to a FileSystemObject. This is useful -- when creating Arbitrary FileSystemObjects. It -- isn't implemented yet-mkLink ::- FilePath -- ^ Target+mkLink+ :: FilePath -- ^ Target -> FilePath -- ^ Link -> FileSystemObject -- ^ FileSystemObject to add link to -> FileSystemObject@@ -554,11 +550,9 @@ -- | Construct FilePathPart from Text by checking that there -- are no '/' or '\\NUL' characters filePathPart :: BSC.ByteString -> Maybe FilePathPart-filePathPart p = case BSC.any (`elem` ['/', '\NUL']) p of- False -> Just $ FilePathPart p- True -> Nothing+filePathPart p = if BSC.any (`elem` ['/', '\NUL']) p then Nothing else Just $ FilePathPart p -data Nar = Nar { narFile :: FileSystemObject }+newtype Nar = Nar { narFile :: FileSystemObject } deriving (Eq, Show) -- | A FileSystemObject (FSO) is an anonymous entity that can be NAR archived@@ -623,11 +617,11 @@ strs ["type", "regular"] >> (if isExec == Nar.Executable then strs ["executable", ""]- else pure ())+ else pass) >> putContents fSize contents putFile (SymLink target) =- strs ["type", "symlink", "target", BSL.fromStrict $ E.encodeUtf8 target]+ strs ["type", "symlink", "target", fromStrict $ encodeUtf8 target] -- toList sorts the entries by FilePathPart before serializing putFile (Directory entries) =@@ -638,7 +632,7 @@ str "entry" parens $ do str "name"- str (BSL.fromStrict name)+ str (fromStrict name) str "node" parens (putFile fso) @@ -650,7 +644,7 @@ in int len <> pad len t putContents :: Int64 -> BSL.ByteString -> Put- putContents fSize bs = str "contents" <> int fSize <> (pad fSize bs)+ putContents fSize bs = str "contents" <> int fSize <> pad fSize bs int :: Integral a => a -> Put int n = putInt64le $ fromIntegral n@@ -698,18 +692,18 @@ assertStr_ "type" assertStr_ "symlink" assertStr_ "target"- fmap (SymLink . E.decodeUtf8 . BSL.toStrict) str+ fmap (SymLink . decodeUtf8) str getEntry = do assertStr_ "entry" parens $ do assertStr_ "name"- name <- E.decodeUtf8 . BSL.toStrict <$> str+ name <- str assertStr_ "node" file <- parens getFile maybe (fail $ "Bad FilePathPart: " <> show name) (pure . (,file))- (filePathPart $ E.encodeUtf8 name)+ (filePathPart $ toStrict name) -- Fetch a length-prefixed, null-padded string str = fmap snd sizedStr
tests/StorePath.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}+{-# language DataKinds #-}+{-# language ScopedTypeVariables #-} module StorePath where @@ -14,18 +12,18 @@ -- | Test that Nix(OS) like paths roundtrip prop_storePathRoundtrip :: NixLike -> NixLike -> Property-prop_storePathRoundtrip (_ :: NixLike) = \(NixLike x) ->- (parsePath "/nix/store" $ storePathToRawFilePath x) === Right x+prop_storePathRoundtrip (_ :: NixLike) (NixLike x) =+ parsePath "/nix/store" (storePathToRawFilePath x) === pure x -- | Test that any `StorePath` roundtrips prop_storePathRoundtrip' :: StorePath -> Property prop_storePathRoundtrip' x =- (parsePath (storePathRoot x) $ storePathToRawFilePath x) === Right x+ parsePath (storePathRoot x) (storePathToRawFilePath x) === pure x prop_storePathRoundtripParser :: NixLike -> NixLike -> Property-prop_storePathRoundtripParser (_ :: NixLike) = \(NixLike x) ->- (Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) $ storePathToText x) === Right x+prop_storePathRoundtripParser (_ :: NixLike) (NixLike x) =+ Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) (storePathToText x) === pure x prop_storePathRoundtripParser' :: StorePath -> Property prop_storePathRoundtripParser' x =- (Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) $ storePathToText x) === Right x+ Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) (storePathToText x) === pure x