hnix-store-core 0.4.0.0 → 0.4.1.0
raw patch · 14 files changed
+171/−157 lines, 14 filesdep −io-streamsdep −process-extrasdep −tasty-discoverPVP ok
version bump matches the API change (PVP)
Dependencies removed: io-streams, process-extras, tasty-discover
API changes (from Hackage documentation)
Files
- ChangeLog.md +2/−2
- hnix-store-core.cabal +46/−44
- src/System/Nix/Build.hs +6/−2
- src/System/Nix/Derivation.hs +1/−4
- src/System/Nix/Internal/Base32.hs +29/−24
- src/System/Nix/Internal/Hash.hs +12/−12
- src/System/Nix/Internal/Nar/Parser.hs +1/−3
- src/System/Nix/Internal/Nar/Streamer.hs +1/−1
- src/System/Nix/Internal/StorePath.hs +4/−4
- tests/Arbitrary.hs +3/−1
- tests/Derivation.hs +2/−0
- tests/Hash.hs +12/−10
- tests/NarFormat.hs +48/−50
- tests/StorePath.hs +4/−0
ChangeLog.md view
@@ -1,8 +1,8 @@ # Revision history for hnix-store-core -## [next](https://github.com/haskell-nix/hnix-store/compare/0.4.0.0...master) 2021-MM-DD+## [0.4.1.0](https://github.com/haskell-nix/hnix-store/compare/0.4.0.0...0.4.1.0) 2021-01-16 -* No changes yet+* Big clean-up of dependencies. ## [0.4.0.0](https://github.com/haskell-nix/hnix-store/compare/0.3.0.0...0.4.0.0) 2020-12-30
hnix-store-core.cabal view
@@ -1,5 +1,6 @@+cabal-version: 2.2 name: hnix-store-core-version: 0.4.0.0+version: 0.4.1.0 synopsis: Core effects for interacting with the Nix store. description: This package contains types and functions needed to describe@@ -17,9 +18,15 @@ , README.md , tests/samples/example0.drv , tests/samples/example1.drv-cabal-version: >=1.10 +Common commons+ if impl(ghc >= 8.10)+ ghc-options: -Wall -Wunused-packages+ else+ ghc-options: -Wall+ library+ import: commons exposed-modules: System.Nix.Base32 , System.Nix.Build , System.Nix.Derivation@@ -42,8 +49,6 @@ , base16-bytestring , base64-bytestring , bytestring- , binary- , bytestring , cereal , containers , cryptohash-md5@@ -67,45 +72,42 @@ default-language: Haskell2010 Flag bounded_memory- description: Run tests of constant memory use (requires +RTS -T)- default: False+ description: Run tests of constant memory use (requires +RTS -T)+ default: False test-suite format-tests- if flag(bounded_memory)- cpp-options: -DBOUNDED_MEMORY- ghc-options: -rtsopts -fprof-auto- type: exitcode-stdio-1.0- main-is: Driver.hs- other-modules:- Arbitrary- Derivation- NarFormat- Hash- StorePath- hs-source-dirs:- tests- build-depends:- hnix-store-core- , attoparsec- , base- , base16-bytestring- , base64-bytestring- , binary- , bytestring- , containers- , filepath- , directory- , filepath- , io-streams- , process- , process-extras- , tasty- , tasty-discover- , tasty-golden- , tasty-hspec- , tasty-hunit- , tasty-quickcheck- , temporary- , text- , unix- default-language: Haskell2010+ import: commons+ if flag(bounded_memory)+ cpp-options: -DBOUNDED_MEMORY+ ghc-options: -rtsopts -fprof-auto+ type: exitcode-stdio-1.0+ main-is: Driver.hs+ other-modules:+ Arbitrary+ Derivation+ NarFormat+ Hash+ StorePath+ hs-source-dirs:+ tests+ build-depends:+ hnix-store-core+ , attoparsec+ , base+ , base16-bytestring+ , base64-bytestring+ , binary+ , bytestring+ , containers+ , directory+ , filepath+ , process+ , tasty+ , tasty-golden+ , tasty-hspec+ , tasty-hunit+ , tasty-quickcheck+ , temporary+ , text+ , unix+ default-language: Haskell2010
src/System/Nix/Build.hs view
@@ -12,7 +12,6 @@ import Data.Time (UTCTime) import Data.Text (Text)-import Data.HashSet (HashSet) -- keep the order of these Enums to match enums from reference implementations -- src/libstore/store-api.hh@@ -52,4 +51,9 @@ stopTime :: !UTCTime } deriving (Eq, Ord, Show) -buildSuccess BuildResult{..} = status == Built || status == Substituted || status == AlreadyValid+buildSuccess :: BuildResult -> Bool+buildSuccess BuildResult{..} = elem status+ [ Built+ , Substituted+ , AlreadyValid+ ]
src/System/Nix/Derivation.hs view
@@ -6,16 +6,13 @@ ) where import Data.Attoparsec.Text.Lazy (Parser)-import Data.ByteString (ByteString) import Data.Text (Text) import Data.Text.Lazy.Builder (Builder) import Nix.Derivation (Derivation)-import System.Nix.StorePath (StorePath, pathParser)+import System.Nix.StorePath (StorePath) -import qualified Data.ByteString.Char8 import qualified Data.Text import qualified Data.Text.Lazy.Builder-import qualified Data.Attoparsec.Text.Lazy import qualified Nix.Derivation import qualified System.Nix.StorePath
src/System/Nix/Internal/Base32.hs view
@@ -1,22 +1,27 @@ module System.Nix.Internal.Base32 where -import Data.Maybe (fromMaybe)+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 qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BSC-import qualified Data.Text as T-import qualified Data.Vector as V import Numeric (readInt) +import qualified Data.Maybe+import qualified Data.ByteString+import qualified Data.ByteString.Char8+import qualified Data.Text+import qualified Data.Vector+ -- omitted: E O U T-digits32 = V.fromList "0123456789abcdfghijklmnpqrsvwxyz"+digits32 :: Vector Char+digits32 = Data.Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz" -- | Encode a 'BS.ByteString' in Nix's base32 encoding-encode :: BS.ByteString -> T.Text-encode c = T.pack $ map char32 [nChar - 1, nChar - 2 .. 0]+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@@ -25,19 +30,19 @@ -- 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 $ ((BS.length c * 8 - 1) `div` 5) + 1+ nChar = fromIntegral $ ((Data.ByteString.length c * 8 - 1) `div` 5) + 1 - byte = BS.index c . fromIntegral+ byte = Data.ByteString.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 .. BS.length c - 1]+ | j <- [0 .. Data.ByteString.length c - 1] ] char32 :: Integer -> Char- char32 i = digits32 V.! digitInd+ char32 i = digits32 Data.Vector.! digitInd where digitInd = fromIntegral $ bAsInteger@@ -45,39 +50,39 @@ `mod` 32 -- | Decode Nix's base32 encoded text-decode :: T.Text -> Either String BS.ByteString+decode :: Text -> Either String ByteString decode what =- if T.all (`elem` digits32) what+ if Data.Text.all (`elem` digits32) what then unsafeDecode what else Left "Invalid base32 string" -- | Decode Nix's base32 encoded text -- Doesn't check if all elements match `digits32`-unsafeDecode :: T.Text -> Either String BS.ByteString+unsafeDecode :: Text -> Either String ByteString unsafeDecode what = case readInt 32 (`elem` digits32)- (\c -> fromMaybe (error "character not in digits32") $- V.findIndex (==c) digits32)- (T.unpack what)+ (\c -> Data.Maybe.fromMaybe (error "character not in digits32")+ $ Data.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- | BS.length x < decLen = x `BS.append` bstr+ | Data.ByteString.length x < decLen = x `Data.ByteString.append` bstr | otherwise = x where- bstr = BSC.pack $ take (decLen - BS.length x) (cycle "\NUL")+ bstr = Data.ByteString.Char8.pack $ take (decLen - Data.ByteString.length x) (cycle "\NUL") - decLen = T.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 -> BS.ByteString-integerToBS 0 = BS.pack [0]+integerToBS :: Integer -> ByteString+integerToBS 0 = Data.ByteString.pack [0] integerToBS i- | i > 0 = BS.pack $ unfoldr f i+ | i > 0 = Data.ByteString.pack $ unfoldr f i | otherwise = error "integerToBS not defined for negative values" where f 0 = Nothing
src/System/Nix/Internal/Hash.hs view
@@ -105,25 +105,25 @@ mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest mkNamedDigest name sriHash =- let (sriName, hash) = T.breakOnEnd "-" sriHash in+ let (sriName, h) = T.breakOnEnd "-" sriHash in if sriName == "" || sriName == (name <> "-")- then mkDigest name hash+ then mkDigest h else Left $ T.unpack $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name where- mkDigest name hash = case name of- "md5" -> SomeDigest <$> decodeGo @'MD5 hash- "sha1" -> SomeDigest <$> decodeGo @'SHA1 hash- "sha256" -> SomeDigest <$> decodeGo @'SHA256 hash- "sha512" -> SomeDigest <$> decodeGo @'SHA512 hash+ mkDigest h = case name of+ "md5" -> SomeDigest <$> decodeGo @'MD5 h+ "sha1" -> SomeDigest <$> decodeGo @'SHA1 h+ "sha256" -> SomeDigest <$> decodeGo @'SHA256 h+ "sha512" -> SomeDigest <$> decodeGo @'SHA512 h _ -> Left $ "Unknown hash name: " ++ T.unpack name decodeGo :: forall a . (NamedAlgo a, ValidAlgo a) => Text -> Either String (Digest a)- decodeGo hash- | size == base16Len = decodeBase Base16 hash- | size == base32Len = decodeBase Base32 hash- | size == base64Len = decodeBase Base64 hash+ 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] where- size = T.length hash+ size = T.length h hsize = hashSize @a base16Len = hsize * 2 base32Len = ((hsize * 8 - 1) `div` 5) + 1;
src/System/Nix/Internal/Nar/Parser.hs view
@@ -21,9 +21,7 @@ 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.Binary.Put as B import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BSL import qualified Data.Either as Either import Data.Int (Int64) import qualified Data.IORef as IORef@@ -179,7 +177,7 @@ when (s `notElem` ["executable", "contents"]) (Fail.fail $ "Parser found " ++ show s ++ " when expecting element from " ++- show ["executable", "contents"])+ (show :: [String] -> String) ["executable", "contents"]) when (s == "executable") $ do expectStr "" expectStr "contents"
src/System/Nix/Internal/Nar/Streamer.hs view
@@ -7,7 +7,7 @@ module System.Nix.Internal.Nar.Streamer where -import Control.Monad (forM, 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
src/System/Nix/Internal/StorePath.hs view
@@ -117,7 +117,7 @@ reasonInvalid n | n == "" = "Empty name" reasonInvalid n | (T.length n > 211) = "Path too long" reasonInvalid n | (T.head n == '.') = "Leading dot"-reasonInvalid n | otherwise = "Invalid character"+reasonInvalid _ | otherwise = "Invalid character" validStorePathName :: Text -> Bool validStorePathName "" = False@@ -198,17 +198,17 @@ pathParser :: FilePath -> Parser StorePath pathParser expectedRoot = do- Data.Attoparsec.Text.Lazy.string (T.pack expectedRoot)+ _ <- Data.Attoparsec.Text.Lazy.string (T.pack expectedRoot) <?> "Store root mismatch" -- e.g. /nix/store - Data.Attoparsec.Text.Lazy.char '/'+ _ <- Data.Attoparsec.Text.Lazy.char '/' <?> "Expecting path separator" digest <- decodeBase Base32 <$> Data.Attoparsec.Text.Lazy.takeWhile1 (`elem` digits32) <?> "Invalid Base32 part" - Data.Attoparsec.Text.Lazy.char '-'+ _ <- Data.Attoparsec.Text.Lazy.char '-' <?> "Expecting dash (path name separator)" c0 <- Data.Attoparsec.Text.Lazy.satisfy (\c -> c /= '.' && validStorePathNameChar c)
tests/Arbitrary.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-}+{-# OPTIONS_GHC -Wno-orphans #-} module Arbitrary where @@ -20,6 +21,7 @@ nonEmptyString :: Gen String nonEmptyString = listOf1 genSafeChar +dir :: Gen String dir = ('/':) <$> (listOf1 $ elements $ ('/':['a'..'z'])) instance Arbitrary StorePathName where@@ -33,7 +35,7 @@ instance Arbitrary (Digest StorePathHashAlgo) where arbitrary = hash . BSC.pack <$> arbitrary -instance Arbitrary (Digest SHA256) where+instance Arbitrary (Digest 'SHA256) where arbitrary = hash . BSC.pack <$> arbitrary newtype NixLike = NixLike {getNixLike :: StorePath}
tests/Derivation.hs view
@@ -11,6 +11,7 @@ import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Builder +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@@ -24,6 +25,7 @@ test_derivation :: TestTree test_derivation = testGroup "golden" $ map mk [0..1] where+ mk :: Int -> TestTree mk n = let fp = "tests/samples/example"
tests/Hash.hs view
@@ -12,7 +12,7 @@ import qualified System.Nix.Base32 as B32 import qualified Data.ByteString.Base64.Lazy as B64 import qualified Data.ByteString.Lazy as BSL-import Data.Text (Text(..))+import Data.Text (Text) import Test.Tasty.Hspec import Test.Tasty.QuickCheck@@ -27,13 +27,13 @@ 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 (encodeInBase Base32 (hash @SHA256 "nix-output:foo"))+ shouldBe (encodeInBase Base32 (hash @'SHA256 "nix-output:foo")) "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5" it "produces (base16 . md5) of \"Hello World\" the same as the thesis" $- shouldBe (encodeInBase Base16 (hash @MD5 "Hello World"))+ shouldBe (encodeInBase Base16 (hash @'MD5 "Hello World")) "b10a8db164e0754105b7a99be72e3fe5" it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $- shouldBe (encodeInBase Base32 (hash @SHA1 "Hello World"))+ shouldBe (encodeInBase Base32 (hash @'SHA1 "Hello World")) "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" -- The example in question:@@ -49,10 +49,12 @@ encodeInBase32 = encodeInBase Base32 -- | Test that Nix-like base32 encoding roundtrips+prop_nixBase32Roundtrip :: Property prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $ \x -> Right (BSC.pack x) === (B32.decode . B32.encode . BSC.pack $ x) -- | API variants+prop_nixBase16Roundtrip :: Digest StorePathHashAlgo -> Property prop_nixBase16Roundtrip = \(x :: Digest StorePathHashAlgo) -> Right x === (decodeBase Base16 . encodeInBase Base16 $ x) @@ -80,19 +82,19 @@ ] it "b16 encoded . b32 decoded should equal original b16" $- forM_ samples $ \(b16, b32, b64) -> shouldBe (B16.encode <$> B32.decode b32) (Right b16)+ forM_ samples $ \(b16, b32, _b64) -> shouldBe (B16.encode <$> B32.decode b32) (Right b16) it "b64 encoded . b32 decoded should equal original b64" $- forM_ samples $ \(b16, b32, b64) -> shouldBe (B64.encode . BSL.fromStrict <$> B32.decode b32) (Right b64)+ forM_ samples $ \(_b16, b32, b64) -> shouldBe (B64.encode . BSL.fromStrict <$> B32.decode b32) (Right b64) it "b32 encoded . b64 decoded should equal original b32" $- forM_ samples $ \(b16, b32, b64) -> shouldBe (B32.encode . BSL.toStrict <$> B64.decode b64 ) (Right b32)+ forM_ samples $ \(_b16, b32, b64) -> shouldBe (B32.encode . BSL.toStrict <$> B64.decode b64 ) (Right b32) it "b16 encoded . b64 decoded should equal original b16" $- forM_ samples $ \(b16, b32, b64) -> shouldBe (B16.encode . BSL.toStrict <$> B64.decode b64 ) (Right b16)+ forM_ samples $ \(b16, _b32, b64) -> shouldBe (B16.encode . BSL.toStrict <$> B64.decode b64 ) (Right b16) it "b32 encoded . b16 decoded should equal original b32" $- forM_ samples $ \(b16, b32, b64) -> shouldBe (B32.encode+ forM_ samples $ \(b16, b32, _b64) -> shouldBe (B32.encode #if MIN_VERSION_base16_bytestring(1,0,0) <$> B16.decode b16) (Right b32) #else@@ -101,7 +103,7 @@ #endif it "b64 encoded . b16 decoded should equal original b64" $- forM_ samples $ \(b16, b32, b64) -> shouldBe (B64.encode . BSL.fromStrict+ forM_ samples $ \(b16, _b32, b64) -> shouldBe (B64.encode . BSL.fromStrict #if MIN_VERSION_base16_bytestring(1,0,0) <$> B16.decode b16) (Right b64) #else
tests/NarFormat.hs view
@@ -9,12 +9,12 @@ import Control.Applicative (many, optional, (<|>)) import qualified Control.Concurrent as Concurrent import Control.Exception (SomeException, try)-import Control.Monad (replicateM,+import Control.Monad (replicateM, void, when)-import Data.Binary.Get (Get (..), getByteString,+import Data.Binary.Get (Get, getByteString, getInt64le, getLazyByteString, runGet)-import Data.Binary.Put (Put (..), putInt64le,+import Data.Binary.Put (Put, putInt64le, putLazyByteString, runPut) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64.Lazy as B64@@ -48,6 +48,7 @@ +withBytesAsHandle :: BSLC.ByteString -> (IO.Handle -> IO a) -> IO a withBytesAsHandle bytes act = do Temp.withSystemTempFile "nar-test-file-XXXXX" $ \tmpFile h -> do IO.hClose h@@ -73,15 +74,15 @@ unpackNarIO narEffectsIO h packageFilePath res `shouldBe` Right () - e <- doesPathExist packageFilePath- e `shouldBe` True+ e' <- doesPathExist packageFilePath+ e' `shouldBe` True - res <- Temp.withSystemTempFile "nar-test-file-hnix" $ \tmpFile h -> do+ res' <- Temp.withSystemTempFile "nar-test-file-hnix" $ \tmpFile h -> do buildNarIO narEffectsIO packageFilePath h 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`@@ -151,18 +152,18 @@ unit_packSelfSrcDir :: HU.Assertion unit_packSelfSrcDir = Temp.withSystemTempDirectory "nar-test" $ \tmpDir -> do ver <- try (P.readProcess "nix-store" ["--version"] "")- let narFile = tmpDir </> "src.nar"+ let narFilePath = tmpDir </> "src.nar" case ver of- Left (e :: SomeException) -> print "No nix-store on system"+ Left (_ :: SomeException) -> print ("No nix-store on system" :: String) Right _ -> do let go dir = do srcHere <- doesDirectoryExist dir case srcHere of False -> return () True -> do- IO.withFile narFile IO.WriteMode $ \h ->+ IO.withFile narFilePath IO.WriteMode $ \h -> buildNarIO narEffectsIO "src" h- hnixNar <- BSL.readFile narFile+ hnixNar <- BSL.readFile narFilePath nixStoreNar <- getNixStoreDump "src" HU.assertEqual "src dir serializes the same between hnix-store and nix-store"@@ -218,16 +219,17 @@ packagePath = baseDir </> "package_with_many_files" packagePath' = baseDir </> "package_with_many_files2"- narFile = packagePath <.> "nar"+ narFilePath = packagePath <.> "nar" - rmFiles = try @SomeException @() $ do- e <- doesPathExist narFile- when e $ removeDirectoryRecursive narFile+ -- unused, see `step "check file exists"` bellow+ _rmFiles = try @SomeException @() $ do+ e <- doesPathExist narFilePath+ when e $ removeDirectoryRecursive narFilePath - run = do+ _run = do filesPrecount <- countProcessFiles IO.withFile "hnar" IO.WriteMode $ \h ->- buildNarIO narEffectsIO narFile h+ buildNarIO narEffectsIO narFilePath h filesPostcount <- countProcessFiles return $ filesPostcount - filesPrecount @@ -240,11 +242,11 @@ filesPrecount <- countProcessFiles step "pack nar"- IO.withFile narFile IO.WriteMode $ \h ->+ IO.withFile narFilePath IO.WriteMode $ \h -> buildNarIO narEffectsIO packagePath h step "unpack nar"- r <- IO.withFile narFile IO.ReadMode $ \h ->+ r <- IO.withFile narFilePath IO.ReadMode $ \h -> unpackNarIO narEffectsIO h packagePath' r `shouldBe` Right () @@ -274,7 +276,7 @@ case ver of -- Left is not an error - testing machine simply doesn't have -- `nix-store` executable, so pass- Left (e :: SomeException) -> print "No nix-store on system"+ Left (_ :: SomeException) -> print ("No nix-store on system" :: String) Right _ -> Temp.withSystemTempDirectory "hnix-store" $ \baseDir -> do let@@ -287,7 +289,7 @@ e `shouldBe` True -- stream nar contents to unpacked file(s)- withBytesAsHandle (runPut $ putNar n) $ \h ->+ void $ withBytesAsHandle (runPut $ putNar n) $ \h -> unpackNarIO narEffectsIO h testFile assertExists testFile@@ -330,39 +332,34 @@ Temp.withSystemTempDirectory "hnix-store" $ \baseDir -> do setup baseDir - let narFile = baseDir </> testName+ let narFilePath = baseDir </> testName ver <- try (P.readProcess "nix-store" ["--version"] "") case ver of- Left (e :: SomeException) -> print "No nix-store on system"+ Left (_ :: SomeException) -> print ("No nix-store on system" :: String) Right _ -> do let- nixNarFile = narFile ++ ".nix"- hnixNarFile = narFile ++ ".hnix"- outputFile = narFile ++ ".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 " ++ narFile ++ " > " ++ nixNarFile)- P.waitForProcess handle+ (_,_,_,handle) <- P.createProcess (P.shell $ "nix-store --dump " ++ narFilePath ++ " > " ++ nixNarFile)+ void $ P.waitForProcess handle - step $ "Build NAR from " ++ narFile ++ " to " ++ hnixNarFile+ step $ "Build NAR from " ++ narFilePath ++ " to " ++ hnixNarFile -- narBS <- buildNarIO narEffectsIO narFile IO.withFile hnixNarFile IO.WriteMode $ \h ->- buildNarIO narEffectsIO narFile h+ buildNarIO narEffectsIO narFilePath h -- BSL.writeFile hnixNarFile narBS step $ "Unpack NAR to " ++ outputFile- narHandle <- IO.withFile nixNarFile IO.ReadMode $ \h ->+ _narHandle <- IO.withFile nixNarFile IO.ReadMode $ \h -> unpackNarIO narEffectsIO h outputFile return () ----- -- | Count file descriptors owned by the current process countProcessFiles :: IO Int countProcessFiles = do@@ -442,12 +439,12 @@ ] ++ [ (FilePathPart (BSC.pack $ 'f' : show n), Regular Nar.NonExecutable 10000 (BSL.take 10000 (BSL.cycle "hi ")))- | n <- [1..100]]+ | n <- [1..100 :: Int]] ++ [ (FilePathPart "d", Directory $ Map.fromList [ (FilePathPart (BSC.pack $ "df" ++ show n) , Regular Nar.NonExecutable 10000 (BSL.take 10000 (BSL.cycle "subhi ")))- | n <- [1..100]]+ | n <- [1..100 :: Int]] ) ] @@ -675,32 +672,32 @@ getFile = getRegularFile <|> getDirectory <|> getSymLink getRegularFile = do- assertStr "type"- assertStr "regular"+ assertStr_ "type"+ assertStr_ "regular" mExecutable <- optional $ Nar.Executable <$ (assertStr "executable" >> assertStr "")- assertStr "contents"+ assertStr_ "contents" (fSize, contents) <- sizedStr return $ Regular (fromMaybe Nar.NonExecutable mExecutable) fSize contents getDirectory = do- assertStr "type"- assertStr "directory"+ assertStr_ "type"+ assertStr_ "directory" fs <- many getEntry return $ Directory (Map.fromList fs) getSymLink = do- assertStr "type"- assertStr "symlink"- assertStr "target"+ assertStr_ "type"+ assertStr_ "symlink"+ assertStr_ "target" fmap (SymLink . E.decodeUtf8 . BSL.toStrict) str getEntry = do- assertStr "entry"+ assertStr_ "entry" parens $ do- assertStr "name"+ assertStr_ "name" name <- E.decodeUtf8 . BSL.toStrict <$> str- assertStr "node"+ assertStr_ "node" file <- parens getFile maybe (fail $ "Bad FilePathPart: " ++ show name) (return . (,file))@@ -712,11 +709,12 @@ sizedStr = do n <- getInt64le s <- getLazyByteString n- p <- getByteString . fromIntegral $ padLen n+ _ <- getByteString . fromIntegral $ padLen n return (n,s) parens m = assertStr "(" *> m <* assertStr ")" + assertStr_ = void . assertStr assertStr s = do s' <- str if s == s'
tests/StorePath.hs view
@@ -13,17 +13,21 @@ import Arbitrary -- | Test that Nix(OS) like paths roundtrip+prop_storePathRoundtrip :: NixLike -> NixLike -> Property prop_storePathRoundtrip (_ :: NixLike) = \(NixLike x) -> (parsePath "/nix/store" $ storePathToRawFilePath x) === Right x -- | Test that any `StorePath` roundtrips+prop_storePathRoundtrip' :: StorePath -> Property prop_storePathRoundtrip' x = (parsePath (storePathRoot x) $ storePathToRawFilePath x) === Right x +prop_storePathRoundtripParser :: NixLike -> NixLike -> Property prop_storePathRoundtripParser (_ :: NixLike) = \(NixLike 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