diff --git a/cabal.project b/cabal.project index cbe7dc7..7e29f88 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 +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 diff --git a/hnix-store-core/CHANGELOG.md b/hnix-store-core/CHANGELOG.md index b006cfa..1143077 100644 --- a/hnix-store-core/CHANGELOG.md +++ b/hnix-store-core/CHANGELOG.md @@ -1,16 +1,32 @@ # 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) + * `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: + * `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) + * 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) * `StorePath` * `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/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-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index 8f14344..c712fb0 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -60,6 +60,8 @@ library , case-insensitive , cereal , containers + , data-default-class + , generic-arbitrary < 1.1 -- Required for cryptonite low-level type convertion , memory , cryptonite @@ -71,6 +73,7 @@ library , mtl , nix-derivation >= 1.1.1 && <2 , QuickCheck + , quickcheck-instances , saltine , time , text @@ -89,9 +92,13 @@ library , DeriveFoldable , DeriveTraversable , DeriveLift + , DerivingStrategies + , DerivingVia , FlexibleContexts , FlexibleInstances , StandaloneDeriving + , ScopedTypeVariables + , RecordWildCards , TypeApplications , TypeSynonymInstances , InstanceSigs @@ -116,6 +123,7 @@ test-suite format-tests main-is: Driver.hs other-modules: Derivation + ContentAddressableAddress NarFormat Hash StorePath @@ -134,9 +142,11 @@ test-suite format-tests , bytestring , containers , cryptonite + , data-default-class , 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 01b29a6..19919ee 100644 --- a/hnix-store-core/src/System/Nix/Build.hs +++ b/hnix-store-core/src/System/Nix/Build.hs @@ -1,4 +1,5 @@ -{-# language RecordWildCards #-} +-- due to recent generic-arbitrary +{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-} {-| Description : Build related types Maintainer : srk @@ -8,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 @@ -32,8 +36,10 @@ data BuildStatus = | DependencyFailed | LogLimitExceeded | NotDeterministic - deriving (Eq, Ord, Enum, Show) - + | ResolvesToAlreadyValid + | NoSubstituters + deriving (Eq, Generic, Ord, Enum, Show) + deriving Arbitrary via GenericArbitrary BuildStatus -- | Result of the build data BuildResult = BuildResult @@ -42,7 +48,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 @@ -50,7 +56,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/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 = 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/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) diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index e062eca..902d433 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -1,10 +1,9 @@ +{-# OPTIONS_GHC -Wno-orphans #-} {-| Description : Representation of Nix store paths. -} {-# language ConstraintKinds #-} -{-# language RecordWildCards #-} -{-# language GeneralizedNewtypeDeriving #-} -{-# language ScopedTypeVariables #-} +{-# language DeriveAnyClass #-} {-# language AllowAmbiguousTypes #-} {-# language DataKinds #-} @@ -16,22 +15,31 @@ module System.Nix.Internal.StorePath , StorePathHashPart(..) , mkStorePathHashPart , ContentAddressableAddress(..) + , contentAddressableAddressBuilder + , contentAddressableAddressParser + , digestBuilder , NarHashMode(..) , -- * Manipulating 'StorePathName' makeStorePathName , validStorePathName + -- * Reason why a path is not valid + , InvalidPathError(..) , -- * Rendering out 'StorePath's storePathToFilePath , storePathToRawFilePath , storePathToText , storePathToNarInfo + , storePathHashPartToText , -- * Parsing 'StorePath's parsePath , pathParser ) 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 @@ -39,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. -- @@ -68,7 +82,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{..} = @@ -88,7 +102,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 +116,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,8 +126,9 @@ mkStorePathHashPart . HashAlgorithm hashAlgo => ByteString -> StorePathHashPart -mkStorePathHashPart = coerce . mkStorePathHash @hashAlgo +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 @@ -132,6 +147,67 @@ 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) + +-- 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. -- @@ -143,19 +219,36 @@ data NarHashMode | -- | Hash an arbitrary nar, including a non-executable regular -- file if so desired. Recursive + deriving (Eq, Enum, Generic, Hashable, Ord, Show) -makeStorePathName :: Text -> Either String StorePathName +deriving via GenericArbitrary NarHashMode + instance Arbitrary NarHashMode + +-- | 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,17 +276,20 @@ 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 +instance Default StoreDir where + def = StoreDir "/nix/store" + -- | Render a 'StorePath' as a 'RawFilePath'. 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'. @@ -210,14 +306,26 @@ 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 :: 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 +334,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 +368,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..394dbf2 100644 --- a/hnix-store-core/src/System/Nix/StorePath.hs +++ b/hnix-store-core/src/System/Nix/StorePath.hs @@ -10,16 +10,22 @@ module System.Nix.StorePath , mkStorePathHashPart , unStorePathHashPart , ContentAddressableAddress(..) + , contentAddressableAddressBuilder + , contentAddressableAddressParser + , digestBuilder , NarHashMode(..) , -- * Manipulating 'StorePathName' makeStorePathName , unStorePathName , validStorePathName + -- * Reason why a path is not valid + , InvalidPathError(..) , -- * Rendering out 'StorePath's storePathToFilePath , storePathToRawFilePath , storePathToText , storePathToNarInfo + , storePathHashPartToText , -- * Parsing 'StorePath's parsePath , pathParser 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-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-core/tests/Derivation.hs b/hnix-store-core/tests/Derivation.hs index a600068..9df3ddd 100644 --- a/hnix-store-core/tests/Derivation.hs +++ b/hnix-store-core/tests/Derivation.hs @@ -5,14 +5,18 @@ 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 Data.Default.Class (Default(def)) 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 () @@ -24,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 ) @@ -46,3 +50,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 + 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 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: . diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index d443d2c..93f08ad 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -42,6 +42,14 @@ common commons , LambdaCase , BangPatterns , ViewPatterns + build-depends: + base >=4.12 && <5 + default-language: Haskell2010 + +common tests + import: commons + build-tool-depends: + tasty-discover:tasty-discover flag io-testsuite default: @@ -52,7 +60,7 @@ flag io-testsuite flag build-readme default: - True + False description: Build README.lhs example @@ -61,21 +69,21 @@ library exposed-modules: System.Nix.Store.Remote , System.Nix.Store.Remote.Binary - , System.Nix.Store.Remote.Builders + , System.Nix.Store.Remote.Serialize + , System.Nix.Store.Remote.Serialize.Prim , 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 build-depends: - base >=4.12 && <5 - , relude >= 1.0 , attoparsec , binary , bytestring + , cereal , containers , cryptonite + , data-default-class , text , time , network @@ -84,15 +92,13 @@ library , unordered-containers , hnix-store-core >= 0.7 && <0.8 , transformers - mixins: - base hiding (Prelude) - , relude (Relude as Prelude) - , relude + , vector hs-source-dirs: src - default-language: Haskell2010 ghc-options: -Wall executable remote-readme + if !flag(build-readme) + buildable: False build-depends: base >=4.12 && <5 , hnix-store-remote @@ -102,45 +108,58 @@ 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 + , nix-derivation + , bytestring + , cereal + , text + , time + , hspec + , tasty + , tasty-hspec + , tasty-quickcheck + , quickcheck-instances + , unordered-containers + 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 + hnix-store-core , hnix-store-remote + , bytestring , containers , cryptonite , directory , process , filepath , hspec-expectations-lifted - , quickcheck-text + , 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.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index cafe0e1..39d1660 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.Attoparsec.ByteString.Char8 +import qualified Data.Text.Encoding +-- import qualified Data.ByteString.Lazy as BSL import Nix.Derivation ( Derivation ) @@ -50,18 +56,17 @@ import System.Nix.Hash ( NamedAlgo(..) import System.Nix.StorePath ( StorePath , StorePathName , StorePathHashPart + , InvalidPathError ) -import System.Nix.StorePathMetadata ( StorePathMetadata(..) +import System.Nix.StorePathMetadata ( Metadata(..) , StorePathTrust(..) ) -import System.Nix.Internal.Base ( encodeWith ) import qualified Data.Binary.Put 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 @@ -81,11 +86,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) @@ -104,7 +109,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 @@ -117,14 +122,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. -- @@ -132,7 +137,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. -- @@ -140,7 +145,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 @@ -166,7 +171,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) @@ -177,18 +182,18 @@ findRoots = do getSocketIncremental $ getMany $ (,) - <$> (fromStrict <$> getByteStringLen) + <$> (BSL.fromStrict <$> getByteStringLen) <*> getPath sd 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 @@ -218,24 +223,24 @@ 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 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 @@ -252,14 +257,16 @@ 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 $ fromString e + Left e -> error e Right x -> Just x trust = if ultimate then BuiltLocally else BuiltElsewhere - pure $ StorePathMetadata{..} + pure $ Metadata{..} queryReferrers :: StorePath -> MonadStore (HashSet StorePath) queryReferrers p = do @@ -288,11 +295,8 @@ queryDerivationOutputNames p = do queryPathFromHashPart :: StorePathHashPart -> MonadStore StorePath queryPathFromHashPart storePathHash = do runOpArgs QueryPathFromHashPart - $ putByteStringLen - $ encodeUtf8 - $ encodeWith NixBase32 - $ System.Nix.StorePath.unStorePathHashPart - storePathHash + $ putText + $ System.Nix.StorePath.storePathHashPartToText storePathHash sockGetPath queryMissing @@ -316,10 +320,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/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/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 deleted file mode 100644 index cb6b6ab..0000000 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# language AllowAmbiguousTypes #-} -{-# language ScopedTypeVariables #-} -{-# language RankNTypes #-} -{-# language DataKinds #-} - -module System.Nix.Store.Remote.Parsers - ( parseContentAddressableAddress - ) -where - -import Data.Attoparsec.ByteString.Char8 -import System.Nix.Hash -import System.Nix.StorePath ( ContentAddressableAddress(..) - , NarHashMode(..) - ) -import Crypto.Hash ( SHA256 ) - --- | 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 = - decodeUtf8 <$> ("sha256" <|> "sha512" <|> "sha1" <|> "md5") <* (":" <|> "-") - -parseHash :: Parser Text -parseHash = 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..b015cda 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,19 @@ 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 Data.Default.Class (Default(def)) +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 +127,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,12 +164,12 @@ 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]) -runStore = runStoreOpts defaultSockPath $ StoreDir "/nix/store" +runStore = runStoreOpts defaultSockPath def runStoreOpts :: FilePath -> StoreDir -> MonadStore a -> IO (Either String a, [Logger]) @@ -198,11 +202,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.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs new file mode 100644 index 0000000..23e327a --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize.hs @@ -0,0 +1,106 @@ +{-# OPTIONS_GHC -Wno-orphans #-} +{-| +Description : Serialize instances for complex types +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 + 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 = do + status <- get + errorMessage <- + (\em -> Data.Bool.bool (Just em) Nothing (Data.Text.null em)) + <$> get + 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 + +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 new file mode 100644 index 0000000..5bd10a1 --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs @@ -0,0 +1,188 @@ +{-| +Description : Nix-like serialization primitives +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 + +-- * 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 + Control.Monad.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 + Control.Monad.when (len `mod` 8 /= 0) $ do + pads <- unpad $ fromIntegral $ 8 - (len `mod` 8) + Control.Monad.unless + (all (== 0) pads) + $ fail $ "No zeroes" <> show (st, len, pads) + pure st + where unpad x = Control.Monad.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 + Control.Monad.when + (len `mod` 8 /= 0) + $ pad $ 8 - (len `mod` 8) + where + len :: Int + len = fromIntegral $ Data.ByteString.length x + pad count = Control.Monad.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 = Data.Text.Encoding.decodeUtf8 <$> getByteString + +-- | Serialize @Text@ +putText :: Putter Text +putText = putByteString . Data.Text.Encoding.encodeUtf8 + +-- | Deserialize a list of @Text@s +getTexts :: Get [Text] +getTexts = fmap Data.Text.Encoding.decodeUtf8 <$> getByteStrings + +-- | Serialize a list of @Text@s +putTexts :: (Functor f, Foldable f) => Putter (f Text) +putTexts = putByteStrings . fmap Data.Text.Encoding.encodeUtf8 + +-- * StorePath + +-- | Deserialize @StorePath@, checking +-- that @StoreDir@ matches expected value +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 = + putByteString + . System.Nix.StorePath.storePathToRawFilePath storeDir + +-- | Deserialize a @HashSet@ of @StorePath@s +getPaths :: StoreDir -> Get (HashSet (Either InvalidPathError 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/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 8692a1c..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 @@ -69,7 +76,7 @@ sockGetPath = do sd <- getStoreDir pth <- getSocketIncremental (getPath sd) either - throwError + (throwError . show) pure pth @@ -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 @@ -106,7 +113,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) @@ -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) 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..44f62e3 --- /dev/null +++ b/hnix-store-remote/tests/SerializeSpec.hs @@ -0,0 +1,159 @@ +{-# LANGUAGE NumericUnderscores #-} +module SerializeSpec where + +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.Text (Text) +import Data.Time (NominalDiffTime) +import Test.Hspec (Spec, describe, it, shouldBe) +import Test.Tasty.QuickCheck +import Test.QuickCheck.Instances () + +import qualified Data.Either +import qualified Data.HashSet +import qualified Data.Time.Clock.POSIX +import qualified System.Nix.Build + +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 (getDerivation, putDerivation) +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 + 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) + (Data.Either.fromRight undefined <$> getPath sd) + +prop_paths :: StoreDir -> HashSet StorePath -> Property +prop_paths = \sd -> + roundTrip + (putPaths 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 + +-- ** BuildStatus + +prop_buildStatus :: BuildStatus -> Property +prop_buildStatus = roundTripS + +-- ** 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 + 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 + 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 })