diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/hnix-store-core.cabal b/hnix-store-core.cabal --- a/hnix-store-core.cabal +++ b/hnix-store-core.cabal @@ -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 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 @@ -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 + ] 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 @@ -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 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 @@ -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 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 @@ -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; 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 @@ -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" diff --git a/src/System/Nix/Internal/Nar/Streamer.hs b/src/System/Nix/Internal/Nar/Streamer.hs --- a/src/System/Nix/Internal/Nar/Streamer.hs +++ b/src/System/Nix/Internal/Nar/Streamer.hs @@ -7,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 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 @@ -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) diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs --- a/tests/Arbitrary.hs +++ b/tests/Arbitrary.hs @@ -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} diff --git a/tests/Derivation.hs b/tests/Derivation.hs --- a/tests/Derivation.hs +++ b/tests/Derivation.hs @@ -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" diff --git a/tests/Hash.hs b/tests/Hash.hs --- a/tests/Hash.hs +++ b/tests/Hash.hs @@ -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 diff --git a/tests/NarFormat.hs b/tests/NarFormat.hs --- a/tests/NarFormat.hs +++ b/tests/NarFormat.hs @@ -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' diff --git a/tests/StorePath.hs b/tests/StorePath.hs --- a/tests/StorePath.hs +++ b/tests/StorePath.hs @@ -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