diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 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.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 diff --git a/src/System/Nix/Build.hs b/src/System/Nix/Build.hs --- a/src/System/Nix/Build.hs +++ b/src/System/Nix/Build.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards #-} +{-# language RecordWildCards #-} {-| Description : Build related types Maintainer : srk @@ -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 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 @@ -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 diff --git a/src/System/Nix/Internal/Base.hs b/src/System/Nix/Internal/Base.hs --- a/src/System/Nix/Internal/Base.hs +++ b/src/System/Nix/Internal/Base.hs @@ -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 diff --git a/src/System/Nix/Internal/Base32.hs b/src/System/Nix/Internal/Base32.hs --- a/src/System/Nix/Internal/Base32.hs +++ b/src/System/Nix/Internal/Base32.hs @@ -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 diff --git a/src/System/Nix/Internal/Hash.hs b/src/System/Nix/Internal/Hash.hs --- a/src/System/Nix/Internal/Hash.hs +++ b/src/System/Nix/Internal/Hash.hs @@ -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 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 @@ -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 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 @@ -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" 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 @@ -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 diff --git a/src/System/Nix/Internal/Signature.hs b/src/System/Nix/Internal/Signature.hs --- a/src/System/Nix/Internal/Signature.hs +++ b/src/System/Nix/Internal/Signature.hs @@ -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(..) ) 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 @@ -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 '/' diff --git a/src/System/Nix/Internal/Truncation.hs b/src/System/Nix/Internal/Truncation.hs --- a/src/System/Nix/Internal/Truncation.hs +++ b/src/System/Nix/Internal/Truncation.hs @@ -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'. -- 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 @@ -3,10 +3,8 @@ Maintainer : Shea Levy -} -{-# 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 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 @@ -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 diff --git a/src/System/Nix/StorePathMetadata.hs b/src/System/Nix/StorePathMetadata.hs --- a/src/System/Nix/StorePathMetadata.hs +++ b/src/System/Nix/StorePathMetadata.hs @@ -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' diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs --- a/tests/Arbitrary.hs +++ b/tests/Arbitrary.hs @@ -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 diff --git a/tests/Derivation.hs b/tests/Derivation.hs --- a/tests/Derivation.hs +++ b/tests/Derivation.hs @@ -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 ) diff --git a/tests/Hash.hs b/tests/Hash.hs --- a/tests/Hash.hs +++ b/tests/Hash.hs @@ -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==" + ) + ] diff --git a/tests/NarFormat.hs b/tests/NarFormat.hs --- a/tests/NarFormat.hs +++ b/tests/NarFormat.hs @@ -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 diff --git a/tests/StorePath.hs b/tests/StorePath.hs --- a/tests/StorePath.hs +++ b/tests/StorePath.hs @@ -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