hnix-store-core 0.4.1.0 → 0.4.2.0
raw patch · 23 files changed
+723/−601 lines, 23 filessetup-changednew-uploaderPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +15/−0
- Setup.hs +0/−2
- hnix-store-core.cabal +3/−1
- src/System/Nix/Base32.hs +5/−4
- src/System/Nix/Build.hs +10/−11
- src/System/Nix/Derivation.hs +24/−22
- src/System/Nix/Hash.hs +16/−14
- src/System/Nix/Internal/Base32.hs +60/−55
- src/System/Nix/Internal/Hash.hs +3/−3
- src/System/Nix/Internal/Nar/Effects.hs +40/−35
- src/System/Nix/Internal/Nar/Parser.hs +205/−162
- src/System/Nix/Internal/Nar/Streamer.hs +71/−62
- src/System/Nix/Internal/Signature.hs +14/−9
- src/System/Nix/Internal/StorePath.hs +97/−98
- src/System/Nix/Nar.hs +16/−12
- src/System/Nix/ReadonlyStore.hs +42/−24
- src/System/Nix/Signature.hs +3/−2
- src/System/Nix/StorePath.hs +3/−2
- src/System/Nix/StorePathMetadata.hs +9/−6
- tests/Arbitrary.hs +21/−24
- tests/Derivation.hs +30/−21
- tests/NarFormat.hs +34/−28
- tests/StorePath.hs +2/−4
ChangeLog.md view
@@ -1,5 +1,20 @@ # Revision history for hnix-store-core +## [0.4.2.0](https://github.com/haskell-nix/hnix-store/compare/0.4.1.0...0.4.2.0) 2021-03-12++* Additional:++ * [(link)](https://github.com/haskell-nix/hnix-store/commit/5d03ffc43cde9448df05e84838ece70cc83b1b6c) Cabal now properly states `tasty-discover` as `build-tool-depends`.++ * [(link)](https://github.com/haskell-nix/hnix-store/commit/b5ad38573d27e0732d0fadfebd98de1f753b4f07) added explicit `hie.yml` cradle description for `cabal` to help Haskell Language Server to work with monorepo.++ * [(link)](https://github.com/haskell-nix/hnix-store/commit/a5b7a614c0e0e11147a93b9a197c2a443afa3244) rm vacuous `Setup.hs`, it was throwing-off HLS, and anyway file is vacuous and gets deprecated by Cabal itself.++ * [(link)](https://github.com/haskell-nix/hnix-store/commit/cf04083aba98ad40d183d1e26251101816cc07ae) Nix dev env: removed GHC 8.6.5 support, afaik it is not even in Nixpkgs anymore.++ * [(link)](https://github.com/haskell-nix/hnix-store/commit/2a897ab581c0501587ce04da6d6e3a6f543b1d72) Test suite: fixed nar test for the envs without `/proc` (test suite now works on `macOS`).++ ## [0.4.1.0](https://github.com/haskell-nix/hnix-store/compare/0.4.0.0...0.4.1.0) 2021-01-16 * Big clean-up of dependencies.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
hnix-store-core.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: hnix-store-core-version: 0.4.1.0+version: 0.4.2.0 synopsis: Core effects for interacting with the Nix store. description: This package contains types and functions needed to describe@@ -90,6 +90,8 @@ StorePath hs-source-dirs: tests+ build-tool-depends:+ tasty-discover:tasty-discover build-depends: hnix-store-core , attoparsec
src/System/Nix/Base32.hs view
@@ -1,9 +1,10 @@ {-| Description: Implementation of Nix's base32 encoding. -}-module System.Nix.Base32 (- encode+module System.Nix.Base32+ ( encode , decode- ) where+ )+where -import System.Nix.Internal.Base32+import System.Nix.Internal.Base32
src/System/Nix/Build.hs view
@@ -3,15 +3,16 @@ Description : Build related types Maintainer : srk <srk@48.io> |-}-module System.Nix.Build (- BuildMode(..)+module System.Nix.Build+ ( BuildMode(..) , BuildStatus(..) , BuildResult(..) , buildSuccess- ) where+ )+where -import Data.Time (UTCTime)-import Data.Text (Text)+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@@ -49,11 +50,9 @@ startTime :: !UTCTime , -- Stop time of this build stopTime :: !UTCTime- } deriving (Eq, Ord, Show)+ }+ deriving (Eq, Ord, Show) buildSuccess :: BuildResult -> Bool-buildSuccess BuildResult{..} = elem status- [ Built- , Substituted- , AlreadyValid- ]+buildSuccess BuildResult {..} =+ status `elem` [Built, Substituted, AlreadyValid]
src/System/Nix/Derivation.hs view
@@ -1,33 +1,35 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Nix.Derivation (- parseDerivation+module System.Nix.Derivation+ ( parseDerivation , buildDerivation- ) where+ )+where -import Data.Attoparsec.Text.Lazy (Parser)-import Data.Text (Text)-import Data.Text.Lazy.Builder (Builder)-import Nix.Derivation (Derivation)-import System.Nix.StorePath (StorePath)+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 )+import qualified Nix.Derivation as Derivation+import System.Nix.StorePath ( StorePath )+import qualified System.Nix.StorePath as StorePath -import qualified Data.Text-import qualified Data.Text.Lazy.Builder -import qualified Nix.Derivation-import qualified System.Nix.StorePath -parseDerivation :: FilePath -> Parser (Derivation StorePath Text)+parseDerivation :: FilePath -> Text.Lazy.Parser (Derivation StorePath Text) parseDerivation expectedRoot =- Nix.Derivation.parseDerivationWith- ("\"" *> System.Nix.StorePath.pathParser expectedRoot <* "\"")- Nix.Derivation.textParser+ Derivation.parseDerivationWith+ ("\"" *> StorePath.pathParser expectedRoot <* "\"")+ Derivation.textParser -buildDerivation :: Derivation StorePath Text -> Builder-buildDerivation derivation =- Nix.Derivation.buildDerivationWith- (string . Data.Text.pack . show)+buildDerivation :: Derivation StorePath Text -> Text.Lazy.Builder+buildDerivation =+ Derivation.buildDerivationWith+ (string . Text.pack . show) string- derivation where- string = Data.Text.Lazy.Builder.fromText . Data.Text.pack . show+ string = Text.Lazy.Builder.fromText . Text.pack . show
src/System/Nix/Hash.hs view
@@ -1,20 +1,22 @@ {-| Description : Cryptographic hashes for hnix-store. -}-module System.Nix.Hash (- HNix.Digest+module System.Nix.Hash+ ( Hash.Digest - , HNix.HashAlgorithm(..)- , HNix.ValidAlgo(..)- , HNix.NamedAlgo(..)- , HNix.SomeNamedDigest(..)- , HNix.hash- , HNix.hashLazy- , HNix.mkNamedDigest+ , Hash.HashAlgorithm(..)+ , Hash.ValidAlgo(..)+ , Hash.NamedAlgo(..)+ , Hash.SomeNamedDigest(..) - , HNix.BaseEncoding(..)- , HNix.encodeInBase- , HNix.decodeBase- ) where+ , Hash.hash+ , Hash.hashLazy+ , Hash.mkNamedDigest -import qualified System.Nix.Internal.Hash as HNix+ , Hash.BaseEncoding(..)+ , Hash.encodeInBase+ , Hash.decodeBase+ )+where++import qualified System.Nix.Internal.Hash as Hash
src/System/Nix/Internal/Base32.hs view
@@ -1,88 +1,93 @@- module System.Nix.Internal.Base32 where -import Data.ByteString (ByteString)-import Data.Vector (Vector)-import Data.Text (Text)-import Data.Bits (shiftR)-import Data.Word (Word8)-import Data.List (unfoldr)-import Numeric (readInt) -import qualified Data.Maybe-import qualified Data.ByteString-import qualified Data.ByteString.Char8+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 qualified Data.Vector+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 ) + -- omitted: E O U T digits32 :: Vector Char-digits32 = Data.Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz"+digits32 = Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz" -- | Encode a 'BS.ByteString' in Nix's base32 encoding encode :: ByteString -> Text-encode c = Data.Text.pack $ map char32 [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- -- one extra character to the result, and because of that extra 1- -- we need to subtract one from the number of bits in the- -- bytestring to cover for the case where the number of bits is- -- already a factor of 5. Thus, the + 1 outside of the 'div' and- -- the - 1 inside of it.- nChar = fromIntegral $ ((Data.ByteString.length c * 8 - 1) `div` 5) + 1+encode c = Data.Text.pack $ fmap char32 [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+ -- one extra character to the result, and because of that extra 1+ -- we need to subtract one from the number of bits in the+ -- bytestring to cover for the case where the number of bits is+ -- already a factor of 5. Thus, the + 1 outside of the 'div' and+ -- the - 1 inside of it.+ nChar = fromIntegral $ ((Bytes.length c * 8 - 1) `div` 5) + 1 - byte = Data.ByteString.index c . fromIntegral+ byte = Bytes.index c . fromIntegral - -- May need to switch to a more efficient calculation at some- -- point.- bAsInteger :: Integer- bAsInteger = sum [fromIntegral (byte j) * (256 ^ j)- | j <- [0 .. Data.ByteString.length c - 1]- ]+ -- May need to switch to a more efficient calculation at some+ -- point.+ bAsInteger :: Integer+ bAsInteger =+ sum+ [ fromIntegral (byte j) * (256 ^ j)+ | j <- [0 .. Bytes.length c - 1] ] - char32 :: Integer -> Char- char32 i = digits32 Data.Vector.! digitInd- where- digitInd = fromIntegral $- bAsInteger- `div` (32^i)- `mod` 32+ char32 :: Integer -> Char+ char32 i = digits32 Vector.! digitInd+ where+ digitInd =+ fromIntegral $+ bAsInteger `div` (32^i) `mod` 32 -- | Decode Nix's base32 encoded text decode :: Text -> Either String ByteString decode what =- if Data.Text.all (`elem` digits32) what- then unsafeDecode what- else Left "Invalid base32 string"+ bool+ (Left "Invalid Base32 string")+ (unsafeDecode what)+ (Data.Text.all (`elem` digits32) what) -- | Decode Nix's base32 encoded text -- Doesn't check if all elements match `digits32` unsafeDecode :: Text -> Either String ByteString unsafeDecode what =- case readInt 32- (`elem` digits32)- (\c -> Data.Maybe.fromMaybe (error "character not in digits32")- $ Data.Vector.findIndex (==c) digits32)- (Data.Text.unpack what)+ case+ readInt+ 32+ (`elem` digits32)+ (\c -> fromMaybe (error "character not in digits32")+ $ Vector.findIndex (== c) digits32+ )+ (Data.Text.unpack what) of [(i, _)] -> Right $ padded $ integerToBS i- x -> Left $ "Can't decode: readInt returned " ++ show x- where- padded x- | Data.ByteString.length x < decLen = x `Data.ByteString.append` bstr- | otherwise = x- where- bstr = Data.ByteString.Char8.pack $ take (decLen - Data.ByteString.length x) (cycle "\NUL")+ x -> Left $ "Can't decode: readInt returned " <> show x+ where+ padded x+ | Bytes.length x < decLen = x `Bytes.append` bstr+ | otherwise = x+ where+ bstr = Bytes.Char8.pack $ take (decLen - Bytes.length x) (cycle "\NUL") - decLen = Data.Text.length what * 5 `div` 8+ decLen = Data.Text.length what * 5 `div` 8 -- | Encode an Integer to a bytestring -- Similar to Data.Base32String (integerToBS) without `reverse` integerToBS :: Integer -> ByteString-integerToBS 0 = Data.ByteString.pack [0]+integerToBS 0 = Bytes.pack [0] integerToBS i- | i > 0 = Data.ByteString.pack $ unfoldr f i+ | i > 0 = Bytes.pack $ unfoldr f i | otherwise = error "integerToBS not defined for negative values" where f 0 = Nothing
src/System/Nix/Internal/Hash.hs view
@@ -115,13 +115,13 @@ "sha1" -> SomeDigest <$> decodeGo @'SHA1 h "sha256" -> SomeDigest <$> decodeGo @'SHA256 h "sha512" -> SomeDigest <$> decodeGo @'SHA512 h- _ -> Left $ "Unknown hash name: " ++ T.unpack name+ _ -> Left $ "Unknown hash name: " <> T.unpack name decodeGo :: forall a . (NamedAlgo a, ValidAlgo a) => Text -> Either String (Digest a) decodeGo h | size == base16Len = decodeBase Base16 h | size == base32Len = decodeBase Base32 h | size == base64Len = decodeBase 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 $ T.unpack sriHash <> " is not a valid " <> T.unpack name <> " hash. Its length (" <> show size <> ") does not match any of " <> show [base16Len, base32Len, base64Len] where size = T.length h hsize = hashSize @a@@ -218,7 +218,7 @@ truncateDigest :: forall n a.(KnownNat n) => Digest a -> Digest ('Truncated n a) truncateDigest (Digest c) =- Digest $ BS.pack $ map truncOutputByte [0.. n-1]+ Digest $ BS.pack $ fmap truncOutputByte [0.. n-1] where n = fromIntegral $ natVal (Proxy @n)
src/System/Nix/Internal/Nar/Effects.hs view
@@ -8,23 +8,26 @@ , narEffectsIO ) where -import qualified Control.Exception.Lifted as Lifted-import qualified Control.Monad.Fail as MonadFail-import qualified Control.Monad.IO.Class as IO-import Control.Monad.Trans.Control (MonadBaseControl)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BSL+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+ , getFileStatus+ , isDirectory+ , readSymbolicLink+ ) import qualified System.IO as IO-import System.Posix.Files (createSymbolicLink, fileSize,- getFileStatus, isDirectory,- readSymbolicLink)+import qualified Control.Monad.IO.Class as IO+import Control.Monad.Trans.Control (MonadBaseControl)+import qualified Control.Exception.Lifted as Exception.Lifted+import qualified Control.Monad.Fail as MonadFail data NarEffects (m :: * -> *) = NarEffects {- narReadFile :: FilePath -> m BSL.ByteString- , narWriteFile :: FilePath -> BSL.ByteString -> m ()- , narStreamFile :: FilePath -> m (Maybe BS.ByteString) -> m ()+ narReadFile :: FilePath -> m Bytes.Lazy.ByteString+ , narWriteFile :: FilePath -> Bytes.Lazy.ByteString -> m ()+ , narStreamFile :: FilePath -> m (Maybe Bytes.ByteString) -> m () , narListDir :: FilePath -> m [FilePath] , narCreateDir :: FilePath -> m () , narCreateLink :: FilePath -> FilePath -> m ()@@ -48,17 +51,17 @@ MonadBaseControl IO m ) => NarEffects m narEffectsIO = NarEffects {- narReadFile = IO.liftIO . BSL.readFile- , narWriteFile = \a b -> IO.liftIO $ BSL.writeFile a b+ narReadFile = IO.liftIO . Bytes.Lazy.readFile+ , narWriteFile = \a -> IO.liftIO . Bytes.Lazy.writeFile a , narStreamFile = streamStringOutIO , narListDir = IO.liftIO . Directory.listDirectory , narCreateDir = IO.liftIO . Directory.createDirectory- , narCreateLink = \f t -> IO.liftIO $ createSymbolicLink f t+ , narCreateLink = \f -> IO.liftIO . createSymbolicLink f , narGetPerms = IO.liftIO . Directory.getPermissions- , narSetPerms = \f p -> IO.liftIO $ Directory.setPermissions f p- , narIsDir = \d -> fmap isDirectory $ IO.liftIO (getFileStatus d)+ , narSetPerms = \f -> IO.liftIO . Directory.setPermissions f+ , narIsDir = fmap isDirectory . IO.liftIO . getFileStatus , narIsSymLink = IO.liftIO . Directory.pathIsSymbolicLink- , narFileSize = \n -> fmap (fromIntegral . fileSize) $ IO.liftIO (getFileStatus n)+ , narFileSize = fmap (fromIntegral . fileSize) . IO.liftIO . getFileStatus , narReadLink = IO.liftIO . readSymbolicLink , narDeleteDir = IO.liftIO . Directory.removeDirectoryRecursive , narDeleteFile = IO.liftIO . Directory.removeFile@@ -72,23 +75,25 @@ MonadFail.MonadFail m, MonadBaseControl IO m ) => FilePath- -> m (Maybe BS.ByteString)+ -> m (Maybe Bytes.ByteString) -> m () streamStringOutIO f getChunk =- Lifted.bracket- (IO.liftIO (IO.openFile f IO.WriteMode)) (IO.liftIO . IO.hClose) go- `Lifted.catch`+ Exception.Lifted.bracket+ (IO.liftIO $ IO.openFile f IO.WriteMode)+ (IO.liftIO . IO.hClose)+ go+ `Exception.Lifted.catch` cleanupException- where- go :: IO.Handle -> m ()- go handle = do- chunk <- getChunk- case chunk of- Nothing -> return ()- Just c -> do- IO.liftIO $ BS.hPut handle c- go handle- cleanupException (e :: Lifted.SomeException) = do- IO.liftIO $ Directory.removeFile f- MonadFail.fail $- "Failed to stream string to " ++ f ++ ": " ++ show e+ where+ go :: IO.Handle -> m ()+ go handle = do+ chunk <- getChunk+ case chunk of+ Nothing -> pure ()+ Just c -> do+ IO.liftIO $ Bytes.hPut handle c+ go handle+ cleanupException (e :: Exception.Lifted.SomeException) = do+ IO.liftIO $ Directory.removeFile f+ MonadFail.fail $+ "Failed to stream string to " <> f <> ": " <> show e
src/System/Nix/Internal/Nar/Parser.hs view
@@ -12,8 +12,11 @@ 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 ExceptionLifted-import Control.Monad (forM, when)+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@@ -21,16 +24,19 @@ import qualified Control.Monad.State as State import qualified Control.Monad.Trans as Trans import qualified Control.Monad.Trans.Control as Base-import qualified Data.ByteString as BS+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 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 S-import qualified Data.Text as T-import qualified Data.Text.Encoding as E+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@@ -44,9 +50,18 @@ -- of the actions the parser can take, and @ParserState@ for the -- internals of the parser newtype NarParser m a = NarParser- { runNarParser- :: State.StateT ParserState- (Except.ExceptT String (Reader.ReaderT (Nar.NarEffects m) m)) a}+ { runNarParser ::+ State.StateT+ ParserState+ (Except.ExceptT+ String+ (Reader.ReaderT+ (Nar.NarEffects m)+ m+ )+ )+ a+ } deriving ( Functor, Applicative, Monad, Fail.MonadFail , Trans.MonadIO, State.MonadState ParserState , Except.MonadError String@@ -57,7 +72,8 @@ -- This is suitable for testing the top-level NAR parser, or any of the -- smaller utilities parsers, if you have bytes appropriate for them runParser- :: forall m a.(IO.MonadIO m, Base.MonadBaseControl IO m)+ :: forall m a+ . (IO.MonadIO m, Base.MonadBaseControl IO m) => Nar.NarEffects m -- ^ Provide the effects set, usually @narEffectsIO@ -> NarParser m a@@ -69,38 +85,43 @@ -- ^ 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- `ExceptionLifted.catch` exceptionHandler+ unpackResult <-+ Reader.runReaderT (Except.runExceptT $ State.evalStateT action state0) effs+ `Exception.Lifted.catch` exceptionHandler when (Either.isLeft unpackResult) cleanup- return unpackResult+ pure unpackResult - where- state0 :: ParserState- state0 = ParserState+ where+ state0 :: ParserState+ state0 =+ ParserState { tokenStack = [] , handle = h , directoryStack = [target] , links = [] }- exceptionHandler :: ExceptionLifted.SomeException -> m (Either String a)- exceptionHandler e = do- return (Left $ "Exception while unpacking NAR file: " ++ show e) - cleanup :: m ()- cleanup = do- isDir <- Nar.narIsDir effs target- if isDir- then Nar.narDeleteDir effs target- else Nar.narDeleteFile effs target+ exceptionHandler :: Exception.Lifted.SomeException -> m (Either String a)+ exceptionHandler e =+ pure $ Left $ "Exception while unpacking NAR file: " <> show e + cleanup :: m ()+ cleanup =+ (\ef trg -> do+ isDir <- Nar.narIsDir ef trg+ bool+ (Nar.narDeleteFile ef trg)+ (Nar.narDeleteDir ef trg)+ isDir+ ) effs target + instance Trans.MonadTrans NarParser where lift act = NarParser $ (Trans.lift . Trans.lift . Trans.lift) act data ParserState = ParserState- { tokenStack :: ![T.Text]+ { tokenStack :: ![Text] -- ^ The parser can push tokens (words or punctuation) -- onto this stack. We use this for a very limited backtracking -- where the Nar format requires it@@ -120,11 +141,11 @@ -- | Parse a NAR byte string, producing @()@. -- Parsing a NAR is mostly used for its side-effect: producing--- the file system objects packed in the NAR. That's why we return @()@+-- the file system objects packed in the NAR. That's why we pure @()@ parseNar :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseNar = do expectStr "nix-archive-1"- parens $ parseFSO+ parens parseFSO createLinks @@ -132,9 +153,9 @@ parseFSO = do expectStr "type" matchStr- [("symlink", parseSymlink)- ,("regular", parseFile)- ,("directory", parseDirectory)+ [ ("symlink" , parseSymlink )+ , ("regular" , parseFile )+ , ("directory", parseDirectory) ] @@ -146,14 +167,19 @@ parseSymlink :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseSymlink = do expectStr "target"- target <- parseStr- (dir,file) <- currentDirectoryAndFile- pushLink $ LinkInfo { linkTarget = (T.unpack target), linkFile = file, linkPWD = dir }- where- currentDirectoryAndFile :: Monad m => NarParser m (FilePath, FilePath)- currentDirectoryAndFile = do- dirStack <- State.gets directoryStack- return $ (List.foldr1 (</>) (List.reverse $ drop 1 dirStack), head dirStack)+ target <- parseStr+ (dir, file) <- currentDirectoryAndFile+ pushLink $+ LinkInfo+ { linkTarget = Text.unpack target+ , linkFile = file+ , linkPWD = dir+ }+ where+ currentDirectoryAndFile :: Monad m => NarParser m (FilePath, FilePath)+ currentDirectoryAndFile = do+ dirStack <- State.gets directoryStack+ pure (List.foldr1 (</>) (List.reverse $ drop 1 dirStack), head dirStack) -- | Internal data type representing symlinks encountered in the NAR@@ -164,25 +190,27 @@ -- ^ file name of the link being created , linkPWD :: String -- ^ directory in which to create the link (relative to unpacking root)- } deriving (Show)+ }+ deriving Show -- | When the NAR includes a file, we read from the NAR handle in chunks and -- write the target in chunks. This lets us avoid reading the full contents -- of the encoded file into memory-parseFile :: forall m.(IO.MonadIO m, Fail.MonadFail m) => NarParser m ()+parseFile :: forall m . (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseFile = do s <- parseStr- when (s `notElem` ["executable", "contents"])- (Fail.fail $ "Parser found " ++ show s ++- " when expecting element from " ++- (show :: [String] -> String) ["executable", "contents"])+ when (s `notElem` ["executable", "contents"]) $+ Fail.fail+ $ "Parser found " <> show s+ <> " when expecting element from "+ <> (show :: [String] -> String) ["executable", "contents"] when (s == "executable") $ do expectStr "" expectStr "contents" - fSize <- parseLength+ fSize <- parseLength -- Set up for defining `getChunk` narHandle <- State.gets handle@@ -192,21 +220,21 @@ -- getChunk tracks the number of total bytes we still need to get from the -- file (starting at the file size, and decrementing by the size of the -- chunk we read)- getChunk :: m (Maybe BS.ByteString)+ getChunk :: m (Maybe ByteString) getChunk = do bytesLeft <- IO.liftIO $ IORef.readIORef bytesLeftVar if bytesLeft == 0- then return Nothing+ then pure Nothing else do- chunk <- IO.liftIO $ BS.hGetSome narHandle (fromIntegral $ min 10000 bytesLeft)- when (BS.null chunk) (Fail.fail "ZERO BYTES")- IO.liftIO $ IORef.modifyIORef bytesLeftVar (\n -> n - fromIntegral (BS.length chunk))+ 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) - -- This short pause is necessary for letting the garbage collector- -- clean up chunks from previous runs. Without it, heap memory usage can- -- quickly spike- IO.liftIO $ Concurrent.threadDelay 10- return $ Just chunk+ -- This short pause is necessary for letting the garbage collector+ -- clean up chunks from previous runs. Without it, heap memory usage can+ -- quickly spike+ IO.liftIO $ Concurrent.threadDelay 10+ pure $ Just chunk target <- currentFile streamFile <- Reader.asks Nar.narStreamFile@@ -218,7 +246,7 @@ p <- Nar.narGetPerms effs target Nar.narSetPerms effs target (p { Directory.executable = True }) - expectRawString (BS.replicate (padLen $ fromIntegral fSize) 0)+ expectRawString (Bytes.replicate (padLen $ fromIntegral fSize) 0) -- | Parse a NAR encoded directory, being careful not to hold onto file@@ -226,33 +254,33 @@ parseDirectory :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseDirectory = do createDirectory <- Reader.asks Nar.narCreateDir- target <- currentFile+ target <- currentFile Trans.lift $ createDirectory target parseEntryOrFinish - where+ where - parseEntryOrFinish :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m ()- parseEntryOrFinish = do- -- If we reach a ")", we finished the directory's entries, and we have- -- to put ")" back into the stream, because the outer call to @parens@- -- expects to consume it.- -- Otherwise, parse an entry as a fresh file system object- matchStr- [(")", pushStr ")")- ,("entry", parseEntry )- ]+ parseEntryOrFinish :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m ()+ parseEntryOrFinish =+ -- If we reach a ")", we finished the directory's entries, and we have+ -- to put ")" back into the stream, because the outer call to @parens@+ -- expects to consume it.+ -- Otherwise, parse an entry as a fresh file system object+ matchStr+ [ ( ")" , pushStr ")" )+ , ("entry", parseEntry )+ ] - parseEntry :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m ()- parseEntry = do- parens $ do- expectStr "name"- fName <- parseStr- pushFileName (T.unpack fName)- expectStr "node"- parens $ parseFSO- popFileName- parseEntryOrFinish+ parseEntry :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m ()+ parseEntry = do+ parens $ do+ expectStr "name"+ fName <- parseStr+ pushFileName (Text.unpack fName)+ expectStr "node"+ parens parseFSO+ popFileName+ parseEntryOrFinish @@ -263,17 +291,17 @@ -- | Short strings guiding the NAR parsing are prefixed with their -- length, then encoded in ASCII, and padded to 8 bytes. @parseStr@ -- captures this logic-parseStr :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m T.Text+parseStr :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m Text parseStr = do cachedStr <- popStr case cachedStr of- Just str -> do- return str+ Just str -> pure str Nothing -> do- len <- parseLength- strBytes <- consume (fromIntegral len)- expectRawString (BS.replicate (fromIntegral $ padLen $ fromIntegral len) 0)- return $ E.decodeUtf8 strBytes+ len <- parseLength+ strBytes <- consume $ fromIntegral len+ expectRawString+ (Bytes.replicate (fromIntegral $ padLen $ fromIntegral len) 0)+ pure $ Text.decodeUtf8 strBytes -- | Get an Int64 describing the length of the upcoming string,@@ -281,50 +309,61 @@ parseLength :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m Int64 parseLength = do eightBytes <- consume 8- case S.runGet S.getInt64le eightBytes of- Left e -> Fail.fail $ "parseLength failed to decode int64: " ++ e- Right n -> return n+ either+ (\e -> Fail.fail $ "parseLength failed to decode int64: " <> e)+ pure+ (Serialize.runGet Serialize.getInt64le eightBytes) -- | Consume a NAR string and assert that it matches an expectation-expectStr :: (IO.MonadIO m, Fail.MonadFail m) => T.Text -> NarParser m ()+expectStr :: (IO.MonadIO m, Fail.MonadFail m) => Text -> NarParser m () expectStr expected = do actual <- parseStr- when (actual /= expected)- (Fail.fail $ "Expected " ++ err expected ++ ", got " ++ err actual )- where- err t =- if T.length t > 10- then show (T.take 10 t)- else show t+ when (actual /= expected) $+ Fail.fail $ "Expected " <> err expected <> ", got " <> err actual+ where+ err t =+ show $+ bool+ t+ (Text.take 10 t <> "...")+ (Text.length t > 10) -- | Consume a raw string and assert that it equals some expectation. -- This is usually used when consuming padding 0's-expectRawString :: (IO.MonadIO m, Fail.MonadFail m) => BS.ByteString -> NarParser m ()+expectRawString+ :: (IO.MonadIO m, Fail.MonadFail m) => ByteString -> NarParser m () expectRawString expected = do- actual <- consume (BS.length expected)- when (actual /= expected) $- Fail.fail $ "Expected " ++ err expected ++ ", got " ++ err actual- where- err bs =- if BS.length bs > 10- then show (BS.take 10 bs) ++ "..."- else show bs+ actual <- consume $ Bytes.length expected+ when (actual /= expected)+ $ Fail.fail+ $ "Expected "+ <> err expected+ <> ", got "+ <> err actual+ where+ err bs =+ show $+ bool+ bs+ (Bytes.take 10 bs <> "...")+ (Bytes.length bs > 10) -- | Consume a NAR string, and dispatch to a parser depending on which string -- matched matchStr :: (IO.MonadIO m, Fail.MonadFail m)- => [(T.Text, NarParser m a)]+ => [(Text, NarParser m a)] -- ^ List of expected possible strings and the parsers they should run -> NarParser m a matchStr parsers = do str <- parseStr case List.lookup str parsers of- Just p -> p- Nothing -> Fail.fail $ "Expected one of " ++ show (fst <$> parsers) ++ " found " ++ show str+ Just p -> p+ Nothing ->+ Fail.fail $ "Expected one of " <> show (fst <$> parsers) <> " found " <> show str -- | Wrap any parser in NAR formatted parentheses@@ -334,7 +373,7 @@ expectStr "(" r <- act expectStr ")"- return r+ pure r -- | Sort links in the symlink stack according to their connectivity@@ -344,38 +383,38 @@ createLink <- Reader.asks Nar.narCreateLink allLinks <- State.gets links sortedLinks <- IO.liftIO $ sortLinksIO allLinks- flip mapM_ sortedLinks $ \li -> do- pwd <- IO.liftIO $ Directory.getCurrentDirectory+ forM_ sortedLinks $ \li -> do+ pwd <- IO.liftIO Directory.getCurrentDirectory IO.liftIO $ Directory.setCurrentDirectory (linkPWD li) Trans.lift $ createLink (linkTarget li) (linkFile li) IO.liftIO $ Directory.setCurrentDirectory pwd - where+ where - -- Convert every target and link file to a filepath relative- -- to NAR root, then @Graph.topSort@ it, and map from the- -- relative filepaths back to the original @LinkInfo@.- -- Relative paths are needed for sorting, but @LinkInfo@s- -- are needed for creating the link files- sortLinksIO :: [LinkInfo] -> IO [LinkInfo]- sortLinksIO ls = do- linkLocations <- fmap Map.fromList $- forM ls $ \li->- (,li) <$> Directory.canonicalizePath (linkFile li)- canonicalLinks <- forM ls $ \l -> do- targetAbsPath <- Directory.canonicalizePath- (linkPWD l </> linkTarget l)- fileAbsPath <- Directory.canonicalizePath- (linkFile l)- return (fileAbsPath, targetAbsPath)- let linkGraph = Graph.edges canonicalLinks- case Graph.topSort linkGraph of- Left _ -> error "Symlinks form a loop"- Right sortedNodes ->- let- sortedLinks = flip Map.lookup linkLocations <$> sortedNodes- in- return $ catMaybes sortedLinks+ -- Convert every target and link file to a filepath relative+ -- to NAR root, then @Graph.topSort@ it, and map from the+ -- relative filepaths back to the original @LinkInfo@.+ -- Relative paths are needed for sorting, but @LinkInfo@s+ -- are needed for creating the link files+ sortLinksIO :: [LinkInfo] -> IO [LinkInfo]+ sortLinksIO ls = do+ linkLocations <- fmap Map.fromList $+ forM ls $ \li->+ (,li) <$> Directory.canonicalizePath (linkFile li)+ canonicalLinks <- forM ls $ \l -> do+ targetAbsPath <- Directory.canonicalizePath+ (linkPWD l </> linkTarget l)+ fileAbsPath <- Directory.canonicalizePath+ (linkFile l)+ pure (fileAbsPath, targetAbsPath)+ let linkGraph = Graph.edges canonicalLinks+ case Graph.topSort linkGraph of+ Left _ -> error "Symlinks form a loop"+ Right sortedNodes ->+ let+ sortedLinks = flip Map.lookup linkLocations <$> sortedNodes+ in+ pure $ catMaybes sortedLinks ------------------------------------------------------------------------------@@ -386,44 +425,45 @@ consume :: (IO.MonadIO m, Fail.MonadFail m) => Int- -> NarParser m BS.ByteString-consume 0 = return ""+ -> NarParser m ByteString+consume 0 = pure "" consume n = do- state0 <- State.get- newBytes <- IO.liftIO $ BS.hGetSome (handle state0) (max 0 n)- when (BS.length newBytes < n) $+ state0 <- State.get+ newBytes <- IO.liftIO $ Bytes.hGetSome (handle state0) (max 0 n)+ when (Bytes.length newBytes < n) $ Fail.fail $ "consume: Not enough bytes in handle. Wanted "- ++ show n ++ " got " ++ show (BS.length newBytes)- return newBytes+ <> show n <> " got " <> show (Bytes.length newBytes)+ pure newBytes -- | Pop a string off the token stack-popStr :: Monad m => NarParser m (Maybe T.Text)+popStr :: Monad m => NarParser m (Maybe Text) popStr = do s <- State.get case List.uncons (tokenStack s) of- Nothing -> return Nothing- Just (x,xs) -> do+ Nothing -> pure Nothing+ Just (x, xs) -> do State.put $ s { tokenStack = xs }- return $ Just x+ pure $ Just x -- | Push a string onto the token stack-pushStr :: Monad m => T.Text -> NarParser m ()-pushStr str = do+pushStr :: Monad m => Text -> NarParser m ()+pushStr str = State.modify $ \s -> -- s { loadedBytes = strBytes <> loadedBytes s } s { tokenStack = str : tokenStack s } -- | Push a level onto the directory stack pushFileName :: Monad m => FilePath -> NarParser m ()-pushFileName fName = State.modify (\s -> s { directoryStack = fName : directoryStack s })+pushFileName fName =+ State.modify (\s -> s { directoryStack = fName : directoryStack s }) -- | Go to the parent level in the directory stack popFileName :: Monad m => NarParser m ()-popFileName = do+popFileName = State.modify (\s -> s { directoryStack = List.drop 1 (directoryStack s )}) @@ -432,7 +472,7 @@ currentFile :: Monad m => NarParser m FilePath currentFile = do dirStack <- State.gets directoryStack- return $ List.foldr1 (</>) (List.reverse dirStack)+ pure $ List.foldr1 (</>) $ List.reverse dirStack -- | Add a link to the collection of encountered symlinks@@ -443,20 +483,23 @@ ------------------------------------------------------------------------------ -- * Utilities -testParser :: (m ~ IO) => NarParser m a -> BS.ByteString -> m (Either String a)+testParser :: (m ~ IO) => NarParser m a -> ByteString -> m (Either String a) testParser p b = do- BS.writeFile "tmp" b- IO.withFile "tmp" IO.ReadMode $ \h ->- runParser Nar.narEffectsIO p h "tmp"+ Bytes.writeFile tmpFileName b+ IO.withFile tmpFileName IO.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"+testParser' fp =+ IO.withFile fp IO.ReadMode $ \h -> runParser Nar.narEffectsIO parseNar h "tmp" -- | Distance to the next multiple of 8-padLen:: Int -> Int+padLen :: Int -> Int padLen n = (8 - n) `mod` 8
src/System/Nix/Internal/Nar/Streamer.hs view
@@ -1,23 +1,24 @@ -- | Stream out a NAR file from a regular file {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-} module System.Nix.Internal.Nar.Streamer where -import Control.Monad (forM_, when)+import Control.Monad ( forM_+ , when+ ) import qualified Control.Monad.IO.Class as IO-import Data.Bool (bool)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BSC-import qualified Data.ByteString.Lazy as BSL+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 GHC.Int ( Int64 ) import qualified System.Directory as Directory-import System.FilePath ((</>))+import System.FilePath ( (</>) ) import qualified System.Nix.Internal.Nar.Effects as Nar @@ -26,79 +27,87 @@ -- function from any streaming library, and repeatedly calls -- it while traversing the filesystem object to Nar encode streamNarIO- :: forall m.(IO.MonadIO m)- => (BS.ByteString -> m ())+ :: forall m+ . (IO.MonadIO m)+ => (ByteString -> m ()) -> Nar.NarEffects IO -> FilePath -> m () streamNarIO yield effs basePath = do- yield (str "nix-archive-1")- parens (go basePath)- where+ yield $ str "nix-archive-1"+ parens $ go basePath - go :: FilePath -> m ()- go path = do- isDir <- IO.liftIO $ Nar.narIsDir effs path- isSymLink <- IO.liftIO $ Nar.narIsSymLink effs path- let isRegular = not (isDir || isSymLink)+ where - when isSymLink $ do- target <- IO.liftIO $ Nar.narReadLink effs path- yield $- strs ["type", "symlink", "target", BSC.pack target]+ go :: FilePath -> m ()+ go path = do+ isDir <- IO.liftIO $ Nar.narIsDir effs path+ isSymLink <- IO.liftIO $ Nar.narIsSymLink effs path+ let isRegular = not $ isDir || isSymLink - when isRegular $ do- isExec <- IO.liftIO $ isExecutable effs path- yield $ strs ["type","regular"]- when (isExec == Executable) (yield $ strs ["executable", ""])- fSize <- IO.liftIO $ Nar.narFileSize effs path- yield $ str "contents"- yield $ int fSize- yieldFile path fSize+ when isSymLink $ do+ target <- IO.liftIO $ Nar.narReadLink effs path+ yield $+ strs ["type", "symlink", "target", Bytes.Char8.pack target] - when isDir $ do- fs <- IO.liftIO (Nar.narListDir effs path)- yield $ strs ["type", "directory"]- forM_ (List.sort fs) $ \f -> do- yield $ str "entry"- parens $ do- let fullName = path </> f- yield (strs ["name", BSC.pack f, "node"])- parens (go fullName)+ when isRegular $ do+ isExec <- IO.liftIO $ isExecutable effs path+ yield $ strs ["type", "regular"]+ when (isExec == Executable) $ yield $ strs ["executable", ""]+ fSize <- IO.liftIO $ Nar.narFileSize effs path+ yield $ str "contents"+ yield $ int fSize+ yieldFile path fSize - str :: BS.ByteString -> BS.ByteString- str t = let len = BS.length t- in int len <> padBS len t+ when isDir $ do+ fs <- IO.liftIO (Nar.narListDir effs path)+ yield $ strs ["type", "directory"]+ forM_ (List.sort fs) $ \f -> do+ yield $ str "entry"+ parens $ do+ let fullName = path </> f+ yield $ strs ["name", Bytes.Char8.pack f, "node"]+ parens $ go fullName - padBS :: Int -> BS.ByteString -> BS.ByteString- padBS strSize bs = bs <> BS.replicate (padLen strSize) 0+ str :: ByteString -> ByteString+ str t =+ let+ len = Bytes.length t+ in+ int len <> padBS len t - parens act = do- yield (str "(")- r <- act- yield (str ")")- return r+ padBS :: Int -> ByteString -> ByteString+ padBS strSize bs = bs <> Bytes.replicate (padLen strSize) 0 - -- Read, yield, and pad the file- yieldFile :: FilePath -> Int64 -> m ()- yieldFile path fsize = do- mapM_ yield . BSL.toChunks =<< IO.liftIO (BSL.readFile path)- yield (BS.replicate (padLen (fromIntegral fsize)) 0)+ parens act = do+ yield $ str "("+ r <- act+ yield $ str ")"+ pure r - strs :: [BS.ByteString] -> BS.ByteString- strs xs = BS.concat $ str <$> xs+ -- Read, yield, and pad the file+ yieldFile :: FilePath -> Int64 -> m ()+ yieldFile path fsize = do+ mapM_ yield . Bytes.Lazy.toChunks =<< IO.liftIO (Bytes.Lazy.readFile path)+ yield $ Bytes.replicate (padLen $ fromIntegral fsize) 0 - int :: Integral a => a -> BS.ByteString- int n = Serial.runPut $ Serial.putInt64le (fromIntegral n)+ 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)+ deriving (Eq, Show) isExecutable :: Functor m => Nar.NarEffects m -> FilePath -> m IsExecutable isExecutable effs fp =- bool NonExecutable Executable . Directory.executable <$> Nar.narGetPerms effs fp+ bool+ NonExecutable+ Executable+ . Directory.executable <$> Nar.narGetPerms effs fp -- | Distance to the next multiple of 8-padLen:: Int -> Int+padLen :: Int -> Int padLen n = (8 - n) `mod` 8
src/System/Nix/Internal/Signature.hs view
@@ -2,21 +2,25 @@ Description : Nix-relevant interfaces to NaCl signatures. -} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module System.Nix.Internal.Signature where -import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import Data.Coerce (coerce)-import Crypto.Saltine.Core.Sign (PublicKey)-import Crypto.Saltine.Class (IsEncoding(..))++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(..) ) import qualified Crypto.Saltine.Internal.ByteSizes as NaClSizes + -- | A NaCl signature.-newtype Signature = Signature ByteString deriving (Eq, Ord)+newtype Signature = Signature ByteString+ deriving (Eq, Ord) instance IsEncoding Signature where decode s- | BS.length s == NaClSizes.sign = Just (Signature s)+ | Bytes.length s == NaClSizes.sign = Just $ Signature s | otherwise = Nothing encode = coerce @@ -25,5 +29,6 @@ { -- | The public key used to sign the archive. publicKey :: PublicKey , -- | The archive's signature.- sig :: Signature- } deriving (Eq, Ord)+ sig :: Signature+ }+ deriving (Eq, Ord)
src/System/Nix/Internal/StorePath.hs view
@@ -8,31 +8,37 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeInType #-} -- Needed for GHC 8.4.4 for some reason+ module System.Nix.Internal.StorePath where-import System.Nix.Hash- ( HashAlgorithm(Truncated, SHA256)- , Digest- , BaseEncoding(..)- , encodeInBase- , decodeBase- , SomeNamedDigest- )-import System.Nix.Internal.Base32 (digits32)+import System.Nix.Hash ( HashAlgorithm+ ( Truncated+ , SHA256+ )+ , Digest+ , BaseEncoding(..)+ , encodeInBase+ , decodeBase+ , SomeNamedDigest+ ) -import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8)-import qualified Data.Text as T-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BC-import qualified Data.Char-import Data.Hashable (Hashable(..))-import Data.HashSet (HashSet) -import Data.Attoparsec.Text.Lazy (Parser, (<?>))+import qualified System.Nix.Internal.Base32 as Nix.Base32+ ( digits32 ) -import qualified Data.Attoparsec.Text.Lazy-import qualified System.FilePath+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 ) -- | A path in a Nix store. --@@ -53,14 +59,15 @@ storePathName :: !StorePathName , -- | Root of the store storePathRoot :: !FilePath- } deriving (Eq, Ord)+ }+ deriving (Eq, Ord) instance Hashable StorePath where- hashWithSalt s (StorePath {..}) =+ hashWithSalt s StorePath{..} = s `hashWithSalt` storePathHash `hashWithSalt` storePathName instance Show StorePath where- show p = BC.unpack $ storePathToRawFilePath p+ show p = Bytes.Char8.unpack $ storePathToRawFilePath p -- | The name portion of a Nix path. --@@ -97,7 +104,7 @@ -- applied to the nar serialization via some 'NarHashMode'. Fixed !NarHashMode !SomeNamedDigest --- | Schemes for hashing a nix archive.+-- | Schemes for hashing a Nix archive. -- -- For backwards-compatibility reasons, there are two different modes -- here, even though 'Recursive' should be able to cover both.@@ -109,115 +116,107 @@ Recursive makeStorePathName :: Text -> Either String StorePathName-makeStorePathName n = case validStorePathName n of- True -> Right $ StorePathName n- False -> Left $ reasonInvalid n+makeStorePathName n =+ if validStorePathName n+ then Right $ StorePathName n+ else Left $ reasonInvalid n reasonInvalid :: Text -> String-reasonInvalid n | n == "" = "Empty name"-reasonInvalid n | (T.length n > 211) = "Path too long"-reasonInvalid n | (T.head n == '.') = "Leading dot"-reasonInvalid _ | otherwise = "Invalid character"+reasonInvalid n+ | n == "" = "Empty name"+ | Text.length n > 211 = "Path too long"+ | Text.head n == '.' = "Leading dot"+ | otherwise = "Invalid character" validStorePathName :: Text -> Bool-validStorePathName "" = False-validStorePathName n = (T.length n <= 211)- && T.head n /= '.'- && T.all validStorePathNameChar n+validStorePathName n =+ n /= ""+ && Text.length n <= 211+ && Text.head n /= '.'+ && Text.all validStorePathNameChar n validStorePathNameChar :: Char -> Bool-validStorePathNameChar c = any ($ c) $- [ Data.Char.isAsciiLower -- 'a'..'z'- , Data.Char.isAsciiUpper -- 'A'..'Z'- , Data.Char.isDigit- ] ++- map (==) "+-._?="+validStorePathNameChar c =+ any ($ c)+ [ Char.isAsciiLower -- 'a'..'z', isAscii..er probably faster then putting it out+ , Char.isAsciiUpper -- 'A'..'Z'+ , Char.isDigit+ , (`elem` ("+-._?=" :: String))+ ] -- | Copied from @RawFilePath@ in the @unix@ package, duplicated here -- to avoid the dependency. type RawFilePath = ByteString -- | Render a 'StorePath' as a 'RawFilePath'.-storePathToRawFilePath- :: StorePath- -> RawFilePath-storePathToRawFilePath StorePath {..} = BS.concat- [ root- , "/"- , hashPart- , "-"- , name- ]- where- root = BC.pack storePathRoot- hashPart = encodeUtf8 $ encodeInBase Base32 storePathHash- name = encodeUtf8 $ unStorePathName storePathName+storePathToRawFilePath :: StorePath -> RawFilePath+storePathToRawFilePath StorePath{..} =+ root <> "/" <> hashPart <> "-" <> name+ where+ root = Bytes.Char8.pack storePathRoot+ hashPart = Text.encodeUtf8 $ encodeInBase Base32 storePathHash+ name = Text.encodeUtf8 $ unStorePathName storePathName -- | Render a 'StorePath' as a 'FilePath'.-storePathToFilePath- :: StorePath- -> FilePath-storePathToFilePath = BC.unpack . storePathToRawFilePath+storePathToFilePath :: StorePath -> FilePath+storePathToFilePath = Bytes.Char8.unpack . storePathToRawFilePath -- | Render a 'StorePath' as a 'Text'.-storePathToText- :: StorePath- -> Text-storePathToText = T.pack . BC.unpack . storePathToRawFilePath+storePathToText :: StorePath -> Text+storePathToText = Text.pack . Bytes.Char8.unpack . storePathToRawFilePath -- | Build `narinfo` suffix from `StorePath` which -- can be used to query binary caches.-storePathToNarInfo- :: StorePath- -> BC.ByteString-storePathToNarInfo StorePath {..} = BS.concat- [ encodeUtf8 $ encodeInBase Base32 storePathHash- , ".narinfo"- ]+storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString+storePathToNarInfo StorePath{..} =+ Text.encodeUtf8 $ encodeInBase Base32 storePathHash <> ".narinfo" --- | Parse `StorePath` from `BC.ByteString`, checking+-- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking -- that store directory matches `expectedRoot`.-parsePath- :: FilePath- -> BC.ByteString- -> Either String StorePath+parsePath :: FilePath -> Bytes.Char8.ByteString -> Either String StorePath parsePath expectedRoot x = let- (rootDir, fname) = System.FilePath.splitFileName . BC.unpack $ x- (digestPart, namePart) = T.breakOn "-" $ T.pack fname+ (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x+ (digestPart, namePart) = Text.breakOn "-" $ Text.pack fname digest = decodeBase Base32 digestPart- name = makeStorePathName . T.drop 1 $ namePart+ name = makeStorePathName . Text.drop 1 $ namePart --rootDir' = dropTrailingPathSeparator rootDir -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b rootDir' = init rootDir- storeDir = if expectedRoot == rootDir'- then Right rootDir'- else Left $ "Root store dir mismatch, expected" <> expectedRoot <> "got" <> rootDir'+ storeDir =+ if expectedRoot == rootDir'+ then Right rootDir'+ else Left $ "Root store dir mismatch, expected" <> expectedRoot <> "got" <> rootDir' in StorePath <$> digest <*> name <*> storeDir pathParser :: FilePath -> Parser StorePath pathParser expectedRoot = do- _ <- Data.Attoparsec.Text.Lazy.string (T.pack expectedRoot)- <?> "Store root mismatch" -- e.g. /nix/store+ _ <-+ Parser.Text.Lazy.string (Text.pack expectedRoot)+ <?> "Store root mismatch" -- e.g. /nix/store - _ <- Data.Attoparsec.Text.Lazy.char '/'- <?> "Expecting path separator"+ _ <- Parser.Text.Lazy.char '/'+ <?> "Expecting path separator" - digest <- decodeBase Base32- <$> Data.Attoparsec.Text.Lazy.takeWhile1 (`elem` digits32)- <?> "Invalid Base32 part"+ digest <-+ decodeBase Base32+ <$> Parser.Text.Lazy.takeWhile1 (`elem` Nix.Base32.digits32)+ <?> "Invalid Base32 part" - _ <- Data.Attoparsec.Text.Lazy.char '-'- <?> "Expecting dash (path name separator)"+ _ <- Parser.Text.Lazy.char '-' <?> "Expecting dash (path name separator)" - c0 <- Data.Attoparsec.Text.Lazy.satisfy (\c -> c /= '.' && validStorePathNameChar c)- <?> "Leading path name character is a dot or invalid character"+ c0 <-+ Parser.Text.Lazy.satisfy (\c -> c /= '.' && validStorePathNameChar c)+ <?> "Leading path name character is a dot or invalid character" - rest <- Data.Attoparsec.Text.Lazy.takeWhile validStorePathNameChar- <?> "Path name contains invalid character"+ rest <-+ Parser.Text.Lazy.takeWhile validStorePathNameChar+ <?> "Path name contains invalid character" - let name = makeStorePathName $ T.cons c0 rest+ let name = makeStorePathName $ Text.cons c0 rest - either fail return- $ StorePath <$> digest <*> name <*> pure expectedRoot+ either+ fail+ pure+ (StorePath <$> digest <*> name <*> pure expectedRoot)
src/System/Nix/Nar.hs view
@@ -9,7 +9,8 @@ {-# LANGUAGE TypeFamilies #-} -module System.Nix.Nar (+module System.Nix.Nar+ ( -- * Encoding and Decoding NAR archives buildNarIO@@ -27,15 +28,16 @@ -- * Internal , Nar.streamNarIO , Nar.runParser- ) where+ )+where -import qualified Control.Concurrent as Concurrent-import qualified Data.ByteString as BS-import qualified System.IO as IO+import qualified Control.Concurrent as Concurrent+import qualified Data.ByteString as BS+import qualified System.IO as IO -import qualified System.Nix.Internal.Nar.Effects as Nar-import qualified System.Nix.Internal.Nar.Parser as Nar-import qualified System.Nix.Internal.Nar.Streamer as Nar+import qualified System.Nix.Internal.Nar.Effects as Nar+import qualified System.Nix.Internal.Nar.Parser as Nar+import qualified System.Nix.Internal.Nar.Streamer as Nar -- For a description of the NAR format, see Eelco's thesis@@ -50,8 +52,11 @@ -> FilePath -> IO.Handle -> IO ()-buildNarIO effs basePath outHandle = do- Nar.streamNarIO (\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10) effs basePath+buildNarIO effs basePath outHandle =+ Nar.streamNarIO+ (\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10)+ effs+ basePath -- | Read NAR formatted bytes from the @IO.Handle@ and unpack them into@@ -61,5 +66,4 @@ -> IO.Handle -> FilePath -> IO (Either String ())-unpackNarIO effs narHandle outputFile = do- Nar.runParser effs Nar.parseNar narHandle outputFile+unpackNarIO effs = Nar.runParser effs Nar.parseNar
src/System/Nix/ReadonlyStore.hs view
@@ -2,50 +2,68 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}+ module System.Nix.ReadonlyStore where -import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.Text as T-import qualified Data.HashSet as HS++import Data.ByteString ( ByteString )+import qualified Data.ByteString as BS+import qualified Data.Text as T+import qualified Data.HashSet as HS import Data.Text.Encoding import System.Nix.Hash import System.Nix.StorePath -makeStorePath :: forall hashAlgo . (NamedAlgo hashAlgo)++makeStorePath+ :: forall hashAlgo+ . (NamedAlgo hashAlgo) => FilePath -> ByteString -> Digest hashAlgo -> StorePathName -> StorePath makeStorePath fp ty h nm = StorePath storeHash nm fp- where- s = BS.intercalate ":"- [ ty- , encodeUtf8 $ algoName @hashAlgo- , encodeUtf8 $ encodeInBase Base16 h- , encodeUtf8 $ T.pack fp- , encodeUtf8 $ unStorePathName nm- ]- storeHash = hash s+ where+ storeHash = hash s -makeTextPath :: FilePath -> StorePathName -> Digest 'SHA256 -> StorePathSet -> StorePath+ s =+ BS.intercalate ":" $+ ty:fmap encodeUtf8+ [ algoName @hashAlgo+ , encodeInBase Base16 h+ , T.pack fp+ , unStorePathName nm+ ]++makeTextPath+ :: FilePath -> StorePathName -> Digest 'SHA256 -> StorePathSet -> StorePath makeTextPath fp nm h refs = makeStorePath fp ty h nm- where- ty = BS.intercalate ":" ("text" : map storePathToRawFilePath (HS.toList refs))+ where+ ty =+ BS.intercalate ":" ("text" : fmap storePathToRawFilePath (HS.toList refs)) -makeFixedOutputPath :: forall hashAlgo . (ValidAlgo hashAlgo, NamedAlgo hashAlgo)+makeFixedOutputPath+ :: forall hashAlgo+ . (ValidAlgo hashAlgo, NamedAlgo hashAlgo) => FilePath -> Bool -> Digest hashAlgo -> StorePathName -> StorePath-makeFixedOutputPath fp recursive h nm =+makeFixedOutputPath fp recursive h = if recursive && (algoName @hashAlgo) == "sha256"- then makeStorePath fp "source" h nm- else makeStorePath fp "output:out" h' nm+ then makeStorePath fp "source" h+ else makeStorePath fp "output:out" h' where- h' = hash @'SHA256 $ "fixed:out:" <> encodeUtf8 (algoName @hashAlgo) <> (if recursive then ":r:" else ":") <> encodeUtf8 (encodeInBase Base16 h) <> ":"+ h' =+ hash @ 'SHA256+ $ "fixed:out:"+ <> encodeUtf8 (algoName @hashAlgo)+ <> (if recursive then ":r:" else ":")+ <> encodeUtf8 (encodeInBase Base16 h)+ <> ":" -computeStorePathForText :: FilePath -> StorePathName -> ByteString -> StorePathSet -> StorePath-computeStorePathForText fp nm s refs = makeTextPath fp nm (hash s) refs+computeStorePathForText+ :: FilePath -> StorePathName -> ByteString -> (StorePathSet -> StorePath)+computeStorePathForText fp nm = makeTextPath fp nm . hash
src/System/Nix/Signature.hs view
@@ -4,6 +4,7 @@ module System.Nix.Signature ( Signature , NarSignature(..)- ) where+ )+where -import System.Nix.Internal.Signature+import System.Nix.Internal.Signature
src/System/Nix/StorePath.hs view
@@ -21,6 +21,7 @@ , -- * Parsing 'StorePath's parsePath , pathParser- ) where+ )+where -import System.Nix.Internal.StorePath+import System.Nix.Internal.StorePath
src/System/Nix/StorePathMetadata.hs view
@@ -3,12 +3,15 @@ -} module System.Nix.StorePathMetadata where -import System.Nix.StorePath (StorePath, StorePathSet, ContentAddressableAddress)-import System.Nix.Hash (SomeNamedDigest)-import Data.Set (Set)-import Data.Time (UTCTime)-import Data.Word (Word64)-import System.Nix.Signature (NarSignature)+import System.Nix.StorePath ( StorePath+ , StorePathSet+ , 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' data StorePathMetadata = StorePathMetadata
tests/Arbitrary.hs view
@@ -4,9 +4,9 @@ module Arbitrary where -import Control.Monad (replicateM)-import qualified Data.ByteString.Char8 as BSC-import qualified Data.Text as T+import Control.Monad ( replicateM )+import qualified Data.ByteString.Char8 as BSC+import qualified Data.Text as T import Test.Tasty.QuickCheck @@ -22,15 +22,14 @@ nonEmptyString = listOf1 genSafeChar dir :: Gen String-dir = ('/':) <$> (listOf1 $ elements $ ('/':['a'..'z']))+dir = ('/':) <$> (listOf1 $ elements $ '/':['a'..'z']) instance Arbitrary StorePathName where- arbitrary = StorePathName . T.pack- <$> ((:) <$> s1 <*> listOf sn)- where- alphanum = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']- s1 = elements $ alphanum ++ "+-_?="- sn = elements $ alphanum ++ "+-._?="+ arbitrary = StorePathName . T.pack <$> ((:) <$> s1 <*> listOf sn)+ where+ alphanum = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9']+ s1 = elements $ alphanum <> "+-_?="+ sn = elements $ alphanum <> "+-._?=" instance Arbitrary (Digest StorePathHashAlgo) where arbitrary = hash . BSC.pack <$> arbitrary@@ -41,19 +40,17 @@ newtype NixLike = NixLike {getNixLike :: StorePath} deriving (Eq, Ord, Show) -instance Arbitrary (NixLike) where- arbitrary = NixLike <$>- (StorePath- <$> arbitraryTruncatedDigest- <*> arbitrary- <*> pure "/nix/store")- where- -- 160-bit hash, 20 bytes, 32 chars in base32- arbitraryTruncatedDigest = Digest . BSC.pack- <$> replicateM 20 genSafeChar+instance Arbitrary NixLike where+ arbitrary =+ NixLike+ <$> (StorePath+ <$> arbitraryTruncatedDigest+ <*> arbitrary+ <*> pure "/nix/store"+ )+ where+ -- 160-bit hash, 20 bytes, 32 chars in base32+ arbitraryTruncatedDigest = Digest . BSC.pack <$> replicateM 20 genSafeChar instance Arbitrary StorePath where- arbitrary = StorePath- <$> arbitrary- <*> arbitrary- <*> dir+ arbitrary = StorePath <$> arbitrary <*> arbitrary <*> dir
tests/Derivation.hs view
@@ -1,10 +1,14 @@ module Derivation where -import Test.Tasty (TestTree, testGroup)-import Test.Tasty.Golden (goldenVsFile)+import Test.Tasty ( TestTree+ , testGroup+ )+import Test.Tasty.Golden ( goldenVsFile ) -import System.Nix.Derivation (parseDerivation, buildDerivation)+import System.Nix.Derivation ( parseDerivation+ , buildDerivation+ ) import qualified Data.Attoparsec.Text.Lazy import qualified Data.Text.IO@@ -14,25 +18,30 @@ processDerivation :: FilePath -> FilePath -> IO () processDerivation source dest = do contents <- Data.Text.IO.readFile source- case Data.Attoparsec.Text.Lazy.parseOnly (parseDerivation "/nix/store") contents of+ case+ Data.Attoparsec.Text.Lazy.parseOnly+ (parseDerivation "/nix/store")+ contents+ of Left e -> error e Right drv ->- Data.Text.IO.writeFile dest- . Data.Text.Lazy.toStrict- . Data.Text.Lazy.Builder.toLazyText- $ buildDerivation drv+ Data.Text.IO.writeFile dest+ . Data.Text.Lazy.toStrict+ . Data.Text.Lazy.Builder.toLazyText+ $ buildDerivation drv test_derivation :: TestTree-test_derivation = testGroup "golden" $ map mk [0..1]- where- mk :: Int -> TestTree- mk n =- let- fp = "tests/samples/example"- drv = (fp ++ show n ++ ".drv")- act = (fp ++ show n ++ ".actual")- in- goldenVsFile- ("derivation roundtrip of " ++ drv)- drv act (processDerivation drv act)-+test_derivation =+ testGroup "golden" $ fmap mk [0 .. 1]+ where+ mk :: Int -> TestTree+ mk n =+ goldenVsFile+ ("derivation roundtrip of " <> drv)+ drv+ act+ (processDerivation drv act)+ where+ drv = fp <> show n <> ".drv"+ act = fp <> show n <> ".actual"+ fp = "tests/samples/example"
tests/NarFormat.hs view
@@ -159,7 +159,7 @@ let go dir = do srcHere <- doesDirectoryExist dir case srcHere of- False -> return ()+ False -> pure () True -> do IO.withFile narFilePath IO.WriteMode $ \h -> buildNarIO narEffectsIO "src" h@@ -231,7 +231,7 @@ IO.withFile "hnar" IO.WriteMode $ \h -> buildNarIO narEffectsIO narFilePath h filesPostcount <- countProcessFiles- return $ filesPostcount - filesPrecount+ pure $ (-) <$> filesPostcount <*> filesPrecount step "create test files" Directory.createDirectory packagePath@@ -252,7 +252,9 @@ step "check constant file usage" filesPostcount <- countProcessFiles- (filesPostcount - filesPrecount) `shouldSatisfy` (< 50)+ case ((-) <$> filesPostcount <*> filesPrecount) of+ Nothing -> pure ()+ Just c -> c `shouldSatisfy` (< 50) -- step "check file exists" -- e <- doesPathExist packagePath'@@ -316,7 +318,7 @@ bytes <- max_live_bytes <$> getRTSStats bytes < 100 * 1000 * 1000 `shouldBe` True #else- return ()+ pure () #endif @@ -339,34 +341,38 @@ Left (_ :: SomeException) -> print ("No nix-store on system" :: String) Right _ -> do let- nixNarFile = narFilePath ++ ".nix"- hnixNarFile = narFilePath ++ ".hnix"- outputFile = narFilePath ++ ".out"+ nixNarFile = narFilePath <> ".nix"+ hnixNarFile = narFilePath <> ".hnix"+ outputFile = narFilePath <> ".out" - step $ "Produce nix-store nar to " ++ nixNarFile- (_,_,_,handle) <- P.createProcess (P.shell $ "nix-store --dump " ++ narFilePath ++ " > " ++ nixNarFile)+ step $ "Produce nix-store nar to " <> nixNarFile+ (_,_,_,handle) <- P.createProcess (P.shell $ "nix-store --dump " <> narFilePath <> " > " <> nixNarFile) void $ P.waitForProcess handle - step $ "Build NAR from " ++ narFilePath ++ " to " ++ hnixNarFile+ step $ "Build NAR from " <> narFilePath <> " to " <> hnixNarFile -- narBS <- buildNarIO narEffectsIO narFile IO.withFile hnixNarFile IO.WriteMode $ \h -> buildNarIO narEffectsIO narFilePath h -- BSL.writeFile hnixNarFile narBS - step $ "Unpack NAR to " ++ outputFile+ step $ "Unpack NAR to " <> outputFile _narHandle <- IO.withFile nixNarFile IO.ReadMode $ \h -> unpackNarIO narEffectsIO h outputFile - return ()+ pure () -- | Count file descriptors owned by the current process-countProcessFiles :: IO Int+countProcessFiles :: IO (Maybe Int) countProcessFiles = do pid <- Unix.getProcessID- let fdDir = "/proc/" ++ show pid ++ "/fd"- fds <- P.readProcess "ls" [fdDir] ""- return $ length $ words fds+ hasProc <- doesDirectoryExist "/proc"+ if not hasProc+ then pure Nothing+ else do+ let fdDir = "/proc/" <> show pid <> "/fd"+ fds <- P.readProcess "ls" [fdDir] ""+ pure $ pure $ length $ words fds -- | Read the binary output of `nix-store --dump` for a filepath@@ -437,12 +443,12 @@ (FilePathPart "bf1", sampleLargeFile fSize) , (FilePathPart "bf2", sampleLargeFile' fSize) ]- ++ [ (FilePathPart (BSC.pack $ 'f' : show n),+ <> [ (FilePathPart (BSC.pack $ 'f' : show n), Regular Nar.NonExecutable 10000 (BSL.take 10000 (BSL.cycle "hi "))) | n <- [1..100 :: Int]]- ++ [+ <> [ (FilePathPart "d", Directory $ Map.fromList- [ (FilePathPart (BSC.pack $ "df" ++ show n)+ [ (FilePathPart (BSC.pack $ "df" <> show n) , Regular Nar.NonExecutable 10000 (BSL.take 10000 (BSL.cycle "subhi "))) | n <- [1..100 :: Int]] )@@ -595,13 +601,13 @@ arbName :: Gen FilePathPart arbName = fmap (FilePathPart . BS.pack . fmap (fromIntegral . fromEnum)) $ do Positive n <- arbitrary- replicateM n (elements $ ['a'..'z'] ++ ['0'..'9'])+ replicateM n (elements $ ['a'..'z'] <> ['0'..'9']) arbDirectory :: Int -> Gen FileSystemObject arbDirectory n = fmap (Directory . Map.fromList) $ replicateM n $ do nm <- arbName f <- oneof [arbFile, arbDirectory (n `div` 2)]- return (nm,f)+ pure (nm,f) ------------------------------------------------------------------------------ -- | Serialize Nar to lazy ByteString@@ -615,7 +621,7 @@ strs ["type", "regular"] >> (if isExec == Nar.Executable then strs ["executable", ""]- else return ())+ else pure ()) >> putContents fSize contents putFile (SymLink target) =@@ -678,13 +684,13 @@ >> assertStr "") assertStr_ "contents" (fSize, contents) <- sizedStr- return $ Regular (fromMaybe Nar.NonExecutable mExecutable) fSize contents+ pure $ Regular (fromMaybe Nar.NonExecutable mExecutable) fSize contents getDirectory = do assertStr_ "type" assertStr_ "directory" fs <- many getEntry- return $ Directory (Map.fromList fs)+ pure $ Directory (Map.fromList fs) getSymLink = do assertStr_ "type"@@ -699,8 +705,8 @@ name <- E.decodeUtf8 . BSL.toStrict <$> str assertStr_ "node" file <- parens getFile- maybe (fail $ "Bad FilePathPart: " ++ show name)- (return . (,file))+ maybe (fail $ "Bad FilePathPart: " <> show name)+ (pure . (,file)) (filePathPart $ E.encodeUtf8 name) -- Fetch a length-prefixed, null-padded string@@ -710,7 +716,7 @@ n <- getInt64le s <- getLazyByteString n _ <- getByteString . fromIntegral $ padLen n- return (n,s)+ pure (n,s) parens m = assertStr "(" *> m <* assertStr ")" @@ -718,5 +724,5 @@ assertStr s = do s' <- str if s == s'- then return s+ then pure s else fail "No"
tests/StorePath.hs view
@@ -24,10 +24,8 @@ prop_storePathRoundtripParser :: NixLike -> NixLike -> Property prop_storePathRoundtripParser (_ :: NixLike) = \(NixLike x) ->- (Data.Attoparsec.Text.Lazy.parseOnly (pathParser (storePathRoot x))- $ storePathToText x) === Right x+ (Data.Attoparsec.Text.Lazy.parseOnly (pathParser $ storePathRoot x) $ storePathToText x) === Right x prop_storePathRoundtripParser' :: StorePath -> Property prop_storePathRoundtripParser' x =- (Data.Attoparsec.Text.Lazy.parseOnly (pathParser (storePathRoot x))- $ storePathToText x) === Right x+ (Data.Attoparsec.Text.Lazy.parseOnly (pathParser $ storePathRoot x) $ storePathToText x) === Right x