From 1f862114c67b7f1a203a1951d93c2cfa256f4257 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Fri, 29 May 2020 14:40:53 +0200 Subject: [PATCH 1/8] simple store path root, remote store rework Closes #15, #16, #21, #22, #62. --- hnix-store-core/hnix-store-core.cabal | 8 +- hnix-store-core/src/System/Nix/Build.hs | 55 +++ .../src/System/Nix/Internal/StorePath.hs | 198 ++++++----- .../src/System/Nix/ReadonlyStore.hs | 21 +- hnix-store-core/src/System/Nix/StorePath.hs | 13 +- .../src/System/Nix/StorePathMetadata.hs | 11 +- hnix-store-core/src/System/Nix/Util.hs | 48 --- hnix-store-core/tests/Arbitrary.hs | 20 ++ hnix-store-core/tests/StorePath.hs | 29 ++ hnix-store-remote/hnix-store-remote.cabal | 47 ++- .../src/System/Nix/Store/Remote.hs | 327 +++++++++++++++++- .../src/System/Nix/Store/Remote/Binary.hs | 55 +++ .../src/System/Nix/Store/Remote/Builders.hs | 48 +++ .../src/System/Nix/Store/Remote/Logger.hs | 22 +- .../src/System/Nix/Store/Remote/Parsers.hs | 64 ++++ .../src/System/Nix/Store/Remote/Protocol.hs | 59 +++- .../src/System/Nix/Store/Remote/Types.hs | 48 ++- .../src/System/Nix/Store/Remote/Util.hs | 134 +++++-- hnix-store-remote/tests/Driver.hs | 8 + hnix-store-remote/tests/NixDaemon.hs | 296 ++++++++++++++++ 20 files changed, 1281 insertions(+), 230 deletions(-) create mode 100644 hnix-store-core/src/System/Nix/Build.hs delete mode 100644 hnix-store-core/src/System/Nix/Util.hs create mode 100644 hnix-store-core/tests/StorePath.hs create mode 100644 hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs create mode 100644 hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs create mode 100644 hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs create mode 100644 hnix-store-remote/tests/Driver.hs create mode 100644 hnix-store-remote/tests/NixDaemon.hs diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index 5ab9d86a..74915eda 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -18,6 +18,7 @@ cabal-version: >=1.10 library exposed-modules: System.Nix.Base32 + , System.Nix.Build , System.Nix.Hash , System.Nix.Internal.Base32 , System.Nix.Internal.Hash @@ -28,8 +29,8 @@ library , System.Nix.Signature , System.Nix.StorePath , System.Nix.StorePathMetadata - , System.Nix.Util build-depends: base >=4.10 && <5 + , attoparsec , base16-bytestring , bytestring , binary @@ -42,8 +43,6 @@ library , filepath , hashable , mtl - , regex-base - , regex-tdfa >= 1.3.1.0 , saltine , time , text @@ -67,16 +66,19 @@ test-suite format-tests Arbitrary NarFormat Hash + StorePath hs-source-dirs: tests build-depends: hnix-store-core + , attoparsec , base , base16-bytestring , base64-bytestring , binary , bytestring , containers + , filepath , directory , process , tasty diff --git a/hnix-store-core/src/System/Nix/Build.hs b/hnix-store-core/src/System/Nix/Build.hs new file mode 100644 index 00000000..2f863d62 --- /dev/null +++ b/hnix-store-core/src/System/Nix/Build.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE RecordWildCards #-} +{-| +Description : Build related types +Maintainer : srk +|-} +module System.Nix.Build ( + BuildMode(..) + , BuildStatus(..) + , BuildResult(..) + , buildSuccess + ) where + +import Data.Time (UTCTime) +import Data.Text (Text) +import Data.HashSet (HashSet) + +-- keep the order of these Enums to match enums from reference implementations +-- src/libstore/store-api.hh +data BuildMode = Normal | Repair | Check + deriving (Eq, Ord, Enum, Show) + +data BuildStatus = + Built + | Substituted + | AlreadyValid + | PermanentFailure + | InputRejected + | OutputRejected + | TransientFailure -- possibly transient + | CachedFailure -- no longer used + | TimedOut + | MiscFailure + | DependencyFailed + | LogLimitExceeded + | NotDeterministic + deriving (Eq, Ord, Enum, Show) + + +-- | Result of the build +data BuildResult = BuildResult + { -- | build status, MiscFailure should be default + status :: !BuildStatus + , -- | possible build error message + errorMessage :: !(Maybe Text) + , -- | How many times this build was performed + timesBuilt :: !Integer + , -- | If timesBuilt > 1, whether some builds did not produce the same result + isNonDeterministic :: !Bool + , -- Start time of this build + startTime :: !UTCTime + , -- Stop time of this build + stopTime :: !UTCTime + } deriving (Eq, Ord, Show) + +buildSuccess BuildResult{..} = status == Built || status == Substituted || status == AlreadyValid diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 5a070ecb..78f06497 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -16,20 +16,28 @@ import System.Nix.Hash ( HashAlgorithm(Truncated, SHA256) , Digest , encodeBase32 + , decodeBase32 , SomeNamedDigest ) -import Text.Regex.Base.RegexLike (makeRegex, matchTest) -import Text.Regex.TDFA.Text (Regex) +import System.Nix.Internal.Base32 (digits32) + import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) +import qualified Data.Text as T import GHC.TypeLits (Symbol, KnownSymbol, symbolVal) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BC +import qualified Data.Char import Data.Hashable (Hashable(..)) import Data.HashSet (HashSet) import Data.Proxy (Proxy(..)) +import Data.Attoparsec.Text.Lazy (Parser, ()) + +import qualified Data.Attoparsec.Text.Lazy +import qualified System.FilePath + -- | A path in a Nix store. -- -- From the Nix thesis: A store path is the full path of a store @@ -39,7 +47,7 @@ import Data.Proxy (Proxy(..)) -- -- See the 'StoreDir' haddocks for details on why we represent this at -- the type level. -data StorePath (storeDir :: StoreDir) = StorePath +data StorePath = StorePath { -- | The 160-bit hash digest reflecting the "address" of the name. -- Currently, this is a truncated SHA256 hash. storePathHash :: !(Digest StorePathHashAlgo) @@ -47,12 +55,17 @@ data StorePath (storeDir :: StoreDir) = StorePath -- this is typically the package name and version (e.g. -- hello-1.2.3). storePathName :: !StorePathName + , -- | Root of the store + storePathRoot :: !FilePath } deriving (Eq, Ord) -instance Hashable (StorePath storeDir) where +instance Hashable StorePath where hashWithSalt s (StorePath {..}) = s `hashWithSalt` storePathHash `hashWithSalt` storePathName +instance Show StorePath where + show p = BC.unpack $ storePathToRawFilePath p + -- | The name portion of a Nix path. -- -- 'unStorePathName' must only contain a-zA-Z0-9+._?=-, can't start @@ -67,7 +80,7 @@ newtype StorePathName = StorePathName type StorePathHashAlgo = 'Truncated 20 'SHA256 -- | A set of 'StorePath's. -type StorePathSet storeDir = HashSet (StorePath storeDir) +type StorePathSet = HashSet StorePath -- | 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 @@ -99,72 +112,30 @@ data NarHashMode -- file if so desired. Recursive --- | A type-level representation of the root directory of a Nix store. --- --- The extra complexity of type indices requires justification. --- Fundamentally, this boils down to the fact that there is little --- meaningful sense in which 'StorePath's rooted at different --- directories are of the same type, i.e. there are few if any --- non-trivial non-contrived functions or data types that could --- equally well accept 'StorePath's from different stores. In current --- practice, any real application dealing with Nix stores (including, --- in particular, the Nix expression language) only operates over one --- store root and only cares about 'StorePath's belonging to that --- root. One could imagine a use case that cares about multiple store --- roots at once (e.g. the normal \/nix\/store along with some private --- store at \/root\/nix\/store to contain secrets), but in that case --- distinguishing 'StorePath's that belong to one store or the other --- is even /more/ critical: Most operations will only be correct over --- one of the stores or another, and it would be an error to mix and --- match (e.g. a 'StorePath' in one store could not legitimately refer --- to one in another). --- --- As of @5886bc5996537fbf00d1fcfbb29595b8ccc9743e@, the C++ Nix --- codebase contains 30 separate places where we assert that a given --- store dir is, in fact, in the store we care about; those run-time --- assertions could be completely removed if we had stronger types --- there. Moreover, there are dozens of other cases where input coming --- from the user, from serializations, etc. is parsed and then --- required to be in the appropriate store; this case is the --- equivalent of an existentially quantified version of 'StorePath' --- and, notably, requiring at runtime that the index matches the --- ambient store directory we're working in. In every case where a --- path is treated as a store path, there is exactly one legitimate --- candidate for the store directory it belongs to. --- --- It may be instructive to consider the example of "chroot stores". --- Since Nix 2.0, it has been possible to have a store actually live --- at one directory (say, $HOME\/nix\/store) with a different --- effective store directory (say, \/nix\/store). Nix can build into --- a chroot store by running the builds in a mount namespace where the --- store is at the effective store directory, can download from a --- binary cache containing paths for the effective store directory, --- and can run programs in the store that expect to be living at the --- effective store directory (via nix run). When viewed as store paths --- (rather than random files in the filesystem), paths in a chroot --- store have nothing in common with paths in a non-chroot store that --- lives in the same directory, and a lot in common with paths in a --- non-chroot store that lives in the effective store directory of the --- store in question. Store paths in stores with the same effective --- store directory share the same hashing scheme, can be copied --- between each other, etc. Store paths in stores with different --- effective store directories have no relationship to each other that --- they don't have to arbitrary other files. -type StoreDir = Symbol - --- | Smart constructor for 'StorePathName' that ensures the underlying --- content invariant is met. -makeStorePathName :: Text -> Maybe StorePathName -makeStorePathName n = case matchTest storePathNameRegex n of - True -> Just $ StorePathName n - False -> Nothing - --- | Regular expression to match valid store path names. -storePathNameRegex :: Regex -storePathNameRegex = makeRegex r - where - r :: String - r = "[a-zA-Z0-9\\+\\-\\_\\?\\=][a-zA-Z0-9\\+\\-\\.\\_\\?\\=]*" +makeStorePathName :: Text -> Either String StorePathName +makeStorePathName n = case validStorePathName n of + True -> Right $ StorePathName n + False -> Left $ reasonInvalid n + +reasonInvalid :: Text -> String +reasonInvalid n | n == "" = "Empty name" +reasonInvalid n | (T.length n > 211) = "Path too long" +reasonInvalid n | (T.head n == '.') = "Leading dot" +reasonInvalid n | otherwise = "Invalid character" + +validStorePathName :: Text -> Bool +validStorePathName "" = False +validStorePathName n = (T.length n <= 211) + && T.head n /= '.' + && T.all validStorePathNameChar n + +validStorePathNameChar :: Char -> Bool +validStorePathNameChar c = any ($ c) $ + [ Data.Char.isAsciiLower -- 'a'..'z' + , Data.Char.isAsciiUpper -- 'A'..'Z' + , Data.Char.isDigit + ] ++ + map (==) "+-._?=" -- | Copied from @RawFilePath@ in the @unix@ package, duplicated here -- to avoid the dependency. @@ -172,10 +143,9 @@ type RawFilePath = ByteString -- | Render a 'StorePath' as a 'RawFilePath'. storePathToRawFilePath - :: forall storeDir . (KnownStoreDir storeDir) - => StorePath storeDir + :: StorePath -> RawFilePath -storePathToRawFilePath (StorePath {..}) = BS.concat +storePathToRawFilePath StorePath {..} = BS.concat [ root , "/" , hashPart @@ -183,19 +153,75 @@ storePathToRawFilePath (StorePath {..}) = BS.concat , name ] where - root = storeDirVal @storeDir + root = BC.pack storePathRoot hashPart = encodeUtf8 $ encodeBase32 storePathHash name = encodeUtf8 $ unStorePathName storePathName --- | Get a value-level representation of a 'KnownStoreDir' -storeDirVal :: forall storeDir . (KnownStoreDir storeDir) - => ByteString -storeDirVal = BC.pack $ symbolVal @storeDir Proxy +-- | Render a 'StorePath' as a 'FilePath'. +storePathToFilePath + :: StorePath + -> FilePath +storePathToFilePath = BC.unpack . storePathToRawFilePath --- | A 'StoreDir' whose value is known at compile time. --- --- A valid instance of 'KnownStoreDir' should represent a valid path, --- i.e. all "characters" fit into bytes (as determined by the logic of --- 'BC.pack') and there are no 0 "characters". Currently this is not --- enforced, but it should be. -type KnownStoreDir = KnownSymbol +-- | Render a 'StorePath' as a 'Text'. +storePathToText + :: StorePath + -> Text +storePathToText = T.pack . BC.unpack . storePathToRawFilePath + +-- | Build `narinfo` suffix from `StorePath` which +-- can be used to query binary caches. +storePathToNarInfo + :: StorePath + -> BC.ByteString +storePathToNarInfo StorePath {..} = BS.concat + [ encodeUtf8 $ encodeBase32 storePathHash + , ".narinfo" + ] + +-- | Parse `StorePath` from `BC.ByteString`, checking +-- that store directory matches `expectedRoot`. +parsePath + :: FilePath + -> BC.ByteString + -> Either String StorePath +parsePath expectedRoot x = + let + (rootDir, fname) = System.FilePath.splitFileName . BC.unpack $ x + (digestPart, namePart) = T.breakOn "-" $ T.pack fname + digest = decodeBase32 digestPart + name = makeStorePathName . T.drop 1 $ namePart + --rootDir' = dropTrailingPathSeparator rootDir + -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b + rootDir' = init rootDir + storeDir = if expectedRoot == rootDir' + then Right rootDir' + else Left $ unwords $ [ "Root store dir mismatch, expected", expectedRoot, "got", rootDir'] + in + StorePath <$> digest <*> name <*> storeDir + +pathParser :: FilePath -> Parser StorePath +pathParser expectedRoot = do + Data.Attoparsec.Text.Lazy.string (T.pack expectedRoot) + "Store root mismatch" -- e.g. /nix/store + + Data.Attoparsec.Text.Lazy.char '/' + "Expecting path separator" + + digest <- decodeBase32 + <$> Data.Attoparsec.Text.Lazy.takeWhile1 (\c -> c `elem` digits32) + "Invalid Base32 part" + + Data.Attoparsec.Text.Lazy.char '-' + "Expecting dash (path name separator)" + + c0 <- Data.Attoparsec.Text.Lazy.satisfy (\c -> c /= '.' && validStorePathNameChar c) + "Leading path name character is a dot or invalid character" + + rest <- Data.Attoparsec.Text.Lazy.takeWhile validStorePathNameChar + "Path name contains invalid character" + + let name = makeStorePathName $ T.cons c0 rest + + either fail return + $ StorePath <$> digest <*> name <*> pure expectedRoot diff --git a/hnix-store-core/src/System/Nix/ReadonlyStore.hs b/hnix-store-core/src/System/Nix/ReadonlyStore.hs index d551f89d..21e9c609 100644 --- a/hnix-store-core/src/System/Nix/ReadonlyStore.hs +++ b/hnix-store-core/src/System/Nix/ReadonlyStore.hs @@ -6,36 +6,37 @@ module System.Nix.ReadonlyStore where import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import qualified Data.Text as T import qualified Data.HashSet as HS import Data.Text.Encoding import System.Nix.Hash import System.Nix.StorePath -makeStorePath :: forall storeDir hashAlgo . (KnownStoreDir storeDir, NamedAlgo hashAlgo) => ByteString -> Digest hashAlgo -> StorePathName -> StorePath storeDir -makeStorePath ty h nm = StorePath storeHash nm +makeStorePath :: forall hashAlgo . (NamedAlgo hashAlgo) => FilePath -> ByteString -> Digest hashAlgo -> StorePathName -> StorePath +makeStorePath fp ty h nm = StorePath storeHash nm fp where s = BS.intercalate ":" [ ty , encodeUtf8 $ algoName @hashAlgo , encodeUtf8 $ encodeBase16 h - , storeDirVal @storeDir + , encodeUtf8 $ T.pack fp , encodeUtf8 $ unStorePathName nm ] storeHash = hash s -makeTextPath :: (KnownStoreDir storeDir) => StorePathName -> Digest 'SHA256 -> StorePathSet storeDir -> StorePath storeDir -makeTextPath nm h refs = makeStorePath ty h nm +makeTextPath :: FilePath -> StorePathName -> Digest 'SHA256 -> StorePathSet -> StorePath +makeTextPath fp nm h refs = makeStorePath fp ty h nm where ty = BS.intercalate ":" ("text" : map storePathToRawFilePath (HS.toList refs)) -makeFixedOutputPath :: forall storeDir hashAlgo. (KnownStoreDir storeDir, ValidAlgo hashAlgo, NamedAlgo hashAlgo) => Bool -> Digest hashAlgo -> StorePathName -> StorePath storeDir -makeFixedOutputPath recursive h nm = - makeStorePath ty h' nm +makeFixedOutputPath :: forall hashAlgo. (ValidAlgo hashAlgo, NamedAlgo hashAlgo) => FilePath -> Bool -> Digest hashAlgo -> StorePathName -> StorePath +makeFixedOutputPath fp recursive h nm = + makeStorePath fp ty h' nm where (ty, h') = if recursive && algoName @hashAlgo == algoName @'SHA256 then ("source", h) else ("output:out", hash ("fixed:out:" <> encodeUtf8 (encodeBase16 h) <> ":")) -computeStorePathForText :: (KnownStoreDir storeDir) => StorePathName -> ByteString -> StorePathSet storeDir -> StorePath storeDir -computeStorePathForText nm s refs = makeTextPath nm (hash s) refs +computeStorePathForText :: FilePath -> StorePathName -> ByteString -> StorePathSet -> StorePath +computeStorePathForText fp nm s refs = makeTextPath fp nm (hash s) refs diff --git a/hnix-store-core/src/System/Nix/StorePath.hs b/hnix-store-core/src/System/Nix/StorePath.hs index eddb34fc..9ae47637 100644 --- a/hnix-store-core/src/System/Nix/StorePath.hs +++ b/hnix-store-core/src/System/Nix/StorePath.hs @@ -7,17 +7,20 @@ module System.Nix.StorePath , StorePathName , StorePathSet , StorePathHashAlgo - , StoreDir , ContentAddressableAddress(..) , NarHashMode(..) , -- * Manipulating 'StorePathName' makeStorePathName , unStorePathName - , storePathNameRegex + , validStorePathName , -- * Rendering out 'StorePath's - storePathToRawFilePath - , storeDirVal - , KnownStoreDir + storePathToFilePath + , storePathToRawFilePath + , storePathToText + , storePathToNarInfo + , -- * Parsing 'StorePath's + parsePath + , pathParser ) where import System.Nix.Internal.StorePath diff --git a/hnix-store-core/src/System/Nix/StorePathMetadata.hs b/hnix-store-core/src/System/Nix/StorePathMetadata.hs index 1179fbb6..a772814a 100644 --- a/hnix-store-core/src/System/Nix/StorePathMetadata.hs +++ b/hnix-store-core/src/System/Nix/StorePathMetadata.hs @@ -10,18 +10,18 @@ import Data.Time (UTCTime) import Data.Word (Word64) import System.Nix.Signature (NarSignature) --- | Metadata about a 'StorePath' in @storeDir@. -data StorePathMetadata storeDir = StorePathMetadata +-- | Metadata about a 'StorePath' +data StorePathMetadata = StorePathMetadata { -- | The path this metadata is about - path :: !(StorePath storeDir) + path :: !StorePath , -- | The path to the derivation file that built this path, if any -- and known. - deriverPath :: !(Maybe (StorePath storeDir)) + deriverPath :: !(Maybe StorePath) , -- TODO should this be optional? -- | The hash of the nar serialization of the path. narHash :: !SomeNamedDigest , -- | The paths that this path directly references - references :: !(StorePathSet storeDir) + references :: !StorePathSet , -- | When was this path registered valid in the store? registrationTime :: !UTCTime , -- | The size of the nar serialization of the path, in bytes. @@ -47,3 +47,4 @@ data StorePathTrust | -- | It was built elsewhere (and substituted or similar) and so -- is less trusted BuiltElsewhere + deriving (Show, Eq) diff --git a/hnix-store-core/src/System/Nix/Util.hs b/hnix-store-core/src/System/Nix/Util.hs deleted file mode 100644 index 62a17ab5..00000000 --- a/hnix-store-core/src/System/Nix/Util.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-| -Description : Utilities for packing stuff -Maintainer : srk -|-} -module System.Nix.Util where - -import Control.Monad -import Data.Binary.Get -import Data.Binary.Put -import qualified Data.ByteString.Lazy as LBS - -putInt :: Integral a => a -> Put -putInt = putWord64le . fromIntegral - -getInt :: Integral a => Get a -getInt = fromIntegral <$> getWord64le - --- length prefixed string packing with padding to 8 bytes -putByteStringLen :: LBS.ByteString -> Put -putByteStringLen x = do - putInt $ fromIntegral $ len - putLazyByteString x - when (len `mod` 8 /= 0) $ - pad $ fromIntegral $ 8 - (len `mod` 8) - where len = LBS.length x - pad x = forM_ (take x $ cycle [0]) putWord8 - -putByteStrings :: Foldable t => t LBS.ByteString -> Put -putByteStrings xs = do - putInt $ fromIntegral $ length xs - mapM_ putByteStringLen xs - -getByteStringLen :: Get LBS.ByteString -getByteStringLen = do - len <- getInt - st <- getLazyByteString 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) - return st - where unpad x = sequence $ replicate x getWord8 - -getByteStrings :: Get [LBS.ByteString] -getByteStrings = do - count <- getInt - res <- sequence $ replicate count getByteStringLen - return res - diff --git a/hnix-store-core/tests/Arbitrary.hs b/hnix-store-core/tests/Arbitrary.hs index 758a3707..d36b525e 100644 --- a/hnix-store-core/tests/Arbitrary.hs +++ b/hnix-store-core/tests/Arbitrary.hs @@ -35,3 +35,23 @@ instance Arbitrary (Digest StorePathHashAlgo) where instance Arbitrary (Digest SHA256) where arbitrary = hash . BSC.pack <$> arbitrary + +newtype NixLike = NixLike {getNixLike :: StorePath} + deriving (Eq, Ord, Show) + +instance Arbitrary (NixLike) where + arbitrary = NixLike <$> + (StorePath + <$> arbitraryTruncatedDigest + <*> arbitrary + <*> pure "/nix/store") + where + -- 160-bit hash, 20 bytes, 32 chars in base32 + arbitraryTruncatedDigest = Digest . BSC.pack + <$> replicateM 20 genSafeChar + +instance Arbitrary StorePath where + arbitrary = StorePath + <$> arbitrary + <*> arbitrary + <*> dir diff --git a/hnix-store-core/tests/StorePath.hs b/hnix-store-core/tests/StorePath.hs new file mode 100644 index 00000000..b723362e --- /dev/null +++ b/hnix-store-core/tests/StorePath.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module StorePath where + +import qualified Data.Attoparsec.Text.Lazy + +import Test.Tasty.QuickCheck + +import System.Nix.StorePath +import Arbitrary + +-- | Test that Nix(OS) like paths roundtrip +prop_storePathRoundtrip (_ :: NixLike) = \(NixLike x) -> + (parsePath "/nix/store" $ storePathToRawFilePath x) === Right x + +-- | Test that any `StorePath` roundtrips +prop_storePathRoundtrip' x = + (parsePath (storePathRoot x) $ storePathToRawFilePath x) === Right x + +prop_storePathRoundtripParser (_ :: NixLike) = \(NixLike x) -> + (Data.Attoparsec.Text.Lazy.parseOnly (pathParser (storePathRoot x)) + $ storePathToText x) === Right x + +prop_storePathRoundtripParser' x = + (Data.Attoparsec.Text.Lazy.parseOnly (pathParser (storePathRoot x)) + $ storePathToText x) === Right x diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index 780e39b7..23b1988e 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -15,26 +15,65 @@ cabal-version: >=1.10 library exposed-modules: System.Nix.Store.Remote + , System.Nix.Store.Remote.Binary + , 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 build-depends: base >=4.10 && <5 - , base64-bytestring + , attoparsec , bytestring , binary , bytestring , containers + , filepath , text , unix , network , mtl , unordered-containers --- , pretty-simple --- , base16-bytestring --- , base32-bytestring + , filepath + , time , hnix-store-core + , vector hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall + +test-suite hnix-store-remote-tests + ghc-options: -rtsopts -fprof-auto + type: exitcode-stdio-1.0 + main-is: Driver.hs + other-modules: + NixDaemon + hs-source-dirs: tests + build-depends: + attoparsec + , hnix-store-core + , hnix-store-remote + , base + , base64-bytestring + , binary + , bytestring + , containers + , directory + , process + , filepath + , hspec-expectations-lifted + , tasty + , tasty-discover + , tasty-hspec + , tasty-hunit + , tasty-quickcheck + , linux-namespaces + , mtl + , temporary + , text + , time + , unix + , unordered-containers + , vector + 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 0c25cc4e..c32519fe 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -4,29 +4,342 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-} -module System.Nix.Store.Remote ( - runStore - , syncWithGC +{-# LANGUAGE RecordWildCards #-} +module System.Nix.Store.Remote + ( + addToStore + , addToStoreNar + , addTextToStore + , addSignatures + , addIndirectRoot + , addTempRoot + , buildPaths + , ensurePath + , findRoots + , isValidPathUncached + , queryValidPaths + , queryAllValidPaths + , querySubstitutablePaths + , queryPathInfoUncached + , queryReferrers + , queryValidDerivers + , queryDerivationOutputs + , queryDerivationOutputNames + , queryPathFromHashPart + , queryMissing , optimiseStore + , runStore + , syncWithGC , verifyStore - ) where + ) + where + +import Control.Monad (void, unless, when) +import Data.ByteString.Lazy (ByteString) +import Data.Map.Strict (Map) +import Data.Text (Text) -import Control.Monad +import System.Nix.Build (BuildMode, BuildResult) +import System.Nix.Hash (Digest, NamedAlgo, ValidAlgo, SomeNamedDigest(..)) +import System.Nix.Nar (Nar) +import System.Nix.StorePath (StorePath, StorePathName, StorePathSet, StorePathHashAlgo) +import System.Nix.StorePathMetadata (StorePathMetadata(..), StorePathTrust(..)) +import qualified Control.Monad.IO.Class +import qualified Data.Binary.Put +import qualified Data.ByteString.Lazy +import qualified Data.Map.Strict +import qualified Data.Set +import qualified Data.Text.Encoding +import qualified Data.Text.Lazy + +import qualified System.Nix.Nar +import qualified System.Nix.Hash +import qualified System.Nix.StorePath +import qualified System.Nix.Store.Remote.Builders +import qualified System.Nix.Store.Remote.Parsers + +import System.Nix.Store.Remote.Binary import System.Nix.Store.Remote.Types import System.Nix.Store.Remote.Protocol import System.Nix.Store.Remote.Util type RepairFlag = Bool type CheckFlag = Bool +type CheckSigsFlag = Bool +type SubstituteFlag = Bool -syncWithGC :: MonadStore () -syncWithGC = void $ simpleOp SyncWithGC +-- | Pack `FilePath` as `Nar` and add it to the store. +addToStore :: forall a. (ValidAlgo a, NamedAlgo a) + => StorePathName -- ^ Name part of the newly created `StorePath` + -> FilePath -- ^ Local `FilePath` to add + -> Bool -- ^ Add target directory recursively + -> (FilePath -> Bool) -- ^ Path filter function + -> RepairFlag -- ^ Only used by local store backend + -> MonadStore StorePath +addToStore name pth recursive _pathFilter _repair = do + + nar :: ByteString <- Control.Monad.IO.Class.liftIO + $ Data.Binary.Put.runPut . System.Nix.Nar.putNar + <$> System.Nix.Nar.localPackNar System.Nix.Nar.narEffectsIO pth + + runOpArgs AddToStore $ do + putText $ System.Nix.StorePath.unStorePathName name + + putBool + $ not + $ System.Nix.Hash.algoName @a == "sha256" && recursive + + putBool recursive + + putText $ System.Nix.Hash.algoName @a + + Data.Binary.Put.putLazyByteString nar + + sockGetPath + +-- | Add `Nar` to the store. +-- +addToStoreNar :: StorePathMetadata + -> Nar + -> RepairFlag + -> CheckSigsFlag + -> MonadStore () +addToStoreNar StorePathMetadata{..} nar repair checkSigs = do + -- after the command, protocol asks for data via Read message + -- so we provide it here + let n = Data.Binary.Put.runPut $ System.Nix.Nar.putNar nar + setData n + + void $ runOpArgs AddToStoreNar $ do + putPath path + maybe (putText "") (putPath) deriverPath + let putNarHash :: SomeNamedDigest -> Data.Binary.Put.PutM () + putNarHash (SomeDigest hash) = putByteStringLen + $ Data.ByteString.Lazy.fromStrict + $ Data.Text.Encoding.encodeUtf8 + $ System.Nix.Hash.encodeBase32 hash + + putNarHash narHash + putPaths references + putTime registrationTime + + -- XXX: StorePathMetadata defines this as Maybe + -- `putInt 0` instead of error? + maybe (error "NO NAR BYTES") putInt narBytes + + putBool (trust == BuiltLocally) + + -- XXX: signatures need pubkey from config + putTexts [""] + + maybe + (putText "") + (putText + . Data.Text.Lazy.toStrict + . System.Nix.Store.Remote.Builders.buildContentAddressableAddress + -- this calls for changing the type of addToStoreNar + -- to forall a . (Valid/Named)Algo and a type app + @'System.Nix.Hash.SHA256 + ) + contentAddressableAddress + + putBool repair + putBool (not checkSigs) + +-- | Add text to store. +-- +-- Reference accepts repair but only uses it +-- to throw error in case of remote talking to nix-daemon. +addTextToStore :: Text -- ^ Name of the text + -> Text -- ^ Actual text to add + -> StorePathSet -- ^ Set of `StorePath`s that the added text references + -> RepairFlag -- ^ Repair flag, must be `False` in case of remote backend + -> MonadStore StorePath +addTextToStore name text references' repair = do + when repair $ error "repairing is not supported when building through the Nix daemon" + runOpArgs AddTextToStore $ do + putText name + putText text + putPaths references' + sockGetPath + +addSignatures :: StorePath + -> [ByteString] + -> MonadStore () +addSignatures p signatures = do + void $ simpleOpArgs AddSignatures $ do + putPath p + putByteStrings signatures + +addIndirectRoot :: StorePath -> MonadStore () +addIndirectRoot pn = do + void $ simpleOpArgs AddIndirectRoot $ putPath pn + +-- | Add temporary garbage collector root. +-- +-- This root is removed as soon as the client exits. +addTempRoot :: StorePath -> MonadStore () +addTempRoot pn = do + void $ simpleOpArgs AddTempRoot $ putPath pn + +-- | Build paths if they are an actual derivations. +-- +-- If derivation output paths are already valid, do nothing. +buildPaths :: StorePathSet + -> BuildMode + -> MonadStore () +buildPaths ps bm = do + void $ simpleOpArgs BuildPaths $ do + putPaths ps + putInt $ fromEnum bm + +ensurePath :: StorePath -> MonadStore () +ensurePath pn = do + void $ simpleOpArgs EnsurePath $ putPath pn + +-- | Find garbage collector roots. +findRoots :: MonadStore (Map ByteString StorePath) +findRoots = do + runOp FindRoots + sd <- getStoreDir + res <- getSocketIncremental + $ getMany + $ (,) <$> (Data.ByteString.Lazy.fromStrict <$> getByteStringLen) + <*> getPath sd + + r <- catRights res + return $ Data.Map.Strict.fromList r + where + catRights :: [(a, Either String b)] -> MonadStore [(a, b)] + catRights = mapM ex + + ex :: (a, Either [Char] b) -> MonadStore (a, b) + ex (x, Right y) = return (x, y) + ex (_x , Left e) = error $ "Unable to decode root: " ++ e + +isValidPathUncached :: StorePath -> MonadStore Bool +isValidPathUncached p = do + simpleOpArgs IsValidPath $ putPath p + +-- | Query valid paths from set, optionally try to use substitutes. +queryValidPaths :: StorePathSet -- ^ Set of `StorePath`s to query + -> SubstituteFlag -- ^ Try substituting missing paths when `True` + -> MonadStore StorePathSet +queryValidPaths ps substitute = do + runOpArgs QueryValidPaths $ do + putPaths ps + putBool substitute + sockGetPaths + +queryAllValidPaths :: MonadStore StorePathSet +queryAllValidPaths = do + runOp QueryAllValidPaths + sockGetPaths + +querySubstitutablePaths :: StorePathSet -> MonadStore StorePathSet +querySubstitutablePaths ps = do + runOpArgs QuerySubstitutablePaths $ do + putPaths ps + sockGetPaths + +queryPathInfoUncached :: forall a . NamedAlgo a + => StorePath + -> MonadStore StorePathMetadata +queryPathInfoUncached path = do + runOpArgs QueryPathInfo $ do + putPath path + + valid <- sockGetBool + unless valid $ error "Path is not valid" + + deriverPath <- sockGetPathMay + + narHashText <- Data.Text.Encoding.decodeUtf8 <$> sockGetStr + let narHash = case System.Nix.Hash.decodeBase32 narHashText of + Left e -> error e + Right x -> SomeDigest @a x + + references <- sockGetPaths + registrationTime <- sockGet getTime + narBytes <- Just <$> sockGetInt + ultimate <- sockGetBool + + _sigStrings <- map bsToText <$> sockGetStrings + caString <- sockGetStr + + let + -- XXX: signatures need pubkey from config + sigs = Data.Set.empty + + contentAddressableAddress = + case System.Nix.Store.Remote.Parsers.parseContentAddressableAddress @a caString of + Left e -> error e + Right x -> Just x + + trust = if ultimate then BuiltLocally + else BuiltElsewhere + + return $ StorePathMetadata {..} + +queryReferrers :: StorePath -> MonadStore StorePathSet +queryReferrers p = do + runOpArgs QueryReferrers $ do + putPath p + sockGetPaths + +queryValidDerivers :: StorePath -> MonadStore StorePathSet +queryValidDerivers p = do + runOpArgs QueryValidDerivers $ do + putPath p + sockGetPaths + +queryDerivationOutputs :: StorePath -> MonadStore StorePathSet +queryDerivationOutputs p = do + runOpArgs QueryDerivationOutputs $ + putPath p + sockGetPaths + +queryDerivationOutputNames :: StorePath -> MonadStore StorePathSet +queryDerivationOutputNames p = do + runOpArgs QueryDerivationOutputNames $ + putPath p + sockGetPaths + +queryPathFromHashPart :: Digest StorePathHashAlgo -> MonadStore StorePath +queryPathFromHashPart storePathHash = do + runOpArgs QueryPathFromHashPart $ + putByteStringLen + $ Data.ByteString.Lazy.fromStrict + $ Data.Text.Encoding.encodeUtf8 + $ System.Nix.Hash.encodeBase32 storePathHash + sockGetPath + +queryMissing :: StorePathSet + -> MonadStore ( StorePathSet -- Paths that will be built + , StorePathSet -- Paths that have substitutes + , StorePathSet -- Unknown paths + , Integer -- Download size + , Integer) -- Nar size? +queryMissing ps = do + runOpArgs QueryMissing $ do + putPaths ps + + willBuild <- sockGetPaths + willSubstitute <- sockGetPaths + unknown <- sockGetPaths + downloadSize' <- sockGetInt + narSize' <- sockGetInt + return (willBuild, willSubstitute, unknown, downloadSize', narSize') optimiseStore :: MonadStore () optimiseStore = void $ simpleOp OptimiseStore +syncWithGC :: MonadStore () +syncWithGC = void $ simpleOp SyncWithGC + -- returns True on errors verifyStore :: CheckFlag -> RepairFlag -> MonadStore Bool verifyStore check repair = simpleOpArgs VerifyStore $ do diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs new file mode 100644 index 00000000..f6c95ba7 --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs @@ -0,0 +1,55 @@ +{-| +Description : Utilities for packing stuff +Maintainer : srk +|-} +module System.Nix.Store.Remote.Binary where + +import Control.Monad +import Data.Binary.Get +import Data.Binary.Put +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as BSL + +putInt :: Integral a => a -> Put +putInt = putWord64le . fromIntegral + +getInt :: Integral a => Get a +getInt = fromIntegral <$> getWord64le + +putMany :: Foldable t => (a -> Put) -> t a -> Put +putMany printer xs = do + putInt (length xs) + mapM_ printer xs + +getMany :: Get a -> Get [a] +getMany parser = do + count <- getInt + replicateM count parser + +-- length prefixed string packing with padding to 8 bytes +putByteStringLen :: BSL.ByteString -> Put +putByteStringLen x = do + putInt len + putLazyByteString x + when (len `mod` 8 /= 0) $ + pad $ 8 - (len `mod` 8) + where + len :: Int + len = fromIntegral $ BSL.length x + pad count = sequence_ $ replicate count (putWord8 0) + +putByteStrings :: Foldable t => t BSL.ByteString -> Put +putByteStrings = putMany putByteStringLen + +getByteStringLen :: Get ByteString +getByteStringLen = do + len <- getInt + st <- getLazyByteString 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) + return $ BSL.toStrict st + where unpad x = sequence $ replicate x getWord8 + +getByteStrings :: Get [ByteString] +getByteStrings = getMany getByteStringLen diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs new file mode 100644 index 00000000..7009915e --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} + +module System.Nix.Store.Remote.Builders ( + buildContentAddressableAddress + ) where + +import Data.Text.Lazy (Text) +import System.Nix.Hash (Digest, NamedAlgo, SomeNamedDigest(SomeDigest)) +import System.Nix.StorePath (ContentAddressableAddress(..), NarHashMode(..)) + +import Data.Text.Lazy.Builder (Builder) +import qualified Data.Text.Lazy.Builder + +import qualified Data.Text +import qualified System.Nix.Hash + +-- | Marshall `ContentAddressableAddress` to `Text` +-- in form suitable for remote protocol usage. +buildContentAddressableAddress :: forall hashAlgo . NamedAlgo hashAlgo + => ContentAddressableAddress + -> Text +buildContentAddressableAddress = + Data.Text.Lazy.Builder.toLazyText . contentAddressableAddressBuilder @hashAlgo + +contentAddressableAddressBuilder :: forall hashAlgo . NamedAlgo hashAlgo + => ContentAddressableAddress + -> Builder +contentAddressableAddressBuilder (Text digest) = + "text:" + <> digestBuilder digest +contentAddressableAddressBuilder (Fixed narHashMode (SomeDigest digest)) = + "fixed:" + <> (Data.Text.Lazy.Builder.fromText $ System.Nix.Hash.algoName @hashAlgo) + <> buildNarHashMode narHashMode + <> digestBuilder digest + where + buildNarHashMode Recursive = "true" + buildNarHashMode RegularFile = "false" + +digestBuilder :: Digest a -> Builder +digestBuilder = + Data.Text.Lazy.Builder.fromText + . System.Nix.Hash.encodeBase32 + 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 36648453..f4bf690c 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs @@ -1,16 +1,20 @@ +{-# LANGUAGE RankNTypes #-} module System.Nix.Store.Remote.Logger ( Logger(..) , Field(..) , processOutput) where -import Control.Monad.Reader (ask, liftIO) +import Control.Monad.Except +import Control.Monad.Reader (ask) +import Control.Monad.State (get) import Data.Binary.Get import Network.Socket.ByteString (recv) +import System.Nix.Store.Remote.Binary import System.Nix.Store.Remote.Types -import System.Nix.Util +import System.Nix.Store.Remote.Util controlParser :: Get Logger controlParser = do @@ -34,12 +38,24 @@ processOutput = go decoder case ctrl of e@(Error _ _) -> return [e] Last -> return [Last] + Read _n -> do + (mdata, _) <- get + case mdata of + Nothing -> throwError "No data to read provided" + Just part -> do + -- XXX: we should check/assert part size against n of (Read n) + sockPut $ putByteStringLen part + clearData + + next <- go decoder + return $ next + -- we should probably handle Read here as well x -> do next <- go decoder return $ x:next go (Partial k) = do - soc <- ask + soc <- storeSocket <$> ask chunk <- liftIO (Just <$> recv soc 8) go (k chunk) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs new file mode 100644 index 00000000..97a2af23 --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} + +module System.Nix.Store.Remote.Parsers ( + parseContentAddressableAddress + ) where + +import Control.Applicative ((<|>)) +import Data.Attoparsec.ByteString.Char8 (Parser, ()) +import Data.ByteString (ByteString) +import System.Nix.Hash (Digest, NamedAlgo, SomeNamedDigest(SomeDigest)) +import System.Nix.StorePath (ContentAddressableAddress(..), NarHashMode(..)) + +import qualified Data.Attoparsec.ByteString.Char8 +import qualified Data.ByteString.Char8 +import qualified Data.Text + +import qualified System.Nix.Internal.Base32 +import qualified System.Nix.Hash + +-- | Parse `ContentAddressableAddress` from `ByteString` +parseContentAddressableAddress :: forall hashAlgo . NamedAlgo hashAlgo + => ByteString + -> Either String ContentAddressableAddress +parseContentAddressableAddress = + Data.Attoparsec.ByteString.Char8.parseOnly + (contentAddressableAddressParser @hashAlgo) + +-- | Parser for content addressable field +contentAddressableAddressParser :: forall hashAlgo . NamedAlgo hashAlgo + => Parser ContentAddressableAddress +contentAddressableAddressParser = + caText + <|> caFixed @hashAlgo + +-- | Parser for @text:sha256:@ +caText :: Parser ContentAddressableAddress +caText = do + _ <- "text:sha256:" + digest <- parseDigest + either fail return + $ Text <$> digest + +-- | Parser for @fixed:::@ +caFixed :: forall hashAlgo . NamedAlgo hashAlgo => Parser ContentAddressableAddress +caFixed = do + _ <- "fixed:" + narHashMode <- (pure Recursive <$> "true") <|> (pure RegularFile <$> "false") + "Invalid Base32 part" + digest <- parseDigest + + either fail return + $ Fixed <$> pure narHashMode <*> (SomeDigest @hashAlgo <$> digest) + +parseDigest :: forall a . Parser (Either String (Digest a)) +parseDigest = + System.Nix.Hash.decodeBase32 + . Data.Text.pack + . Data.ByteString.Char8.unpack + <$> Data.Attoparsec.ByteString.Char8.takeWhile1 + (\c -> c `elem` System.Nix.Internal.Base32.digits32) 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 e0e724cd..52f0dcb6 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs @@ -1,10 +1,14 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module System.Nix.Store.Remote.Protocol ( WorkerOp(..) , simpleOp , simpleOpArgs , runOp , runOpArgs - , runStore) where + , runStore + , runStoreOpts) where import Control.Exception (bracket) import Control.Monad.Except @@ -13,16 +17,17 @@ import Control.Monad.State import Data.Binary.Get import Data.Binary.Put -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Char8 +import qualified Data.ByteString.Lazy -import Network.Socket hiding (send, sendTo, recv, recvFrom) +import Network.Socket (SockAddr(SockAddrUnix)) +import qualified Network.Socket import Network.Socket.ByteString (recv) +import System.Nix.Store.Remote.Binary import System.Nix.Store.Remote.Logger import System.Nix.Store.Remote.Types import System.Nix.Store.Remote.Util -import System.Nix.Util protoVersion :: Int protoVersion = 0x115 @@ -34,8 +39,8 @@ workerMagic1 = 0x6e697863 workerMagic2 :: Int workerMagic2 = 0x6478696f -sockPath :: String -sockPath = "/nix/var/nix/daemon-socket/socket" +defaultSockPath :: String +defaultSockPath = "/nix/var/nix/daemon-socket/socket" data WorkerOp = IsValidPath @@ -118,7 +123,7 @@ simpleOpArgs op args = do case err of True -> do Error _num msg <- head <$> getError - throwError $ BSC.unpack $ LBS.toStrict msg + throwError $ Data.ByteString.Char8.unpack msg False -> do sockGetBool @@ -130,7 +135,7 @@ runOpArgs op args = do -- Temporary hack for printing the messages destined for nix-daemon socket when False $ - liftIO $ LBS.writeFile "mytestfile2" $ runPut $ do + liftIO $ Data.ByteString.Lazy.writeFile "mytestfile2" $ runPut $ do putInt $ opNum op args @@ -139,25 +144,38 @@ runOpArgs op args = do args out <- processOutput - modify (++out) + modify (\(a, b) -> (a, b++out)) err <- gotError when err $ do Error _num msg <- head <$> getError - throwError $ BSC.unpack $ LBS.toStrict msg + throwError $ Data.ByteString.Char8.unpack msg runStore :: MonadStore a -> IO (Either String a, [Logger]) -runStore code = do - bracket (open sockPath) close run +runStore = runStoreOpts defaultSockPath "/nix/store" + +runStoreOpts :: FilePath -> FilePath -> MonadStore a -> IO (Either String a, [Logger]) +runStoreOpts sockPath storeRootDir code = do + bracket (open sockPath) (Network.Socket.close . storeSocket) run where open path = do - soc <- socket AF_UNIX Stream 0 - connect soc (SockAddrUnix path) - return soc + soc <- + Network.Socket.socket + Network.Socket.AF_UNIX + Network.Socket.Stream + 0 + + Network.Socket.connect soc (SockAddrUnix path) + return $ StoreConfig { storeSocket = soc + , storeDir = storeRootDir } + greet = do sockPut $ putInt workerMagic1 - soc <- ask + soc <- storeSocket <$> ask vermagic <- liftIO $ recv soc 16 - let (magic2, daemonProtoVersion) = flip runGet (LBS.fromStrict vermagic) $ (,) <$> getInt <*> getInt + let (magic2, _daemonProtoVersion) = + flip runGet (Data.ByteString.Lazy.fromStrict vermagic) + $ (,) <$> (getInt :: Get Int) + <*> (getInt :: Get Int) unless (magic2 == workerMagic2) $ error "Worker magic 2 mismatch" sockPut $ putInt protoVersion -- clientVersion @@ -167,4 +185,7 @@ runStore code = do processOutput run sock = - flip runReaderT sock $ flip runStateT [] $ runExceptT (greet >> code) + fmap (\(res, (_data, logs)) -> (res, logs)) + $ flip runReaderT sock + $ flip runStateT (Nothing, []) + $ runExceptT (greet >> code) 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 eb2520cd..14a33add 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs @@ -1,20 +1,35 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} module System.Nix.Store.Remote.Types ( MonadStore + , StoreConfig(..) , Logger(..) , Field(..) + , getStoreDir , getLog , flushLog , gotError - , getError) where + , getError + , setData + , clearData + ) where -import qualified Data.ByteString.Lazy as LBS +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as BSL import Network.Socket (Socket) import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State -type MonadStore a = ExceptT String (StateT [Logger] (ReaderT Socket IO)) a +data StoreConfig = StoreConfig { + storeDir :: FilePath + , storeSocket :: Socket + } + +type MonadStore a = ExceptT String (StateT (Maybe BSL.ByteString, [Logger]) (ReaderT StoreConfig IO)) a type ActivityID = Int type ActivityParentID = Int @@ -22,16 +37,16 @@ type ActivityType = Int type Verbosity = Int type ResultType = Int -data Field = LogStr LBS.ByteString | LogInt Int +data Field = LogStr ByteString | LogInt Int deriving (Eq, Ord, Show) data Logger = - Next LBS.ByteString + Next ByteString | Read Int -- data needed from source - | Write LBS.ByteString -- data for sink + | Write ByteString -- data for sink | Last - | Error Int LBS.ByteString - | StartActivity ActivityID Verbosity ActivityType LBS.ByteString [Field] ActivityParentID + | Error Int ByteString + | StartActivity ActivityID Verbosity ActivityType ByteString [Field] ActivityParentID | StopActivity ActivityID | Result ActivityID ResultType [Field] deriving (Eq, Ord, Show) @@ -41,13 +56,22 @@ isError (Error _ _) = True isError _ = False gotError :: MonadStore Bool -gotError = any isError <$> get +gotError = any isError . snd <$> get getError :: MonadStore [Logger] -getError = filter isError <$> get +getError = filter isError . snd <$> get getLog :: MonadStore [Logger] -getLog = get +getLog = snd <$> get flushLog :: MonadStore () -flushLog = put [] +flushLog = modify (\(a, _b) -> (a, [])) + +setData :: BSL.ByteString -> MonadStore () +setData x = modify (\(_, b) -> (Just x, b)) + +clearData :: MonadStore () +clearData = modify (\(_, b) -> (Nothing, b)) + +getStoreDir :: MonadStore FilePath +getStoreDir = storeDir <$> ask 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 9717dc20..c38967ba 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs @@ -1,47 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RecordWildCards #-} module System.Nix.Store.Remote.Util where +import Control.Monad.Except import Control.Monad.Reader -import Data.Maybe +import Data.Either import Data.Binary.Get import Data.Binary.Put import Data.Text (Text) import qualified Data.Text as T -import qualified Data.ByteString as B +import Data.Time +import Data.Time.Clock.POSIX +import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Lazy as LBS -import qualified Data.HashSet as HashSet +import qualified Data.ByteString.Lazy as BSL import Network.Socket.ByteString (recv, sendAll) +import System.Nix.Build +import System.Nix.StorePath +import System.Nix.Store.Remote.Binary import System.Nix.Store.Remote.Types -import System.Nix.Hash -import System.Nix.Util +import qualified Data.HashSet +import qualified Data.Map -genericIncremental :: (MonadIO m) => m (Maybe B.ByteString) -> Get a -> m a +genericIncremental :: (MonadIO m) => m (Maybe ByteString) -> Get a -> m a genericIncremental getsome parser = go decoder - where decoder = runGetIncremental parser - go (Done _leftover _consumed x) = do - return x - go (Partial k) = do - chunk <- getsome - go (k chunk) - go (Fail _leftover _consumed msg) = do - error msg + where + decoder = runGetIncremental parser + go (Done _leftover _consumed x) = do + return x + go (Partial k) = do + chunk <- getsome + go (k chunk) + go (Fail _leftover _consumed msg) = do + error msg getSocketIncremental :: Get a -> MonadStore a -getSocketIncremental = genericIncremental sockGet +getSocketIncremental = genericIncremental sockGet8 + where + sockGet8 :: MonadStore (Maybe BSC.ByteString) + sockGet8 = do + soc <- storeSocket <$> ask + liftIO $ Just <$> recv soc 8 sockPut :: Put -> MonadStore () sockPut p = do - soc <- ask - liftIO $ sendAll soc $ LBS.toStrict $ runPut p + soc <- storeSocket <$> ask + liftIO $ sendAll soc $ BSL.toStrict $ runPut p -sockGet :: MonadStore (Maybe BSC.ByteString) -sockGet = do - soc <- ask - liftIO $ Just <$> recv soc 8 +sockGet :: Get a -> MonadStore a +sockGet = getSocketIncremental sockGetInt :: Integral a => MonadStore a sockGetInt = getSocketIncremental getInt @@ -49,18 +61,84 @@ sockGetInt = getSocketIncremental getInt sockGetBool :: MonadStore Bool sockGetBool = (== (1 :: Int)) <$> sockGetInt -sockGetStr :: MonadStore LBS.ByteString +sockGetStr :: MonadStore ByteString sockGetStr = getSocketIncremental getByteStringLen -sockGetStrings :: MonadStore [LBS.ByteString] +sockGetStrings :: MonadStore [ByteString] sockGetStrings = getSocketIncremental getByteStrings -lBSToText :: LBS.ByteString -> Text -lBSToText = T.pack . BSC.unpack . LBS.toStrict +sockGetPath :: MonadStore StorePath +sockGetPath = do + sd <- getStoreDir + pth <- getSocketIncremental (getPath sd) + case pth of + Left e -> throwError e + Right x -> return x -textToLBS :: Text -> LBS.ByteString -textToLBS = LBS.fromStrict . BSC.pack . T.unpack +sockGetPathMay :: MonadStore (Maybe StorePath) +sockGetPathMay = do + sd <- getStoreDir + pth <- getSocketIncremental (getPath sd) + return $ case pth of + Left _e -> Nothing + Right x -> Just x + +sockGetPaths :: MonadStore StorePathSet +sockGetPaths = do + sd <- getStoreDir + getSocketIncremental (getPaths sd) + +bsToText :: ByteString -> Text +bsToText = T.pack . BSC.unpack + +bslToText :: BSL.ByteString -> Text +bslToText = T.pack . BSC.unpack . BSL.toStrict + +textToBSL :: Text -> BSL.ByteString +textToBSL = BSL.fromStrict . BSC.pack . T.unpack + +putText :: Text -> Put +putText = putByteStringLen . textToBSL + +putTexts :: [Text] -> Put +putTexts = putByteStrings . (map textToBSL) + +getPath :: FilePath -> Get (Either String StorePath) +getPath sd = parsePath sd <$> getByteStringLen + +getPaths :: FilePath -> Get StorePathSet +getPaths sd = Data.HashSet.fromList . rights . map (parsePath sd) <$> getByteStrings + +putPath :: StorePath -> Put +putPath = putByteStringLen . BSL.fromStrict . storePathToRawFilePath + +putPaths :: StorePathSet -> Put +putPaths = putByteStrings . Data.HashSet.toList . Data.HashSet.map (BSL.fromStrict . storePathToRawFilePath) putBool :: Bool -> Put putBool True = putInt (1 :: Int) putBool False = putInt (0 :: Int) + +getBool :: Get Bool +getBool = (==1) <$> (getInt :: Get Int) + +putEnum :: (Enum a) => a -> Put +putEnum = putInt . fromEnum + +getEnum :: (Enum a) => Get a +getEnum = toEnum <$> getInt + +putTime :: UTCTime -> Put +putTime = (putInt :: Int -> Put) . round . utcTimeToPOSIXSeconds + +getTime :: Get UTCTime +getTime = posixSecondsToUTCTime <$> getEnum + +getBuildResult :: Get BuildResult +getBuildResult = BuildResult + <$> getEnum + <*> (Just . bsToText <$> getByteStringLen) + <*> getInt + <*> getBool + <*> getTime + <*> getTime diff --git a/hnix-store-remote/tests/Driver.hs b/hnix-store-remote/tests/Driver.hs new file mode 100644 index 00000000..604f0c43 --- /dev/null +++ b/hnix-store-remote/tests/Driver.hs @@ -0,0 +1,8 @@ +import Test.Tasty.Hspec +import NixDaemon + +-- we run remote tests in +-- Linux namespaces to avoid interacting with systems store +main = do + enterNamespaces + hspec spec_protocol diff --git a/hnix-store-remote/tests/NixDaemon.hs b/hnix-store-remote/tests/NixDaemon.hs new file mode 100644 index 00000000..c0fe4142 --- /dev/null +++ b/hnix-store-remote/tests/NixDaemon.hs @@ -0,0 +1,296 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module NixDaemon where + +import Prelude +import Control.Monad +import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Exception (bracket) +import Control.Concurrent (threadDelay) +import Data.Either (isRight, isLeft, fromRight) +import Data.Binary.Put +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64.Lazy as B64 +import qualified Data.ByteString.Lazy as BSL +import Data.Monoid ((<>)) +import Data.Maybe (fromJust) +import Data.Proxy +import Data.Time +import qualified Data.Text as T +import qualified Data.Text.Lazy.Builder +import qualified Data.HashSet as HS +import qualified Data.Map.Strict as M +import qualified Data.Set as S +import qualified Data.Vector as V +import System.Directory +import qualified System.Environment +import System.IO.Temp +import qualified System.IO as IO (hGetContents, hPutStr, openFile) +import qualified System.Process as P +import System.Posix.User as U +import System.Linux.Namespaces as NS +import Test.Tasty as T +import Test.Tasty.Hspec (Spec, HasCallStack, describe, context) +import qualified Test.Tasty.Hspec as Hspec +import Test.Hspec.Expectations.Lifted +import qualified Test.Tasty.HUnit as HU +import Test.Tasty.QuickCheck +import Text.Read (readMaybe) + +import System.FilePath + +import System.Nix.Build +import System.Nix.Hash +import System.Nix.StorePath +import System.Nix.ReadonlyStore +import System.Nix.Nar +import qualified System.Nix.StorePathMetadata as VP +import System.Nix.Store.Remote +import System.Nix.Store.Remote.Logger +import System.Nix.Store.Remote.Types +import System.Nix.Store.Remote.Protocol +import System.Nix.Store.Remote.Util + + +createProcessEnv :: FilePath + -> String + -> [String] + -> IO P.ProcessHandle +createProcessEnv fp proc args = do + mPath <- System.Environment.lookupEnv "PATH" + + (_, _, _, ph) <- P.createProcess (P.proc proc args) { P.cwd = Just $ fp + , P.env = Just $ mockedEnv mPath fp } + return ph + +mockedEnv :: Maybe String -> FilePath -> [(String, FilePath)] +mockedEnv mEnvPath fp = map (\(a, b) -> (a, b)) [ + ("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") +-- , ("NIX_REMOTE", "daemon") + ] ++ (maybe [] (\x -> [("PATH", x)]) mEnvPath) + +waitSocket :: FilePath -> Int -> IO () +waitSocket fp 0 = fail "No socket" +waitSocket fp x = do + ex <- doesFileExist fp + case ex of + True -> return () + False -> threadDelay 100000 >> waitSocket fp (x - 1) + +writeConf fp = do + writeFile fp $ unlines [ + "build-users-group = " + , "trusted-users = root" + , "allowed-users = *" + , "fsync-metadata = false" + ] + +{- + - we run in user namespace as root but groups are failed + - => build-users-group has to be empty but we still + - get an error (maybe older nix-daemon) + - +uid=0(root) gid=65534(nobody) groups=65534(nobody) + +drwxr-xr-x 3 0 65534 60 Nov 29 05:53 store + +accepted connection from pid 22959, user root (trusted) +error: changing ownership of path '/run/user/1000/test-nix-store-06b0d249e5616122/store': Invalid argument +-} + +startDaemon :: FilePath -> IO (P.ProcessHandle, MonadStore a -> IO (Either String a, [Logger])) +startDaemon fp = do + writeConf (fp "etc" "nix.conf") + p <- createProcessEnv fp "nix-daemon" [] + waitSocket sockFp 30 + return (p, runStoreOpts sockFp (fp "store")) + where + sockFp = fp "var/nix/daemon-socket/socket" + +enterNamespaces = do + uid <- getEffectiveUserID + gid <- getEffectiveGroupID + + unshare [User, Network, Mount] + -- map our (parent) uid to root + writeUserMappings Nothing [UserMapping 0 uid 1] + -- map our (parent) gid to root group + writeGroupMappings Nothing [GroupMapping 0 gid 1] True + +withNixDaemon action = do + withSystemTempDirectory "test-nix-store" $ \path -> do + + mapM_ (createDirectory . snd) + (filter ((/= "NIX_REMOTE") . fst) $ mockedEnv Nothing path) + + ini <- createProcessEnv path + "nix-store" ["--init"] + P.waitForProcess ini + + writeFile (path "dummy") "Hello World" + + setCurrentDirectory path + + bracket (startDaemon path) + (P.terminateProcess . fst) + (\x -> action . snd $ x) + +checks action check = action >>= (`Hspec.shouldSatisfy` (check . fst)) +it name action check = Hspec.it name $ \run -> (run (action >> return ())) `checks` check +itRights name action = it name action isRight +itLefts name action = it name action isLeft + +withPath action = do + path <- addTextToStore "hnix-store" "test" (HS.fromList []) False + action path + +-- | dummy path, adds /dummpy with "Hello World" contents +dummy = do + let Right n = makeStorePathName "dummy" + res <- addToStore @SHA256 n "dummy" False (pure True) False + return res + +invalidPath :: StorePath +invalidPath = + let Right n = makeStorePathName "invalid" + in StorePath (hash "invalid") n "no_such_root" + +withNar act = do + nar <- liftIO $ localPackNar narEffectsIO "dummy" + now <- liftIO $ getCurrentTime + + let narContents = runPut $ putNar nar + narHash = hashLazy @SHA256 narContents + -- narSize vs narBytes + narBytes = BSL.length narContents + + deriver <- addTextToStore "some-deriver" "" (HS.fromList []) False + + sd <- getStoreDir + let Right n = makeStorePathName "nar-path" + path = makeFixedOutputPath sd False narHash n + + addTempRoot path + + let vp = VP.StorePathMetadata + { VP.path = path + , VP.deriverPath = Just deriver + , VP.narHash = SomeDigest narHash + , VP.references = HS.empty + , VP.registrationTime = now + , VP.narBytes = Just $ fromIntegral narBytes + , VP.trust = VP.BuiltLocally + , VP.sigs = S.empty -- [] + , VP.contentAddressableAddress = Nothing + } + + addToStoreNar vp nar False False + + act path + +withBuilder action = do + path <- addTextToStore "builder" builderSh (HS.fromList []) False + action path + +builderSh = T.concat [ "declare -xp", "export > $out" ] + +spec_protocol :: Spec +spec_protocol = Hspec.around withNixDaemon $ do + + describe "store" $ do + + context "syncWithGC" $ do + itRights "syncs with garbage collector" syncWithGC + + context "verifyStore" $ do + itRights "check=False repair=False" $ do + verifyStore False False `shouldReturn` False + + itRights "check=True repair=False" $ do + verifyStore True False `shouldReturn` False + + --privileged + itRights "check=True repair=True" $ do + verifyStore True True `shouldReturn` False + + context "addTextToStore" $ do + itRights "adds text to store" $ withPath $ const return () + + context "isValidPathUncached" $ do + itRights "validates path" $ withPath $ \path -> do + liftIO $ putStrLn $ show path + (isValidPathUncached path) `shouldReturn` True + itLefts "fails on invalid path" $ isValidPathUncached $ invalidPath + + context "queryAllValidPaths" $ do + itRights "empty query" $ queryAllValidPaths + itRights "non-empty query" $ withPath $ \path -> queryAllValidPaths `shouldReturn` (HS.fromList [path]) + + context "queryPathInfoUncached" $ do + itRights "queries path info" $ withPath $ queryPathInfoUncached @SHA256 + + context "ensurePath" $ do + itRights "simple ensure" $ withPath $ ensurePath + + context "addTempRoot" $ do + itRights "simple addition" $ withPath $ addTempRoot + + context "addIndirectRoot" $ do + itRights "simple addition" $ withPath $ addIndirectRoot + + context "buildPaths" $ do + itRights "build Normal" $ withPath $ \path -> do + let pathSet = HS.fromList [path] + buildPaths pathSet Normal + + itRights "build Check" $ withPath $ \path -> do + let pathSet = HS.fromList [path] + buildPaths pathSet Check + + itLefts "build Repair" $ withPath $ \path -> do + let pathSet = HS.fromList [path] + buildPaths pathSet Repair + + context "roots" $ do + context "findRoots" $ do + itRights "empty roots" $ (findRoots `shouldReturn` M.empty) + + itRights "path added as a temp root" $ withPath $ \path -> do + roots <- findRoots + roots `shouldSatisfy` ((==1) . M.size) + + context "optimiseStore" $ do + itRights "optimises" $ optimiseStore + + context "queryMissing" $ do + itRights "queries" $ withPath $ \path -> do + let pathSet = HS.fromList [path] + queryMissing pathSet `shouldReturn` (HS.empty, HS.empty, HS.empty, 0, 0) + + context "addToStoreNar" $ do + itRights "simple" $ withNar $ const return () + itRights "valid" $ withNar $ \narPath -> do + liftIO $ print narPath + (isValidPathUncached narPath) `shouldReturn` True + + context "addToStore" $ do + itRights "adds file to store" $ do + fp <- liftIO $ writeSystemTempFile "addition" "lal" + let Right n = makeStorePathName "tmp-addition" + res <- addToStore @SHA256 n fp False (pure True) False + liftIO $ print res + + context "with dummy" $ do + itRights "adds dummy" dummy + + itRights "valid dummy" $ do + path <- dummy + liftIO $ putStrLn $ show path + (isValidPathUncached path) `shouldReturn` True From 11277253c0aae0a3b0c04845293a0feaba3db816 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Fri, 1 May 2020 12:59:59 +0200 Subject: [PATCH 2/8] switch hackage category from System to Nix --- hnix-store-core/hnix-store-core.cabal | 2 +- hnix-store-remote/hnix-store-remote.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index 74915eda..bd8a2d26 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -11,7 +11,7 @@ license-file: LICENSE author: Shea Levy maintainer: shea@shealevy.com copyright: 2018 Shea Levy -category: System +category: Nix build-type: Simple extra-source-files: ChangeLog.md, README.md cabal-version: >=1.10 diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index 23b1988e..541ffdcc 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -8,7 +8,7 @@ license-file: LICENSE author: Richard Marko maintainer: srk@48.io copyright: 2018 Richard Marko -category: System +category: Nix build-type: Simple extra-source-files: README.md cabal-version: >=1.10 From 1076926515c8c2e0e901ebc49b3f116872d207c8 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Tue, 19 May 2020 11:09:25 +0200 Subject: [PATCH 3/8] core: add System.Nix.Derivation and tests --- hnix-store-core/hnix-store-core.cabal | 4 +++ hnix-store-core/src/System/Nix/Derivation.hs | 36 +++++++++++++++++++ hnix-store-core/tests/Derivation.hs | 36 +++++++++++++++++++ hnix-store-core/tests/samples/example0.actual | 1 + hnix-store-core/tests/samples/example0.drv | 1 + hnix-store-core/tests/samples/example1.actual | 1 + hnix-store-core/tests/samples/example1.drv | 1 + 7 files changed, 80 insertions(+) create mode 100644 hnix-store-core/src/System/Nix/Derivation.hs create mode 100644 hnix-store-core/tests/Derivation.hs create mode 100644 hnix-store-core/tests/samples/example0.actual create mode 100644 hnix-store-core/tests/samples/example0.drv create mode 100644 hnix-store-core/tests/samples/example1.actual create mode 100644 hnix-store-core/tests/samples/example1.drv diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index bd8a2d26..e9a71c4f 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -19,6 +19,7 @@ cabal-version: >=1.10 library exposed-modules: System.Nix.Base32 , System.Nix.Build + , System.Nix.Derivation , System.Nix.Hash , System.Nix.Internal.Base32 , System.Nix.Internal.Hash @@ -43,6 +44,7 @@ library , filepath , hashable , mtl + , nix-derivation >= 1.1.1 && <2 , saltine , time , text @@ -64,6 +66,7 @@ test-suite format-tests main-is: Driver.hs other-modules: Arbitrary + Derivation NarFormat Hash StorePath @@ -83,6 +86,7 @@ test-suite format-tests , process , tasty , tasty-discover + , tasty-golden , tasty-hspec , tasty-hunit , tasty-quickcheck diff --git a/hnix-store-core/src/System/Nix/Derivation.hs b/hnix-store-core/src/System/Nix/Derivation.hs new file mode 100644 index 00000000..914773d9 --- /dev/null +++ b/hnix-store-core/src/System/Nix/Derivation.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} + +module System.Nix.Derivation ( + parseDerivation + , buildDerivation + ) where + +import Data.Attoparsec.Text.Lazy (Parser) +import Data.ByteString (ByteString) +import Data.Text (Text) +import Data.Text.Lazy.Builder (Builder) +import Nix.Derivation (Derivation) +import System.Nix.StorePath (StorePath, pathParser) + +import qualified Data.ByteString.Char8 +import qualified Data.Text +import qualified Data.Text.Lazy.Builder +import qualified Data.Attoparsec.Text.Lazy + +import qualified Nix.Derivation +import qualified System.Nix.StorePath + +parseDerivation :: FilePath -> Parser (Derivation StorePath Text) +parseDerivation expectedRoot = + Nix.Derivation.parseDerivationWith + ("\"" *> System.Nix.StorePath.pathParser expectedRoot <* "\"") + Nix.Derivation.textParser + +buildDerivation :: Derivation StorePath Text -> Builder +buildDerivation derivation = + Nix.Derivation.buildDerivationWith + (string . Data.Text.pack . show) + string + derivation + where + string = Data.Text.Lazy.Builder.fromText . Data.Text.pack . show diff --git a/hnix-store-core/tests/Derivation.hs b/hnix-store-core/tests/Derivation.hs new file mode 100644 index 00000000..1e39f573 --- /dev/null +++ b/hnix-store-core/tests/Derivation.hs @@ -0,0 +1,36 @@ + +module Derivation where + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Golden (goldenVsFile) + +import System.Nix.Derivation (parseDerivation, buildDerivation) + +import qualified Data.Attoparsec.Text.Lazy +import qualified Data.Text.IO +import qualified Data.Text.Lazy +import qualified Data.Text.Lazy.Builder + +processDerivation source dest = do + contents <- Data.Text.IO.readFile source + case Data.Attoparsec.Text.Lazy.parseOnly (parseDerivation "/nix/store") contents of + Left e -> error e + Right drv -> + Data.Text.IO.writeFile dest + . Data.Text.Lazy.toStrict + . Data.Text.Lazy.Builder.toLazyText + $ buildDerivation drv + +test_derivation :: TestTree +test_derivation = testGroup "golden" $ map mk [0..1] + where + mk n = + let + fp = "tests/samples/example" + drv = (fp ++ show n ++ ".drv") + act = (fp ++ show n ++ ".actual") + in + goldenVsFile + ("derivation roundtrip of " ++ drv) + drv act (processDerivation drv act) + diff --git a/hnix-store-core/tests/samples/example0.actual b/hnix-store-core/tests/samples/example0.actual new file mode 100644 index 00000000..68db5764 --- /dev/null +++ b/hnix-store-core/tests/samples/example0.actual @@ -0,0 +1 @@ +Derive([("devdoc","/nix/store/15x9ii8c3n5wb5lg80cm8x0yk6zy7rha-perl-MIME-Types-2.13-devdoc","",""),("out","/nix/store/93d75ghjyibmbxgfzwhh4b5zwsxzs44w-perl-MIME-Types-2.13","","")],[("/nix/store/cvdbbvnvg131bz9bwyyk97jpq1crclqr-MIME-Types-2.13.tar.gz.drv",["out"]),("/nix/store/p5g31bc5x92awghx9dlm065d7j773l0r-stdenv.drv",["out"]),("/nix/store/x50y5qihwsn0lfjhrf1s81b5hgb9w632-bash-4.4-p5.drv",["out"]),("/nix/store/57h2hjsdkdiwbzilcjqkn46138n1xb4a-perl-5.22.3.drv",["out"])],["/nix/store/cdips4lakfk1qbf1x68fq18wnn3r5r14-builder.sh"],"x86_64-linux","/nix/store/fi3mbd2ml4pbgzyasrlnp0wyy6qi48fh-bash-4.4-p5/bin/bash",["-e","/nix/store/cdips4lakfk1qbf1x68fq18wnn3r5r14-builder.sh"],[("AUTOMATED_TESTING","1"),("PERL_AUTOINSTALL","--skipdeps"),("buildInputs",""),("builder","/nix/store/fi3mbd2ml4pbgzyasrlnp0wyy6qi48fh-bash-4.4-p5/bin/bash"),("checkTarget","test"),("devdoc","/nix/store/15x9ii8c3n5wb5lg80cm8x0yk6zy7rha-perl-MIME-Types-2.13-devdoc"),("doCheck","1"),("installTargets","pure_install"),("name","perl-MIME-Types-2.13"),("nativeBuildInputs","/nix/store/nsa311yg8h93wfaacjk16c96a98bs09f-perl-5.22.3"),("out","/nix/store/93d75ghjyibmbxgfzwhh4b5zwsxzs44w-perl-MIME-Types-2.13"),("outputs","out devdoc"),("propagatedBuildInputs",""),("propagatedNativeBuildInputs",""),("src","/nix/store/5smhymz7viq8p47mc3jgyvqd003ab732-MIME-Types-2.13.tar.gz"),("stdenv","/nix/store/s3rlr45jzlzx0d6k2azlpxa5zwzr7xyy-stdenv"),("system","x86_64-linux")]) \ No newline at end of file diff --git a/hnix-store-core/tests/samples/example0.drv b/hnix-store-core/tests/samples/example0.drv new file mode 100644 index 00000000..68db5764 --- /dev/null +++ b/hnix-store-core/tests/samples/example0.drv @@ -0,0 +1 @@ +Derive([("devdoc","/nix/store/15x9ii8c3n5wb5lg80cm8x0yk6zy7rha-perl-MIME-Types-2.13-devdoc","",""),("out","/nix/store/93d75ghjyibmbxgfzwhh4b5zwsxzs44w-perl-MIME-Types-2.13","","")],[("/nix/store/cvdbbvnvg131bz9bwyyk97jpq1crclqr-MIME-Types-2.13.tar.gz.drv",["out"]),("/nix/store/p5g31bc5x92awghx9dlm065d7j773l0r-stdenv.drv",["out"]),("/nix/store/x50y5qihwsn0lfjhrf1s81b5hgb9w632-bash-4.4-p5.drv",["out"]),("/nix/store/57h2hjsdkdiwbzilcjqkn46138n1xb4a-perl-5.22.3.drv",["out"])],["/nix/store/cdips4lakfk1qbf1x68fq18wnn3r5r14-builder.sh"],"x86_64-linux","/nix/store/fi3mbd2ml4pbgzyasrlnp0wyy6qi48fh-bash-4.4-p5/bin/bash",["-e","/nix/store/cdips4lakfk1qbf1x68fq18wnn3r5r14-builder.sh"],[("AUTOMATED_TESTING","1"),("PERL_AUTOINSTALL","--skipdeps"),("buildInputs",""),("builder","/nix/store/fi3mbd2ml4pbgzyasrlnp0wyy6qi48fh-bash-4.4-p5/bin/bash"),("checkTarget","test"),("devdoc","/nix/store/15x9ii8c3n5wb5lg80cm8x0yk6zy7rha-perl-MIME-Types-2.13-devdoc"),("doCheck","1"),("installTargets","pure_install"),("name","perl-MIME-Types-2.13"),("nativeBuildInputs","/nix/store/nsa311yg8h93wfaacjk16c96a98bs09f-perl-5.22.3"),("out","/nix/store/93d75ghjyibmbxgfzwhh4b5zwsxzs44w-perl-MIME-Types-2.13"),("outputs","out devdoc"),("propagatedBuildInputs",""),("propagatedNativeBuildInputs",""),("src","/nix/store/5smhymz7viq8p47mc3jgyvqd003ab732-MIME-Types-2.13.tar.gz"),("stdenv","/nix/store/s3rlr45jzlzx0d6k2azlpxa5zwzr7xyy-stdenv"),("system","x86_64-linux")]) \ No newline at end of file diff --git a/hnix-store-core/tests/samples/example1.actual b/hnix-store-core/tests/samples/example1.actual new file mode 100644 index 00000000..1530d8d3 --- /dev/null +++ b/hnix-store-core/tests/samples/example1.actual @@ -0,0 +1 @@ +Derive([("out","/nix/store/w3zbr9zj9mn08hnirn34wsxhry40qi3c-ghc-8.0.2-with-packages","","")],[("/nix/store/r44a3jm3q5rhi75rl1m6jr1vgwpiyw02-hnix-0.3.4.drv",["out"]),("/nix/store/clxg57lhlflbjrk6w3fv51fxjnqkk7q4-transformers-compat-0.5.1.4.drv",["out"]),("/nix/store/z036z61lsrk2gqbwljix0akzhz2bgl8j-semigroups-0.18.2.drv",["out"]),("/nix/store/fyi4gg70v1lgjz03v07flnmjr8x55mqk-async-2.1.1.1.drv",["out"]),("/nix/store/qi0668xlc3q03n74k1wrqri7ss7bvphk-stm-2.4.4.1.drv",["out"]),("/nix/store/nwapw7zf014frf49c0b7y5694jyc38hm-streaming-commons-0.1.17.drv",["out"]),("/nix/store/rqcq6jigs1sj53f8wrbff3s06wzazfqw-comonad-5.0.1.drv",["out"]),("/nix/store/dg6n7519y227s9c867wqi2v40cj41zqy-attoparsec-0.13.1.0.drv",["out"]),("/nix/store/y4ll9c29g76jzycl7zhdmqzxgciyrfr1-case-insensitive-1.2.0.9.drv",["out"]),("/nix/store/a2ar311g8chbi4ila55qzi3dfp9g5zr6-blaze-html-0.8.1.3.drv",["out"]),("/nix/store/2bmxgjskcw4vdmcqrw9pc9yjffsqn3i9-byteable-0.1.1.drv",["out"]),("/nix/store/xbygsq84395vhj7bnh7786i9864jf9i9-ghc-8.0.2.drv",["out"]),("/nix/store/wx9vx1z55bzkzym0lzbgpzd7rrsx9w9b-scientific-0.3.4.12.drv",["out"]),("/nix/store/zvxd18a65gwcg3bz7v1rb0h59w9wwi9d-network-2.6.3.1.drv",["out"]),("/nix/store/y8l0lv08hfi6qnrzd25dxgi4712yjf9f-base-orphans-0.5.4.drv",["out"]),("/nix/store/0w9vy2hmz50j0yhlbj519hnpjbvqhjrj-cookie-0.4.2.1.drv",["out"]),("/nix/store/xp7jayhmiphx0zqxx9dxrk673shhj89l-optparse-applicative-0.13.2.0.drv",["out"]),("/nix/store/xzda3rxckhf0h3lp1hr6wanyig9s9y1p-utf8-string-1.0.1.1.drv",["out"]),("/nix/store/zg5as9jrs5vfa5iw7539vihmwm436g1q-network-uri-2.6.1.0.drv",["out"]),("/nix/store/5x6d3f9krpqlmzhmk71qf7m97g38hba1-base-prelude-1.0.1.1.drv",["out"]),("/nix/store/d1n1p6mdabwkgkc7y6151j37c4kqh1a2-exceptions-0.8.3.drv",["out"]),("/nix/store/m7l8bg4k82snsl759k2mlkjlb8g0352a-foundation-0.0.7.drv",["out"]),("/nix/store/l3wmibr3b1b3a8ql8ypy860209iqbasg-connection-0.2.8.drv",["out"]),("/nix/store/gq055a1910w9q6mbb5kf6p6igzg6b5ai-StateVar-1.1.0.4.drv",["out"]),("/nix/store/pra6ynwnksgks1xxv2l7h48swjq4vb2j-data-default-class-0.1.2.0.drv",["out"]),("/nix/store/as62r0pdaq0q76rxz719xy33vqa7xcal-double-conversion-2.0.2.0.drv",["out"]),("/nix/store/0cyv377kjnhjc9j1pb0m530lczqj4ksm-optparse-generic-1.1.5.drv",["out"]),("/nix/store/75iir4x52007r0fq41kwk5cdfvmi02jp-profunctors-5.2.drv",["out"]),("/nix/store/z8vpk1rwkikc8pg20vyg5kvsdv626ksw-dhall-1.3.0.drv",["out"]),("/nix/store/ckl2x2vkqj82k4b7c5l8p611g6jmfbsz-zlib-0.6.1.2.drv",["out"]),("/nix/store/x50y5qihwsn0lfjhrf1s81b5hgb9w632-bash-4.4-p5.drv",["out"]),("/nix/store/fdq2dn4gal13xl9jbyk8igvaw5f2x9b5-blaze-builder-0.4.0.2.drv",["out"]),("/nix/store/9w2n7jqc9ll78r7xj31ckrqcq6g8g8kf-integer-logarithms-1.0.1.drv",["out"]),("/nix/store/lvm3zp40qfdqr0v9i27z7dqpdwlxprbl-text-1.2.2.1.drv",["out"]),("/nix/store/bwf0a834k4jf5ss2ccribn9w7g2r3j3m-stdenv.drv",["out"]),("/nix/store/1b75igh40c9agy3sfyl5n7av4070swvn-old-locale-1.0.0.7.drv",["out"]),("/nix/store/lnxgjiywc89iaby3g0na1sc4hryvnikq-trifecta-1.6.2.1.drv",["out"]),("/nix/store/mq338r0an8lj00g88c6rpylbnmds7fbx-adjunctions-4.3.drv",["out"]),("/nix/store/qr8wf0b1lqwxwi6ban2k307jy91bj640-reducers-3.12.1.drv",["out"]),("/nix/store/56l353i7v6i7i5vkk2qx4wi4r6p4xll1-void-0.7.2.drv",["out"]),("/nix/store/8p1f0rs49czq74yxlfcimlag9wnbwsc5-http-client-tls-0.3.4.1.drv",["out"]),("/nix/store/nv7frilmipcpylijp492l3hc0s2cmgw6-tls-1.3.10.drv",["out"]),("/nix/store/7ah4kd8kbwsfr350wkr0y4i0h6gm7vc8-base64-bytestring-1.0.0.1.drv",["out"]),("/nix/store/ginljsxbpxli394mc06gvqkmvddhqwlc-x509-store-1.6.2.drv",["out"]),("/nix/store/w6a3c55nhmpcia6cvdg31nqsc7v910lc-ansi-terminal-0.6.2.3.drv",["out"]),("/nix/store/7545pmiaccgvkxjfvl9cm0qk7y1x96wi-reflection-2.1.2.drv",["out"]),("/nix/store/ahypsxsxcczsllax40jnccdg5ilps2lq-http-client-0.5.6.1.drv",["out"]),("/nix/store/6n2kl1fnn66a24ipjm1dxjhhvni1404r-mtl-2.2.1.drv",["out"]),("/nix/store/fr1acpclaljwizrvic520wdf36kmxjwr-blaze-markup-0.7.1.1.drv",["out"]),("/nix/store/vpqjk2wral953nnqnhvp8zbmkbhnyxls-x509-validation-1.6.5.drv",["out"]),("/nix/store/sdx411558r03fdvfi3p6wzfsi701sv4w-system-fileio-0.3.16.3.drv",["out"]),("/nix/store/pz3s86hbxvwr7m4x7cpz5h8z124wgk4x-x509-1.6.5.drv",["out"]),("/nix/store/v0srwl68sz6dirasq53bd3ddjipa1d5b-deriving-compat-0.3.6.drv",["out"]),("/nix/store/61fzrmaxsfc9q4qzsdcrsaqgg05hr6xi-bifunctors-5.4.2.drv",["out"]),("/nix/store/vr8scnq8lxgc0m6k7bqjwi4fg0k55lxn-data-fix-0.0.4.drv",["out"]),("/nix/store/zdx2r8q401h7xcyh7jg0cnp092iwlhmv-contravariant-1.4.drv",["out"]),("/nix/store/n4wyn46xw0nw8a3rhqw47xd4h6bgnn5w-lens-4.15.1.drv",["out"]),("/nix/store/j6zji0jn6cm8b4i0fmakksk1cp54bhn0-asn1-types-0.3.2.drv",["out"]),("/nix/store/pcg29qa8fm9niixbjy0r7bbp3s4jxk62-neat-interpolation-0.3.2.1.drv",["out"]),("/nix/store/5hx7hjjrwqa4zjd9ql224aif86ncj764-hook.drv",["out"]),("/nix/store/lg64zgciix9644hzkfc02rfbq4qgcrf8-memory-0.14.3.drv",["out"]),("/nix/store/f67vqhk71lrab7ncx8fz8bj7iggmm66f-cryptonite-0.21.drv",["out"]),("/nix/store/5rpa05i9i5p3i0a06lhyvgg1nvlwnlfi-unordered-containers-0.2.8.0.drv",["out"]),("/nix/store/20m5alpbwyvyhh43aq3prw07g48apdnj-parsers-0.12.4.drv",["out"]),("/nix/store/f3l740wl94r84fgsiindy88jppcjya6l-text-format-0.3.1.1.drv",["out"]),("/nix/store/7f6ddryzkw9jckayqs1gdz18njrqd0fq-random-1.1.drv",["out"]),("/nix/store/vwhic7ibwkzqk65mqicb29d5qz06gkns-socks-0.5.5.drv",["out"]),("/nix/store/wld7wjy6lws02rky68mpg0x591wv0j6v-pem-0.2.2.drv",["out"]),("/nix/store/43hyjsydndk7vsdjs94why36s8isn6fw-kan-extensions-5.0.1.drv",["out"]),("/nix/store/ql8bpbnl7x7ybn3rnsknpkpwvlz7s2nz-distributive-0.5.2.drv",["out"]),("/nix/store/s1ymda8d763cn5gq4cw107h19xs1ddz0-ansi-wl-pprint-0.6.7.3.drv",["out"]),("/nix/store/3fji5p4x9j0cb3q3lp8amrj0qak9d471-asn1-encoding-0.9.5.drv",["out"]),("/nix/store/mi1fdfdkc5qc7iq2ry6095ayp9cqn075-x509-system-1.6.4.drv",["out"]),("/nix/store/6qggipw2ra59q6333y25gywllbbcx3p5-hourglass-0.2.10.drv",["out"]),("/nix/store/b67b65arib97rsl4z5iqz03gf24ymvz5-http-types-0.9.1.drv",["out"]),("/nix/store/7d6yxihb828lgs4199f81k17jh8987z6-lndir-1.0.3.drv",["out"]),("/nix/store/pg609c09rfqzyfn8l4hsc1q2xy50w4p8-semigroupoids-5.1.drv",["out"]),("/nix/store/6l4s2nlxc9fq8c3y3j2k2c7af5llx278-hashable-1.2.6.0.drv",["out"]),("/nix/store/5d3v9g9jjqznbpxrlgvcyvmqqz2ffpgc-fingertree-0.1.1.0.drv",["out"]),("/nix/store/ip7nh1r7mj4qwgra27x8i6nyz6yd1ggd-prelude-extras-0.4.0.3.drv",["out"]),("/nix/store/bczn7hbvp39aplp70gvmyijdysvkyspg-primitive-0.6.1.0.drv",["out"]),("/nix/store/x8k0rsb1ig82vdls0dc6jdlny7r04izj-parallel-3.2.1.1.drv",["out"]),("/nix/store/iqd84gv7b8dq5kddxyjimaqqlxjpqdzk-vector-0.11.0.0.drv",["out"]),("/nix/store/1g2qxhbpk7qjyz8qbami29bn7qmnmgpk-tagged-0.8.5.drv",["out"]),("/nix/store/x2dkgpklc1adq1cgg1k8ykdqv7ghwhzm-system-filepath-0.4.13.4.drv",["out"]),("/nix/store/hhx5xjb6cm5rdkri763669bf6karrnpn-parsec-3.1.11.drv",["out"]),("/nix/store/j24c6d5zv7nim3rkmzzapk6x61lzgizq-charset-0.3.7.1.drv",["out"]),("/nix/store/5c748d8gmrmg2gy4792a0kzp5bjw8sgr-cereal-0.5.4.0.drv",["out"]),("/nix/store/mpql2q0b6a1m2vkb114f9l2s8dhy09zv-asn1-parse-0.9.4.drv",["out"]),("/nix/store/4hkya8j2isw660pj6b0q3by85q2wz1zw-free-4.12.4.drv",["out"]),("/nix/store/wdgbs33iwqadfmlaymw00k6iwnf3as7z-mime-types-0.1.0.7.drv",["out"])],["/nix/store/9krlzvny65gdc8s7kpb6lkx8cd02c25b-default-builder.sh"],"x86_64-linux","/nix/store/fi3mbd2ml4pbgzyasrlnp0wyy6qi48fh-bash-4.4-p5/bin/bash",["-e","/nix/store/9krlzvny65gdc8s7kpb6lkx8cd02c25b-default-builder.sh"],[("allowSubstitutes",""),("buildCommand","mkdir -p $out\nfor i in $paths; do\n /nix/store/lnai0im3lcpb03arxfi0wx1dm7anf4f8-lndir-1.0.3/bin/lndir $i $out\ndone\n. /nix/store/plmya6mkfvq658ba7z6j6n36r5pdbxk5-hook/nix-support/setup-hook\n\n# wrap compiler executables with correct env variables\n\nfor prg in ghc ghci ghc-8.0.2 ghci-8.0.2; do\n if [[ -x \"/nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg\" ]]; then\n rm -f $out/bin/$prg\n makeWrapper /nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg $out/bin/$prg \\\n --add-flags '\"-B$NIX_GHC_LIBDIR\"' \\\n --set \"NIX_GHC\" \"$out/bin/ghc\" \\\n --set \"NIX_GHCPKG\" \"$out/bin/ghc-pkg\" \\\n --set \"NIX_GHC_DOCDIR\" \"$out/share/doc/ghc/html\" \\\n --set \"NIX_GHC_LIBDIR\" \"$out/lib/ghc-8.0.2\" \\\n \n fi\ndone\n\nfor prg in runghc runhaskell; do\n if [[ -x \"/nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg\" ]]; then\n rm -f $out/bin/$prg\n makeWrapper /nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg $out/bin/$prg \\\n --add-flags \"-f $out/bin/ghc\" \\\n --set \"NIX_GHC\" \"$out/bin/ghc\" \\\n --set \"NIX_GHCPKG\" \"$out/bin/ghc-pkg\" \\\n --set \"NIX_GHC_DOCDIR\" \"$out/share/doc/ghc/html\" \\\n --set \"NIX_GHC_LIBDIR\" \"$out/lib/ghc-8.0.2\"\n fi\ndone\n\nfor prg in ghc-pkg ghc-pkg-8.0.2; do\n if [[ -x \"/nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg\" ]]; then\n rm -f $out/bin/$prg\n makeWrapper /nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg $out/bin/$prg --add-flags \"--global-package-db=$out/lib/ghc-8.0.2/package.conf.d\"\n fi\ndone\n$out/bin/ghc-pkg recache\n\n$out/bin/ghc-pkg check\n\n"),("buildInputs",""),("builder","/nix/store/fi3mbd2ml4pbgzyasrlnp0wyy6qi48fh-bash-4.4-p5/bin/bash"),("extraOutputsToInstall","out doc"),("ignoreCollisions",""),("name","ghc-8.0.2-with-packages"),("nativeBuildInputs",""),("out","/nix/store/w3zbr9zj9mn08hnirn34wsxhry40qi3c-ghc-8.0.2-with-packages"),("passAsFile","buildCommand"),("paths","/nix/store/rlsammwp1ib8d3d9qgbppmdhkbdfg3i9-deriving-compat-0.3.6 /nix/store/v2qsqznrik64f46msahvgg7dmaiag18k-hnix-0.3.4 /nix/store/vbkqj8zdckqqiyjh08ykx75fwc90gwg4-optparse-applicative-0.13.2.0 /nix/store/6m7qia8q0rkdkzvmiak38kdscf27malf-optparse-generic-1.1.5 /nix/store/r687llig7vn9x15hhkmfak01ff7082n6-utf8-string-1.0.1.1 /nix/store/j6gvad67dav8fl3vdbqmar84kgmh5gar-reducers-3.12.1 /nix/store/i8wf08764lknc0f9ja12miqvg509jn1k-fingertree-0.1.1.0 /nix/store/301hq4fabrpbi3l47n908gvakkzq1s88-blaze-markup-0.7.1.1 /nix/store/055mhi44s20x5xgxdjr82vmhnyv79pzl-blaze-html-0.8.1.3 /nix/store/vnc1yyig90skcwx3l1xrbp1jqwmmb9xv-trifecta-1.6.2.1 /nix/store/vraffi24marw5sks8b78xrim6c8i1ng6-double-conversion-2.0.2.0 /nix/store/kwdk03p0lyk5lyll1fp7a6z20j17b3sx-text-format-0.3.1.1 /nix/store/zn5hlw3y94sbli4ssygr2w04mpb396zs-system-filepath-0.4.13.4 /nix/store/jn7lbnk0gsirj8kb02an31v8idy7ym3c-system-fileio-0.3.16.3 /nix/store/9frfci9ywf9lc216ci9nwc1yy0qwrn1b-integer-logarithms-1.0.1 /nix/store/rps46jwa7yyab629p27lar094gk8dal2-scientific-0.3.4.12 /nix/store/c4a3ynvnv3kdxgd7ngmnjhka4mvfk8ll-attoparsec-0.13.1.0 /nix/store/kc34l1gpzh65y4gclmv4dgv6agpmagdi-parsers-0.12.4 /nix/store/1kf78yxf3lliagb5rc5din24iq40g96y-base-prelude-1.0.1.1 /nix/store/hi868d12pkzcbzyvp7a7cigc58mp2lmg-neat-interpolation-0.3.2.1 /nix/store/h00jrbdvzj4yfy796j8vq00lkd1gxr6w-primitive-0.6.1.0 /nix/store/vys8qsf317rn8qwy00p80zlywb47lqwz-vector-0.11.0.0 /nix/store/wchch11312m3lxkwl8rad04x02svcs3i-reflection-2.1.2 /nix/store/jj1kfv52mjxp54flz8v5ba64va3hvy22-parallel-3.2.1.1 /nix/store/jwj23y7vfvs14jdrkw1py9q7lm9fyhy4-adjunctions-4.3 /nix/store/px4979la9b98knwv36551zg3p5jb69lw-kan-extensions-5.0.1 /nix/store/2cp1ar0f73jrcn231ai07zpwayy735j2-semigroupoids-5.1 /nix/store/3nkxw5wdadckz28laijrvwdkkfqp07sb-profunctors-5.2 /nix/store/bd3njvy0ahcsqw47vaz5zayhx34hari7-prelude-extras-0.4.0.3 /nix/store/zdp7zqasz1l1wifpngbg6ngq189gbbqh-free-4.12.4 /nix/store/n7c5ynfqc6j570bbyaajqx34c3pvfvph-tagged-0.8.5 /nix/store/xdkhd7mkqj2mmcami8ycmf7j0valwp5h-distributive-0.5.2 /nix/store/9dxba4g9x0xjj21r3vchqnh4rdwbc31b-void-0.7.2 /nix/store/dahah2ivrn4hc5gjygnlvxlad2399zqh-StateVar-1.1.0.4 /nix/store/f2rdi1bx46fs165n1j316k5w90ab6lwy-contravariant-1.4 /nix/store/mgg9rsvhvn4dd4qzv559nn24iqvspjnb-comonad-5.0.1 /nix/store/18n8i570pf4gpszdyc0bki9qxm1p9xd7-bifunctors-5.4.2 /nix/store/d8ys5wq4wrvdjqw0bzv3y23zqprkhjs2-base-orphans-0.5.4 /nix/store/j4hbyhnj4a2z4z4vb1437vk7ha0b287a-lens-4.15.1 /nix/store/ra3jh12mbyz82n4gvj2bam77vl8aabbq-x509-system-1.6.4 /nix/store/ps8915q1047frp891jg1anp85ads0s9b-x509-validation-1.6.5 /nix/store/5vrgrls6l1cdsbbznis39chx8scq2r98-x509-store-1.6.2 /nix/store/7vvg8y8fp0s50qiciq11irfvh31f1q58-pem-0.2.2 /nix/store/myv75wk9s19f8vms2dcy6sl773288zy4-asn1-parse-0.9.4 /nix/store/kwyc1jdz09lazw21qpc96wyamxalcg11-x509-1.6.5 /nix/store/gadc7c6d1lqn0wqk29bhn56is67x0r45-cryptonite-0.21 /nix/store/ix26y5rpidwpgjzrsixz0ff59j1p1swr-foundation-0.0.7 /nix/store/n784p4qh18zx9v8ag3n3ypszq1kifjjr-memory-0.14.3 /nix/store/h3qq6m5ahdb4kw784gcvx2skil8ilks8-hourglass-0.2.10 /nix/store/dn65dl65spk4j0sky2zpdig75c42ycj1-asn1-types-0.3.2 /nix/store/s5jklkk0y6i7d8h3akgsciv1kv2js786-asn1-encoding-0.9.5 /nix/store/g5qjgns5cyz9c5xw4w5s2iji1kbhg47z-tls-1.3.10 /nix/store/iyllk46by75f428pwis9v74jpr1rmk4x-cereal-0.5.4.0 /nix/store/b22wyyl3wdl6kb7gkpk3yxnynk340lya-socks-0.5.5 /nix/store/05r3i8w2n7hbxqyb4w8rina9rldyacd3-byteable-0.1.1 /nix/store/xjbl6w60czyfqlfwwfs5q93by144yr1n-connection-0.2.8 /nix/store/j10yqzk323rvnwgsk3nj7rgmvqlv035a-http-client-tls-0.3.4.1 /nix/store/vf84v2398g55mai2gjh2d9gipwizhhzd-zlib-0.6.1.2 /nix/store/7h7vy3mi603y536dgvxwfglaacxw5ra8-async-2.1.1.1 /nix/store/y6hh2ifv35afw1j5phpzp1y72x532izn-streaming-commons-0.1.17 /nix/store/f5jdarp8djisa1wrv4bv1saimrabcb3f-random-1.1 /nix/store/18vpnmd28bnjib6andw8bx522wcb3zwa-parsec-3.1.11 /nix/store/i3ra66pcpj0v9wq3m00gh9i72br2bki3-network-uri-2.6.1.0 /nix/store/2ck9avbwacfpi16p2ib2shw951mx33pz-network-2.6.3.1 /nix/store/rz0227nv8n8kdrxjg3arya6r2ixxjh4h-mime-types-0.1.0.7 /nix/store/rx71j4kg0l02dginiswnmwswdq9i9msv-http-types-0.9.1 /nix/store/y2ca4scn0n2f9qsmvsiixcnx11793jlf-transformers-compat-0.5.1.4 /nix/store/bzicr83ibzzzbab6cjkb3i95sc8cvxy9-stm-2.4.4.1 /nix/store/qk5pl6r2h0vfkhhwjgrv8x1ldf8dyj5a-mtl-2.2.1 /nix/store/0d6k71ljl108dgq1l7l3pz12bfwv0z4h-exceptions-0.8.3 /nix/store/z5k23ymwjhhpd670a7mcsm1869hlpncf-old-locale-1.0.0.7 /nix/store/k4an783d4j3m48fqhx7gpnizqg2ns38j-data-default-class-0.1.2.0 /nix/store/p5867jsig02zi0ynww9w4916nm0k527s-cookie-0.4.2.1 /nix/store/wy7j42kqlw1sskagmyc1bzb0xv04s2na-case-insensitive-1.2.0.9 /nix/store/j35339b0nk7k3qaq3m75nl3i4x603rqf-blaze-builder-0.4.0.2 /nix/store/33mip0ql9x1jjbhi34kf8izh4ilyf2k0-base64-bytestring-1.0.0.1 /nix/store/29a73kd2jkwvfdcrhysmi5xjr7nysrxf-http-client-0.5.6.1 /nix/store/d2hy666g79qvhmbh520x5jclwvnr1gk2-text-1.2.2.1 /nix/store/2bdzia66lg08d5zngmllcjry2c08m96j-hashable-1.2.6.0 /nix/store/7kdgc6c0b21s9j5qgg0s0gxj7iid2wk5-unordered-containers-0.2.8.0 /nix/store/zsryzwadshszfnkm740b2412v88iqgi4-semigroups-0.18.2 /nix/store/h2c0kz3m83x6fkl2jzkmin8xvkmfgs7s-charset-0.3.7.1 /nix/store/gapj6j0ya5bi9q9dxspda15k50gx8f1v-ansi-terminal-0.6.2.3 /nix/store/l46769n2p6rlh936zrbwznq3zxxa6mjd-ansi-wl-pprint-0.6.7.3 /nix/store/p7zmpgz0sq5pamgrf1xvhvidc3m4cfmk-dhall-1.3.0 /nix/store/938ndd0mqfm148367lwhl6pk5smv5bm0-data-fix-0.0.4 /nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2"),("preferLocalBuild","1"),("propagatedBuildInputs",""),("propagatedNativeBuildInputs",""),("stdenv","/nix/store/685n25b9yc8sds57vljk459ldly1xyhn-stdenv"),("system","x86_64-linux")]) \ No newline at end of file diff --git a/hnix-store-core/tests/samples/example1.drv b/hnix-store-core/tests/samples/example1.drv new file mode 100644 index 00000000..1530d8d3 --- /dev/null +++ b/hnix-store-core/tests/samples/example1.drv @@ -0,0 +1 @@ +Derive([("out","/nix/store/w3zbr9zj9mn08hnirn34wsxhry40qi3c-ghc-8.0.2-with-packages","","")],[("/nix/store/r44a3jm3q5rhi75rl1m6jr1vgwpiyw02-hnix-0.3.4.drv",["out"]),("/nix/store/clxg57lhlflbjrk6w3fv51fxjnqkk7q4-transformers-compat-0.5.1.4.drv",["out"]),("/nix/store/z036z61lsrk2gqbwljix0akzhz2bgl8j-semigroups-0.18.2.drv",["out"]),("/nix/store/fyi4gg70v1lgjz03v07flnmjr8x55mqk-async-2.1.1.1.drv",["out"]),("/nix/store/qi0668xlc3q03n74k1wrqri7ss7bvphk-stm-2.4.4.1.drv",["out"]),("/nix/store/nwapw7zf014frf49c0b7y5694jyc38hm-streaming-commons-0.1.17.drv",["out"]),("/nix/store/rqcq6jigs1sj53f8wrbff3s06wzazfqw-comonad-5.0.1.drv",["out"]),("/nix/store/dg6n7519y227s9c867wqi2v40cj41zqy-attoparsec-0.13.1.0.drv",["out"]),("/nix/store/y4ll9c29g76jzycl7zhdmqzxgciyrfr1-case-insensitive-1.2.0.9.drv",["out"]),("/nix/store/a2ar311g8chbi4ila55qzi3dfp9g5zr6-blaze-html-0.8.1.3.drv",["out"]),("/nix/store/2bmxgjskcw4vdmcqrw9pc9yjffsqn3i9-byteable-0.1.1.drv",["out"]),("/nix/store/xbygsq84395vhj7bnh7786i9864jf9i9-ghc-8.0.2.drv",["out"]),("/nix/store/wx9vx1z55bzkzym0lzbgpzd7rrsx9w9b-scientific-0.3.4.12.drv",["out"]),("/nix/store/zvxd18a65gwcg3bz7v1rb0h59w9wwi9d-network-2.6.3.1.drv",["out"]),("/nix/store/y8l0lv08hfi6qnrzd25dxgi4712yjf9f-base-orphans-0.5.4.drv",["out"]),("/nix/store/0w9vy2hmz50j0yhlbj519hnpjbvqhjrj-cookie-0.4.2.1.drv",["out"]),("/nix/store/xp7jayhmiphx0zqxx9dxrk673shhj89l-optparse-applicative-0.13.2.0.drv",["out"]),("/nix/store/xzda3rxckhf0h3lp1hr6wanyig9s9y1p-utf8-string-1.0.1.1.drv",["out"]),("/nix/store/zg5as9jrs5vfa5iw7539vihmwm436g1q-network-uri-2.6.1.0.drv",["out"]),("/nix/store/5x6d3f9krpqlmzhmk71qf7m97g38hba1-base-prelude-1.0.1.1.drv",["out"]),("/nix/store/d1n1p6mdabwkgkc7y6151j37c4kqh1a2-exceptions-0.8.3.drv",["out"]),("/nix/store/m7l8bg4k82snsl759k2mlkjlb8g0352a-foundation-0.0.7.drv",["out"]),("/nix/store/l3wmibr3b1b3a8ql8ypy860209iqbasg-connection-0.2.8.drv",["out"]),("/nix/store/gq055a1910w9q6mbb5kf6p6igzg6b5ai-StateVar-1.1.0.4.drv",["out"]),("/nix/store/pra6ynwnksgks1xxv2l7h48swjq4vb2j-data-default-class-0.1.2.0.drv",["out"]),("/nix/store/as62r0pdaq0q76rxz719xy33vqa7xcal-double-conversion-2.0.2.0.drv",["out"]),("/nix/store/0cyv377kjnhjc9j1pb0m530lczqj4ksm-optparse-generic-1.1.5.drv",["out"]),("/nix/store/75iir4x52007r0fq41kwk5cdfvmi02jp-profunctors-5.2.drv",["out"]),("/nix/store/z8vpk1rwkikc8pg20vyg5kvsdv626ksw-dhall-1.3.0.drv",["out"]),("/nix/store/ckl2x2vkqj82k4b7c5l8p611g6jmfbsz-zlib-0.6.1.2.drv",["out"]),("/nix/store/x50y5qihwsn0lfjhrf1s81b5hgb9w632-bash-4.4-p5.drv",["out"]),("/nix/store/fdq2dn4gal13xl9jbyk8igvaw5f2x9b5-blaze-builder-0.4.0.2.drv",["out"]),("/nix/store/9w2n7jqc9ll78r7xj31ckrqcq6g8g8kf-integer-logarithms-1.0.1.drv",["out"]),("/nix/store/lvm3zp40qfdqr0v9i27z7dqpdwlxprbl-text-1.2.2.1.drv",["out"]),("/nix/store/bwf0a834k4jf5ss2ccribn9w7g2r3j3m-stdenv.drv",["out"]),("/nix/store/1b75igh40c9agy3sfyl5n7av4070swvn-old-locale-1.0.0.7.drv",["out"]),("/nix/store/lnxgjiywc89iaby3g0na1sc4hryvnikq-trifecta-1.6.2.1.drv",["out"]),("/nix/store/mq338r0an8lj00g88c6rpylbnmds7fbx-adjunctions-4.3.drv",["out"]),("/nix/store/qr8wf0b1lqwxwi6ban2k307jy91bj640-reducers-3.12.1.drv",["out"]),("/nix/store/56l353i7v6i7i5vkk2qx4wi4r6p4xll1-void-0.7.2.drv",["out"]),("/nix/store/8p1f0rs49czq74yxlfcimlag9wnbwsc5-http-client-tls-0.3.4.1.drv",["out"]),("/nix/store/nv7frilmipcpylijp492l3hc0s2cmgw6-tls-1.3.10.drv",["out"]),("/nix/store/7ah4kd8kbwsfr350wkr0y4i0h6gm7vc8-base64-bytestring-1.0.0.1.drv",["out"]),("/nix/store/ginljsxbpxli394mc06gvqkmvddhqwlc-x509-store-1.6.2.drv",["out"]),("/nix/store/w6a3c55nhmpcia6cvdg31nqsc7v910lc-ansi-terminal-0.6.2.3.drv",["out"]),("/nix/store/7545pmiaccgvkxjfvl9cm0qk7y1x96wi-reflection-2.1.2.drv",["out"]),("/nix/store/ahypsxsxcczsllax40jnccdg5ilps2lq-http-client-0.5.6.1.drv",["out"]),("/nix/store/6n2kl1fnn66a24ipjm1dxjhhvni1404r-mtl-2.2.1.drv",["out"]),("/nix/store/fr1acpclaljwizrvic520wdf36kmxjwr-blaze-markup-0.7.1.1.drv",["out"]),("/nix/store/vpqjk2wral953nnqnhvp8zbmkbhnyxls-x509-validation-1.6.5.drv",["out"]),("/nix/store/sdx411558r03fdvfi3p6wzfsi701sv4w-system-fileio-0.3.16.3.drv",["out"]),("/nix/store/pz3s86hbxvwr7m4x7cpz5h8z124wgk4x-x509-1.6.5.drv",["out"]),("/nix/store/v0srwl68sz6dirasq53bd3ddjipa1d5b-deriving-compat-0.3.6.drv",["out"]),("/nix/store/61fzrmaxsfc9q4qzsdcrsaqgg05hr6xi-bifunctors-5.4.2.drv",["out"]),("/nix/store/vr8scnq8lxgc0m6k7bqjwi4fg0k55lxn-data-fix-0.0.4.drv",["out"]),("/nix/store/zdx2r8q401h7xcyh7jg0cnp092iwlhmv-contravariant-1.4.drv",["out"]),("/nix/store/n4wyn46xw0nw8a3rhqw47xd4h6bgnn5w-lens-4.15.1.drv",["out"]),("/nix/store/j6zji0jn6cm8b4i0fmakksk1cp54bhn0-asn1-types-0.3.2.drv",["out"]),("/nix/store/pcg29qa8fm9niixbjy0r7bbp3s4jxk62-neat-interpolation-0.3.2.1.drv",["out"]),("/nix/store/5hx7hjjrwqa4zjd9ql224aif86ncj764-hook.drv",["out"]),("/nix/store/lg64zgciix9644hzkfc02rfbq4qgcrf8-memory-0.14.3.drv",["out"]),("/nix/store/f67vqhk71lrab7ncx8fz8bj7iggmm66f-cryptonite-0.21.drv",["out"]),("/nix/store/5rpa05i9i5p3i0a06lhyvgg1nvlwnlfi-unordered-containers-0.2.8.0.drv",["out"]),("/nix/store/20m5alpbwyvyhh43aq3prw07g48apdnj-parsers-0.12.4.drv",["out"]),("/nix/store/f3l740wl94r84fgsiindy88jppcjya6l-text-format-0.3.1.1.drv",["out"]),("/nix/store/7f6ddryzkw9jckayqs1gdz18njrqd0fq-random-1.1.drv",["out"]),("/nix/store/vwhic7ibwkzqk65mqicb29d5qz06gkns-socks-0.5.5.drv",["out"]),("/nix/store/wld7wjy6lws02rky68mpg0x591wv0j6v-pem-0.2.2.drv",["out"]),("/nix/store/43hyjsydndk7vsdjs94why36s8isn6fw-kan-extensions-5.0.1.drv",["out"]),("/nix/store/ql8bpbnl7x7ybn3rnsknpkpwvlz7s2nz-distributive-0.5.2.drv",["out"]),("/nix/store/s1ymda8d763cn5gq4cw107h19xs1ddz0-ansi-wl-pprint-0.6.7.3.drv",["out"]),("/nix/store/3fji5p4x9j0cb3q3lp8amrj0qak9d471-asn1-encoding-0.9.5.drv",["out"]),("/nix/store/mi1fdfdkc5qc7iq2ry6095ayp9cqn075-x509-system-1.6.4.drv",["out"]),("/nix/store/6qggipw2ra59q6333y25gywllbbcx3p5-hourglass-0.2.10.drv",["out"]),("/nix/store/b67b65arib97rsl4z5iqz03gf24ymvz5-http-types-0.9.1.drv",["out"]),("/nix/store/7d6yxihb828lgs4199f81k17jh8987z6-lndir-1.0.3.drv",["out"]),("/nix/store/pg609c09rfqzyfn8l4hsc1q2xy50w4p8-semigroupoids-5.1.drv",["out"]),("/nix/store/6l4s2nlxc9fq8c3y3j2k2c7af5llx278-hashable-1.2.6.0.drv",["out"]),("/nix/store/5d3v9g9jjqznbpxrlgvcyvmqqz2ffpgc-fingertree-0.1.1.0.drv",["out"]),("/nix/store/ip7nh1r7mj4qwgra27x8i6nyz6yd1ggd-prelude-extras-0.4.0.3.drv",["out"]),("/nix/store/bczn7hbvp39aplp70gvmyijdysvkyspg-primitive-0.6.1.0.drv",["out"]),("/nix/store/x8k0rsb1ig82vdls0dc6jdlny7r04izj-parallel-3.2.1.1.drv",["out"]),("/nix/store/iqd84gv7b8dq5kddxyjimaqqlxjpqdzk-vector-0.11.0.0.drv",["out"]),("/nix/store/1g2qxhbpk7qjyz8qbami29bn7qmnmgpk-tagged-0.8.5.drv",["out"]),("/nix/store/x2dkgpklc1adq1cgg1k8ykdqv7ghwhzm-system-filepath-0.4.13.4.drv",["out"]),("/nix/store/hhx5xjb6cm5rdkri763669bf6karrnpn-parsec-3.1.11.drv",["out"]),("/nix/store/j24c6d5zv7nim3rkmzzapk6x61lzgizq-charset-0.3.7.1.drv",["out"]),("/nix/store/5c748d8gmrmg2gy4792a0kzp5bjw8sgr-cereal-0.5.4.0.drv",["out"]),("/nix/store/mpql2q0b6a1m2vkb114f9l2s8dhy09zv-asn1-parse-0.9.4.drv",["out"]),("/nix/store/4hkya8j2isw660pj6b0q3by85q2wz1zw-free-4.12.4.drv",["out"]),("/nix/store/wdgbs33iwqadfmlaymw00k6iwnf3as7z-mime-types-0.1.0.7.drv",["out"])],["/nix/store/9krlzvny65gdc8s7kpb6lkx8cd02c25b-default-builder.sh"],"x86_64-linux","/nix/store/fi3mbd2ml4pbgzyasrlnp0wyy6qi48fh-bash-4.4-p5/bin/bash",["-e","/nix/store/9krlzvny65gdc8s7kpb6lkx8cd02c25b-default-builder.sh"],[("allowSubstitutes",""),("buildCommand","mkdir -p $out\nfor i in $paths; do\n /nix/store/lnai0im3lcpb03arxfi0wx1dm7anf4f8-lndir-1.0.3/bin/lndir $i $out\ndone\n. /nix/store/plmya6mkfvq658ba7z6j6n36r5pdbxk5-hook/nix-support/setup-hook\n\n# wrap compiler executables with correct env variables\n\nfor prg in ghc ghci ghc-8.0.2 ghci-8.0.2; do\n if [[ -x \"/nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg\" ]]; then\n rm -f $out/bin/$prg\n makeWrapper /nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg $out/bin/$prg \\\n --add-flags '\"-B$NIX_GHC_LIBDIR\"' \\\n --set \"NIX_GHC\" \"$out/bin/ghc\" \\\n --set \"NIX_GHCPKG\" \"$out/bin/ghc-pkg\" \\\n --set \"NIX_GHC_DOCDIR\" \"$out/share/doc/ghc/html\" \\\n --set \"NIX_GHC_LIBDIR\" \"$out/lib/ghc-8.0.2\" \\\n \n fi\ndone\n\nfor prg in runghc runhaskell; do\n if [[ -x \"/nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg\" ]]; then\n rm -f $out/bin/$prg\n makeWrapper /nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg $out/bin/$prg \\\n --add-flags \"-f $out/bin/ghc\" \\\n --set \"NIX_GHC\" \"$out/bin/ghc\" \\\n --set \"NIX_GHCPKG\" \"$out/bin/ghc-pkg\" \\\n --set \"NIX_GHC_DOCDIR\" \"$out/share/doc/ghc/html\" \\\n --set \"NIX_GHC_LIBDIR\" \"$out/lib/ghc-8.0.2\"\n fi\ndone\n\nfor prg in ghc-pkg ghc-pkg-8.0.2; do\n if [[ -x \"/nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg\" ]]; then\n rm -f $out/bin/$prg\n makeWrapper /nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2/bin/$prg $out/bin/$prg --add-flags \"--global-package-db=$out/lib/ghc-8.0.2/package.conf.d\"\n fi\ndone\n$out/bin/ghc-pkg recache\n\n$out/bin/ghc-pkg check\n\n"),("buildInputs",""),("builder","/nix/store/fi3mbd2ml4pbgzyasrlnp0wyy6qi48fh-bash-4.4-p5/bin/bash"),("extraOutputsToInstall","out doc"),("ignoreCollisions",""),("name","ghc-8.0.2-with-packages"),("nativeBuildInputs",""),("out","/nix/store/w3zbr9zj9mn08hnirn34wsxhry40qi3c-ghc-8.0.2-with-packages"),("passAsFile","buildCommand"),("paths","/nix/store/rlsammwp1ib8d3d9qgbppmdhkbdfg3i9-deriving-compat-0.3.6 /nix/store/v2qsqznrik64f46msahvgg7dmaiag18k-hnix-0.3.4 /nix/store/vbkqj8zdckqqiyjh08ykx75fwc90gwg4-optparse-applicative-0.13.2.0 /nix/store/6m7qia8q0rkdkzvmiak38kdscf27malf-optparse-generic-1.1.5 /nix/store/r687llig7vn9x15hhkmfak01ff7082n6-utf8-string-1.0.1.1 /nix/store/j6gvad67dav8fl3vdbqmar84kgmh5gar-reducers-3.12.1 /nix/store/i8wf08764lknc0f9ja12miqvg509jn1k-fingertree-0.1.1.0 /nix/store/301hq4fabrpbi3l47n908gvakkzq1s88-blaze-markup-0.7.1.1 /nix/store/055mhi44s20x5xgxdjr82vmhnyv79pzl-blaze-html-0.8.1.3 /nix/store/vnc1yyig90skcwx3l1xrbp1jqwmmb9xv-trifecta-1.6.2.1 /nix/store/vraffi24marw5sks8b78xrim6c8i1ng6-double-conversion-2.0.2.0 /nix/store/kwdk03p0lyk5lyll1fp7a6z20j17b3sx-text-format-0.3.1.1 /nix/store/zn5hlw3y94sbli4ssygr2w04mpb396zs-system-filepath-0.4.13.4 /nix/store/jn7lbnk0gsirj8kb02an31v8idy7ym3c-system-fileio-0.3.16.3 /nix/store/9frfci9ywf9lc216ci9nwc1yy0qwrn1b-integer-logarithms-1.0.1 /nix/store/rps46jwa7yyab629p27lar094gk8dal2-scientific-0.3.4.12 /nix/store/c4a3ynvnv3kdxgd7ngmnjhka4mvfk8ll-attoparsec-0.13.1.0 /nix/store/kc34l1gpzh65y4gclmv4dgv6agpmagdi-parsers-0.12.4 /nix/store/1kf78yxf3lliagb5rc5din24iq40g96y-base-prelude-1.0.1.1 /nix/store/hi868d12pkzcbzyvp7a7cigc58mp2lmg-neat-interpolation-0.3.2.1 /nix/store/h00jrbdvzj4yfy796j8vq00lkd1gxr6w-primitive-0.6.1.0 /nix/store/vys8qsf317rn8qwy00p80zlywb47lqwz-vector-0.11.0.0 /nix/store/wchch11312m3lxkwl8rad04x02svcs3i-reflection-2.1.2 /nix/store/jj1kfv52mjxp54flz8v5ba64va3hvy22-parallel-3.2.1.1 /nix/store/jwj23y7vfvs14jdrkw1py9q7lm9fyhy4-adjunctions-4.3 /nix/store/px4979la9b98knwv36551zg3p5jb69lw-kan-extensions-5.0.1 /nix/store/2cp1ar0f73jrcn231ai07zpwayy735j2-semigroupoids-5.1 /nix/store/3nkxw5wdadckz28laijrvwdkkfqp07sb-profunctors-5.2 /nix/store/bd3njvy0ahcsqw47vaz5zayhx34hari7-prelude-extras-0.4.0.3 /nix/store/zdp7zqasz1l1wifpngbg6ngq189gbbqh-free-4.12.4 /nix/store/n7c5ynfqc6j570bbyaajqx34c3pvfvph-tagged-0.8.5 /nix/store/xdkhd7mkqj2mmcami8ycmf7j0valwp5h-distributive-0.5.2 /nix/store/9dxba4g9x0xjj21r3vchqnh4rdwbc31b-void-0.7.2 /nix/store/dahah2ivrn4hc5gjygnlvxlad2399zqh-StateVar-1.1.0.4 /nix/store/f2rdi1bx46fs165n1j316k5w90ab6lwy-contravariant-1.4 /nix/store/mgg9rsvhvn4dd4qzv559nn24iqvspjnb-comonad-5.0.1 /nix/store/18n8i570pf4gpszdyc0bki9qxm1p9xd7-bifunctors-5.4.2 /nix/store/d8ys5wq4wrvdjqw0bzv3y23zqprkhjs2-base-orphans-0.5.4 /nix/store/j4hbyhnj4a2z4z4vb1437vk7ha0b287a-lens-4.15.1 /nix/store/ra3jh12mbyz82n4gvj2bam77vl8aabbq-x509-system-1.6.4 /nix/store/ps8915q1047frp891jg1anp85ads0s9b-x509-validation-1.6.5 /nix/store/5vrgrls6l1cdsbbznis39chx8scq2r98-x509-store-1.6.2 /nix/store/7vvg8y8fp0s50qiciq11irfvh31f1q58-pem-0.2.2 /nix/store/myv75wk9s19f8vms2dcy6sl773288zy4-asn1-parse-0.9.4 /nix/store/kwyc1jdz09lazw21qpc96wyamxalcg11-x509-1.6.5 /nix/store/gadc7c6d1lqn0wqk29bhn56is67x0r45-cryptonite-0.21 /nix/store/ix26y5rpidwpgjzrsixz0ff59j1p1swr-foundation-0.0.7 /nix/store/n784p4qh18zx9v8ag3n3ypszq1kifjjr-memory-0.14.3 /nix/store/h3qq6m5ahdb4kw784gcvx2skil8ilks8-hourglass-0.2.10 /nix/store/dn65dl65spk4j0sky2zpdig75c42ycj1-asn1-types-0.3.2 /nix/store/s5jklkk0y6i7d8h3akgsciv1kv2js786-asn1-encoding-0.9.5 /nix/store/g5qjgns5cyz9c5xw4w5s2iji1kbhg47z-tls-1.3.10 /nix/store/iyllk46by75f428pwis9v74jpr1rmk4x-cereal-0.5.4.0 /nix/store/b22wyyl3wdl6kb7gkpk3yxnynk340lya-socks-0.5.5 /nix/store/05r3i8w2n7hbxqyb4w8rina9rldyacd3-byteable-0.1.1 /nix/store/xjbl6w60czyfqlfwwfs5q93by144yr1n-connection-0.2.8 /nix/store/j10yqzk323rvnwgsk3nj7rgmvqlv035a-http-client-tls-0.3.4.1 /nix/store/vf84v2398g55mai2gjh2d9gipwizhhzd-zlib-0.6.1.2 /nix/store/7h7vy3mi603y536dgvxwfglaacxw5ra8-async-2.1.1.1 /nix/store/y6hh2ifv35afw1j5phpzp1y72x532izn-streaming-commons-0.1.17 /nix/store/f5jdarp8djisa1wrv4bv1saimrabcb3f-random-1.1 /nix/store/18vpnmd28bnjib6andw8bx522wcb3zwa-parsec-3.1.11 /nix/store/i3ra66pcpj0v9wq3m00gh9i72br2bki3-network-uri-2.6.1.0 /nix/store/2ck9avbwacfpi16p2ib2shw951mx33pz-network-2.6.3.1 /nix/store/rz0227nv8n8kdrxjg3arya6r2ixxjh4h-mime-types-0.1.0.7 /nix/store/rx71j4kg0l02dginiswnmwswdq9i9msv-http-types-0.9.1 /nix/store/y2ca4scn0n2f9qsmvsiixcnx11793jlf-transformers-compat-0.5.1.4 /nix/store/bzicr83ibzzzbab6cjkb3i95sc8cvxy9-stm-2.4.4.1 /nix/store/qk5pl6r2h0vfkhhwjgrv8x1ldf8dyj5a-mtl-2.2.1 /nix/store/0d6k71ljl108dgq1l7l3pz12bfwv0z4h-exceptions-0.8.3 /nix/store/z5k23ymwjhhpd670a7mcsm1869hlpncf-old-locale-1.0.0.7 /nix/store/k4an783d4j3m48fqhx7gpnizqg2ns38j-data-default-class-0.1.2.0 /nix/store/p5867jsig02zi0ynww9w4916nm0k527s-cookie-0.4.2.1 /nix/store/wy7j42kqlw1sskagmyc1bzb0xv04s2na-case-insensitive-1.2.0.9 /nix/store/j35339b0nk7k3qaq3m75nl3i4x603rqf-blaze-builder-0.4.0.2 /nix/store/33mip0ql9x1jjbhi34kf8izh4ilyf2k0-base64-bytestring-1.0.0.1 /nix/store/29a73kd2jkwvfdcrhysmi5xjr7nysrxf-http-client-0.5.6.1 /nix/store/d2hy666g79qvhmbh520x5jclwvnr1gk2-text-1.2.2.1 /nix/store/2bdzia66lg08d5zngmllcjry2c08m96j-hashable-1.2.6.0 /nix/store/7kdgc6c0b21s9j5qgg0s0gxj7iid2wk5-unordered-containers-0.2.8.0 /nix/store/zsryzwadshszfnkm740b2412v88iqgi4-semigroups-0.18.2 /nix/store/h2c0kz3m83x6fkl2jzkmin8xvkmfgs7s-charset-0.3.7.1 /nix/store/gapj6j0ya5bi9q9dxspda15k50gx8f1v-ansi-terminal-0.6.2.3 /nix/store/l46769n2p6rlh936zrbwznq3zxxa6mjd-ansi-wl-pprint-0.6.7.3 /nix/store/p7zmpgz0sq5pamgrf1xvhvidc3m4cfmk-dhall-1.3.0 /nix/store/938ndd0mqfm148367lwhl6pk5smv5bm0-data-fix-0.0.4 /nix/store/s0hpng652hsn40jy4kjdh1x0jm86dx9l-ghc-8.0.2"),("preferLocalBuild","1"),("propagatedBuildInputs",""),("propagatedNativeBuildInputs",""),("stdenv","/nix/store/685n25b9yc8sds57vljk459ldly1xyhn-stdenv"),("system","x86_64-linux")]) \ No newline at end of file From 5f33d9755b856062cf4c4e9bdffac29634bdf547 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Tue, 19 May 2020 11:12:36 +0200 Subject: [PATCH 4/8] remote: add buildDerivation and test Closes #20. --- hnix-store-remote/hnix-store-remote.cabal | 7 +- .../src/System/Nix/Store/Remote.hs | 19 +++++ .../src/System/Nix/Store/Remote/Builders.hs | 6 -- .../src/System/Nix/Store/Remote/Util.hs | 19 +++++ hnix-store-remote/tests/Derivation.hs | 72 +++++++++++++++++++ hnix-store-remote/tests/NixDaemon.hs | 7 ++ 6 files changed, 122 insertions(+), 8 deletions(-) create mode 100644 hnix-store-remote/tests/Derivation.hs diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index 541ffdcc..f1f181b7 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -33,6 +33,7 @@ library , text , unix , network + , nix-derivation >= 1.1.1 && <2 , mtl , unordered-containers , filepath @@ -47,8 +48,8 @@ test-suite hnix-store-remote-tests ghc-options: -rtsopts -fprof-auto type: exitcode-stdio-1.0 main-is: Driver.hs - other-modules: - NixDaemon + other-modules: Derivation + , NixDaemon hs-source-dirs: tests build-depends: attoparsec @@ -70,10 +71,12 @@ test-suite hnix-store-remote-tests , tasty-quickcheck , linux-namespaces , mtl + , nix-derivation , temporary , text , time , unix , unordered-containers , vector + , which 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 c32519fe..d68f313c 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -16,6 +16,7 @@ module System.Nix.Store.Remote , addIndirectRoot , addTempRoot , buildPaths + , buildDerivation , ensurePath , findRoots , isValidPathUncached @@ -41,6 +42,7 @@ import Data.ByteString.Lazy (ByteString) import Data.Map.Strict (Map) import Data.Text (Text) +import Nix.Derivation (Derivation) import System.Nix.Build (BuildMode, BuildResult) import System.Nix.Hash (Digest, NamedAlgo, ValidAlgo, SomeNamedDigest(..)) import System.Nix.Nar (Nar) @@ -196,6 +198,23 @@ buildPaths ps bm = do putPaths ps putInt $ fromEnum bm +buildDerivation :: StorePath + -> Derivation StorePath Text + -> BuildMode + -> MonadStore BuildResult +buildDerivation p drv buildMode = do + runOpArgs BuildDerivation $ do + putPath p + putDerivation drv + putEnum buildMode + -- XXX: reason for this is unknown + -- but without it protocol just hangs waiting for + -- more data. Needs investigation + putInt 0 + + res <- getSocketIncremental $ getBuildResult + return res + ensurePath :: StorePath -> MonadStore () ensurePath pn = do void $ simpleOpArgs EnsurePath $ putPath pn diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs index 7009915e..1a5ff4b1 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs @@ -15,7 +15,6 @@ import System.Nix.StorePath (ContentAddressableAddress(..), NarHashMode(..)) import Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder -import qualified Data.Text import qualified System.Nix.Hash -- | Marshall `ContentAddressableAddress` to `Text` @@ -35,14 +34,9 @@ contentAddressableAddressBuilder (Text digest) = contentAddressableAddressBuilder (Fixed narHashMode (SomeDigest digest)) = "fixed:" <> (Data.Text.Lazy.Builder.fromText $ System.Nix.Hash.algoName @hashAlgo) - <> buildNarHashMode narHashMode <> digestBuilder digest - where - buildNarHashMode Recursive = "true" - buildNarHashMode RegularFile = "false" digestBuilder :: Digest a -> Builder digestBuilder = Data.Text.Lazy.Builder.fromText . System.Nix.Hash.encodeBase32 - 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 c38967ba..afe0cf77 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs @@ -19,6 +19,8 @@ import qualified Data.ByteString.Lazy as BSL import Network.Socket.ByteString (recv, sendAll) +import Nix.Derivation + import System.Nix.Build import System.Nix.StorePath import System.Nix.Store.Remote.Binary @@ -142,3 +144,20 @@ getBuildResult = BuildResult <*> getBool <*> getTime <*> getTime + +putDerivation :: Derivation StorePath Text -> Put +putDerivation Derivation{..} = do + flip putMany (Data.Map.toList outputs) + $ \(outputName, DerivationOutput{..}) -> do + putText outputName + putPath path + putText hashAlgo + putText hash + + putMany putPath inputSrcs + putText platform + putText builder + putMany putText args + + flip putMany (Data.Map.toList env) + $ \(first, second) -> putText first >> putText second diff --git a/hnix-store-remote/tests/Derivation.hs b/hnix-store-remote/tests/Derivation.hs new file mode 100644 index 00000000..5cfd2ce2 --- /dev/null +++ b/hnix-store-remote/tests/Derivation.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} + +module Derivation where + +import Control.Monad.IO.Class (liftIO) + +import Data.Text (Text) +import Nix.Derivation (Derivation(..), DerivationOutput(..)) +import System.Nix.StorePath (StorePath, storePathToText) + +import System.Nix.Store.Remote (addToStore, addTextToStore) +import System.Nix.Hash (HashAlgorithm(Truncated, SHA256)) + +import qualified Data.Map +import qualified Data.Set +import qualified Data.Text +import qualified Data.Text.Lazy +import qualified Data.Text.Lazy.Builder +import qualified Data.Vector +import qualified Nix.Derivation +import qualified System.Nix.Derivation +import qualified System.Nix.StorePath +import qualified System.Which + +drvSample :: StorePath -> StorePath -> StorePath -> Derivation StorePath Text +drvSample builder buildScript out = Derivation { + outputs = Data.Map.fromList [ ("out", DerivationOutput out "sha256" "test") ] + , inputDrvs = Data.Map.fromList [ (builder, Data.Set.fromList [ "out" ]) ] + , inputSrcs = Data.Set.fromList [ buildScript ] + , platform = "x86_64-linux" + , builder = storePathToText builder + , args = Data.Vector.fromList ["-e", storePathToText buildScript ] + , env = Data.Map.fromList [("testEnv", "true")] + } + +withBash action = do + mfp <- liftIO $ System.Which.which "bash" + case mfp of + Nothing -> error "No bash executable found" + Just fp -> do + let Right n = System.Nix.StorePath.makeStorePathName "bash" + path <- addToStore @SHA256 n fp False (pure True) False + action path + +withBuildScript action = do + path <- addTextToStore + "buildScript" + (Data.Text.concat [ "declare -xp", "export > $out" ]) + mempty + False + + action path + +withDerivation action = withBuildScript $ \buildScript -> withBash $ \bash -> do + outputPath <- addTextToStore "wannabe-output" "" mempty False + + let d = drvSample bash buildScript outputPath + + path <- addTextToStore + "hnix-store-derivation" + (Data.Text.Lazy.toStrict + $ Data.Text.Lazy.Builder.toLazyText + $ System.Nix.Derivation.buildDerivation d + ) + mempty + False + + liftIO $ print d + action path d + diff --git a/hnix-store-remote/tests/NixDaemon.hs b/hnix-store-remote/tests/NixDaemon.hs index c0fe4142..caca4728 100644 --- a/hnix-store-remote/tests/NixDaemon.hs +++ b/hnix-store-remote/tests/NixDaemon.hs @@ -54,6 +54,7 @@ import System.Nix.Store.Remote.Types import System.Nix.Store.Remote.Protocol import System.Nix.Store.Remote.Util +import Derivation createProcessEnv :: FilePath -> String @@ -294,3 +295,9 @@ spec_protocol = Hspec.around withNixDaemon $ do path <- dummy liftIO $ putStrLn $ show path (isValidPathUncached path) `shouldReturn` True + + context "derivation" $ do + itRights "build derivation" $ do + withDerivation $ \path drv -> do + result <- buildDerivation path drv Normal + result `shouldSatisfy` ((==AlreadyValid) . status) From 4ddea5b1e9b9650b15235fafeef51c9757b58c5a Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Sun, 7 Jun 2020 10:59:53 +0200 Subject: [PATCH 5/8] core: derive Ord for StorePathTrust --- hnix-store-core/src/System/Nix/StorePathMetadata.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hnix-store-core/src/System/Nix/StorePathMetadata.hs b/hnix-store-core/src/System/Nix/StorePathMetadata.hs index a772814a..6f9c509c 100644 --- a/hnix-store-core/src/System/Nix/StorePathMetadata.hs +++ b/hnix-store-core/src/System/Nix/StorePathMetadata.hs @@ -47,4 +47,4 @@ data StorePathTrust | -- | It was built elsewhere (and substituted or similar) and so -- is less trusted BuiltElsewhere - deriving (Show, Eq) + deriving (Show, Eq, Ord) From 84cbca23e31831af685124936328730049b9d058 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Tue, 14 Jul 2020 12:39:32 +0200 Subject: [PATCH 6/8] core: Update ChangeLog --- hnix-store-core/ChangeLog.md | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/hnix-store-core/ChangeLog.md b/hnix-store-core/ChangeLog.md index 42ae2558..f379c921 100644 --- a/hnix-store-core/ChangeLog.md +++ b/hnix-store-core/ChangeLog.md @@ -1,10 +1,25 @@ # Revision history for hnix-store-core +## (unreleased) 0.3.0.0 -- 2020-XY-ZV + +* `StorePath` type changed to simple variant without type level +symbolic store path root. +* Added `makeFixedOutputPath` to `System.Nix.ReadonlyStore` +* Added `decodeBase16` and `decodeBase32` to `System.Nix.Hash` +* `System.Nix.StorePath` module now provides + * `storePathToFilePath` and `storePathToText` helpers + * `storePathToNarInfo` for converting paths to `narinfo` URLs + * `parsePath` function + * `pathParser` Attoparsec parser +* Added `System.Nix.Build` module +* Added `System.Nix.Derivation` module +* Removed `System.Nix.Util` module, moved to `hnix-store-remote` + ## 0.2.0.0 -- 2020-03-12 Removed `System.Nix.Store`. We may reintroduce it later when multiple backends exist and we can tell what common effects they should share. -## 0.1.0.0 -- YYYY-mm-dd +## 0.1.0.0 -- 2019-03-18 * First version. From 850bafdb848caa335cd700bf679edb58b19268d0 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Tue, 14 Jul 2020 12:42:46 +0200 Subject: [PATCH 7/8] remote: Add ChangeLog.md --- hnix-store-remote/ChangeLog.md | 14 ++++++++++++++ hnix-store-remote/hnix-store-remote.cabal | 2 +- 2 files changed, 15 insertions(+), 1 deletion(-) create mode 100644 hnix-store-remote/ChangeLog.md diff --git a/hnix-store-remote/ChangeLog.md b/hnix-store-remote/ChangeLog.md new file mode 100644 index 00000000..e1da8835 --- /dev/null +++ b/hnix-store-remote/ChangeLog.md @@ -0,0 +1,14 @@ +# Revision history for hnix-store-remote + +## (unreleased) 0.3.0.0 -- 2020-XY-ZV + +* Restored most store API functions +* Added `buildDerivation` + +## 0.2.0.0 -- skipped + +* `hnix-store-core` release only + +## 0.1.0.0 -- 2019-03-18 + +* First version. diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index f1f181b7..59c1c4b7 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -10,7 +10,7 @@ maintainer: srk@48.io copyright: 2018 Richard Marko category: Nix build-type: Simple -extra-source-files: README.md +extra-source-files: ChangeLog.md, README.md cabal-version: >=1.10 library From dff752750d2fd324454f6f7bbb156266b66e5a78 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Tue, 14 Jul 2020 13:20:04 +0200 Subject: [PATCH 8/8] remote: Put tests behind io-testsuite flag Disabled by default since it requires `nix-daemon` binary and Linux namespaces support. For development this can be enabled by ``` cabal configure --flag=io-testsuite ``` or by adding ``` flags: +io-testsuite ``` to `cabal.project.local` Enabled by `callCabal2nixWithOptions` in `overlay.nix` so it is tested by `nix-build` and `nix-shell` brings all test dependencies. This is fine on NixOS where `build-tool-depends: nix:nix-daemon` works and we have namespaces supported. --- hnix-store-remote/hnix-store-remote.cabal | 12 ++++++++++++ overlay.nix | 2 +- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index 59c1c4b7..8f7ce895 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -13,6 +13,13 @@ build-type: Simple extra-source-files: ChangeLog.md, README.md cabal-version: >=1.10 +flag io-testsuite + default: + False + description: + Enable testsuite, which requires external + binaries and Linux namespace support. + library exposed-modules: System.Nix.Store.Remote , System.Nix.Store.Remote.Binary @@ -45,6 +52,11 @@ library ghc-options: -Wall test-suite hnix-store-remote-tests + if !flag(io-testsuite) + buildable: False + + build-tool-depends: nix:nix-daemon + ghc-options: -rtsopts -fprof-auto type: exitcode-stdio-1.0 main-is: Driver.hs diff --git a/overlay.nix b/overlay.nix index bec82795..0410d0ec 100644 --- a/overlay.nix +++ b/overlay.nix @@ -2,5 +2,5 @@ huper: helf: { hnix-store-core = helf.callCabal2nix "hnix-store-core" ./hnix-store-core {}; hnix-store-remote = - helf.callCabal2nix "hnix-store-remote" ./hnix-store-remote {}; + helf.callCabal2nixWithOptions "hnix-store-remote" ./hnix-store-remote "-fio-testsuite" {}; }