From 445f59df6d3a4c2fe7984e7c48fb447b383f9d20 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Wed, 15 Nov 2023 09:46:48 +0100 Subject: [PATCH 01/23] remote: start transitioning from binary to cereal Strict by default, with round trip props. Nix-like serialization primitives for now via System.Nix.Store.Remote.Serialize.Prim --- hnix-store-remote/hnix-store-remote.cabal | 59 +++--- .../src/System/Nix/Store/Remote/Serialize.hs | 5 + .../System/Nix/Store/Remote/Serialize/Prim.hs | 170 ++++++++++++++++++ hnix-store-remote/tests/Driver.hs | 1 + hnix-store-remote/tests/SerializeSpec.hs | 81 +++++++++ 5 files changed, 294 insertions(+), 22 deletions(-) create mode 100644 hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs create mode 100644 hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs create mode 100644 hnix-store-remote/tests/Driver.hs create mode 100644 hnix-store-remote/tests/SerializeSpec.hs diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index d443d2c..489ce96 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -42,6 +42,19 @@ common commons , LambdaCase , BangPatterns , ViewPatterns + build-depends: + base >=4.12 && <5 + , relude + mixins: + base hiding (Prelude) + , relude (Relude as Prelude) + , relude + default-language: Haskell2010 + +common tests + import: commons + build-tool-depends: + tasty-discover:tasty-discover flag io-testsuite default: @@ -61,6 +74,8 @@ library exposed-modules: System.Nix.Store.Remote , System.Nix.Store.Remote.Binary + , System.Nix.Store.Remote.Serialize + , System.Nix.Store.Remote.Serialize.Prim , System.Nix.Store.Remote.Builders , System.Nix.Store.Remote.Logger , System.Nix.Store.Remote.Parsers @@ -69,11 +84,10 @@ library , System.Nix.Store.Remote.Util build-depends: - base >=4.12 && <5 - , relude >= 1.0 , attoparsec , binary , bytestring + , cereal , containers , cryptonite , text @@ -84,12 +98,7 @@ library , unordered-containers , hnix-store-core >= 0.7 && <0.8 , transformers - mixins: - base hiding (Prelude) - , relude (Relude as Prelude) - , relude hs-source-dirs: src - default-language: Haskell2010 ghc-options: -Wall executable remote-readme @@ -102,25 +111,40 @@ executable remote-readme main-is: README.lhs ghc-options: -pgmL markdown-unlit -Wall +test-suite remote + import: tests + type: exitcode-stdio-1.0 + main-is: Driver.hs + hs-source-dirs: tests + ghc-options: -Wall + other-modules: + SerializeSpec + build-depends: + hnix-store-core + , hnix-store-remote + , cereal + , time + , tasty + , tasty-quickcheck + , quickcheck-instances + test-suite remote-io - import: commons + import: tests if !flag(io-testsuite) || os(darwin) buildable: False type: exitcode-stdio-1.0 main-is: Driver.hs + hs-source-dirs: tests-io -- See https://github.com/redneb/hs-linux-namespaces/issues/3 ghc-options: -rtsopts -fprof-auto "-with-rtsopts -V0" other-modules: NixDaemon , Spec - hs-source-dirs: tests-io build-depends: - base - , bytestring - , relude - , hnix-store-core >= 0.3 + bytestring + , hnix-store-core , hnix-store-remote , containers , cryptonite @@ -128,19 +152,10 @@ test-suite remote-io , process , filepath , hspec-expectations-lifted - , quickcheck-text , tasty , hspec , tasty-hspec - , tasty-quickcheck , linux-namespaces , temporary , unix , unordered-containers - build-tool-depends: - tasty-discover:tasty-discover - mixins: - base hiding (Prelude) - , relude (Relude as Prelude) - , relude - default-language: Haskell2010 diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs new file mode 100644 index 0000000..ab48db0 --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs @@ -0,0 +1,5 @@ +{-| +Description : Incremental decoding +Maintainer : srk +|-} +module System.Nix.Store.Remote.Serialize where diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs new file mode 100644 index 0000000..ab269bf --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs @@ -0,0 +1,170 @@ +{-| +Description : Nix-like serialization primitives +Maintainer : srk +|-} +module System.Nix.Store.Remote.Serialize.Prim where + +import Data.Fixed (Uni) +import Data.Serialize.Get (Get) +import Data.Serialize.Put (Putter) +import Data.Time (NominalDiffTime, UTCTime) +import System.Nix.StorePath (StoreDir, StorePath) + +import qualified Data.HashSet +import qualified Data.Serialize.Get +import qualified Data.Serialize.Put +import qualified Data.ByteString +import qualified Data.Time.Clock.POSIX +import qualified System.Nix.StorePath + +-- * Int + +-- | Deserialize Nix like integer +getInt :: Get Int +getInt = fromIntegral <$> Data.Serialize.Get.getWord64le + +-- | Serialize Nix like integer +putInt :: Putter Int +putInt = Data.Serialize.Put.putWord64le . fromIntegral + +-- * Bool + +-- | Deserialize @Bool@ from integer +getBool :: Get Bool +getBool = (== 1) <$> (getInt :: Get Int) + +-- | Serialize @Bool@ into integer +putBool :: Putter Bool +putBool True = putInt (1 :: Int) +putBool False = putInt (0 :: Int) + +-- * Enum + +-- | Deserialize @Enum@ to integer +getEnum :: Enum a => Get a +getEnum = toEnum <$> getInt + +-- | Serialize @Enum@ to integer +putEnum :: Enum a => Putter a +putEnum = putInt . fromEnum + +-- * UTCTime + +-- | Deserialize @UTCTime@ from integer +-- Only 1 second precision. +getTime :: Get UTCTime +getTime = + Data.Time.Clock.POSIX.posixSecondsToUTCTime + . seconds + <$> getInt + where + -- fancy (*10^12), from Int to Uni to Pico(seconds) + seconds :: Int -> NominalDiffTime + seconds n = realToFrac (toEnum n :: Uni) + +-- | Serialize @UTCTime@ to integer +-- Only 1 second precision. +putTime :: Putter UTCTime +putTime = + putInt + . seconds + . Data.Time.Clock.POSIX.utcTimeToPOSIXSeconds + where + -- fancy (`div`10^12), from Pico to Uni to Int + seconds :: NominalDiffTime -> Int + seconds = (fromEnum :: Uni -> Int) . realToFrac + +-- * Combinators + +-- | Deserialize a list +getMany :: Get a -> Get [a] +getMany parser = do + count <- getInt + replicateM count parser + +-- | Serialize a list +putMany :: Foldable t => Putter a -> Putter (t a) +putMany printer xs = do + putInt (length xs) + mapM_ printer xs + +-- * ByteString + +-- | Deserialize length prefixed string +-- into @ByteString@, checking for correct padding +getByteString :: Get ByteString +getByteString = do + len <- getInt + st <- Data.Serialize.Get.getByteString len + when (len `mod` 8 /= 0) $ do + pads <- unpad $ fromIntegral $ 8 - (len `mod` 8) + unless (all (== 0) pads) $ fail $ "No zeroes" <> show (st, len, pads) + pure st + where unpad x = replicateM x Data.Serialize.Get.getWord8 + +-- | Serialize @ByteString@ using length +-- prefixed string packing with padding to 8 bytes +putByteString :: Putter ByteString +putByteString x = do + putInt len + Data.Serialize.Put.putByteString x + when (len `mod` 8 /= 0) $ pad $ 8 - (len `mod` 8) + where + len :: Int + len = fromIntegral $ Data.ByteString.length x + pad count = replicateM_ count (Data.Serialize.Put.putWord8 0) + +-- | Deserialize a list of @ByteString@s +getByteStrings :: Get [ByteString] +getByteStrings = getMany getByteString + +-- | Serialize a list of @ByteString@s +putByteStrings :: Foldable t => Putter (t ByteString) +putByteStrings = putMany putByteString + +-- * Text + +-- | Deserialize @Text@ +getText :: Get Text +getText = decodeUtf8 <$> getByteString + +-- | Serialize @Text@ +putText :: Putter Text +putText = putByteString . encodeUtf8 + +-- | Deserialize a list of @Text@s +getTexts :: Get [Text] +getTexts = fmap decodeUtf8 <$> getByteStrings + +-- | Serialize a list of @Text@s +putTexts :: (Functor f, Foldable f) => Putter (f Text) +putTexts = putByteStrings . fmap encodeUtf8 + +-- * StorePath + +-- | Deserialize @StorePath@, checking +-- that @StoreDir@ matches expected value +getPath :: StoreDir -> Get (Either String StorePath) +getPath sd = + System.Nix.StorePath.parsePath sd <$> getByteString + +-- | Serialize @StorePath@ with its associated @StoreDir@ +putPath :: StoreDir -> Putter StorePath +putPath storeDir = + putByteString + . System.Nix.StorePath.storePathToRawFilePath storeDir + +-- | Deserialize a @HashSet@ of @StorePath@s +getPaths :: StoreDir -> Get (HashSet (Either String StorePath)) +getPaths sd = + Data.HashSet.fromList + . fmap (System.Nix.StorePath.parsePath sd) + <$> getByteStrings + +-- | Serialize a @HashSet@ of @StorePath@s +putPaths :: StoreDir -> Putter (HashSet StorePath) +putPaths storeDir = + putByteStrings + . Data.HashSet.toList + . Data.HashSet.map + (System.Nix.StorePath.storePathToRawFilePath storeDir) diff --git a/hnix-store-remote/tests/Driver.hs b/hnix-store-remote/tests/Driver.hs new file mode 100644 index 0000000..70c55f5 --- /dev/null +++ b/hnix-store-remote/tests/Driver.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF tasty-discover #-} diff --git a/hnix-store-remote/tests/SerializeSpec.hs b/hnix-store-remote/tests/SerializeSpec.hs new file mode 100644 index 0000000..0cd6225 --- /dev/null +++ b/hnix-store-remote/tests/SerializeSpec.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE NumericUnderscores #-} +module SerializeSpec where + +import Prelude hiding (putText) +import Data.Fixed (Uni) +import Data.Serialize.Get (Get, runGet) +import Data.Serialize.Put (Putter, runPut) +import Data.Time (NominalDiffTime, UTCTime) +import Test.Tasty.QuickCheck +import Test.QuickCheck.Instances + +import System.Nix.StorePath (StoreDir, StorePath) +import System.Nix.Store.Remote.Serialize +import System.Nix.Store.Remote.Serialize.Prim + +import qualified Data.HashSet +import qualified Data.Time.Clock.POSIX + +roundTrip :: (Eq a, Show a) => Putter a -> Get a -> a -> Property +roundTrip p g a = res === Right a + where res = runGet g (runPut (p a)) + +-- * Prim +-- ** Int + +prop_int :: Int -> Property +prop_int = roundTrip putInt getInt + +-- ** Bool + +prop_bool :: Bool -> Property +prop_bool = roundTrip putBool getBool + +-- ** UTCTime + +prop_time :: Int -> Property +prop_time = + roundTrip + (putTime . Data.Time.Clock.POSIX.posixSecondsToUTCTime . toSeconds) + (fromSeconds . Data.Time.Clock.POSIX.utcTimeToPOSIXSeconds <$> getTime) + where + -- scale to seconds and back + toSeconds :: Int -> NominalDiffTime + toSeconds n = realToFrac (toEnum n :: Uni) + fromSeconds :: NominalDiffTime -> Int + fromSeconds = (fromEnum :: Uni -> Int) . realToFrac + +-- ** Combinators + +prop_many :: [Int] -> Property +prop_many = roundTrip (putMany putInt) (getMany getInt) + +-- ** ByteString + +prop_bytestring :: ByteString -> Property +prop_bytestring = roundTrip putByteString getByteString + +prop_bytestrings :: [ByteString] -> Property +prop_bytestrings = roundTrip putByteStrings getByteStrings + +-- ** Text + +prop_text :: Text -> Property +prop_text = roundTrip putText getText + +prop_texts :: [Text] -> Property +prop_texts = roundTrip putTexts getTexts + +-- ** StorePath + +prop_path :: StoreDir -> StorePath -> Property +prop_path = \sd -> + roundTrip + (putPath sd) + (fromRight undefined <$> getPath sd) + +prop_paths :: StoreDir -> HashSet StorePath -> Property +prop_paths = \sd -> + roundTrip + (putPaths sd) + (Data.HashSet.map (fromRight undefined) <$> getPaths sd) From 40838bd6dd2a992ed3a31cbdc0a464c48632ca40 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Wed, 15 Nov 2023 10:24:59 +0100 Subject: [PATCH 02/23] Introduce InvalidPathError --- hnix-store-core/CHANGELOG.md | 3 + .../src/System/Nix/Internal/StorePath.hs | 62 ++++++++++++++----- hnix-store-core/src/System/Nix/StorePath.hs | 2 + .../src/System/Nix/Store/Remote.hs | 7 ++- .../System/Nix/Store/Remote/Serialize/Prim.hs | 6 +- .../src/System/Nix/Store/Remote/Util.hs | 4 +- 6 files changed, 59 insertions(+), 25 deletions(-) diff --git a/hnix-store-core/CHANGELOG.md b/hnix-store-core/CHANGELOG.md index b006cfa..13a5773 100644 --- a/hnix-store-core/CHANGELOG.md +++ b/hnix-store-core/CHANGELOG.md @@ -4,8 +4,11 @@ * Constructors of `StorePathName` and `StorePathHashPart` are no longer exported. Use respective `mkStorePath..` functions. [#230](https://github.com/haskell-nix/hnix-store/pull/230) * `StorePathSet` type alias is no more, use `HashSet StorePath` [#230](https://github.com/haskell-nix/hnix-store/pull/230) + * `makeStorePath` and `parsePath` now returns `Either InvalidPathError StorePath` [#231](https://github.com/haskell-nix/hnix-store/pull/231) + * Additions: + * `InvalidPathError` replacing previous stringy error [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Added `Arbitrary` instances for (exported by default) [#230](https://github.com/haskell-nix/hnix-store/pull/230) * `StorePath` * `StorePathName` diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index e062eca..06f4a23 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -2,8 +2,8 @@ Description : Representation of Nix store paths. -} {-# language ConstraintKinds #-} +{-# language DeriveAnyClass #-} {-# language RecordWildCards #-} -{-# language GeneralizedNewtypeDeriving #-} {-# language ScopedTypeVariables #-} {-# language AllowAmbiguousTypes #-} {-# language DataKinds #-} @@ -20,6 +20,8 @@ module System.Nix.Internal.StorePath , -- * Manipulating 'StorePathName' makeStorePathName , validStorePathName + -- * Reason why a path is not valid + , InvalidPathError(..) , -- * Rendering out 'StorePath's storePathToFilePath , storePathToRawFilePath @@ -88,7 +90,7 @@ instance Arbitrary StorePath where newtype StorePathName = StorePathName { -- | Extract the contents of the name. unStorePathName :: Text - } deriving (Eq, Hashable, Ord, Show) + } deriving (Eq, Generic, Hashable, Ord, Show) instance Arbitrary StorePathName where arbitrary = StorePathName . toText <$> ((:) <$> s1 <*> listOf sn) @@ -102,7 +104,7 @@ newtype StorePathHashPart = StorePathHashPart { -- | Extract the contents of the hash. unStorePathHashPart :: ByteString } - deriving (Eq, Hashable, Ord, Show) + deriving (Eq, Generic, Hashable, Ord, Show) instance Arbitrary StorePathHashPart where arbitrary = mkStorePathHashPart @SHA256 . Bytes.Char8.pack <$> arbitrary @@ -112,7 +114,7 @@ mkStorePathHashPart . HashAlgorithm hashAlgo => ByteString -> StorePathHashPart -mkStorePathHashPart = coerce . mkStorePathHash @hashAlgo +mkStorePathHashPart = StorePathHashPart . mkStorePathHash @hashAlgo -- | An address for a content-addressable store path, i.e. one whose -- store path hash is purely a function of its contents (as opposed to @@ -144,18 +146,31 @@ data NarHashMode -- file if so desired. Recursive -makeStorePathName :: Text -> Either String StorePathName +-- | Reason why a path is not valid +data InvalidPathError = + EmptyName + | PathTooLong + | LeadingDot + | InvalidCharacter + | HashDecodingFailure String + | RootDirMismatch + { rdMismatchExpected :: StoreDir + , rdMismatchGot :: StoreDir + } + deriving (Eq, Generic, Hashable, Ord, Show) + +makeStorePathName :: Text -> Either InvalidPathError StorePathName makeStorePathName n = if validStorePathName n then pure $ StorePathName n else Left $ reasonInvalid n -reasonInvalid :: Text -> String +reasonInvalid :: Text -> InvalidPathError reasonInvalid n - | n == "" = "Empty name" - | Text.length n > 211 = "Path too long" - | Text.head n == '.' = "Leading dot" - | otherwise = "Invalid character" + | n == "" = EmptyName + | Text.length n > 211 = PathTooLong + | Text.head n == '.' = LeadingDot + | otherwise = InvalidCharacter validStorePathName :: Text -> Bool validStorePathName n = @@ -183,7 +198,7 @@ type RawFilePath = ByteString -- do not know their own store dir by design. newtype StoreDir = StoreDir { unStoreDir :: RawFilePath - } deriving (Eq, Hashable, Ord, Show) + } deriving (Eq, Generic, Hashable, Ord, Show) instance Arbitrary StoreDir where arbitrary = StoreDir . ("/" <>) . Bytes.Char8.pack <$> arbitrary @@ -212,12 +227,18 @@ storePathToNarInfo StorePath{..} = -- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking -- that store directory matches `expectedRoot`. -parsePath :: StoreDir -> Bytes.Char8.ByteString -> Either String StorePath +parsePath + :: StoreDir + -> Bytes.Char8.ByteString + -> Either InvalidPathError StorePath parsePath expectedRoot x = let (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x (storeBasedHashPart, namePart) = Text.breakOn "-" $ toText fname - storeHash = decodeWith NixBase32 storeBasedHashPart + hashPart = bimap + HashDecodingFailure + StorePathHashPart + $ decodeWith NixBase32 storeBasedHashPart name = makeStorePathName . Text.drop 1 $ namePart --rootDir' = dropTrailingPathSeparator rootDir -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b @@ -226,9 +247,12 @@ parsePath expectedRoot x = storeDir = if expectedRootS == rootDir' then pure rootDir' - else Left $ "Root store dir mismatch, expected" <> expectedRootS <> "got" <> rootDir' + else Left $ RootDirMismatch + { rdMismatchExpected = expectedRoot + , rdMismatchGot = StoreDir $ Bytes.Char8.pack rootDir + } in - either Left (pure $ StorePath <$> coerce storeHash <*> name) storeDir + either Left (pure $ StorePath <$> hashPart <*> name) storeDir pathParser :: StoreDir -> Parser StorePath pathParser expectedRoot = do @@ -257,8 +281,12 @@ pathParser expectedRoot = do "Path name contains invalid character" let name = makeStorePathName $ Text.cons c0 rest + hashPart = bimap + HashDecodingFailure + StorePathHashPart + digest either - fail + (fail . show) pure - (StorePath <$> coerce digest <*> name) + (StorePath <$> hashPart <*> name) diff --git a/hnix-store-core/src/System/Nix/StorePath.hs b/hnix-store-core/src/System/Nix/StorePath.hs index d30450f..b42ebd8 100644 --- a/hnix-store-core/src/System/Nix/StorePath.hs +++ b/hnix-store-core/src/System/Nix/StorePath.hs @@ -15,6 +15,8 @@ module System.Nix.StorePath makeStorePathName , unStorePathName , validStorePathName + -- * Reason why a path is not valid + , InvalidPathError(..) , -- * Rendering out 'StorePath's storePathToFilePath , storePathToRawFilePath diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index cafe0e1..9f961c3 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -50,6 +50,7 @@ import System.Nix.Hash ( NamedAlgo(..) import System.Nix.StorePath ( StorePath , StorePathName , StorePathHashPart + , InvalidPathError ) import System.Nix.StorePathMetadata ( StorePathMetadata(..) , StorePathTrust(..) @@ -183,12 +184,12 @@ findRoots = do r <- catRights res pure $ Data.Map.Strict.fromList r where - catRights :: [(a, Either String b)] -> MonadStore [(a, b)] + catRights :: [(a, Either InvalidPathError b)] -> MonadStore [(a, b)] catRights = mapM ex - ex :: (a, Either [Char] b) -> MonadStore (a, b) + ex :: (a, Either InvalidPathError b) -> MonadStore (a, b) ex (x , Right y) = pure (x, y) - ex (_x, Left e ) = error $ "Unable to decode root: " <> fromString e + ex (_x, Left e ) = error $ "Unable to decode root: " <> show e isValidPathUncached :: StorePath -> MonadStore Bool isValidPathUncached p = do diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs index ab269bf..102dade 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs @@ -8,7 +8,7 @@ import Data.Fixed (Uni) import Data.Serialize.Get (Get) import Data.Serialize.Put (Putter) import Data.Time (NominalDiffTime, UTCTime) -import System.Nix.StorePath (StoreDir, StorePath) +import System.Nix.StorePath (StoreDir, StorePath, InvalidPathError) import qualified Data.HashSet import qualified Data.Serialize.Get @@ -144,7 +144,7 @@ putTexts = putByteStrings . fmap encodeUtf8 -- | Deserialize @StorePath@, checking -- that @StoreDir@ matches expected value -getPath :: StoreDir -> Get (Either String StorePath) +getPath :: StoreDir -> Get (Either InvalidPathError StorePath) getPath sd = System.Nix.StorePath.parsePath sd <$> getByteString @@ -155,7 +155,7 @@ putPath storeDir = . System.Nix.StorePath.storePathToRawFilePath storeDir -- | Deserialize a @HashSet@ of @StorePath@s -getPaths :: StoreDir -> Get (HashSet (Either String StorePath)) +getPaths :: StoreDir -> Get (HashSet (Either InvalidPathError StorePath)) getPaths sd = Data.HashSet.fromList . fmap (System.Nix.StorePath.parsePath sd) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs index 8692a1c..b3cb256 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs @@ -69,7 +69,7 @@ sockGetPath = do sd <- getStoreDir pth <- getSocketIncremental (getPath sd) either - throwError + (throwError . show) pure pth @@ -106,7 +106,7 @@ putText = putByteStringLen . textToBSL putTexts :: [Text] -> Put putTexts = putByteStrings . fmap textToBSL -getPath :: StoreDir -> Get (Either String StorePath) +getPath :: StoreDir -> Get (Either InvalidPathError StorePath) getPath sd = parsePath sd <$> getByteStringLen getPaths :: StoreDir -> Get (HashSet StorePath) From 319fd00b913fec4ba6c449567522345c62c3d91d Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Wed, 15 Nov 2023 16:01:17 +0100 Subject: [PATCH 03/23] remote: drop relude I prefer explicit imports vs magic and this causes an unused packages warning to pop (with no workaround or fix in sight). --- hnix-store-remote/hnix-store-remote.cabal | 15 +++---- .../src/System/Nix/Store/Remote.hs | 41 +++++++++++-------- .../src/System/Nix/Store/Remote/Binary.hs | 4 +- .../src/System/Nix/Store/Remote/Logger.hs | 10 +++-- .../src/System/Nix/Store/Remote/Parsers.hs | 11 ++++- .../src/System/Nix/Store/Remote/Protocol.hs | 25 ++++++----- .../System/Nix/Store/Remote/Serialize/Prim.hs | 29 ++++++++----- .../src/System/Nix/Store/Remote/Types.hs | 14 +++++-- .../src/System/Nix/Store/Remote/Util.hs | 27 +++++++----- hnix-store-remote/tests-io/NixDaemon.hs | 34 +++++++++------ 10 files changed, 133 insertions(+), 77 deletions(-) diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index 489ce96..8ea8b40 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -44,11 +44,6 @@ common commons , ViewPatterns build-depends: base >=4.12 && <5 - , relude - mixins: - base hiding (Prelude) - , relude (Relude as Prelude) - , relude default-language: Haskell2010 common tests @@ -122,11 +117,16 @@ test-suite remote build-depends: hnix-store-core , hnix-store-remote + , bytestring , cereal + , text , time + , hspec , tasty + , tasty-hspec , tasty-quickcheck , quickcheck-instances + , unordered-containers test-suite remote-io import: tests @@ -143,15 +143,16 @@ test-suite remote-io NixDaemon , Spec build-depends: - bytestring - , hnix-store-core + hnix-store-core , hnix-store-remote + , bytestring , containers , cryptonite , directory , process , filepath , hspec-expectations-lifted + , text , tasty , hspec , tasty-hspec diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index 9f961c3..666ded1 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -35,7 +35,13 @@ module System.Nix.Store.Remote ) where -import Prelude hiding ( putText ) +import Data.HashSet (HashSet) +import Data.Map (Map) +import Data.Text (Text) +import qualified Control.Monad +import qualified Data.ByteString.Lazy +import qualified Data.Text.Encoding +-- import qualified Data.ByteString.Lazy as BSL import Nix.Derivation ( Derivation ) @@ -82,11 +88,11 @@ addToStore -> RepairFlag -- ^ Only used by local store backend -> MonadStore StorePath addToStore name source recursive repair = do - when (unRepairFlag repair) + Control.Monad.when (unRepairFlag repair) $ error "repairing is not supported when building through the Nix daemon" runOpArgsIO AddToStore $ \yield -> do - yield $ toStrict $ Data.Binary.Put.runPut $ do + yield $ BSL.toStrict $ Data.Binary.Put.runPut $ do putText $ System.Nix.StorePath.unStorePathName name putBool $ not $ System.Nix.Hash.algoName @a == "sha256" && (unRecursive recursive) putBool (unRecursive recursive) @@ -105,7 +111,7 @@ addTextToStore -> RepairFlag -- ^ Repair flag, must be `False` in case of remote backend -> MonadStore StorePath addTextToStore name text references' repair = do - when (unRepairFlag repair) + Control.Monad.when (unRepairFlag repair) $ error "repairing is not supported when building through the Nix daemon" storeDir <- getStoreDir @@ -118,14 +124,14 @@ addTextToStore name text references' repair = do addSignatures :: StorePath -> [BSL.ByteString] -> MonadStore () addSignatures p signatures = do storeDir <- getStoreDir - void $ simpleOpArgs AddSignatures $ do + Control.Monad.void $ simpleOpArgs AddSignatures $ do putPath storeDir p putByteStrings signatures addIndirectRoot :: StorePath -> MonadStore () addIndirectRoot pn = do storeDir <- getStoreDir - void $ simpleOpArgs AddIndirectRoot $ putPath storeDir pn + Control.Monad.void $ simpleOpArgs AddIndirectRoot $ putPath storeDir pn -- | Add temporary garbage collector root. -- @@ -133,7 +139,7 @@ addIndirectRoot pn = do addTempRoot :: StorePath -> MonadStore () addTempRoot pn = do storeDir <- getStoreDir - void $ simpleOpArgs AddTempRoot $ putPath storeDir pn + Control.Monad.void $ simpleOpArgs AddTempRoot $ putPath storeDir pn -- | Build paths if they are an actual derivations. -- @@ -141,7 +147,7 @@ addTempRoot pn = do buildPaths :: HashSet StorePath -> BuildMode -> MonadStore () buildPaths ps bm = do storeDir <- getStoreDir - void $ simpleOpArgs BuildPaths $ do + Control.Monad.void $ simpleOpArgs BuildPaths $ do putPaths storeDir ps putInt $ fromEnum bm @@ -167,7 +173,7 @@ buildDerivation p drv buildMode = do ensurePath :: StorePath -> MonadStore () ensurePath pn = do storeDir <- getStoreDir - void $ simpleOpArgs EnsurePath $ putPath storeDir pn + Control.Monad.void $ simpleOpArgs EnsurePath $ putPath storeDir pn -- | Find garbage collector roots. findRoots :: MonadStore (Map BSL.ByteString StorePath) @@ -178,7 +184,7 @@ findRoots = do getSocketIncremental $ getMany $ (,) - <$> (fromStrict <$> getByteStringLen) + <$> (BSL.fromStrict <$> getByteStringLen) <*> getPath sd r <- catRights res @@ -226,17 +232,17 @@ queryPathInfoUncached path = do putPath storeDir path valid <- sockGetBool - unless valid $ error "Path is not valid" + Control.Monad.unless valid $ error "Path is not valid" deriverPath <- sockGetPathMay - narHashText <- decodeUtf8 <$> sockGetStr + narHashText <- Data.Text.Encoding.decodeUtf8 <$> sockGetStr let narHash = case decodeDigestWith @SHA256 NixBase32 narHashText of - Left e -> error $ fromString e + Left e -> error e Right x -> SomeDigest x references <- sockGetPaths @@ -255,7 +261,7 @@ queryPathInfoUncached path = do case System.Nix.Store.Remote.Parsers.parseContentAddressableAddress caString of - Left e -> error $ fromString e + Left e -> error e Right x -> Just x trust = if ultimate then BuiltLocally else BuiltElsewhere @@ -290,7 +296,8 @@ queryPathFromHashPart :: StorePathHashPart -> MonadStore StorePath queryPathFromHashPart storePathHash = do runOpArgs QueryPathFromHashPart $ putByteStringLen - $ encodeUtf8 + $ Data.ByteString.Lazy.fromStrict + $ Data.Text.Encoding.encodeUtf8 $ encodeWith NixBase32 $ System.Nix.StorePath.unStorePathHashPart storePathHash @@ -317,10 +324,10 @@ queryMissing ps = do pure (willBuild, willSubstitute, unknown, downloadSize', narSize') optimiseStore :: MonadStore () -optimiseStore = void $ simpleOp OptimiseStore +optimiseStore = Control.Monad.void $ simpleOp OptimiseStore syncWithGC :: MonadStore () -syncWithGC = void $ simpleOp SyncWithGC +syncWithGC = Control.Monad.void $ simpleOp SyncWithGC -- returns True on errors verifyStore :: CheckFlag -> RepairFlag -> MonadStore Bool diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs index b084216..21ac369 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs @@ -4,6 +4,8 @@ Maintainer : srk |-} module System.Nix.Store.Remote.Binary where +import Control.Monad +import Data.ByteString (ByteString) import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString.Lazy as BSL @@ -45,7 +47,7 @@ getByteStringLen = do when (len `mod` 8 /= 0) $ do pads <- unpad $ fromIntegral $ 8 - (len `mod` 8) unless (all (== 0) pads) $ fail $ "No zeroes" <> show (st, len, pads) - pure $ toStrict st + pure $ BSL.toStrict st where unpad x = replicateM x getWord8 getByteStrings :: Get [ByteString] diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs index cc4768b..26925f7 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs @@ -8,8 +8,10 @@ module System.Nix.Store.Remote.Logger where -import Prelude hiding ( Last ) import Control.Monad.Except ( throwError ) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Reader (asks) +import Control.Monad.State.Strict (get) import Data.Binary.Get import Network.Socket.ByteString ( recv ) @@ -19,6 +21,8 @@ import System.Nix.Store.Remote.Types import System.Nix.Store.Remote.Util +import qualified Control.Monad + controlParser :: Get Logger controlParser = do ctrl <- getInt @@ -70,12 +74,12 @@ processOutput = go decoder chunk <- liftIO (Just <$> recv soc 8) go (k chunk) - go (Fail _leftover _consumed msg) = error $ fromString msg + go (Fail _leftover _consumed msg) = error msg getFields :: Get [Field] getFields = do cnt <- getInt - replicateM cnt getField + Control.Monad.replicateM cnt getField getField :: Get Field getField = do diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs index cb6b6ab..65d2b96 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs @@ -8,12 +8,16 @@ module System.Nix.Store.Remote.Parsers ) where +import Control.Applicative ((<|>)) +import Data.ByteString (ByteString) +import Data.Text (Text) import Data.Attoparsec.ByteString.Char8 import System.Nix.Hash import System.Nix.StorePath ( ContentAddressableAddress(..) , NarHashMode(..) ) import Crypto.Hash ( SHA256 ) +import qualified Data.Text.Encoding -- | Parse `ContentAddressableAddress` from `ByteString` parseContentAddressableAddress @@ -45,7 +49,10 @@ parseTypedDigest = mkNamedDigest <$> parseHashType <*> parseHash parseHashType :: Parser Text parseHashType = - decodeUtf8 <$> ("sha256" <|> "sha512" <|> "sha1" <|> "md5") <* (":" <|> "-") + Data.Text.Encoding.decodeUtf8 + <$> ("sha256" <|> "sha512" <|> "sha1" <|> "md5") <* (":" <|> "-") parseHash :: Parser Text -parseHash = decodeUtf8 <$> takeWhile1 (/= ':') +parseHash = + Data.Text.Encoding.decodeUtf8 + <$> takeWhile1 (/= ':') diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs index 5471e5b..ba80235 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs @@ -16,15 +16,18 @@ module System.Nix.Store.Remote.Protocol ) where -import qualified Relude.Unsafe as Unsafe - +import qualified Control.Monad import Control.Exception ( bracket ) import Control.Monad.Except +import Control.Monad.Reader (asks, runReaderT) +import Control.Monad.State.Strict +import qualified Data.Bool import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString import qualified Data.ByteString.Char8 +import qualified Data.ByteString.Lazy import Network.Socket ( SockAddr(SockAddrUnix) ) import qualified Network.Socket as S @@ -123,28 +126,28 @@ opNum QueryMissing = 40 simpleOp :: WorkerOp -> MonadStore Bool -simpleOp op = simpleOpArgs op pass +simpleOp op = simpleOpArgs op $ pure () simpleOpArgs :: WorkerOp -> Put -> MonadStore Bool simpleOpArgs op args = do runOpArgs op args err <- gotError - bool + Data.Bool.bool sockGetBool (do - Error _num msg <- Unsafe.head <$> getError + Error _num msg <- head <$> getError throwError $ Data.ByteString.Char8.unpack msg ) err runOp :: WorkerOp -> MonadStore () -runOp op = runOpArgs op pass +runOp op = runOpArgs op $ pure () runOpArgs :: WorkerOp -> Put -> MonadStore () runOpArgs op args = runOpArgsIO op - (\encode -> encode $ toStrict $ runPut args) + (\encode -> encode $ Data.ByteString.Lazy.toStrict $ runPut args) runOpArgsIO :: WorkerOp @@ -160,8 +163,8 @@ runOpArgsIO op encoder = do out <- processOutput modify (\(a, b) -> (a, b <> out)) err <- gotError - when err $ do - Error _num msg <- Unsafe.head <$> getError + Control.Monad.when err $ do + Error _num msg <- head <$> getError throwError $ Data.ByteString.Char8.unpack msg runStore :: MonadStore a -> IO (Either String a, [Logger]) @@ -198,11 +201,11 @@ runStoreOpts' sockFamily sockAddr storeRootDir code = vermagic <- liftIO $ recv soc 16 let (magic2, _daemonProtoVersion) = - flip runGet (fromStrict vermagic) + flip runGet (Data.ByteString.Lazy.fromStrict vermagic) $ (,) <$> (getInt :: Get Int) <*> (getInt :: Get Int) - unless (magic2 == workerMagic2) $ error "Worker magic 2 mismatch" + Control.Monad.unless (magic2 == workerMagic2) $ error "Worker magic 2 mismatch" sockPut $ putInt protoVersion -- clientVersion sockPut $ putInt (0 :: Int) -- affinity diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs index 102dade..0e65fd2 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs @@ -4,16 +4,21 @@ Maintainer : srk |-} module System.Nix.Store.Remote.Serialize.Prim where +import Data.ByteString (ByteString) import Data.Fixed (Uni) +import Data.HashSet (HashSet) import Data.Serialize.Get (Get) import Data.Serialize.Put (Putter) +import Data.Text (Text) import Data.Time (NominalDiffTime, UTCTime) import System.Nix.StorePath (StoreDir, StorePath, InvalidPathError) +import qualified Control.Monad import qualified Data.HashSet import qualified Data.Serialize.Get import qualified Data.Serialize.Put import qualified Data.ByteString +import qualified Data.Text.Encoding import qualified Data.Time.Clock.POSIX import qualified System.Nix.StorePath @@ -80,7 +85,7 @@ putTime = getMany :: Get a -> Get [a] getMany parser = do count <- getInt - replicateM count parser + Control.Monad.replicateM count parser -- | Serialize a list putMany :: Foldable t => Putter a -> Putter (t a) @@ -96,11 +101,13 @@ getByteString :: Get ByteString getByteString = do len <- getInt st <- Data.Serialize.Get.getByteString len - when (len `mod` 8 /= 0) $ do + Control.Monad.when (len `mod` 8 /= 0) $ do pads <- unpad $ fromIntegral $ 8 - (len `mod` 8) - unless (all (== 0) pads) $ fail $ "No zeroes" <> show (st, len, pads) + Control.Monad.unless + (all (== 0) pads) + $ fail $ "No zeroes" <> show (st, len, pads) pure st - where unpad x = replicateM x Data.Serialize.Get.getWord8 + where unpad x = Control.Monad.replicateM x Data.Serialize.Get.getWord8 -- | Serialize @ByteString@ using length -- prefixed string packing with padding to 8 bytes @@ -108,11 +115,13 @@ putByteString :: Putter ByteString putByteString x = do putInt len Data.Serialize.Put.putByteString x - when (len `mod` 8 /= 0) $ pad $ 8 - (len `mod` 8) + Control.Monad.when + (len `mod` 8 /= 0) + $ pad $ 8 - (len `mod` 8) where len :: Int len = fromIntegral $ Data.ByteString.length x - pad count = replicateM_ count (Data.Serialize.Put.putWord8 0) + pad count = Control.Monad.replicateM_ count (Data.Serialize.Put.putWord8 0) -- | Deserialize a list of @ByteString@s getByteStrings :: Get [ByteString] @@ -126,19 +135,19 @@ putByteStrings = putMany putByteString -- | Deserialize @Text@ getText :: Get Text -getText = decodeUtf8 <$> getByteString +getText = Data.Text.Encoding.decodeUtf8 <$> getByteString -- | Serialize @Text@ putText :: Putter Text -putText = putByteString . encodeUtf8 +putText = putByteString . Data.Text.Encoding.encodeUtf8 -- | Deserialize a list of @Text@s getTexts :: Get [Text] -getTexts = fmap decodeUtf8 <$> getByteStrings +getTexts = fmap Data.Text.Encoding.decodeUtf8 <$> getByteStrings -- | Serialize a list of @Text@s putTexts :: (Functor f, Foldable f) => Putter (f Text) -putTexts = putByteStrings . fmap encodeUtf8 +putTexts = putByteStrings . fmap Data.Text.Encoding.encodeUtf8 -- * StorePath diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs index b3cda6a..25052b1 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs @@ -33,13 +33,21 @@ module System.Nix.Store.Remote.Types ) where -import Control.Monad.Trans.State.Strict (mapStateT) -import Control.Monad.Trans.Except (mapExceptT) +import Control.Monad.Except (ExceptT) +import Control.Monad.Reader (ReaderT, asks) +import Control.Monad.State.Strict (StateT, gets, modify) +import Data.ByteString (ByteString) +import Network.Socket (Socket) + import qualified Data.ByteString.Lazy as BSL -import Network.Socket ( Socket ) + +import Control.Monad.Trans.State.Strict (mapStateT) +import Control.Monad.Trans.Except (mapExceptT) +import Control.Monad.Trans.Reader (withReaderT) import System.Nix.StorePath ( StoreDir ) + data StoreConfig = StoreConfig { storeDir :: StoreDir , storeSocket :: Socket diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs index b3cb256..a2d4d52 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs @@ -1,11 +1,18 @@ {-# language RecordWildCards #-} module System.Nix.Store.Remote.Util where -import Prelude hiding ( putText ) -import Control.Monad.Except +import Control.Monad.Except (throwError) +import Control.Monad.Reader (asks) +import Control.Monad.IO.Class (MonadIO(..)) +import Data.ByteString (ByteString) +import Data.HashSet (HashSet) +import Data.Text (Text) +import Data.Either (rights) import Data.Binary.Get import Data.Binary.Put +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import Data.Time import Data.Time.Clock.POSIX @@ -34,7 +41,7 @@ genericIncremental getsome parser = go decoder go (Partial k ) = do chunk <- getsome go (k chunk) - go (Fail _leftover _consumed msg) = error $ fromString msg + go (Fail _leftover _consumed msg) = error msg getSocketIncremental :: Get a -> MonadStore a getSocketIncremental = genericIncremental sockGet8 @@ -47,7 +54,7 @@ getSocketIncremental = genericIncremental sockGet8 sockPut :: Put -> MonadStore () sockPut p = do soc <- asks storeSocket - liftIO $ sendAll soc $ toStrict $ runPut p + liftIO $ sendAll soc $ BSL.toStrict $ runPut p sockGet :: Get a -> MonadStore a sockGet = getSocketIncremental @@ -89,16 +96,16 @@ sockGetPaths = do getSocketIncremental (getPaths sd) bsToText :: ByteString -> Text -bsToText = decodeUtf8 +bsToText = T.decodeUtf8 textToBS :: Text -> ByteString -textToBS = encodeUtf8 +textToBS = T.encodeUtf8 bslToText :: BSL.ByteString -> Text -bslToText = toText . TL.decodeUtf8 +bslToText = TL.toStrict . TL.decodeUtf8 textToBSL :: Text -> BSL.ByteString -textToBSL = TL.encodeUtf8 . toLText +textToBSL = TL.encodeUtf8 . TL.fromStrict putText :: Text -> Put putText = putByteStringLen . textToBSL @@ -114,11 +121,11 @@ getPaths sd = Data.HashSet.fromList . rights . fmap (parsePath sd) <$> getByteStrings putPath :: StoreDir -> StorePath -> Put -putPath storeDir = putByteStringLen . fromStrict . storePathToRawFilePath storeDir +putPath storeDir = putByteStringLen . BSL.fromStrict . storePathToRawFilePath storeDir putPaths :: StoreDir -> HashSet StorePath -> Put putPaths storeDir = putByteStrings . Data.HashSet.toList . Data.HashSet.map - (fromStrict . storePathToRawFilePath storeDir) + (BSL.fromStrict . storePathToRawFilePath storeDir) putBool :: Bool -> Put putBool True = putInt (1 :: Int) diff --git a/hnix-store-remote/tests-io/NixDaemon.hs b/hnix-store-remote/tests-io/NixDaemon.hs index 94cf45d..d28416f 100644 --- a/hnix-store-remote/tests-io/NixDaemon.hs +++ b/hnix-store-remote/tests-io/NixDaemon.hs @@ -1,9 +1,17 @@ {-# language DataKinds #-} -{-# language ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} module NixDaemon where -import qualified System.Environment as Env +import Data.Text (Text) +import Data.Either ( isRight + , isLeft + ) +import Data.Bool ( bool ) +import Control.Monad ( void ) +import Control.Monad.IO.Class ( liftIO ) + +import qualified System.Environment import Control.Exception ( bracket ) import Control.Concurrent ( threadDelay ) import qualified Data.ByteString.Char8 as BSC @@ -34,7 +42,7 @@ import System.Nix.Nar ( dumpPath ) createProcessEnv :: FilePath -> String -> [String] -> IO P.ProcessHandle createProcessEnv fp proc args = do - mPath <- Env.lookupEnv "PATH" + mPath <- System.Environment.lookupEnv "PATH" (_, _, _, ph) <- P.createProcess (P.proc proc args) @@ -44,13 +52,13 @@ createProcessEnv fp proc args = do pure ph mockedEnv :: Maybe String -> FilePath -> [(String, FilePath)] -mockedEnv mEnvPath fp = (fp ) <<$>> - [ ("NIX_STORE_DIR" , "store") - , ("NIX_LOCALSTATE_DIR", "var") - , ("NIX_LOG_DIR" , "var" "log") - , ("NIX_STATE_DIR" , "var" "nix") - , ("NIX_CONF_DIR" , "etc") - , ("HOME" , "home") +mockedEnv mEnvPath fp = + [ ("NIX_STORE_DIR" , fp "store") + , ("NIX_LOCALSTATE_DIR", fp "var") + , ("NIX_LOG_DIR" , fp "var" "log") + , ("NIX_STATE_DIR" , fp "var" "nix") + , ("NIX_CONF_DIR" , fp "etc") + , ("HOME" , fp "home") -- , ("NIX_REMOTE", "daemon") ] <> foldMap (\x -> [("PATH", x)]) mEnvPath @@ -60,12 +68,12 @@ waitSocket fp x = do ex <- doesFileExist fp bool (threadDelay 100000 >> waitSocket fp (x - 1)) - pass + (pure ()) ex writeConf :: FilePath -> IO () writeConf fp = - writeFileText fp $ unlines + writeFile fp $ unlines [ "build-users-group = " , "trusted-users = root" , "allowed-users = *" @@ -136,7 +144,7 @@ it -> (a -> Bool) -> Hspec.SpecWith (m () -> IO (a, b)) it name action check = - Hspec.it name $ \run -> run (action >> pass) `checks` check + Hspec.it name $ \run -> run (void $ action) `checks` check itRights :: (Show a, Show b, Show c, Monad m) From 34e788e312d8e00f195aeca4f562c12c431be00e Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Wed, 15 Nov 2023 11:24:11 +0100 Subject: [PATCH 04/23] core: add RecordWildCards, ScopedTypeVariables to default-extensions --- hnix-store-core/hnix-store-core.cabal | 2 ++ hnix-store-core/src/System/Nix/Build.hs | 1 - hnix-store-core/src/System/Nix/Internal/StorePath.hs | 2 -- 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index 8f14344..ac7ecc1 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -92,6 +92,8 @@ library , FlexibleContexts , FlexibleInstances , StandaloneDeriving + , ScopedTypeVariables + , RecordWildCards , TypeApplications , TypeSynonymInstances , InstanceSigs diff --git a/hnix-store-core/src/System/Nix/Build.hs b/hnix-store-core/src/System/Nix/Build.hs index 01b29a6..4ea3877 100644 --- a/hnix-store-core/src/System/Nix/Build.hs +++ b/hnix-store-core/src/System/Nix/Build.hs @@ -1,4 +1,3 @@ -{-# language RecordWildCards #-} {-| Description : Build related types Maintainer : srk diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 06f4a23..0a477fa 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -3,8 +3,6 @@ Description : Representation of Nix store paths. -} {-# language ConstraintKinds #-} {-# language DeriveAnyClass #-} -{-# language RecordWildCards #-} -{-# language ScopedTypeVariables #-} {-# language AllowAmbiguousTypes #-} {-# language DataKinds #-} From 3e26a0dd2f74094a15bddf08ae09b5be0055aaf2 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Wed, 15 Nov 2023 14:46:23 +0100 Subject: [PATCH 05/23] core: add GenericArbitrary derived instances for `Build` and `Derivation` modules. Switch derivation path parser to use `Nix.Derivation.textParser` like `nix-derivation` does. --- hnix-store-core/CHANGELOG.md | 6 +++ hnix-store-core/hnix-store-core.cabal | 5 ++ hnix-store-core/src/System/Nix/Build.hs | 20 ++++--- hnix-store-core/src/System/Nix/Derivation.hs | 56 +++++++++++++------- hnix-store-core/tests/Derivation.hs | 19 ++++++- 5 files changed, 78 insertions(+), 28 deletions(-) diff --git a/hnix-store-core/CHANGELOG.md b/hnix-store-core/CHANGELOG.md index 13a5773..f25c35b 100644 --- a/hnix-store-core/CHANGELOG.md +++ b/hnix-store-core/CHANGELOG.md @@ -14,6 +14,12 @@ * `StorePathName` * `StorePathHashPart` * `StoreDir` + * Added `Arbitrary` instances for [#231](https://github.com/haskell-nix/hnix-store/pull/231) + * `BuildMode` + * `BuildStatus` + * `BuildResult` + * `Derivation StorePath Text` + * `DerivationOutput StorePath Text` # [0.7.0.0](https://github.com/haskell-nix/hnix-store/compare/core-0.6.1.0...core-0.7.0.0) 2023-11-15 diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index ac7ecc1..ab2d68e 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -60,6 +60,7 @@ library , case-insensitive , cereal , containers + , generic-arbitrary < 1.1 -- Required for cryptonite low-level type convertion , memory , cryptonite @@ -71,6 +72,7 @@ library , mtl , nix-derivation >= 1.1.1 && <2 , QuickCheck + , quickcheck-instances , saltine , time , text @@ -89,6 +91,8 @@ library , DeriveFoldable , DeriveTraversable , DeriveLift + , DerivingStrategies + , DerivingVia , FlexibleContexts , FlexibleInstances , StandaloneDeriving @@ -139,6 +143,7 @@ test-suite format-tests , directory , filepath , process + , nix-derivation >= 1.1.1 && <2 , tasty , tasty-golden , hspec diff --git a/hnix-store-core/src/System/Nix/Build.hs b/hnix-store-core/src/System/Nix/Build.hs index 4ea3877..b9dd55a 100644 --- a/hnix-store-core/src/System/Nix/Build.hs +++ b/hnix-store-core/src/System/Nix/Build.hs @@ -1,3 +1,5 @@ +-- due to recent generic-arbitrary +{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-} {-| Description : Build related types Maintainer : srk @@ -7,15 +9,18 @@ module System.Nix.Build , BuildStatus(..) , BuildResult(..) , buildSuccess - ) -where + ) where -import Data.Time ( UTCTime ) +import Data.Time (UTCTime) +import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..)) +import Test.QuickCheck.Instances () -- keep the order of these Enums to match enums from reference implementations -- src/libstore/store-api.hh data BuildMode = Normal | Repair | Check - deriving (Eq, Ord, Enum, Show) + deriving (Eq, Generic, Ord, Enum, Show) + deriving Arbitrary via GenericArbitrary BuildMode data BuildStatus = Built @@ -31,8 +36,8 @@ data BuildStatus = | DependencyFailed | LogLimitExceeded | NotDeterministic - deriving (Eq, Ord, Enum, Show) - + deriving (Eq, Generic, Ord, Enum, Show) + deriving Arbitrary via GenericArbitrary BuildStatus -- | Result of the build data BuildResult = BuildResult @@ -49,7 +54,8 @@ data BuildResult = BuildResult , -- Stop time of this build stopTime :: !UTCTime } - deriving (Eq, Ord, Show) + deriving (Eq, Generic, Ord, Show) + deriving Arbitrary via GenericArbitrary BuildResult buildSuccess :: BuildResult -> Bool buildSuccess BuildResult {..} = diff --git a/hnix-store-core/src/System/Nix/Derivation.hs b/hnix-store-core/src/System/Nix/Derivation.hs index f2fbbc9..da9d072 100644 --- a/hnix-store-core/src/System/Nix/Derivation.hs +++ b/hnix-store-core/src/System/Nix/Derivation.hs @@ -1,32 +1,48 @@ +-- due to recent generic-arbitrary +{-# OPTIONS_GHC -Wno-orphans -fconstraint-solver-iterations=0 #-} module System.Nix.Derivation ( parseDerivation , buildDerivation - ) -where + ) where -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 ( StoreDir - , StorePath - , storePathToFilePath - ) -import qualified System.Nix.StorePath as StorePath +import Data.Attoparsec.Text.Lazy (Parser) +import Data.Text.Lazy.Builder (Builder) +import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..)) +import Test.QuickCheck.Instances () +import Nix.Derivation (Derivation, DerivationOutput) +import System.Nix.StorePath (StoreDir, StorePath) +import qualified Data.Attoparsec.Text.Lazy +import qualified Data.Text.Lazy -parseDerivation :: StoreDir -> Text.Lazy.Parser (Derivation StorePath Text) +import qualified Nix.Derivation +import qualified System.Nix.StorePath + +deriving via GenericArbitrary (Derivation StorePath Text) + instance Arbitrary (Derivation StorePath Text) +deriving via GenericArbitrary (DerivationOutput StorePath Text) + instance Arbitrary (DerivationOutput StorePath Text) + +parseDerivation :: StoreDir -> Parser (Derivation StorePath Text) parseDerivation expectedRoot = - Derivation.parseDerivationWith - ("\"" *> StorePath.pathParser expectedRoot <* "\"") - Derivation.textParser + Nix.Derivation.parseDerivationWith + pathParser + Nix.Derivation.textParser + where + pathParser = do + text <- Nix.Derivation.textParser + case Data.Attoparsec.Text.Lazy.parseOnly + (System.Nix.StorePath.pathParser expectedRoot) + (Data.Text.Lazy.fromStrict text) + of + Right p -> pure p + Left e -> fail e -buildDerivation :: StoreDir -> Derivation StorePath Text -> Text.Lazy.Builder +buildDerivation :: StoreDir -> Derivation StorePath Text -> Builder buildDerivation storeDir = - Derivation.buildDerivationWith - (show . storePathToFilePath storeDir) + Nix.Derivation.buildDerivationWith + (show . System.Nix.StorePath.storePathToText storeDir) show diff --git a/hnix-store-core/tests/Derivation.hs b/hnix-store-core/tests/Derivation.hs index a600068..6e02fa4 100644 --- a/hnix-store-core/tests/Derivation.hs +++ b/hnix-store-core/tests/Derivation.hs @@ -5,14 +5,17 @@ import Test.Tasty ( TestTree , testGroup ) import Test.Tasty.Golden ( goldenVsFile ) +import Test.Tasty.QuickCheck -import System.Nix.StorePath ( StoreDir(..) ) +import Nix.Derivation ( Derivation ) +import System.Nix.StorePath ( StoreDir(..), StorePath ) import System.Nix.Derivation ( parseDerivation , buildDerivation ) import qualified Data.Attoparsec.Text import qualified Data.Text.IO +import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Builder processDerivation :: FilePath -> FilePath -> IO () @@ -46,3 +49,17 @@ test_derivation = drv = fp <> show n <> ".drv" act = fp <> show n <> ".actual" fp = "tests/samples/example" + +-- TODO(srk): this won't roundtrip as Arbitrary Text +-- contains wild stuff like control characters and UTF8 sequences. +-- Either fix in nix-derivation or use wrapper type +-- (but we use Nix.Derivation.textParser so we need Text for now) +xprop_derivationRoundTrip :: StoreDir -> Derivation StorePath Text -> Property +xprop_derivationRoundTrip = \sd drv -> + Data.Attoparsec.Text.parseOnly (parseDerivation sd) + ( Data.Text.Lazy.toStrict + $ Data.Text.Lazy.Builder.toLazyText + $ buildDerivation sd drv + ) + === pure drv + From ddc914bcb482dca610d5b10c5a4164b15043f38f Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Wed, 15 Nov 2023 16:02:07 +0100 Subject: [PATCH 06/23] remote: add Serialize instances for BuildMode, BuildStatus, Text + tests --- .../src/System/Nix/Store/Remote/Serialize.hs | 33 ++++++++- hnix-store-remote/tests/SerializeSpec.hs | 67 ++++++++++++++++--- 2 files changed, 90 insertions(+), 10 deletions(-) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs index ab48db0..94571f4 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs @@ -1,5 +1,36 @@ +{-# OPTIONS_GHC -Wno-orphans #-} {-| -Description : Incremental decoding +Description : Serialize instances for complex types Maintainer : srk |-} module System.Nix.Store.Remote.Serialize where + +import Data.Text +import Data.Serialize (Serialize(..)) + +import System.Nix.Build (BuildMode(..), BuildStatus(..), BuildResult(..)) +import System.Nix.Store.Remote.Serialize.Prim + +instance Serialize Text where + get = getText + put = putText + +instance Serialize BuildMode where + get = getEnum + put = putEnum + +instance Serialize BuildStatus where + get = getEnum + put = putEnum + +instance Serialize BuildResult where + get = + BuildResult + <$> get + -- TODO(srk): fishy + <*> (Just <$> get) + <*> (fromIntegral <$> getInt) + <*> getBool + <*> getTime + <*> getTime + put = undefined diff --git a/hnix-store-remote/tests/SerializeSpec.hs b/hnix-store-remote/tests/SerializeSpec.hs index 0cd6225..a4a1836 100644 --- a/hnix-store-remote/tests/SerializeSpec.hs +++ b/hnix-store-remote/tests/SerializeSpec.hs @@ -1,20 +1,27 @@ {-# LANGUAGE NumericUnderscores #-} module SerializeSpec where -import Prelude hiding (putText) +import Data.ByteString (ByteString) import Data.Fixed (Uni) +import Data.HashSet (HashSet) +import Data.Serialize (Serialize(..)) import Data.Serialize.Get (Get, runGet) import Data.Serialize.Put (Putter, runPut) -import Data.Time (NominalDiffTime, UTCTime) +import Data.Text (Text) +import Data.Time (NominalDiffTime) +import Test.Hspec (Spec, describe, it, shouldBe) import Test.Tasty.QuickCheck -import Test.QuickCheck.Instances - -import System.Nix.StorePath (StoreDir, StorePath) -import System.Nix.Store.Remote.Serialize -import System.Nix.Store.Remote.Serialize.Prim +import Test.QuickCheck.Instances () +import qualified Data.Either import qualified Data.HashSet import qualified Data.Time.Clock.POSIX +import qualified System.Nix.Build + +import System.Nix.Build (BuildMode, BuildStatus, BuildResult) +import System.Nix.StorePath (StoreDir, StorePath) +import System.Nix.Store.Remote.Serialize () +import System.Nix.Store.Remote.Serialize.Prim roundTrip :: (Eq a, Show a) => Putter a -> Get a -> a -> Property roundTrip p g a = res === Right a @@ -72,10 +79,52 @@ prop_path :: StoreDir -> StorePath -> Property prop_path = \sd -> roundTrip (putPath sd) - (fromRight undefined <$> getPath sd) + (Data.Either.fromRight undefined <$> getPath sd) prop_paths :: StoreDir -> HashSet StorePath -> Property prop_paths = \sd -> roundTrip (putPaths sd) - (Data.HashSet.map (fromRight undefined) <$> getPaths sd) + (Data.HashSet.map (Data.Either.fromRight undefined) <$> getPaths sd) + +-- * Serialize +roundTripS :: (Eq a, Serialize a, Show a) => a -> Property +roundTripS a = res === Right a + where res = runGet get (runPut (put a)) + +-- ** Text + +prop_Text :: Text -> Property +prop_Text = roundTripS + +-- ** BuildMode + +prop_buildMode :: BuildMode -> Property +prop_buildMode = roundTripS + +prop_buildStatus :: BuildStatus -> Property +prop_buildStatus = roundTripS + +spec_buildMode :: Spec +spec_buildMode = + let it' name constr value = it name $ runPut (put constr) `shouldBe` runPut (putInt value) + in do + describe "Build enum order matches Nix" $ do + it' "Normal" System.Nix.Build.Normal 0 + it' "Repair" System.Nix.Build.Repair 1 + it' "Check" System.Nix.Build.Check 2 + + describe "BuildStatus enum order matches Nix" $ do + it' "Built" System.Nix.Build.Built 0 + it' "Substituted" System.Nix.Build.Substituted 1 + it' "AlreadyValid" System.Nix.Build.AlreadyValid 2 + it' "PermanentFailure" System.Nix.Build.PermanentFailure 3 + it' "InputRejected" System.Nix.Build.InputRejected 4 + it' "OutputRejected" System.Nix.Build.OutputRejected 5 + it' "TransientFailure" System.Nix.Build.TransientFailure 6 + it' "CachedFailure" System.Nix.Build.CachedFailure 7 + it' "TimedOut" System.Nix.Build.TimedOut 8 + it' "MiscFailure" System.Nix.Build.MiscFailure 9 + it' "DependencyFailed" System.Nix.Build.DependencyFailed 10 + it' "LogLimitExceeded" System.Nix.Build.LogLimitExceeded 11 + it' "NotDeterministic" System.Nix.Build.NotDeterministic 12 From 99e6217cf92c2ca8513bf83d9d9d8d3cfd3b0bed Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Wed, 15 Nov 2023 15:37:07 +0100 Subject: [PATCH 07/23] Switch BuildResult builtTimes from Integer to Int --- hnix-store-core/CHANGELOG.md | 2 +- hnix-store-core/src/System/Nix/Build.hs | 2 +- hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/hnix-store-core/CHANGELOG.md b/hnix-store-core/CHANGELOG.md index f25c35b..4f89048 100644 --- a/hnix-store-core/CHANGELOG.md +++ b/hnix-store-core/CHANGELOG.md @@ -5,7 +5,7 @@ exported. Use respective `mkStorePath..` functions. [#230](https://github.com/haskell-nix/hnix-store/pull/230) * `StorePathSet` type alias is no more, use `HashSet StorePath` [#230](https://github.com/haskell-nix/hnix-store/pull/230) * `makeStorePath` and `parsePath` now returns `Either InvalidPathError StorePath` [#231](https://github.com/haskell-nix/hnix-store/pull/231) - + * `BuildResult`s `timesBuild` field changes type from `Integer` to `Int` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Additions: * `InvalidPathError` replacing previous stringy error [#231](https://github.com/haskell-nix/hnix-store/pull/231) diff --git a/hnix-store-core/src/System/Nix/Build.hs b/hnix-store-core/src/System/Nix/Build.hs index b9dd55a..ed774bd 100644 --- a/hnix-store-core/src/System/Nix/Build.hs +++ b/hnix-store-core/src/System/Nix/Build.hs @@ -46,7 +46,7 @@ data BuildResult = BuildResult , -- | possible build error message errorMessage :: !(Maybe Text) , -- | How many times this build was performed - timesBuilt :: !Integer + timesBuilt :: !Int , -- | If timesBuilt > 1, whether some builds did not produce the same result isNonDeterministic :: !Bool , -- Start time of this build diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs index 94571f4..0d0d68e 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs @@ -29,7 +29,7 @@ instance Serialize BuildResult where <$> get -- TODO(srk): fishy <*> (Just <$> get) - <*> (fromIntegral <$> getInt) + <*> getInt <*> getBool <*> getTime <*> getTime From 7f4aeae935f68fae1583980d3e5a1e0abe1de185 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Wed, 15 Nov 2023 15:40:29 +0100 Subject: [PATCH 08/23] add BuildStatus ResolvesToAlreadyValid and NoSubstituters --- hnix-store-core/CHANGELOG.md | 1 + hnix-store-core/src/System/Nix/Build.hs | 2 ++ hnix-store-remote/tests/SerializeSpec.hs | 28 +++++++++++++----------- 3 files changed, 18 insertions(+), 13 deletions(-) diff --git a/hnix-store-core/CHANGELOG.md b/hnix-store-core/CHANGELOG.md index 4f89048..a09f8a2 100644 --- a/hnix-store-core/CHANGELOG.md +++ b/hnix-store-core/CHANGELOG.md @@ -8,6 +8,7 @@ * `BuildResult`s `timesBuild` field changes type from `Integer` to `Int` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Additions: + * `BuildStatus` grows `NoSubstituters` and `ResolvesToAlreadyValid` constructors [#231](https://github.com/haskell-nix/hnix-store/pull/231) * `InvalidPathError` replacing previous stringy error [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Added `Arbitrary` instances for (exported by default) [#230](https://github.com/haskell-nix/hnix-store/pull/230) * `StorePath` diff --git a/hnix-store-core/src/System/Nix/Build.hs b/hnix-store-core/src/System/Nix/Build.hs index ed774bd..19919ee 100644 --- a/hnix-store-core/src/System/Nix/Build.hs +++ b/hnix-store-core/src/System/Nix/Build.hs @@ -36,6 +36,8 @@ data BuildStatus = | DependencyFailed | LogLimitExceeded | NotDeterministic + | ResolvesToAlreadyValid + | NoSubstituters deriving (Eq, Generic, Ord, Enum, Show) deriving Arbitrary via GenericArbitrary BuildStatus diff --git a/hnix-store-remote/tests/SerializeSpec.hs b/hnix-store-remote/tests/SerializeSpec.hs index a4a1836..c348574 100644 --- a/hnix-store-remote/tests/SerializeSpec.hs +++ b/hnix-store-remote/tests/SerializeSpec.hs @@ -115,16 +115,18 @@ spec_buildMode = it' "Check" System.Nix.Build.Check 2 describe "BuildStatus enum order matches Nix" $ do - it' "Built" System.Nix.Build.Built 0 - it' "Substituted" System.Nix.Build.Substituted 1 - it' "AlreadyValid" System.Nix.Build.AlreadyValid 2 - it' "PermanentFailure" System.Nix.Build.PermanentFailure 3 - it' "InputRejected" System.Nix.Build.InputRejected 4 - it' "OutputRejected" System.Nix.Build.OutputRejected 5 - it' "TransientFailure" System.Nix.Build.TransientFailure 6 - it' "CachedFailure" System.Nix.Build.CachedFailure 7 - it' "TimedOut" System.Nix.Build.TimedOut 8 - it' "MiscFailure" System.Nix.Build.MiscFailure 9 - it' "DependencyFailed" System.Nix.Build.DependencyFailed 10 - it' "LogLimitExceeded" System.Nix.Build.LogLimitExceeded 11 - it' "NotDeterministic" System.Nix.Build.NotDeterministic 12 + it' "Built" System.Nix.Build.Built 0 + it' "Substituted" System.Nix.Build.Substituted 1 + it' "AlreadyValid" System.Nix.Build.AlreadyValid 2 + it' "PermanentFailure" System.Nix.Build.PermanentFailure 3 + it' "InputRejected" System.Nix.Build.InputRejected 4 + it' "OutputRejected" System.Nix.Build.OutputRejected 5 + it' "TransientFailure" System.Nix.Build.TransientFailure 6 + it' "CachedFailure" System.Nix.Build.CachedFailure 7 + it' "TimedOut" System.Nix.Build.TimedOut 8 + it' "MiscFailure" System.Nix.Build.MiscFailure 9 + it' "DependencyFailed" System.Nix.Build.DependencyFailed 10 + it' "LogLimitExceeded" System.Nix.Build.LogLimitExceeded 11 + it' "NotDeterministic" System.Nix.Build.NotDeterministic 12 + it' "ResolvesToAlreadyValid" System.Nix.Build.ResolvesToAlreadyValid 13 + it' "NoSubstituters" System.Nix.Build.NoSubstituters 14 From c53c10721b07117949b2836b072a3a0f313286f8 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Wed, 15 Nov 2023 15:59:36 +0100 Subject: [PATCH 09/23] add Serialize for BuildResult --- .../src/System/Nix/Store/Remote/Serialize.hs | 33 +++++++++++++------ hnix-store-remote/tests/SerializeSpec.hs | 19 +++++++++-- 2 files changed, 40 insertions(+), 12 deletions(-) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs index 0d0d68e..dd42f8b 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs @@ -5,8 +5,11 @@ Maintainer : srk |-} module System.Nix.Store.Remote.Serialize where -import Data.Text import Data.Serialize (Serialize(..)) +import Data.Text (Text) + +import qualified Data.Bool +import qualified Data.Text import System.Nix.Build (BuildMode(..), BuildStatus(..), BuildResult(..)) import System.Nix.Store.Remote.Serialize.Prim @@ -24,13 +27,23 @@ instance Serialize BuildStatus where put = putEnum instance Serialize BuildResult where - get = - BuildResult + get = do + status <- get + errorMessage <- + (\em -> Data.Bool.bool (Just em) Nothing (Data.Text.null em)) <$> get - -- TODO(srk): fishy - <*> (Just <$> get) - <*> getInt - <*> getBool - <*> getTime - <*> getTime - put = undefined + timesBuilt <- getInt + isNonDeterministic <- getBool + startTime <- getTime + stopTime <- getTime + pure $ BuildResult{..} + + put BuildResult{..} = do + put status + case errorMessage of + Just err -> putText err + Nothing -> putText mempty + putInt timesBuilt + putBool isNonDeterministic + putTime startTime + putTime stopTime diff --git a/hnix-store-remote/tests/SerializeSpec.hs b/hnix-store-remote/tests/SerializeSpec.hs index c348574..74abbfb 100644 --- a/hnix-store-remote/tests/SerializeSpec.hs +++ b/hnix-store-remote/tests/SerializeSpec.hs @@ -102,11 +102,26 @@ prop_Text = roundTripS prop_buildMode :: BuildMode -> Property prop_buildMode = roundTripS +-- ** BuildStatus + prop_buildStatus :: BuildStatus -> Property prop_buildStatus = roundTripS -spec_buildMode :: Spec -spec_buildMode = +-- ** BuildResult + +prop_buildResult :: Property +prop_buildResult = + forAll (arbitrary `suchThat` ((/= Just "") . System.Nix.Build.errorMessage)) + $ \br -> + roundTripS + $ br { System.Nix.Build.startTime = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0 + , System.Nix.Build.stopTime = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0 + } + +-- ** Enums + +spec_buildEnums :: Spec +spec_buildEnums = let it' name constr value = it name $ runPut (put constr) `shouldBe` runPut (putInt value) in do describe "Build enum order matches Nix" $ do From 360845155953d34a7e1c7267911242ac0ee8c6c1 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Wed, 15 Nov 2023 18:36:25 +0100 Subject: [PATCH 10/23] add Serialize for Derivation, add getPathOrFail --- hnix-store-remote/hnix-store-remote.cabal | 2 + .../src/System/Nix/Store/Remote/Serialize.hs | 57 +++++++++++++++++++ .../System/Nix/Store/Remote/Serialize/Prim.hs | 9 +++ hnix-store-remote/tests/SerializeSpec.hs | 16 +++++- 4 files changed, 82 insertions(+), 2 deletions(-) diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index 8ea8b40..eac55eb 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -93,6 +93,7 @@ library , unordered-containers , hnix-store-core >= 0.7 && <0.8 , transformers + , vector hs-source-dirs: src ghc-options: -Wall @@ -117,6 +118,7 @@ test-suite remote build-depends: hnix-store-core , hnix-store-remote + , nix-derivation , bytestring , cereal , text diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs index dd42f8b..23e327a 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs @@ -6,12 +6,19 @@ Maintainer : srk module System.Nix.Store.Remote.Serialize where import Data.Serialize (Serialize(..)) +import Data.Serialize.Get (Get) +import Data.Serialize.Put (Putter) import Data.Text (Text) import qualified Data.Bool +import qualified Data.Map +import qualified Data.Set import qualified Data.Text +import qualified Data.Vector +import Nix.Derivation (Derivation(..), DerivationOutput(..)) import System.Nix.Build (BuildMode(..), BuildStatus(..), BuildResult(..)) +import System.Nix.StorePath (StoreDir, StorePath) import System.Nix.Store.Remote.Serialize.Prim instance Serialize Text where @@ -47,3 +54,53 @@ instance Serialize BuildResult where putBool isNonDeterministic putTime startTime putTime stopTime + +getDerivation + :: StoreDir + -> Get (Derivation StorePath Text) +getDerivation storeDir = do + outputs <- + Data.Map.fromList + <$> (getMany $ do + outputName <- get + path <- getPathOrFail storeDir + hashAlgo <- get + hash <- get + pure (outputName, DerivationOutput{..}) + ) + + -- Our type is Derivation, but in Nix + -- the type sent over the wire is BasicDerivation + -- which omits inputDrvs + inputDrvs <- pure mempty + inputSrcs <- + Data.Set.fromList + <$> getMany (getPathOrFail storeDir) + + platform <- get + builder <- get + args <- + Data.Vector.fromList + <$> getMany get + + env <- + Data.Map.fromList + <$> getMany ((,) <$> get <*> get) + pure Derivation{..} + +putDerivation :: StoreDir -> Putter (Derivation StorePath Text) +putDerivation storeDir Derivation{..} = do + flip putMany (Data.Map.toList outputs) + $ \(outputName, DerivationOutput{..}) -> do + putText outputName + putPath storeDir path + putText hashAlgo + putText hash + + putMany (putPath storeDir) inputSrcs + putText platform + putText builder + putMany putText args + + flip putMany (Data.Map.toList env) + $ \(a1, a2) -> putText a1 *> putText a2 diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs index 0e65fd2..5bd10a1 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs @@ -157,6 +157,15 @@ getPath :: StoreDir -> Get (Either InvalidPathError StorePath) getPath sd = System.Nix.StorePath.parsePath sd <$> getByteString +-- | Deserialize @StorePath@, checking +-- that @StoreDir@ matches expected value +getPathOrFail :: StoreDir -> Get StorePath +getPathOrFail sd = + getPath sd + >>= either + (fail . show) + pure + -- | Serialize @StorePath@ with its associated @StoreDir@ putPath :: StoreDir -> Putter StorePath putPath storeDir = diff --git a/hnix-store-remote/tests/SerializeSpec.hs b/hnix-store-remote/tests/SerializeSpec.hs index 74abbfb..44f62e3 100644 --- a/hnix-store-remote/tests/SerializeSpec.hs +++ b/hnix-store-remote/tests/SerializeSpec.hs @@ -18,9 +18,11 @@ import qualified Data.HashSet import qualified Data.Time.Clock.POSIX import qualified System.Nix.Build -import System.Nix.Build (BuildMode, BuildStatus, BuildResult) +import Nix.Derivation (Derivation(..)) +import System.Nix.Build (BuildMode, BuildStatus) +import System.Nix.Derivation () import System.Nix.StorePath (StoreDir, StorePath) -import System.Nix.Store.Remote.Serialize () +import System.Nix.Store.Remote.Serialize (getDerivation, putDerivation) import System.Nix.Store.Remote.Serialize.Prim roundTrip :: (Eq a, Show a) => Putter a -> Get a -> a -> Property @@ -145,3 +147,13 @@ spec_buildEnums = it' "NotDeterministic" System.Nix.Build.NotDeterministic 12 it' "ResolvesToAlreadyValid" System.Nix.Build.ResolvesToAlreadyValid 13 it' "NoSubstituters" System.Nix.Build.NoSubstituters 14 + +-- ** Derivation + +prop_derivation :: StoreDir -> Derivation StorePath Text -> Property +prop_derivation sd drv = + roundTrip + (putDerivation sd) + (getDerivation sd) + -- inputDrvs is not used in remote protocol serialization + (drv { inputDrvs = mempty }) From ef9fb46f89dd9fa91ba667f3a16bfb5e670d25bf Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Thu, 16 Nov 2023 07:05:05 +0100 Subject: [PATCH 11/23] core: Fix unused warnings in Nar --- hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs | 11 ++++------- hnix-store-core/tests/NarFormat.hs | 6 +++--- 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs b/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs index a028940..6449fc1 100644 --- a/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs +++ b/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs @@ -47,7 +47,7 @@ import qualified System.Nix.Internal.Nar.Options as Nar -- of the actions the parser can take, and @ParserState@ for the -- internals of the parser newtype NarParser m a = NarParser - { runNarParser :: + { _runNarParser :: State.StateT ParserState (Except.ExceptT @@ -554,15 +554,12 @@ testParser' :: (m ~ IO) => FilePath -> IO (Either String ()) testParser' fp = withFile fp ReadMode $ \h -> runParser Nar.narEffectsIO parseNar h "tmp" - - - -- | Distance to the next multiple of 8 padLen :: Int -> Int padLen n = (8 - n) `mod` 8 - -dbgState :: IO.MonadIO m => NarParser m () -dbgState = do +-- | Debugging helper +_dbgState :: IO.MonadIO m => NarParser m () +_dbgState = do s <- State.get IO.liftIO $ print (tokenStack s, directoryStack s) diff --git a/hnix-store-core/tests/NarFormat.hs b/hnix-store-core/tests/NarFormat.hs index 5882644..2cab46a 100644 --- a/hnix-store-core/tests/NarFormat.hs +++ b/hnix-store-core/tests/NarFormat.hs @@ -561,16 +561,16 @@ sampleLinkToDirectoryBaseline = B64.decodeLenient $ BSL.concat getBigFileSize :: IO Int64 getBigFileSize = fromMaybe 5000000 . readMaybe <$> (getEnv "HNIX_BIG_FILE_SIZE" <|> pure "") - +-- TODO: implement and use in generator #232 -- | Add a link to a FileSystemObject. This is useful -- when creating Arbitrary FileSystemObjects. It -- isn't implemented yet -mkLink +_mkLink :: FilePath -- ^ Target -> FilePath -- ^ Link -> FileSystemObject -- ^ FileSystemObject to add link to -> FileSystemObject -mkLink = undefined -- TODO +_mkLink = undefined mkBigFile :: FilePath -> IO () mkBigFile path = do From abc57f5975fdf4c8e066ea08878abdc0085e7f2c Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Thu, 16 Nov 2023 07:08:14 +0100 Subject: [PATCH 12/23] core: Add Eq and Ord for SomeNamedDigest --- hnix-store-core/CHANGELOG.md | 1 + hnix-store-core/src/System/Nix/Internal/Hash.hs | 17 +++++++++++++++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/hnix-store-core/CHANGELOG.md b/hnix-store-core/CHANGELOG.md index a09f8a2..d7e6664 100644 --- a/hnix-store-core/CHANGELOG.md +++ b/hnix-store-core/CHANGELOG.md @@ -8,6 +8,7 @@ * `BuildResult`s `timesBuild` field changes type from `Integer` to `Int` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Additions: + * Added `Eq` and `Ord` instances for `SomeNamedDigest` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * `BuildStatus` grows `NoSubstituters` and `ResolvesToAlreadyValid` constructors [#231](https://github.com/haskell-nix/hnix-store/pull/231) * `InvalidPathError` replacing previous stringy error [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Added `Arbitrary` instances for (exported by default) [#230](https://github.com/haskell-nix/hnix-store/pull/230) diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 7ac3c49..100a25a 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -19,6 +19,7 @@ module System.Nix.Internal.Hash ) where +import Crypto.Hash (Digest) import qualified Text.Show import qualified Crypto.Hash as C import qualified Data.ByteString as BS @@ -45,11 +46,23 @@ instance NamedAlgo C.SHA512 where algoName = "sha512" -- | A digest whose 'NamedAlgo' is not known at compile time. -data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (C.Digest a) +data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (Digest a) instance Show SomeNamedDigest where show sd = case sd of - SomeDigest (digest :: C.Digest hashType) -> toString $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest + SomeDigest (digest :: Digest hashType) -> toString $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest + +instance Eq SomeNamedDigest where + (==) (SomeDigest (a :: Digest aType)) + (SomeDigest (b :: Digest bType)) + = algoName @aType == algoName @bType + && encodeDigestWith NixBase32 a == encodeDigestWith NixBase32 b + +instance Ord SomeNamedDigest where + (<=) (SomeDigest (a :: Digest aType)) + (SomeDigest (b :: Digest bType)) + = algoName @aType <= algoName @bType + && encodeDigestWith NixBase32 a <= encodeDigestWith NixBase32 b mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest mkNamedDigest name sriHash = From e332afbdf04cceca5620191b1b94d7c192a00900 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Thu, 16 Nov 2023 07:11:29 +0100 Subject: [PATCH 13/23] core: add Generic, Show for Signature and NarSignature --- hnix-store-core/CHANGELOG.md | 2 ++ hnix-store-core/src/System/Nix/Internal/Signature.hs | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/hnix-store-core/CHANGELOG.md b/hnix-store-core/CHANGELOG.md index d7e6664..9fbee57 100644 --- a/hnix-store-core/CHANGELOG.md +++ b/hnix-store-core/CHANGELOG.md @@ -8,6 +8,8 @@ * `BuildResult`s `timesBuild` field changes type from `Integer` to `Int` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Additions: + * Added `Generic` and `Show` instances for + `Signature` and `NarSignature` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Added `Eq` and `Ord` instances for `SomeNamedDigest` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * `BuildStatus` grows `NoSubstituters` and `ResolvesToAlreadyValid` constructors [#231](https://github.com/haskell-nix/hnix-store/pull/231) * `InvalidPathError` replacing previous stringy error [#231](https://github.com/haskell-nix/hnix-store/pull/231) diff --git a/hnix-store-core/src/System/Nix/Internal/Signature.hs b/hnix-store-core/src/System/Nix/Internal/Signature.hs index 75d7ad6..2ad0241 100644 --- a/hnix-store-core/src/System/Nix/Internal/Signature.hs +++ b/hnix-store-core/src/System/Nix/Internal/Signature.hs @@ -23,7 +23,7 @@ import qualified Crypto.Saltine.Internal.ByteSizes as NaClSizes -- | A NaCl signature. newtype Signature = Signature ByteString - deriving (Eq, Ord) + deriving (Eq, Generic, Ord, Show) instance IsEncoding Signature where decode s @@ -42,4 +42,4 @@ data NarSignature = NarSignature , -- | The archive's signature. sig :: Signature } - deriving (Eq, Ord) + deriving (Eq, Generic, Ord, Show) From f70460f0d42630949603c692cff07cfb00b6c70a Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Thu, 16 Nov 2023 07:13:32 +0100 Subject: [PATCH 14/23] core: derive Generic to StorePath --- hnix-store-core/src/System/Nix/Internal/StorePath.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 0a477fa..1278687 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -68,7 +68,7 @@ data StorePath = StorePath -- hello-1.2.3). storePathName :: !StorePathName } - deriving (Eq, Ord, Show) + deriving (Eq, Generic, Ord, Show) instance Hashable StorePath where hashWithSalt s StorePath{..} = From 1413c158225333e8b985b53195e0d8eff45f08d3 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Thu, 16 Nov 2023 07:15:30 +0100 Subject: [PATCH 15/23] core: derive Eq, Generic, Ord, Show for ContentAddressableAddress --- hnix-store-core/src/System/Nix/Internal/StorePath.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 1278687..353c668 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -132,6 +132,7 @@ data ContentAddressableAddress -- addToStore. It is addressed according to some hash algorithm -- applied to the nar serialization via some 'NarHashMode'. Fixed !NarHashMode !SomeNamedDigest + deriving (Eq, Generic, Ord, Show) -- | Schemes for hashing a Nix archive. -- From a75162d826101be7bdc4e4f4e2ebdef14ba27a4e Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Thu, 16 Nov 2023 07:16:20 +0100 Subject: [PATCH 16/23] core: derive Eq, Enum, Generic, Hashable Ord, Show for NarHashMode --- hnix-store-core/src/System/Nix/Internal/StorePath.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 353c668..31c0cc2 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -144,6 +144,7 @@ data NarHashMode | -- | Hash an arbitrary nar, including a non-executable regular -- file if so desired. Recursive + deriving (Eq, Enum, Generic, Hashable, Ord, Show) -- | Reason why a path is not valid data InvalidPathError = From e6f016d72f9c9fbd139850d8d54b9afc3689a434 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Thu, 16 Nov 2023 07:22:37 +0100 Subject: [PATCH 17/23] Convert StorePathMetadata into Metadata a Also derive bunch of common instances. Closes #147 --- hnix-store-core/CHANGELOG.md | 1 + .../src/System/Nix/StorePathMetadata.hs | 30 ++++++++++--------- .../src/System/Nix/Store/Remote.hs | 6 ++-- 3 files changed, 20 insertions(+), 17 deletions(-) diff --git a/hnix-store-core/CHANGELOG.md b/hnix-store-core/CHANGELOG.md index 9fbee57..c99e63d 100644 --- a/hnix-store-core/CHANGELOG.md +++ b/hnix-store-core/CHANGELOG.md @@ -1,6 +1,7 @@ # Next * Changes: + * `StorePathMetadata` converted to `Metadata a` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Constructors of `StorePathName` and `StorePathHashPart` are no longer exported. Use respective `mkStorePath..` functions. [#230](https://github.com/haskell-nix/hnix-store/pull/230) * `StorePathSet` type alias is no more, use `HashSet StorePath` [#230](https://github.com/haskell-nix/hnix-store/pull/230) diff --git a/hnix-store-core/src/System/Nix/StorePathMetadata.hs b/hnix-store-core/src/System/Nix/StorePathMetadata.hs index 926ddaf..56d6065 100644 --- a/hnix-store-core/src/System/Nix/StorePathMetadata.hs +++ b/hnix-store-core/src/System/Nix/StorePathMetadata.hs @@ -1,27 +1,29 @@ {-| Description : Metadata about Nix store paths. -} -module System.Nix.StorePathMetadata where +module System.Nix.StorePathMetadata + ( Metadata(..) + , StorePathTrust(..) + ) where -import System.Nix.StorePath ( StorePath - , ContentAddressableAddress - ) -import System.Nix.Hash ( SomeNamedDigest ) -import Data.Time ( UTCTime ) -import System.Nix.Signature ( NarSignature ) +import Data.Time (UTCTime) --- | Metadata about a 'StorePath' -data StorePathMetadata = StorePathMetadata +import System.Nix.Hash (SomeNamedDigest) +import System.Nix.Signature (NarSignature) +import System.Nix.StorePath (ContentAddressableAddress) + +-- | Metadata (typically about a 'StorePath') +data Metadata a = Metadata { -- | The path this metadata is about - path :: !StorePath + path :: !a , -- | The path to the derivation file that built this path, if any -- and known. - deriverPath :: !(Maybe StorePath) + deriverPath :: !(Maybe a) , -- TODO should this be optional? -- | The hash of the nar serialization of the path. narHash :: !SomeNamedDigest , -- | The paths that this path directly references - references :: !(HashSet StorePath) + references :: !(HashSet a) , -- | When was this path registered valid in the store? registrationTime :: !UTCTime , -- | The size of the nar serialization of the path, in bytes. @@ -38,7 +40,7 @@ data StorePathMetadata = StorePathMetadata -- There is no guarantee from this type alone that this address -- is actually correct for this store path. contentAddressableAddress :: !(Maybe ContentAddressableAddress) - } + } deriving (Eq, Generic, Ord, Show) -- | How much do we trust the path, based on its provenance? data StorePathTrust @@ -47,4 +49,4 @@ data StorePathTrust | -- | It was built elsewhere (and substituted or similar) and so -- is less trusted BuiltElsewhere - deriving (Show, Eq, Ord) + deriving (Eq, Enum, Generic, Ord, Show) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index 666ded1..4c2bb23 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -58,7 +58,7 @@ import System.Nix.StorePath ( StorePath , StorePathHashPart , InvalidPathError ) -import System.Nix.StorePathMetadata ( StorePathMetadata(..) +import System.Nix.StorePathMetadata ( Metadata(..) , StorePathTrust(..) ) import System.Nix.Internal.Base ( encodeWith ) @@ -225,7 +225,7 @@ querySubstitutablePaths ps = do runOpArgs QuerySubstitutablePaths $ putPaths storeDir ps sockGetPaths -queryPathInfoUncached :: StorePath -> MonadStore StorePathMetadata +queryPathInfoUncached :: StorePath -> MonadStore (Metadata StorePath) queryPathInfoUncached path = do storeDir <- getStoreDir runOpArgs QueryPathInfo $ do @@ -266,7 +266,7 @@ queryPathInfoUncached path = do trust = if ultimate then BuiltLocally else BuiltElsewhere - pure $ StorePathMetadata{..} + pure $ Metadata{..} queryReferrers :: StorePath -> MonadStore (HashSet StorePath) queryReferrers p = do From e6740b570472114bad377b9806972e37a34fdcf0 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Thu, 16 Nov 2023 13:18:01 +0100 Subject: [PATCH 18/23] add storePathHashPartToText --- hnix-store-core/CHANGELOG.md | 1 + hnix-store-core/src/System/Nix/Internal/StorePath.hs | 9 ++++++++- hnix-store-core/src/System/Nix/StorePath.hs | 1 + hnix-store-remote/src/System/Nix/Store/Remote.hs | 10 ++-------- 4 files changed, 12 insertions(+), 9 deletions(-) diff --git a/hnix-store-core/CHANGELOG.md b/hnix-store-core/CHANGELOG.md index c99e63d..584b04b 100644 --- a/hnix-store-core/CHANGELOG.md +++ b/hnix-store-core/CHANGELOG.md @@ -9,6 +9,7 @@ * `BuildResult`s `timesBuild` field changes type from `Integer` to `Int` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Additions: + * `System.Nix.StorePath.storePathHashPartToText` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Added `Generic` and `Show` instances for `Signature` and `NarSignature` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Added `Eq` and `Ord` instances for `SomeNamedDigest` [#231](https://github.com/haskell-nix/hnix-store/pull/231) diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 31c0cc2..7b595de 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -25,6 +25,7 @@ module System.Nix.Internal.StorePath , storePathToRawFilePath , storePathToText , storePathToNarInfo + , storePathHashPartToText , -- * Parsing 'StorePath's parsePath , pathParser @@ -208,7 +209,7 @@ storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath storePathToRawFilePath storeDir StorePath{..} = unStoreDir storeDir <> "/" <> hashPart <> "-" <> name where - hashPart = encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash + hashPart = encodeUtf8 $ storePathHashPartToText storePathHash name = encodeUtf8 $ unStorePathName storePathName -- | Render a 'StorePath' as a 'FilePath'. @@ -225,6 +226,12 @@ storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString storePathToNarInfo StorePath{..} = encodeUtf8 $ encodeWith NixBase32 (coerce storePathHash) <> ".narinfo" +-- | Render a 'StorePathHashPart' as a 'Text'. +-- This is used by remote store / database +-- via queryPathFromHashPart +storePathHashPartToText :: StorePathHashPart -> Text +storePathHashPartToText = encodeWith NixBase32 . unStorePathHashPart + -- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking -- that store directory matches `expectedRoot`. parsePath diff --git a/hnix-store-core/src/System/Nix/StorePath.hs b/hnix-store-core/src/System/Nix/StorePath.hs index b42ebd8..7de11ee 100644 --- a/hnix-store-core/src/System/Nix/StorePath.hs +++ b/hnix-store-core/src/System/Nix/StorePath.hs @@ -22,6 +22,7 @@ module System.Nix.StorePath , storePathToRawFilePath , storePathToText , storePathToNarInfo + , storePathHashPartToText , -- * Parsing 'StorePath's parsePath , pathParser diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index 4c2bb23..d123ac1 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -39,7 +39,6 @@ import Data.HashSet (HashSet) import Data.Map (Map) import Data.Text (Text) import qualified Control.Monad -import qualified Data.ByteString.Lazy import qualified Data.Text.Encoding -- import qualified Data.ByteString.Lazy as BSL @@ -61,7 +60,6 @@ import System.Nix.StorePath ( StorePath import System.Nix.StorePathMetadata ( Metadata(..) , StorePathTrust(..) ) -import System.Nix.Internal.Base ( encodeWith ) import qualified Data.Binary.Put import qualified Data.Map.Strict @@ -295,12 +293,8 @@ queryDerivationOutputNames p = do queryPathFromHashPart :: StorePathHashPart -> MonadStore StorePath queryPathFromHashPart storePathHash = do runOpArgs QueryPathFromHashPart - $ putByteStringLen - $ Data.ByteString.Lazy.fromStrict - $ Data.Text.Encoding.encodeUtf8 - $ encodeWith NixBase32 - $ System.Nix.StorePath.unStorePathHashPart - storePathHash + $ putText + $ System.Nix.StorePath.storePathHashPartToText storePathHash sockGetPath queryMissing From b80ee47f6a4b34e3483387427282a2ec36f508d8 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Thu, 16 Nov 2023 13:25:20 +0100 Subject: [PATCH 19/23] Add Default StoreDir instance --- hnix-store-core/CHANGELOG.md | 1 + hnix-store-core/hnix-store-core.cabal | 2 ++ hnix-store-core/src/System/Nix/Internal/StorePath.hs | 4 ++++ hnix-store-core/tests/Derivation.hs | 5 +++-- hnix-store-remote/hnix-store-remote.cabal | 1 + hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs | 3 ++- 6 files changed, 13 insertions(+), 3 deletions(-) diff --git a/hnix-store-core/CHANGELOG.md b/hnix-store-core/CHANGELOG.md index 584b04b..1143077 100644 --- a/hnix-store-core/CHANGELOG.md +++ b/hnix-store-core/CHANGELOG.md @@ -9,6 +9,7 @@ * `BuildResult`s `timesBuild` field changes type from `Integer` to `Int` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Additions: + * `Default StoreDir` instance [#231](https://github.com/haskell-nix/hnix-store/pull/231) * `System.Nix.StorePath.storePathHashPartToText` [#231](https://github.com/haskell-nix/hnix-store/pull/231) * Added `Generic` and `Show` instances for `Signature` and `NarSignature` [#231](https://github.com/haskell-nix/hnix-store/pull/231) diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index ab2d68e..d5b8a02 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -60,6 +60,7 @@ library , case-insensitive , cereal , containers + , data-default-class , generic-arbitrary < 1.1 -- Required for cryptonite low-level type convertion , memory @@ -140,6 +141,7 @@ test-suite format-tests , bytestring , containers , cryptonite + , data-default-class , directory , filepath , process diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 7b595de..9e3ced2 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -32,6 +32,7 @@ module System.Nix.Internal.StorePath ) where +import Data.Default.Class (Default(def)) import qualified Relude.Unsafe as Unsafe import System.Nix.Internal.Hash import System.Nix.Internal.Base @@ -204,6 +205,9 @@ newtype StoreDir = StoreDir { instance Arbitrary StoreDir where arbitrary = StoreDir . ("/" <>) . Bytes.Char8.pack <$> arbitrary +instance Default StoreDir where + def = StoreDir "/nix/store" + -- | Render a 'StorePath' as a 'RawFilePath'. storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath storePathToRawFilePath storeDir StorePath{..} = diff --git a/hnix-store-core/tests/Derivation.hs b/hnix-store-core/tests/Derivation.hs index 6e02fa4..9df3ddd 100644 --- a/hnix-store-core/tests/Derivation.hs +++ b/hnix-store-core/tests/Derivation.hs @@ -13,6 +13,7 @@ import System.Nix.Derivation ( parseDerivation , buildDerivation ) +import Data.Default.Class (Default(def)) import qualified Data.Attoparsec.Text import qualified Data.Text.IO import qualified Data.Text.Lazy @@ -27,10 +28,10 @@ processDerivation source dest = do (Data.Text.IO.writeFile dest . toText . Data.Text.Lazy.Builder.toLazyText - . buildDerivation (StoreDir "/nix/store") + . buildDerivation def ) (Data.Attoparsec.Text.parseOnly - (parseDerivation $ StoreDir "/nix/store") + (parseDerivation def) contents ) diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index eac55eb..1bbb4f6 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -85,6 +85,7 @@ library , cereal , containers , cryptonite + , data-default-class , text , time , network diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs index ba80235..b015cda 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs @@ -22,6 +22,7 @@ import Control.Monad.Except import Control.Monad.Reader (asks, runReaderT) import Control.Monad.State.Strict +import Data.Default.Class (Default(def)) import qualified Data.Bool import Data.Binary.Get import Data.Binary.Put @@ -168,7 +169,7 @@ runOpArgsIO op encoder = do throwError $ Data.ByteString.Char8.unpack msg runStore :: MonadStore a -> IO (Either String a, [Logger]) -runStore = runStoreOpts defaultSockPath $ StoreDir "/nix/store" +runStore = runStoreOpts defaultSockPath def runStoreOpts :: FilePath -> StoreDir -> MonadStore a -> IO (Either String a, [Logger]) From 2e1cab22b3273c0855ff0879c0a5201d91d4cb1d Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Thu, 16 Nov 2023 16:54:03 +0100 Subject: [PATCH 20/23] move ContentAddressableAddress builder and parser to core, add roundtrip prop --- hnix-store-core/hnix-store-core.cabal | 1 + .../src/System/Nix/Internal/StorePath.hs | 78 ++++++++++++++++++- hnix-store-core/src/System/Nix/StorePath.hs | 3 + .../tests/ContentAddressableAddress.hs | 21 +++++ hnix-store-remote/hnix-store-remote.cabal | 2 - .../src/System/Nix/Store/Remote.hs | 6 +- .../src/System/Nix/Store/Remote/Builders.hs | 36 --------- .../src/System/Nix/Store/Remote/Parsers.hs | 58 -------------- 8 files changed, 106 insertions(+), 99 deletions(-) create mode 100644 hnix-store-core/tests/ContentAddressableAddress.hs delete mode 100644 hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs delete mode 100644 hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index d5b8a02..c712fb0 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -123,6 +123,7 @@ test-suite format-tests main-is: Driver.hs other-modules: Derivation + ContentAddressableAddress NarFormat Hash StorePath diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 9e3ced2..902d433 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -Wno-orphans #-} {-| Description : Representation of Nix store paths. -} @@ -14,6 +15,9 @@ module System.Nix.Internal.StorePath , StorePathHashPart(..) , mkStorePathHashPart , ContentAddressableAddress(..) + , contentAddressableAddressBuilder + , contentAddressableAddressParser + , digestBuilder , NarHashMode(..) , -- * Manipulating 'StorePathName' makeStorePathName @@ -33,7 +37,9 @@ module System.Nix.Internal.StorePath where import Data.Default.Class (Default(def)) +import Data.Text.Lazy.Builder (Builder) import qualified Relude.Unsafe as Unsafe +import qualified System.Nix.Hash import System.Nix.Internal.Hash import System.Nix.Internal.Base import qualified System.Nix.Internal.Base32 as Nix.Base32 @@ -41,17 +47,23 @@ import qualified System.Nix.Internal.Base32 as Nix.Base32 import qualified Data.ByteString.Char8 as Bytes.Char8 import qualified Data.Char as Char import qualified Data.Text as Text +import qualified Data.Text.Encoding +import qualified Data.Text.Lazy.Builder import Data.Attoparsec.Text.Lazy ( Parser , () ) +import qualified Data.Attoparsec.ByteString.Char8 import qualified Data.Attoparsec.Text.Lazy as Parser.Text.Lazy import qualified System.FilePath as FilePath import Crypto.Hash ( SHA256 , Digest , HashAlgorithm + , hash ) -import Test.QuickCheck +import Test.QuickCheck (Arbitrary(arbitrary), listOf, elements) +import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..)) +import Test.QuickCheck.Instances () -- | A path in a Nix store. -- @@ -116,6 +128,7 @@ mkStorePathHashPart -> StorePathHashPart mkStorePathHashPart = StorePathHashPart . mkStorePathHash @hashAlgo +-- TODO(srk): split into its own module + .Builder/.Parser -- | An address for a content-addressable store path, i.e. one whose -- store path hash is purely a function of its contents (as opposed to -- paths that are derivation outputs, whose hashes are a function of @@ -136,6 +149,66 @@ data ContentAddressableAddress Fixed !NarHashMode !SomeNamedDigest deriving (Eq, Generic, Ord, Show) +-- TODO(srk): extend to all hash types +instance Arbitrary (Digest SHA256) where + arbitrary = hash @ByteString <$> arbitrary + +instance Arbitrary SomeNamedDigest where + arbitrary = SomeDigest @SHA256 <$> arbitrary + +deriving via GenericArbitrary ContentAddressableAddress + instance Arbitrary ContentAddressableAddress + +-- | Builder for `ContentAddressableAddress` +contentAddressableAddressBuilder :: ContentAddressableAddress -> Builder +contentAddressableAddressBuilder (Text digest) = + "text:" + <> digestBuilder digest +contentAddressableAddressBuilder (Fixed narHashMode (SomeDigest (digest :: Digest hashAlgo))) = + "fixed:" + <> (if narHashMode == Recursive then "r:" else mempty) +-- <> Data.Text.Lazy.Builder.fromText (System.Nix.Hash.algoName @hashAlgo) + <> digestBuilder digest + +-- | Builder for @Digest@s +digestBuilder :: forall hashAlgo . (NamedAlgo hashAlgo) => Digest hashAlgo -> Builder +digestBuilder digest = + Data.Text.Lazy.Builder.fromText (System.Nix.Hash.algoName @hashAlgo) + <> ":" + <> Data.Text.Lazy.Builder.fromText (encodeDigestWith NixBase32 digest) + +-- | Parser for content addressable field +contentAddressableAddressParser :: Data.Attoparsec.ByteString.Char8.Parser ContentAddressableAddress +contentAddressableAddressParser = caText <|> caFixed + where + -- | Parser for @text:sha256:@ + --caText :: Parser ContentAddressableAddress + caText = do + _ <- "text:sha256:" + digest <- decodeDigestWith @SHA256 NixBase32 <$> parseHash + either fail pure $ Text <$> digest + + -- | Parser for @fixed:::@ + --caFixed :: Parser ContentAddressableAddress + caFixed = do + _ <- "fixed:" + narHashMode <- (Recursive <$ "r:") <|> (RegularFile <$ "") + digest <- parseTypedDigest + either fail pure $ Fixed narHashMode <$> digest + + --parseTypedDigest :: Parser (Either String SomeNamedDigest) + parseTypedDigest = mkNamedDigest <$> parseHashType <*> parseHash + + --parseHashType :: Parser Text + parseHashType = + Data.Text.Encoding.decodeUtf8 + <$> ("sha256" <|> "sha512" <|> "sha1" <|> "md5") <* (":" <|> "-") + + --parseHash :: Parser Text + parseHash = + Data.Text.Encoding.decodeUtf8 + <$> Data.Attoparsec.ByteString.Char8.takeWhile1 (/= ':') + -- | Schemes for hashing a Nix archive. -- -- For backwards-compatibility reasons, there are two different modes @@ -148,6 +221,9 @@ data NarHashMode Recursive deriving (Eq, Enum, Generic, Hashable, Ord, Show) +deriving via GenericArbitrary NarHashMode + instance Arbitrary NarHashMode + -- | Reason why a path is not valid data InvalidPathError = EmptyName diff --git a/hnix-store-core/src/System/Nix/StorePath.hs b/hnix-store-core/src/System/Nix/StorePath.hs index 7de11ee..394dbf2 100644 --- a/hnix-store-core/src/System/Nix/StorePath.hs +++ b/hnix-store-core/src/System/Nix/StorePath.hs @@ -10,6 +10,9 @@ module System.Nix.StorePath , mkStorePathHashPart , unStorePathHashPart , ContentAddressableAddress(..) + , contentAddressableAddressBuilder + , contentAddressableAddressParser + , digestBuilder , NarHashMode(..) , -- * Manipulating 'StorePathName' makeStorePathName diff --git a/hnix-store-core/tests/ContentAddressableAddress.hs b/hnix-store-core/tests/ContentAddressableAddress.hs new file mode 100644 index 0000000..acf303a --- /dev/null +++ b/hnix-store-core/tests/ContentAddressableAddress.hs @@ -0,0 +1,21 @@ + +module ContentAddressableAddress where + +import Test.Tasty.QuickCheck +import System.Nix.StorePath (ContentAddressableAddress, contentAddressableAddressBuilder, contentAddressableAddressParser) + +import qualified Data.Attoparsec.ByteString.Char8 +import qualified Data.Text.Lazy +import qualified Data.Text.Lazy.Builder +import qualified Data.Text.Encoding + +prop_caAddrRoundTrip :: ContentAddressableAddress -> Property +prop_caAddrRoundTrip = \caAddr -> + Data.Attoparsec.ByteString.Char8.parseOnly contentAddressableAddressParser + ( Data.Text.Encoding.encodeUtf8 + . Data.Text.Lazy.toStrict + . Data.Text.Lazy.Builder.toLazyText + $ contentAddressableAddressBuilder caAddr + ) + === pure caAddr + diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index 1bbb4f6..aa39e59 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -71,9 +71,7 @@ library , System.Nix.Store.Remote.Binary , System.Nix.Store.Remote.Serialize , System.Nix.Store.Remote.Serialize.Prim - , System.Nix.Store.Remote.Builders , System.Nix.Store.Remote.Logger - , System.Nix.Store.Remote.Parsers , System.Nix.Store.Remote.Protocol , System.Nix.Store.Remote.Types , System.Nix.Store.Remote.Util diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index d123ac1..39d1660 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -39,6 +39,7 @@ import Data.HashSet (HashSet) import Data.Map (Map) import Data.Text (Text) import qualified Control.Monad +import qualified Data.Attoparsec.ByteString.Char8 import qualified Data.Text.Encoding -- import qualified Data.ByteString.Lazy as BSL @@ -66,7 +67,6 @@ import qualified Data.Map.Strict import qualified Data.Set import qualified System.Nix.StorePath -import qualified System.Nix.Store.Remote.Parsers import System.Nix.Store.Remote.Binary import System.Nix.Store.Remote.Types @@ -257,7 +257,9 @@ queryPathInfoUncached path = do contentAddressableAddress = case - System.Nix.Store.Remote.Parsers.parseContentAddressableAddress caString + Data.Attoparsec.ByteString.Char8.parseOnly + System.Nix.StorePath.contentAddressableAddressParser + caString of Left e -> error e Right x -> Just x diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs deleted file mode 100644 index 1ee5dfe..0000000 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# language AllowAmbiguousTypes #-} -{-# language ScopedTypeVariables #-} -{-# language RankNTypes #-} - -module System.Nix.Store.Remote.Builders - ( buildContentAddressableAddress - ) -where - -import qualified Data.Text.Lazy as TL -import Crypto.Hash ( Digest ) -import System.Nix.StorePath ( ContentAddressableAddress(..) - ) - -import Data.Text.Lazy.Builder ( Builder ) -import qualified Data.Text.Lazy.Builder as TL - -import System.Nix.Hash - --- | Marshall `ContentAddressableAddress` to `Text` --- in form suitable for remote protocol usage. -buildContentAddressableAddress :: ContentAddressableAddress -> TL.Text -buildContentAddressableAddress = - TL.toLazyText . contentAddressableAddressBuilder - -contentAddressableAddressBuilder :: ContentAddressableAddress -> Builder -contentAddressableAddressBuilder (Text digest) = - "text:" <> digestBuilder digest -contentAddressableAddressBuilder (Fixed _narHashMode (SomeDigest (digest :: Digest hashAlgo))) = - "fixed:" - <> TL.fromText (System.Nix.Hash.algoName @hashAlgo) - <> digestBuilder digest - -digestBuilder :: Digest a -> Builder -digestBuilder = - TL.fromText . encodeDigestWith NixBase32 diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs deleted file mode 100644 index 65d2b96..0000000 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# language AllowAmbiguousTypes #-} -{-# language ScopedTypeVariables #-} -{-# language RankNTypes #-} -{-# language DataKinds #-} - -module System.Nix.Store.Remote.Parsers - ( parseContentAddressableAddress - ) -where - -import Control.Applicative ((<|>)) -import Data.ByteString (ByteString) -import Data.Text (Text) -import Data.Attoparsec.ByteString.Char8 -import System.Nix.Hash -import System.Nix.StorePath ( ContentAddressableAddress(..) - , NarHashMode(..) - ) -import Crypto.Hash ( SHA256 ) -import qualified Data.Text.Encoding - --- | Parse `ContentAddressableAddress` from `ByteString` -parseContentAddressableAddress - :: ByteString -> Either String ContentAddressableAddress -parseContentAddressableAddress = - Data.Attoparsec.ByteString.Char8.parseOnly contentAddressableAddressParser - --- | Parser for content addressable field -contentAddressableAddressParser :: Parser ContentAddressableAddress -contentAddressableAddressParser = caText <|> caFixed - --- | Parser for @text:sha256:@ -caText :: Parser ContentAddressableAddress -caText = do - _ <- "text:sha256:" - digest <- decodeDigestWith @SHA256 NixBase32 <$> parseHash - either fail pure $ Text <$> digest - --- | Parser for @fixed:::@ -caFixed :: Parser ContentAddressableAddress -caFixed = do - _ <- "fixed:" - narHashMode <- (Recursive <$ "r:") <|> (RegularFile <$ "") - digest <- parseTypedDigest - either fail pure $ Fixed narHashMode <$> digest - -parseTypedDigest :: Parser (Either String SomeNamedDigest) -parseTypedDigest = mkNamedDigest <$> parseHashType <*> parseHash - -parseHashType :: Parser Text -parseHashType = - Data.Text.Encoding.decodeUtf8 - <$> ("sha256" <|> "sha512" <|> "sha1" <|> "md5") <* (":" <|> "-") - -parseHash :: Parser Text -parseHash = - Data.Text.Encoding.decodeUtf8 - <$> takeWhile1 (/= ':') From 9e1142882480d6e246e10f685ba88e4a1a2cc289 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Fri, 17 Nov 2023 09:57:11 +0100 Subject: [PATCH 21/23] remote: actually use build-remote flag, disable by default, enable via cabal.project --- cabal.project | 8 +++++++- hnix-store-remote/hnix-store-remote.cabal | 4 +++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index cbe7dc7..ad967fc 100644 --- a/cabal.project +++ b/cabal.project @@ -1 +1,7 @@ -packages: ./hnix-store-core/*.cabal ./hnix-store-remote/*.cabal +packages: + ./hnix-store-core/hnix-store-core.cabal + ./hnix-store-remote/hnix-store-remote.cabal + +package hnix-store-remote + flags: +build-readme + diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index aa39e59..93f08ad 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -60,7 +60,7 @@ flag io-testsuite flag build-readme default: - True + False description: Build README.lhs example @@ -97,6 +97,8 @@ library ghc-options: -Wall executable remote-readme + if !flag(build-readme) + buildable: False build-depends: base >=4.12 && <5 , hnix-store-remote From e484ee77d2c14656c6da84b6aea694fe0836201b Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Fri, 17 Nov 2023 09:57:34 +0100 Subject: [PATCH 22/23] remove cabal.project from subdirs --- hnix-store-core/cabal.project | 1 - hnix-store-remote/cabal.project | 1 - 2 files changed, 2 deletions(-) delete mode 100644 hnix-store-core/cabal.project delete mode 100644 hnix-store-remote/cabal.project diff --git a/hnix-store-core/cabal.project b/hnix-store-core/cabal.project deleted file mode 100644 index e6fdbad..0000000 --- a/hnix-store-core/cabal.project +++ /dev/null @@ -1 +0,0 @@ -packages: . diff --git a/hnix-store-remote/cabal.project b/hnix-store-remote/cabal.project deleted file mode 100644 index e6fdbad..0000000 --- a/hnix-store-remote/cabal.project +++ /dev/null @@ -1 +0,0 @@ -packages: . From cefbca3a01c54c6d9733f6a3e2611dd44bbc2a5d Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Fri, 17 Nov 2023 09:59:36 +0100 Subject: [PATCH 23/23] remote: move +io-testsuite from cabal.project.local to cabal.project --- cabal.project | 2 +- cabal.project.local.ci | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/cabal.project b/cabal.project index ad967fc..7e29f88 100644 --- a/cabal.project +++ b/cabal.project @@ -3,5 +3,5 @@ packages: ./hnix-store-remote/hnix-store-remote.cabal package hnix-store-remote - flags: +build-readme + flags: +build-readme +io-testsuite diff --git a/cabal.project.local.ci b/cabal.project.local.ci index 482d29d..b6ed841 100644 --- a/cabal.project.local.ci +++ b/cabal.project.local.ci @@ -1,7 +1,5 @@ tests: True -flags: +io-testsuite - package hnix-store-core ghc-options: -Wunused-packages -Wall