hnix-store-remote 0.5.0.0 → 0.6.0.0
raw patch · 13 files changed
+194/−276 lines, 13 filesdep +reludedep −vectordep ~basedep ~hnix-store-coredep ~nix-derivationPVP ok
version bump matches the API change (PVP)
Dependencies added: relude
Dependencies removed: vector
Dependency ranges changed: base, hnix-store-core, nix-derivation
API changes (from Hackage documentation)
+ System.Nix.Store.Remote.Protocol: runStoreOpts' :: Family -> SockAddr -> FilePath -> MonadStore a -> IO (Either String a, [Logger])
+ System.Nix.Store.Remote.Protocol: runStoreOptsTCP :: String -> Int -> FilePath -> MonadStore a -> IO (Either String a, [Logger])
- System.Nix.Store.Remote: addToStore :: forall a. NamedAlgo a => StorePathName -> FilePath -> Bool -> (FilePath -> Bool) -> RepairFlag -> MonadStore StorePath
+ System.Nix.Store.Remote: addToStore :: forall a. NamedAlgo a => StorePathName -> NarSource MonadStore -> Bool -> RepairFlag -> MonadStore StorePath
Files
- ChangeLog.md +8/−1
- hnix-store-remote.cabal +52/−8
- src/System/Nix/Store/Remote.hs +27/−46
- src/System/Nix/Store/Remote/Binary.hs +3/−5
- src/System/Nix/Store/Remote/Builders.hs +9/−11
- src/System/Nix/Store/Remote/Logger.hs +6/−8
- src/System/Nix/Store/Remote/Parsers.hs +5/−11
- src/System/Nix/Store/Remote/Protocol.hs +30/−24
- src/System/Nix/Store/Remote/Types.hs +7/−12
- src/System/Nix/Store/Remote/Util.hs +11/−17
- tests/Derivation.hs +0/−81
- tests/NixDaemon.hs +35/−51
- tests/Util.hs +1/−1
ChangeLog.md view
@@ -1,6 +1,13 @@ # Revision history for hnix-store-remote -## [0.5.0.0](https://github.com/haskell-nix/hnix-store/compare/0.4.3.0...0.5.0.0) 2021-06-11+## [0.6.0.0](https://github.com/haskell-nix/hnix-store/compare/remote-0.5.0.0...remote-0.6.0.0) 2021-06-06++* Breaking:+ * [(link)](https://github.com/haskell-nix/hnix-store/pull/179) `System.Nix.Store.Remote`:+ * `addToStore` no longer accepts `FilePath` as its second argument but uses+ more generic `NarSource` [(NarSource PR)](https://github.com/haskell-nix/hnix-store/pull/177)++## [0.5.0.0](https://github.com/haskell-nix/hnix-store/compare/0.4.3.0...remote-0.5.0.0) 2021-06-11 * Breaking: * [(link)](https://github.com/haskell-nix/hnix-store/commit/3b948d112aa9307b0451258f28c7ee5dc86b24c7) `System.Nix.Store.Remote`:
hnix-store-remote.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: hnix-store-remote-version: 0.5.0.0+version: 0.6.0.0 synopsis: Remote hnix store description: Implementation of the nix store using the daemon protocol. homepage: https://github.com/haskell-nix/hnix-store@@ -39,7 +39,8 @@ , System.Nix.Store.Remote.Util build-depends:- base >=4.10 && <5+ base >=4.12 && <5+ , relude >= 1.0 , attoparsec , binary , bytestring@@ -51,7 +52,30 @@ , nix-derivation >= 1.1.1 && <2 , mtl , unordered-containers- , hnix-store-core >= 0.5 && <0.6+ , hnix-store-core >= 0.6 && <0.7+ mixins:+ base hiding (Prelude)+ , relude (Relude as Prelude)+ , relude+ default-extensions:+ OverloadedStrings+ , DeriveGeneric+ , DeriveDataTypeable+ , DeriveFunctor+ , DeriveFoldable+ , DeriveTraversable+ , DeriveLift+ , FlexibleContexts+ , FlexibleInstances+ , StandaloneDeriving+ , TypeApplications+ , TypeSynonymInstances+ , InstanceSigs+ , MultiParamTypeClasses+ , TupleSections+ , LambdaCase+ , BangPatterns+ , ViewPatterns hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall@@ -66,8 +90,7 @@ type: exitcode-stdio-1.0 main-is: Driver.hs other-modules:- Derivation- , NixDaemon+ NixDaemon , Spec , Util hs-source-dirs: tests@@ -75,6 +98,7 @@ tasty-discover:tasty-discover build-depends: base+ , relude , hnix-store-core >= 0.3 , hnix-store-remote , containers@@ -89,10 +113,30 @@ , tasty-hspec , tasty-quickcheck , linux-namespaces- , nix-derivation , temporary- , text , unix , unordered-containers- , vector+ mixins:+ base hiding (Prelude)+ , relude (Relude as Prelude)+ , relude+ default-extensions:+ OverloadedStrings+ , DeriveGeneric+ , DeriveDataTypeable+ , DeriveFunctor+ , DeriveFoldable+ , DeriveTraversable+ , DeriveLift+ , FlexibleContexts+ , FlexibleInstances+ , StandaloneDeriving+ , TypeApplications+ , TypeSynonymInstances+ , InstanceSigs+ , MultiParamTypeClasses+ , TupleSections+ , LambdaCase+ , BangPatterns+ , ViewPatterns default-language: Haskell2010
src/System/Nix/Store/Remote.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE RecordWildCards #-}+{-# language AllowAmbiguousTypes #-}+{-# language KindSignatures #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language DataKinds #-}+{-# language RecordWildCards #-}+{-# language LiberalTypeSynonyms #-}+ module System.Nix.Store.Remote ( addToStore , addTextToStore@@ -35,19 +35,14 @@ ) where -import Control.Monad ( void- , unless- , when- )-import Data.ByteString.Lazy ( ByteString )-import Data.Map.Strict ( Map )-import Data.Text ( Text )+import Prelude hiding ( putText )+import qualified Data.ByteString.Lazy as BSL import Nix.Derivation ( Derivation ) import System.Nix.Build ( BuildMode , BuildResult )-import System.Nix.Hash ( NamedAlgo+import System.Nix.Hash ( NamedAlgo(..) , SomeNamedDigest(..) , BaseEncoding(NixBase32) , decodeDigestWith@@ -63,13 +58,9 @@ import System.Nix.Internal.Base ( encodeWith ) 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 System.Nix.Nar-import qualified System.Nix.Hash import qualified System.Nix.StorePath import qualified System.Nix.Store.Remote.Parsers @@ -78,36 +69,29 @@ import System.Nix.Store.Remote.Protocol import System.Nix.Store.Remote.Util import Crypto.Hash ( SHA256 )-import Data.Coerce ( coerce )+import System.Nix.Nar ( NarSource ) type RepairFlag = Bool type CheckFlag = Bool type SubstituteFlag = Bool --- | Pack `FilePath` as `Nar` and add it to the store.+-- | Pack `Nar` and add it to the store. addToStore :: forall a- . NamedAlgo a+ . (NamedAlgo a) => StorePathName -- ^ Name part of the newly created `StorePath`- -> FilePath -- ^ Local `FilePath` to add+ -> NarSource MonadStore -- ^ provide nar stream -> 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-+addToStore name source recursive _repair = do runOpArgsIO AddToStore $ \yield -> do- yield $ Data.ByteString.Lazy.toStrict $ Data.Binary.Put.runPut $ do+ yield $ toStrict $ Data.Binary.Put.runPut $ do putText $ System.Nix.StorePath.unStorePathName name- putBool $ not $ System.Nix.Hash.algoName @a == "sha256" && recursive- putBool recursive- putText $ System.Nix.Hash.algoName @a-- System.Nix.Nar.streamNarIO yield System.Nix.Nar.narEffectsIO pth-+ source yield sockGetPath -- | Add text to store.@@ -129,7 +113,7 @@ putPaths references' sockGetPath -addSignatures :: StorePath -> [ByteString] -> MonadStore ()+addSignatures :: StorePath -> [BSL.ByteString] -> MonadStore () addSignatures p signatures = do void $ simpleOpArgs AddSignatures $ do putPath p@@ -171,15 +155,14 @@ -- Intentionally the only warning that should pop-up. putInt (0 :: Integer) - res <- getSocketIncremental getBuildResult- pure res+ getSocketIncremental getBuildResult ensurePath :: StorePath -> MonadStore () ensurePath pn = do void $ simpleOpArgs EnsurePath $ putPath pn -- | Find garbage collector roots.-findRoots :: MonadStore (Map ByteString StorePath)+findRoots :: MonadStore (Map BSL.ByteString StorePath) findRoots = do runOp FindRoots sd <- getStoreDir@@ -187,7 +170,7 @@ getSocketIncremental $ getMany $ (,)- <$> (Data.ByteString.Lazy.fromStrict <$> getByteStringLen)+ <$> (fromStrict <$> getByteStringLen) <*> getPath sd r <- catRights res@@ -198,7 +181,7 @@ ex :: (a, Either [Char] b) -> MonadStore (a, b) ex (x , Right y) = pure (x, y)- ex (_x, Left e ) = error $ "Unable to decode root: " <> e+ ex (_x, Left e ) = error $ "Unable to decode root: " <> fromString e isValidPathUncached :: StorePath -> MonadStore Bool isValidPathUncached p = do@@ -235,13 +218,13 @@ deriverPath <- sockGetPathMay - narHashText <- Data.Text.Encoding.decodeUtf8 <$> sockGetStr+ narHashText <- decodeUtf8 <$> sockGetStr let narHash = case decodeDigestWith @SHA256 NixBase32 narHashText of- Left e -> error e+ Left e -> error $ fromString e Right x -> SomeDigest x references <- sockGetPaths@@ -260,7 +243,7 @@ case System.Nix.Store.Remote.Parsers.parseContentAddressableAddress caString of- Left e -> error e+ Left e -> error $ fromString e Right x -> Just x trust = if ultimate then BuiltLocally else BuiltElsewhere@@ -291,9 +274,7 @@ queryPathFromHashPart storePathHash = do runOpArgs QueryPathFromHashPart $ putByteStringLen- $ Data.ByteString.Lazy.fromStrict- $ Data.Text.Encoding.encodeUtf8- $ encodeWith NixBase32 $ coerce storePathHash+ $ encodeUtf8 (encodeWith NixBase32 $ coerce storePathHash) sockGetPath queryMissing
src/System/Nix/Store/Remote/Binary.hs view
@@ -4,10 +4,8 @@ |-} 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@@ -35,7 +33,7 @@ where len :: Int len = fromIntegral $ BSL.length x- pad count = sequence_ $ replicate count (putWord8 0)+ pad count = replicateM_ count (putWord8 0) putByteStrings :: Foldable t => t BSL.ByteString -> Put putByteStrings = putMany putByteStringLen@@ -47,8 +45,8 @@ when (len `mod` 8 /= 0) $ do pads <- unpad $ fromIntegral $ 8 - (len `mod` 8) unless (all (== 0) pads) $ fail $ "No zeroes" <> show (st, len, pads)- pure $ BSL.toStrict st- where unpad x = sequence $ replicate x getWord8+ pure $ toStrict st+ where unpad x = replicateM x getWord8 getByteStrings :: Get [ByteString] getByteStrings = getMany getByteStringLen
src/System/Nix/Store/Remote/Builders.hs view
@@ -1,38 +1,36 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeApplications #-}+{-# language AllowAmbiguousTypes #-}+{-# language ScopedTypeVariables #-}+{-# language RankNTypes #-} module System.Nix.Store.Remote.Builders ( buildContentAddressableAddress ) where -import Data.Text.Lazy ( Text )+import qualified Data.Text.Lazy as TL import Crypto.Hash ( Digest ) import System.Nix.StorePath ( ContentAddressableAddress(..) ) import Data.Text.Lazy.Builder ( Builder )-import qualified Data.Text.Lazy.Builder+import qualified Data.Text.Lazy.Builder as TL import System.Nix.Hash -- | Marshall `ContentAddressableAddress` to `Text` -- in form suitable for remote protocol usage.-buildContentAddressableAddress :: ContentAddressableAddress -> Text+buildContentAddressableAddress :: ContentAddressableAddress -> TL.Text buildContentAddressableAddress =- Data.Text.Lazy.Builder.toLazyText . contentAddressableAddressBuilder+ TL.toLazyText . contentAddressableAddressBuilder contentAddressableAddressBuilder :: ContentAddressableAddress -> Builder contentAddressableAddressBuilder (Text digest) = "text:" <> digestBuilder digest contentAddressableAddressBuilder (Fixed _narHashMode (SomeDigest (digest :: Digest hashAlgo))) = "fixed:"- <> (Data.Text.Lazy.Builder.fromText $ System.Nix.Hash.algoName @hashAlgo)+ <> TL.fromText (System.Nix.Hash.algoName @hashAlgo) <> digestBuilder digest digestBuilder :: Digest a -> Builder digestBuilder =- Data.Text.Lazy.Builder.fromText . encodeDigestWith NixBase32+ TL.fromText . encodeDigestWith NixBase32
src/System/Nix/Store/Remote/Logger.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RankNTypes #-}+{-# language RankNTypes #-} module System.Nix.Store.Remote.Logger ( Logger(..)@@ -8,9 +8,8 @@ where -import Control.Monad.Except-import Control.Monad.Reader ( asks )-import Control.Monad.State ( get )+import Prelude hiding ( Last )+import Control.Monad.Except ( throwError ) import Data.Binary.Get import Network.Socket.ByteString ( recv )@@ -60,8 +59,7 @@ sockPut $ putByteStringLen part clearData - next <- go decoder- pure next+ go decoder -- we should probably handle Read here as well x -> do@@ -72,12 +70,12 @@ chunk <- liftIO (Just <$> recv soc 8) go (k chunk) - go (Fail _leftover _consumed msg) = error msg+ go (Fail _leftover _consumed msg) = error $ fromString msg getFields :: Get [Field] getFields = do cnt <- getInt- sequence $ replicate cnt getField+ replicateM cnt getField getField :: Get Field getField = do
src/System/Nix/Store/Remote/Parsers.hs view
@@ -1,20 +1,14 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeApplications #-}+{-# language AllowAmbiguousTypes #-}+{-# language ScopedTypeVariables #-}+{-# language RankNTypes #-}+{-# language DataKinds #-} module System.Nix.Store.Remote.Parsers ( parseContentAddressableAddress ) where -import Control.Applicative ( (<|>) ) import Data.Attoparsec.ByteString.Char8-import Data.ByteString.Char8-import Data.Text ( Text )-import Data.Text.Encoding ( decodeUtf8 ) import System.Nix.Hash import System.Nix.StorePath ( ContentAddressableAddress(..) , NarHashMode(..)@@ -42,7 +36,7 @@ caFixed :: Parser ContentAddressableAddress caFixed = do _ <- "fixed:"- narHashMode <- (pure Recursive <$> "r:") <|> (pure RegularFile <$> "")+ narHashMode <- (Recursive <$ "r:") <|> (RegularFile <$ "") digest <- parseTypedDigest either fail pure $ Fixed narHashMode <$> digest
src/System/Nix/Store/Remote/Protocol.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}+{-# language DataKinds #-}+{-# language ScopedTypeVariables #-}+{-# LANGUAGE LambdaCase #-} module System.Nix.Store.Remote.Protocol ( WorkerOp(..) , simpleOp@@ -10,24 +10,23 @@ , runOpArgsIO , runStore , runStoreOpts+ , runStoreOptsTCP+ , runStoreOpts' ) where +import qualified Relude.Unsafe as Unsafe -import Data.Bool ( bool ) import Control.Exception ( bracket ) import Control.Monad.Except-import Control.Monad.Reader-import Control.Monad.State import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString import qualified Data.ByteString.Char8-import qualified Data.ByteString.Lazy import Network.Socket ( SockAddr(SockAddrUnix) )-import qualified Network.Socket+import qualified Network.Socket as S import Network.Socket.ByteString ( recv , sendAll )@@ -122,7 +121,7 @@ simpleOp :: WorkerOp -> MonadStore Bool-simpleOp op = simpleOpArgs op $ pure ()+simpleOp op = simpleOpArgs op pass simpleOpArgs :: WorkerOp -> Put -> MonadStore Bool simpleOpArgs op args = do@@ -131,19 +130,19 @@ bool sockGetBool (do- Error _num msg <- head <$> getError+ Error _num msg <- Unsafe.head <$> getError throwError $ Data.ByteString.Char8.unpack msg ) err runOp :: WorkerOp -> MonadStore ()-runOp op = runOpArgs op $ pure ()+runOp op = runOpArgs op pass runOpArgs :: WorkerOp -> Put -> MonadStore () runOpArgs op args = runOpArgsIO op- (\encode -> encode $ Data.ByteString.Lazy.toStrict $ runPut args)+ (\encode -> encode $ toStrict $ runPut args) runOpArgsIO :: WorkerOp@@ -160,7 +159,7 @@ modify (\(a, b) -> (a, b <> out)) err <- gotError when err $ do- Error _num msg <- head <$> getError+ Error _num msg <- Unsafe.head <$> getError throwError $ Data.ByteString.Char8.unpack msg runStore :: MonadStore a -> IO (Either String a, [Logger])@@ -168,17 +167,24 @@ 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 <-- Network.Socket.socket- Network.Socket.AF_UNIX- Network.Socket.Stream- 0+runStoreOpts path = runStoreOpts' S.AF_UNIX (SockAddrUnix path) - Network.Socket.connect soc (SockAddrUnix path)+runStoreOptsTCP+ :: String -> Int -> FilePath -> MonadStore a -> IO (Either String a, [Logger])+runStoreOptsTCP host port storeRootDir code = do+ S.getAddrInfo (Just S.defaultHints) (Just host) (Just $ show port) >>= \case+ (sockAddr:_) -> runStoreOpts' (S.addrFamily sockAddr) (S.addrAddress sockAddr) storeRootDir code+ _ -> pure (Left "Couldn't resolve host and port with getAddrInfo.", [])++runStoreOpts'+ :: S.Family -> S.SockAddr -> FilePath -> MonadStore a -> IO (Either String a, [Logger])+runStoreOpts' sockFamily sockAddr storeRootDir code =+ bracket open (S.close . storeSocket) run++ where+ open = do+ soc <- S.socket sockFamily S.Stream 0+ S.connect soc sockAddr pure StoreConfig { storeSocket = soc , storeDir = storeRootDir@@ -190,7 +196,7 @@ vermagic <- liftIO $ recv soc 16 let (magic2, _daemonProtoVersion) =- flip runGet (Data.ByteString.Lazy.fromStrict vermagic)+ flip runGet (fromStrict vermagic) $ (,) <$> (getInt :: Get Int) <*> (getInt :: Get Int)
src/System/Nix/Store/Remote/Types.hs view
@@ -1,7 +1,6 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language ScopedTypeVariables #-} module System.Nix.Store.Remote.Types ( MonadStore , StoreConfig(..)@@ -18,12 +17,8 @@ where -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 data StoreConfig = StoreConfig { storeDir :: FilePath@@ -61,13 +56,13 @@ isError _ = False gotError :: MonadStore Bool-gotError = any isError . snd <$> get+gotError = gets (any isError . snd) getError :: MonadStore [Logger]-getError = filter isError . snd <$> get+getError = gets (filter isError . snd) getLog :: MonadStore [Logger]-getLog = snd <$> get+getLog = gets snd flushLog :: MonadStore () flushLog = modify (\(a, _b) -> (a, []))@@ -79,4 +74,4 @@ clearData = modify (\(_, b) -> (Nothing, b)) getStoreDir :: MonadStore FilePath-getStoreDir = storeDir <$> ask+getStoreDir = asks storeDir
src/System/Nix/Store/Remote/Util.hs view
@@ -1,20 +1,14 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}+{-# language RecordWildCards #-} module System.Nix.Store.Remote.Util where +import Prelude hiding ( putText ) import Control.Monad.Except-import Control.Monad.Reader -import Data.Either import Data.Binary.Get import Data.Binary.Put-import Data.Text ( Text )-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import Data.Time import Data.Time.Clock.POSIX-import Data.ByteString ( ByteString ) import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as BSL @@ -40,7 +34,7 @@ go (Partial k ) = do chunk <- getsome go (k chunk)- go (Fail _leftover _consumed msg) = error msg+ go (Fail _leftover _consumed msg) = error $ fromString msg getSocketIncremental :: Get a -> MonadStore a getSocketIncremental = genericIncremental sockGet8@@ -53,7 +47,7 @@ sockPut :: Put -> MonadStore () sockPut p = do soc <- asks storeSocket- liftIO $ sendAll soc $ BSL.toStrict $ runPut p+ liftIO $ sendAll soc $ toStrict $ runPut p sockGet :: Get a -> MonadStore a sockGet = getSocketIncremental@@ -95,16 +89,16 @@ getSocketIncremental (getPaths sd) bsToText :: ByteString -> Text-bsToText = T.decodeUtf8+bsToText = decodeUtf8 textToBS :: Text -> ByteString-textToBS = T.encodeUtf8+textToBS = encodeUtf8 bslToText :: BSL.ByteString -> Text-bslToText = TL.toStrict . TL.decodeUtf8+bslToText = toText . TL.decodeUtf8 textToBSL :: Text -> BSL.ByteString-textToBSL = TL.encodeUtf8 . TL.fromStrict+textToBSL = TL.encodeUtf8 . toLText putText :: Text -> Put putText = putByteStringLen . textToBSL@@ -120,11 +114,11 @@ Data.HashSet.fromList . rights . fmap (parsePath sd) <$> getByteStrings putPath :: StorePath -> Put-putPath = putByteStringLen . BSL.fromStrict . storePathToRawFilePath+putPath = putByteStringLen . fromStrict . storePathToRawFilePath putPaths :: StorePathSet -> Put putPaths = putByteStrings . Data.HashSet.toList . Data.HashSet.map- (BSL.fromStrict . storePathToRawFilePath)+ (fromStrict . storePathToRawFilePath) putBool :: Bool -> Put putBool True = putInt (1 :: Int)@@ -170,4 +164,4 @@ putMany putText args flip putMany (Data.Map.toList env)- $ \(first, second) -> putText first >> putText second+ $ \(a1, a2) -> putText a1 *> putText a2
− tests/Derivation.hs
@@ -1,81 +0,0 @@-{-# 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 ( MonadStore- , addToStore- , addTextToStore- )-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 System.Nix.Derivation-import qualified System.Nix.StorePath-import qualified System.Directory-import Crypto.Hash ( SHA256 )--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 :: (StorePath -> MonadStore a) -> MonadStore a-withBash action = do- mfp <- liftIO $ System.Directory.findExecutable "bash"- case mfp of- Nothing -> error "No bash executable found"- Just fp -> do- let Right n = System.Nix.StorePath.makeStorePathName "bash"- pth <- addToStore @SHA256 n fp False (pure True) False- action pth--withBuildScript :: (StorePath -> MonadStore a) -> MonadStore a-withBuildScript action = do- pth <- addTextToStore "buildScript"- (Data.Text.concat ["declare -xp", "export > $out"])- mempty- False-- action pth--withDerivation- :: (StorePath -> Derivation StorePath Text -> MonadStore a) -> MonadStore a-withDerivation action = withBuildScript $ \buildScript -> withBash $ \bash ->- do- outputPath <- addTextToStore "wannabe-output" "" mempty False-- let d = drvSample bash buildScript outputPath-- pth <- addTextToStore- "hnix-store-derivation"- ( Data.Text.Lazy.toStrict- $ Data.Text.Lazy.Builder.toLazyText- $ System.Nix.Derivation.buildDerivation d- )- mempty- False-- liftIO $ print d- action pth d-
tests/NixDaemon.hs view
@@ -1,23 +1,14 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}+{-# language DataKinds #-}+{-# language ScopedTypeVariables #-} module NixDaemon where -import Data.Bool ( bool )-import Control.Monad ( void )-import Control.Monad.IO.Class ( liftIO )+import qualified System.Environment as Env import Control.Exception ( bracket ) import Control.Concurrent ( threadDelay )-import Data.Either ( isRight- , isLeft- )-import Data.Text ( Text ) import qualified Data.HashSet as HS import qualified Data.Map.Strict as M import System.Directory-import qualified System.Environment import System.IO.Temp import qualified System.Process as P import System.Posix.User as U@@ -36,30 +27,30 @@ import System.Nix.Store.Remote import System.Nix.Store.Remote.Protocol -import Derivation-import Crypto.Hash ( SHA256- )+import Crypto.Hash ( SHA256 )+import System.Nix.Nar ( dumpPath ) createProcessEnv :: FilePath -> String -> [String] -> IO P.ProcessHandle createProcessEnv fp proc args = do- mPath <- System.Environment.lookupEnv "PATH"+ mPath <- Env.lookupEnv "PATH" (_, _, _, ph) <- P.createProcess (P.proc proc args)- { P.cwd = Just $ fp+ { P.cwd = Just fp , P.env = Just $ mockedEnv mPath fp } pure ph mockedEnv :: Maybe String -> FilePath -> [(String, FilePath)]-mockedEnv mEnvPath fp =- [ ("NIX_STORE_DIR" , fp </> "store")- , ("NIX_LOCALSTATE_DIR", fp </> "var")- , ("NIX_LOG_DIR" , fp </> "var" </> "log")- , ("NIX_STATE_DIR" , fp </> "var" </> "nix")- , ("NIX_CONF_DIR" , fp </> "etc")+mockedEnv mEnvPath fp = (fp </>) <<$>>+ [ ("NIX_STORE_DIR" , "store")+ , ("NIX_LOCALSTATE_DIR", "var")+ , ("NIX_LOG_DIR" , "var" </> "log")+ , ("NIX_STATE_DIR" , "var" </> "nix")+ , ("NIX_CONF_DIR" , "etc")+ , ("HOME" , "home") -- , ("NIX_REMOTE", "daemon")- ] <> (maybe [] (\x -> [("PATH", x)]) mEnvPath)+ ] <> foldMap (\x -> [("PATH", x)]) mEnvPath waitSocket :: FilePath -> Int -> IO () waitSocket _ 0 = fail "No socket"@@ -67,12 +58,12 @@ ex <- doesFileExist fp bool (threadDelay 100000 >> waitSocket fp (x - 1))- (pure ())+ pass ex writeConf :: FilePath -> IO () writeConf fp =- writeFile fp $ unlines+ writeFileText fp $ unlines [ "build-users-group = " , "trusted-users = root" , "allowed-users = *"@@ -131,7 +122,7 @@ bracket (startDaemon path) (P.terminateProcess . fst)- (\x -> action . snd $ x)+ (action . snd) checks :: (Show a, Show b) => IO (a, b) -> (a -> Bool) -> IO () checks action check = action >>= (`Hspec.shouldSatisfy` (check . fst))@@ -143,7 +134,7 @@ -> (a -> Bool) -> Hspec.SpecWith (m () -> IO (a, b)) it name action check =- Hspec.it name $ \run -> (run (action >> pure ())) `checks` check+ Hspec.it name $ \run -> run (action >> pass) `checks` check itRights :: (Show a, Show b, Show c, Monad m)@@ -168,8 +159,7 @@ dummy :: MonadStore StorePath dummy = do let Right n = makeStorePathName "dummy"- res <- addToStore @SHA256 n "dummy" False (pure True) False- pure res+ addToStore @SHA256 n (dumpPath "dummy") False False invalidPath :: StorePath invalidPath =@@ -204,30 +194,30 @@ verifyStore True True `shouldReturn` False context "addTextToStore" $- itRights "adds text to store" $ withPath $ const pure ()+ itRights "adds text to store" $ withPath pure context "isValidPathUncached" $ do itRights "validates path" $ withPath $ \path -> do- liftIO $ putStrLn $ show path- (isValidPathUncached path) `shouldReturn` True- itLefts "fails on invalid path" $ isValidPathUncached $ invalidPath+ liftIO $ print path+ isValidPathUncached path `shouldReturn` True+ itLefts "fails on invalid path" $ isValidPathUncached invalidPath context "queryAllValidPaths" $ do- itRights "empty query" $ queryAllValidPaths+ itRights "empty query" queryAllValidPaths itRights "non-empty query" $ withPath $ \path ->- queryAllValidPaths `shouldReturn` (HS.fromList [path])+ queryAllValidPaths `shouldReturn` HS.fromList [path] context "queryPathInfoUncached" $- itRights "queries path info" $ withPath $ queryPathInfoUncached+ itRights "queries path info" $ withPath queryPathInfoUncached context "ensurePath" $- itRights "simple ensure" $ withPath $ ensurePath+ itRights "simple ensure" $ withPath ensurePath context "addTempRoot" $- itRights "simple addition" $ withPath $ addTempRoot+ itRights "simple addition" $ withPath addTempRoot context "addIndirectRoot" $- itRights "simple addition" $ withPath $ addIndirectRoot+ itRights "simple addition" $ withPath addIndirectRoot context "buildPaths" $ do itRights "build Normal" $ withPath $ \path -> do@@ -243,13 +233,13 @@ buildPaths pathSet Repair context "roots" $ context "findRoots" $ do- itRights "empty roots" $ (findRoots `shouldReturn` M.empty)+ itRights "empty roots" (findRoots `shouldReturn` M.empty) itRights "path added as a temp root" $ withPath $ \_ -> do roots <- findRoots roots `shouldSatisfy` ((== 1) . M.size) - context "optimiseStore" $ itRights "optimises" $ optimiseStore+ context "optimiseStore" $ itRights "optimises" optimiseStore context "queryMissing" $ itRights "queries" $ withPath $ \path -> do@@ -260,7 +250,7 @@ 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+ res <- addToStore @SHA256 n (dumpPath fp) False False liftIO $ print res context "with dummy" $ do@@ -268,11 +258,5 @@ itRights "valid dummy" $ do path <- dummy- liftIO $ putStrLn $ show path- (isValidPathUncached path) `shouldReturn` True-- context "derivation" $- itRights "build derivation" $- withDerivation $ \path drv -> do- result <- buildDerivation path drv Normal- result `shouldSatisfy` ((== AlreadyValid) . status)+ liftIO $ print path+ isValidPathUncached path `shouldReturn` True
tests/Util.hs view
@@ -1,7 +1,7 @@ module Util where -import Data.Text.Arbitrary+import Data.Text.Arbitrary () import System.Nix.Store.Remote.Util import Test.Tasty.QuickCheck