diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,8 +1,9 @@ # Revision history for hnix-store-remote -## [next](https://github.com/haskell-nix/hnix-store/compare/0.4.0.0...master) 2021-MM-DD +## [0.4.1.0](https://github.com/haskell-nix/hnix-store/compare/0.4.0.0...0.4.1.0) 2021-01-16 -* No changes yet +* `System.Nix.Store.Remote`: module API now re-exports `System.Nix.Store.Remote.Types` API +* Big clean-up of dependencies. ## [0.4.0.0](https://github.com/haskell-nix/hnix-store/compare/0.3.0.0...0.4.0.0) 2020-12-30 diff --git a/hnix-store-remote.cabal b/hnix-store-remote.cabal --- a/hnix-store-remote.cabal +++ b/hnix-store-remote.cabal @@ -1,5 +1,6 @@ +cabal-version: 2.2 name: hnix-store-remote -version: 0.4.0.0 +version: 0.4.1.0 synopsis: Remote hnix store description: Implementation of the nix store using the daemon protocol. homepage: https://github.com/haskell-nix/hnix-store @@ -11,8 +12,13 @@ category: Nix build-type: Simple extra-source-files: ChangeLog.md, README.md -cabal-version: >=1.10 +Common commons + if impl(ghc >= 8.10) + ghc-options: -Wall -Wunused-packages + else + ghc-options: -Wall + flag io-testsuite default: False @@ -21,6 +27,7 @@ binaries and Linux namespace support. library + import: commons exposed-modules: System.Nix.Store.Remote , System.Nix.Store.Remote.Binary , System.Nix.Store.Remote.Builders @@ -32,64 +39,51 @@ build-depends: base >=4.10 && <5 , attoparsec - , bytestring , binary , bytestring , containers - , filepath , text - , unix + , time , network , nix-derivation >= 1.1.1 && <2 , mtl , unordered-containers - , filepath - , time , hnix-store-core >= 0.4 && <0.5 - , vector hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall test-suite hnix-store-remote-tests - if !flag(io-testsuite) - buildable: False + import: commons - ghc-options: -rtsopts -fprof-auto - type: exitcode-stdio-1.0 - main-is: Driver.hs - other-modules: Derivation - , NixDaemon - , Spec - , Util - hs-source-dirs: tests - build-depends: - attoparsec - , hnix-store-core >= 0.3 - , hnix-store-remote - , base - , base64-bytestring - , binary - , bytestring - , containers - , directory - , process - , filepath - , hspec-expectations-lifted - , quickcheck-text - , tasty - , tasty-discover - , tasty-hspec - , tasty-hunit - , tasty-quickcheck - , linux-namespaces - , mtl - , nix-derivation - , temporary - , text - , time - , unix - , unordered-containers - , vector - , which - default-language: Haskell2010 + if !flag(io-testsuite) + buildable: False + + ghc-options: -rtsopts -fprof-auto + type: exitcode-stdio-1.0 + main-is: Driver.hs + other-modules: Derivation + , NixDaemon + , Spec + , Util + hs-source-dirs: tests + build-depends: base + , hnix-store-core >= 0.3 + , hnix-store-remote + , containers + , directory + , process + , filepath + , hspec-expectations-lifted + , quickcheck-text + , tasty + , tasty-hspec + , tasty-quickcheck + , linux-namespaces + , nix-derivation + , temporary + , text + , unix + , unordered-containers + , vector + default-language: Haskell2010 diff --git a/src/System/Nix/Store/Remote.hs b/src/System/Nix/Store/Remote.hs --- a/src/System/Nix/Store/Remote.hs +++ b/src/System/Nix/Store/Remote.hs @@ -32,6 +32,7 @@ , runStore , syncWithGC , verifyStore + , module System.Nix.Store.Remote.Types ) where @@ -64,7 +65,6 @@ type RepairFlag = Bool type CheckFlag = Bool -type CheckSigsFlag = Bool type SubstituteFlag = Bool -- | Pack `FilePath` as `Nar` and add it to the store. @@ -151,7 +151,8 @@ putEnum buildMode -- XXX: reason for this is unknown -- but without it protocol just hangs waiting for - -- more data. Needs investigation + -- more data. Needs investigation. + -- Intentionally the only warning that should pop-up. putInt 0 res <- getSocketIncremental $ getBuildResult diff --git a/tests/Derivation.hs b/tests/Derivation.hs --- a/tests/Derivation.hs +++ b/tests/Derivation.hs @@ -10,8 +10,8 @@ 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 System.Nix.Store.Remote (MonadStore, addToStore, addTextToStore) +import System.Nix.Hash (HashAlgorithm(SHA256)) import qualified Data.Map import qualified Data.Set @@ -19,46 +19,48 @@ 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 +import qualified System.Directory drvSample :: StorePath -> StorePath -> StorePath -> Derivation StorePath Text -drvSample builder buildScript out = Derivation { +drvSample builder' buildScript out = Derivation { outputs = Data.Map.fromList [ ("out", DerivationOutput out "sha256" "test") ] - , inputDrvs = Data.Map.fromList [ (builder, Data.Set.fromList [ "out" ]) ] + , inputDrvs = Data.Map.fromList [ (builder', Data.Set.fromList [ "out" ]) ] , inputSrcs = Data.Set.fromList [ buildScript ] , platform = "x86_64-linux" - , builder = storePathToText builder + , 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.Which.which "bash" + 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" - path <- addToStore @SHA256 n fp False (pure True) False - action path + pth <- addToStore @'SHA256 n fp False (pure True) False + action pth +withBuildScript :: (StorePath -> MonadStore a) -> MonadStore a withBuildScript action = do - path <- addTextToStore + pth <- addTextToStore "buildScript" (Data.Text.concat [ "declare -xp", "export > $out" ]) mempty False - action path + 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 - path <- addTextToStore + pth <- addTextToStore "hnix-store-derivation" (Data.Text.Lazy.toStrict $ Data.Text.Lazy.Builder.toLazyText @@ -68,5 +70,5 @@ False liftIO $ print d - action path d + action pth d diff --git a/tests/Driver.hs b/tests/Driver.hs --- a/tests/Driver.hs +++ b/tests/Driver.hs @@ -1,9 +1,9 @@ -import Test.Tasty.Hspec import NixDaemon import qualified Spec -- we run remote tests in -- Linux namespaces to avoid interacting with systems store +main :: IO () main = do enterNamespaces Spec.main diff --git a/tests/NixDaemon.hs b/tests/NixDaemon.hs --- a/tests/NixDaemon.hs +++ b/tests/NixDaemon.hs @@ -5,54 +5,32 @@ module NixDaemon where -import Prelude -import Control.Monad -import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) 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 Data.Either (isRight, isLeft) +import Data.Text (Text) 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 Test.Tasty.Hspec (Spec, 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 import Derivation @@ -78,13 +56,14 @@ ] ++ (maybe [] (\x -> [("PATH", x)]) mEnvPath) waitSocket :: FilePath -> Int -> IO () -waitSocket fp 0 = fail "No socket" +waitSocket _ 0 = fail "No socket" waitSocket fp x = do ex <- doesFileExist fp case ex of True -> return () False -> threadDelay 100000 >> waitSocket fp (x - 1) +writeConf :: FilePath -> IO () writeConf fp = do writeFile fp $ unlines [ "build-users-group = " @@ -115,6 +94,7 @@ where sockFp = fp "var/nix/daemon-socket/socket" +enterNamespaces :: IO () enterNamespaces = do uid <- getEffectiveUserID gid <- getEffectiveGroupID @@ -125,6 +105,8 @@ -- map our (parent) gid to root group writeGroupMappings Nothing [GroupMapping 0 gid 1] True +withNixDaemon + :: ((MonadStore a -> IO (Either String a, [Logger])) -> IO a) -> IO a withNixDaemon action = do withSystemTempDirectory "test-nix-store" $ \path -> do @@ -133,7 +115,7 @@ ini <- createProcessEnv path "nix-store" ["--init"] - P.waitForProcess ini + void $ P.waitForProcess ini writeFile (path "dummy") "Hello World" @@ -143,19 +125,41 @@ (P.terminateProcess . fst) (\x -> action . snd $ x) +checks :: (Show a, Show b) => IO (a, b) -> (a -> Bool) -> IO () checks action check = action >>= (`Hspec.shouldSatisfy` (check . fst)) + +it + :: (Show a, Show b, Monad m) + => String + -> m c + -> (a -> Bool) + -> Hspec.SpecWith (m () -> IO (a, b)) it name action check = Hspec.it name $ \run -> (run (action >> return ())) `checks` check + +itRights + :: (Show a, Show b, Show c, Monad m) + => String + -> m d + -> Hspec.SpecWith (m () -> IO (Either a b, c)) itRights name action = it name action isRight + +itLefts + :: (Show a, Show b, Show c, Monad m) + => String + -> m d + -> Hspec.SpecWith (m () -> IO (Either a b, c)) itLefts name action = it name action isLeft +withPath :: (StorePath -> MonadStore a) -> MonadStore a withPath action = do path <- addTextToStore "hnix-store" "test" (HS.fromList []) False action path -- | dummy path, adds /dummpy with "Hello World" contents +dummy :: MonadStore StorePath dummy = do let Right n = makeStorePathName "dummy" - res <- addToStore @SHA256 n "dummy" False (pure True) False + res <- addToStore @'SHA256 n "dummy" False (pure True) False return res invalidPath :: StorePath @@ -163,10 +167,12 @@ let Right n = makeStorePathName "invalid" in StorePath (hash "invalid") n "no_such_root" +withBuilder :: (StorePath -> MonadStore a) -> MonadStore a withBuilder action = do path <- addTextToStore "builder" builderSh (HS.fromList []) False action path +builderSh :: Text builderSh = T.concat [ "declare -xp", "export > $out" ] spec_protocol :: Spec @@ -230,7 +236,7 @@ context "findRoots" $ do itRights "empty roots" $ (findRoots `shouldReturn` M.empty) - itRights "path added as a temp root" $ withPath $ \path -> do + itRights "path added as a temp root" $ withPath $ \_ -> do roots <- findRoots roots `shouldSatisfy` ((==1) . M.size) @@ -246,7 +252,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 fp False (pure True) False liftIO $ print res context "with dummy" $ do diff --git a/tests/Util.hs b/tests/Util.hs --- a/tests/Util.hs +++ b/tests/Util.hs @@ -1,13 +1,14 @@ module Util where -import Test.Tasty.QuickCheck import Data.Text.Arbitrary - import System.Nix.Store.Remote.Util +import Test.Tasty.QuickCheck +prop_TextToBSLRoundtrip :: Text -> Property prop_TextToBSLRoundtrip x = bslToText (textToBSL x) === x +prop_TextToBSRoundtrip :: Text -> Property prop_TextToBSRoundtrip x = bsToText (textToBS x) === x