diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index 8b9ac8df..ffc5520d 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.Hash , System.Nix.Internal.Signature @@ -28,6 +29,7 @@ library , System.Nix.StorePath , System.Nix.StorePathMetadata , System.Nix.Util + , System.Nix.ValidPath build-depends: base >=4.10 && <5 , base16-bytestring , bytestring 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/Hash.hs b/hnix-store-core/src/System/Nix/Hash.hs index 93619674..1942b3aa 100644 --- a/hnix-store-core/src/System/Nix/Hash.hs +++ b/hnix-store-core/src/System/Nix/Hash.hs @@ -10,7 +10,6 @@ module System.Nix.Hash ( , HNix.SomeNamedDigest(..) , HNix.hash , HNix.hashLazy - , HNix.encodeBase32 , HNix.encodeBase16 ) where diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index e0b93c23..af7a51cc 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -95,6 +95,16 @@ hashLazy :: forall a.ValidAlgo a => BSL.ByteString -> Digest a hashLazy bsl = finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl) +-- | Hash file +hashFile :: forall a.ValidAlgo a => FilePath -> IO (Digest a) +hashFile fp = hashLazy <$> BSL.readFile fp + +digestText32 :: forall a. (NamedAlgo a, ValidAlgo a) => Digest a -> T.Text +digestText32 d = algoName @a <> ":" <> encodeBase32 d + +digestText16 :: forall a. NamedAlgo a => Digest a -> T.Text +digestText16 d = algoName @a <> ":" <> encodeBase16 d + -- | Encode a 'Digest' in the special Nix base-32 encoding. encodeBase32 :: Digest a -> T.Text encodeBase32 (Digest bs) = Base32.encode bs diff --git a/hnix-store-core/src/System/Nix/Internal/Path.hs b/hnix-store-core/src/System/Nix/Internal/Path.hs new file mode 100644 index 00000000..b08717a4 --- /dev/null +++ b/hnix-store-core/src/System/Nix/Internal/Path.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} + +{-| +Description : Internal path utilities +Maintainer : srk +|-} +module System.Nix.Internal.Path where + +import Control.Monad +import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Char8 as BSC +import Data.Text (Text) +import qualified Data.Text as T +import System.FilePath.Posix (takeBaseName, takeDirectory) +import System.Nix.Path (Path(..), PathName(..), pathName, PathHashAlgo) +import System.Nix.Internal.Hash (Digest(..), HashAlgorithm'( SHA256 )) +import System.Nix.Hash (HasDigest, printAsBase16, printAsBase32, printHashAlgo) +import qualified System.Nix.Hash + +-- | Parse store location +parseStore :: BSL.ByteString -> T.Text +parseStore = T.pack . takeDirectory . BSC.unpack . BSL.toStrict + +-- | Parse path from string +-- +-- in form /- +-- into (Just (Path (PathName ))) +-- or Nothing on error +-- +-- XXX: should check for @PathHashAlgo length +parsePath :: BSL.ByteString -> Maybe Path +parsePath p = case name of + Nothing -> Nothing + Just n -> Just $ Path digest n + where + base = T.pack . takeBaseName . BSC.unpack . BSL.toStrict $ p + parts = T.breakOn "-" base + digest = Digest . BSC.pack . T.unpack . fst $ parts + name = pathName . T.drop 1 . snd $ parts + + +-- experimental +-- Directory of the store +type StoreDir = Text +type Stored a = (StoreDir, a) + +-- wrap StoreDir and Path into tuple +makeStored :: StoreDir -> Path -> Stored Path +makeStored sl p = (sl, p) + +type PathType = Text +-- "text:::..." +-- "source" +-- "output:" +-- is the name of the output (usually, "out"). + +-- store settings +data Settings = Settings { + storeDir :: StoreDir -- settings.nixStore + } deriving (Eq, Show) + +-- build a store path in the following form: +-- /- +storedToText :: Stored Path -> Text +storedToText (storeLoc, (Path digest pName)) = T.concat + [ storeLoc + , "/" + , printAsBase32 @PathHashAlgo digest + , "-" + , pathNameContents pName + ] + +makeStorePath :: (HasDigest a) => PathType -> PathName -> Digest a -> Settings -> Text +makeStorePath typ pName digest settings = T.concat + [ storeDir settings + , "/" + , printAsBase32 @PathHashAlgo $ pathHash typ pName digest (storeDir settings) + , "-" + , pathNameContents pName + ] + +makeStorePath' :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Path +makeStorePath' typ pName digest storeLoc = snd $ makeStoredPath typ pName digest storeLoc + +-- | build Stored Path from the type of the path, path name and a digest stored at StoreDir +-- As StoreDir is part of the path hashing process we need to take it into account +-- when building Path(s) +makeStoredPath :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Stored Path +makeStoredPath typ pName digest storeLoc = makeStored storeLoc $ Path (pathHash typ pName digest storeLoc) pName + +-- build string which is a truncated base32 formatted SHA256 hash of +pathHash :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Digest PathHashAlgo +pathHash typ pName digest storeLoc = System.Nix.Hash.hash . BSC.pack . T.unpack $ + makePathDigestString typ pName digest storeLoc + +-- build string which is hashed and used in makeStorePath +-- = "::::" +-- (exposed for testing purposes only) +makePathDigestString :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Text +makePathDigestString typ pName digest storeLoc = T.intercalate (T.pack ":") + [ typ + , printHashAlgo digest + , printAsBase16 digest + , storeLoc + , pathNameContents pName + ] + +-- make output path from `PathName` digest and outputId which typically is "out" +makeOutputPath :: (HasDigest a) => PathName -> Digest a -> T.Text -> Settings -> Text +makeOutputPath pName digest outputId settings = + makeStorePath typ (adjustName pName) digest settings + where + typ = T.concat [ "output:", outputId ] + adjustName n | outputId == "out" = n + adjustName (PathName name) | otherwise = PathName $ T.concat [ name, T.pack "-", outputId ] + +type Recursive = Bool +-- make fixed output path from `PathName` and Recursive option +makeFixedOutputPath :: (HasDigest a) => PathName -> Digest a -> Recursive -> Settings -> Text +makeFixedOutputPath pName digest True settings = -- XXX: this needs be restricted to @a == @SHA256 + makeStorePath ("source") pName digest settings +makeFixedOutputPath pName digest recursive settings = + makeStorePath ("output:out") pName digest' settings + where + rec True = "r:" + rec False = T.empty + digest' = System.Nix.Hash.hash @SHA256 $ BSC.pack . T.unpack . T.concat $ + [ "fixed:out:" + , rec recursive + , printHashAlgo digest + , printAsBase16 digest + , ":" + ] + +-- references should be PathSet not [T.Text] +-- but how to turn PathSet into store paths (texts) again +-- when we don't have PathType +type References = [T.Text] + +makeTextPath :: (HasDigest a) => PathName -> Digest a -> References-> Settings -> Text +makeTextPath pName digest references settings = + makeStorePath typ pName digest settings + where typ = T.concat $ [ "text" ] ++ (map (T.cons ':') references) + +storePathForText :: PathName -> T.Text -> References -> Settings -> Text +storePathForText pName contents references settings = + makeTextPath pName hashOfContents references settings + where hashOfContents = System.Nix.Hash.hash @SHA256 (BSC.pack . T.unpack $ contents) diff --git a/hnix-store-core/src/System/Nix/ValidPath.hs b/hnix-store-core/src/System/Nix/ValidPath.hs new file mode 100644 index 00000000..d57cb19b --- /dev/null +++ b/hnix-store-core/src/System/Nix/ValidPath.hs @@ -0,0 +1,55 @@ +{-| +Description : Types and effects for interacting with the Nix store. +Maintainer : Shea Levy +-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module System.Nix.ValidPath + ( ValidPath(..) + ) where + +import System.Nix.Hash (Digest(..)) +import System.Nix.StorePath (StorePath(..), StorePathSet, KnownStoreDir) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import Data.Hashable (Hashable (..), hashPtrWithSalt) +import Data.HashMap.Strict (HashMap) +import Data.HashSet (HashSet) +import Data.Map.Strict (Map) +import Data.Text (Text) +import Data.Time (UTCTime) +import qualified Data.Text as T +import System.IO.Unsafe (unsafeDupablePerformIO) +import Text.Regex.Base.RegexLike (makeRegex, matchTest) +import Text.Regex.TDFA.Text (Regex) + +-- | Information about @Path@ +data (KnownStoreDir a) => ValidPath a = ValidPath + { -- | Path itself + path :: !(StorePath a) + , -- | The .drv which led to this 'Path'. + deriver :: !(Maybe (StorePath a)) + , -- | NAR hash + narHash :: !Text + , -- | The references of the 'Path' + references :: !(StorePathSet a) + , -- | Registration time + registrationTime :: !UTCTime + , -- | The size of the uncompressed NAR serialization of this + -- 'Path'. + narSize :: !Integer + , -- | Whether the path is ultimately trusted, that is, it's a + -- derivation output that was built locally. + ultimate :: !Bool + , -- | Signatures + sigs :: ![Text] + , -- | Content-addressed + -- Store path is computed from a cryptographic hash + -- of the contents of the path, plus some other bits of data like + -- the "name" part of the path. + -- + -- ‘ca’ has one of the following forms: + -- * ‘text:sha256:’ (paths by makeTextPath() / addTextToStore()) + -- * ‘fixed:::’ (paths by makeFixedOutputPath() / addToStore()) + ca :: !Text + } deriving (Eq, Ord) -- , Show) diff --git a/hnix-store-core/tests/Hash.hs b/hnix-store-core/tests/Hash.hs index 2f41ca92..2f36a7ec 100644 --- a/hnix-store-core/tests/Hash.hs +++ b/hnix-store-core/tests/Hash.hs @@ -34,7 +34,9 @@ spec_hash = do it "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" $ shouldBe (encodeBase32 (hash @SHA256 "nix-output:foo")) "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5" - + it "produces (base16 . md5) of \"Hello World\" the same as the thesis" $ + shouldBe (encodeBase16 (hash @MD5 "Hello World")) + "b10a8db164e0754105b7a99be72e3fe5" it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $ shouldBe (encodeBase32 (hash @SHA1 "Hello World")) "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" diff --git a/hnix-store-core/tests/Path.hs b/hnix-store-core/tests/Path.hs new file mode 100644 index 00000000..ecfb6199 --- /dev/null +++ b/hnix-store-core/tests/Path.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Path where + +import Control.Monad.IO.Class (liftIO) +import Control.Exception (bracket) +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 qualified Data.Text as T +import System.Directory (removeFile) +import System.IO.Temp (withSystemTempFile, writeSystemTempFile) +import qualified System.IO as IO -- (hGetContents, hPutStr, openFile) +import qualified System.Process as P +import Test.Tasty as T +import Test.Tasty.Hspec +import qualified Test.Tasty.HUnit as HU +import Test.Tasty.QuickCheck +import Text.Read (readMaybe) + +import System.Nix.Hash +import System.Nix.Internal.Hash +import NarFormat -- TODO: Move the fixtures into a common module + +spec_path :: Spec +spec_path = do + return () + +{- + describe "path operations" $ do + + it "makeStorePath hashes correctly" $ + makeStorePath "text" (PathName "lal") (hash @MD5 "Hello World") (Settings "/nix/store") `shouldBe` "/nix/store/vsfi9phi6a2hvvvihyh48jn8xh9ld5ax-lal" + + it "store path for text matches real world test scenario" $ + storePathForText (PathName "lal") ("Hello World") [] (Settings "/run/user/1000/test-nix-store-a256230bc88fe520/store") `shouldBe` "/run/user/1000/test-nix-store-a256230bc88fe520/store/3v0g8si7h0as1nqdanymv2zh2gagbl4f-lal" + + it "parses valid path" $ + parsePath "/nix/store/vsfi9phi6a2hvvvihyh48jn8xh9ld5ax-lal" `shouldBe` (Just (Path (Digest "vsfi9phi6a2hvvvihyh48jn8xh9ld5ax") (PathName "lal"))) + + it "fails on invalid name" $ + parsePath "/st/hash-$%^^#" `shouldBe` Nothing + + it "parses store" $ + parseStore "/nix/store/vsfi9phi6a2hvvvihyh48jn8xh9ld5ax-lal" `shouldBe` "/nix/store" +-} diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index 780e39b7..726cf565 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -26,15 +26,55 @@ library , binary , bytestring , containers + , filepath , text , unix , network + , nix-derivation , mtl , unordered-containers + , system-filepath + , time -- , pretty-simple -- , base16-bytestring -- , base32-bytestring , 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 + , nix-derivation + , hnix-store-core + , hnix-store-remote + , base + , base64-bytestring + , binary + , bytestring + , containers + , directory + , process + , system-filepath + , hspec-expectations-lifted + , tasty + , tasty-discover + , tasty-hspec + , tasty-hunit + , tasty-quickcheck + , linux-namespaces + , 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..9f379d61 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -4,31 +4,303 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RecordWildCards #-} module System.Nix.Store.Remote ( runStore + , addTextToStore , syncWithGC , optimiseStore , verifyStore ) where import Control.Monad +import Control.Monad.IO.Class (liftIO) +import qualified Data.Binary as B +import qualified Data.Binary.Put as B +import Data.Maybe +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Map.Strict as M +import Data.Proxy (Proxy(Proxy)) +import Data.Text (Text) +import qualified Data.Text.Lazy as T +import qualified Data.Text.Lazy.Encoding as T + +import qualified System.Nix.Build as Build +import qualified Nix.Derivation as Drv + +--import qualified System.Nix.GC as GC +import System.Nix.Hash (Digest, ValidAlgo) +import System.Nix.StorePath +import System.Nix.Hash +import System.Nix.Nar (localPackNar, putNar, narEffectsIO, Nar) +import System.Nix.Util +import System.Nix.ValidPath import System.Nix.Store.Remote.Types import System.Nix.Store.Remote.Protocol import System.Nix.Store.Remote.Util +import Data.Text.Encoding (encodeUtf8) + type RepairFlag = Bool type CheckFlag = Bool +type CheckSigsFlag = Bool +type SubstituteFlag = Bool + +--setOptions :: StoreSetting -> MonadStore () + +isValidPathUncached :: (KnownStoreDir a) => (StorePath a) -> MonadStore Bool +isValidPathUncached p = do + simpleOpArgs IsValidPath $ putPath p + +queryValidPaths :: (KnownStoreDir a) => (StorePathSet a) -> SubstituteFlag -> MonadStore (StorePathSet a) +queryValidPaths ps substitute = do + runOpArgs QueryValidPaths $ do + putPaths ps + putBool substitute + sockGetPaths + +queryAllValidPaths :: (KnownStoreDir a) => MonadStore (StorePathSet a) +queryAllValidPaths = do + runOp QueryAllValidPaths + sockGetPaths + +querySubstitutablePaths :: (KnownStoreDir a) => (StorePathSet a) -> MonadStore (StorePathSet a) +querySubstitutablePaths ps = do + runOpArgs QuerySubstitutablePaths $ do + putPaths ps + sockGetPaths + +{- +querySubstitutablePathInfos :: (KnownStoreDir a) => (StorePathSet a) -> MonadStore [SubstitutablePathInfo] +querySubstitutablePathInfos ps = do + runOpArgs QuerySubstitutablePathInfos $ do + putPaths ps + + cnt <- sockGetInt + forM (take cnt $ cycle [(0 :: Int)]) $ pure $ do + _pth <- sockGetPath + drv <- sockGetPath + refs <- sockGetPaths + dlSize <- sockGetInt + narSize' <- sockGetInt + return $ SubstitutablePathInfo { + deriver = drv + , references = refs + , downloadSize = dlSize + , narSize = narSize' + } +-} + +queryPathInfoUncached :: (KnownStoreDir a) => (StorePath a) -> MonadStore (ValidPath a) +queryPathInfoUncached path = do + runOpArgs QueryPathInfo $ do + putPath path + + valid <- sockGetBool + unless valid $ error "Path is not valid" + + deriver <- sockGetPath + narHash <- lBSToText <$> sockGetStr + references <- sockGetPaths + registrationTime <- sockGet getTime + narSize <- sockGetInt + ultimate <- sockGetBool + sigs <- map lBSToText <$> sockGetStrings + ca <- lBSToText <$> sockGetStr + return $ ValidPath {..} + +queryReferrers :: (KnownStoreDir a) => (StorePath a) -> MonadStore (StorePathSet a) +queryReferrers p = do + runOpArgs QueryReferrers $ do + putPath p + sockGetPaths + +queryValidDerivers :: (KnownStoreDir a) => (StorePath a) -> MonadStore (StorePathSet a) +queryValidDerivers p = do + runOpArgs QueryValidDerivers $ do + putPath p + sockGetPaths + +queryDerivationOutputs :: (KnownStoreDir a) => (StorePath a) -> MonadStore (StorePathSet a) +queryDerivationOutputs p = do + runOpArgs QueryDerivationOutputs $ + putPath p + sockGetPaths + +queryDerivationOutputNames :: (KnownStoreDir a) => (StorePath a) -> MonadStore (StorePathSet a) +queryDerivationOutputNames p = do + runOpArgs QueryDerivationOutputNames $ + putPath p + sockGetPaths + +queryPathFromHashPart :: (KnownStoreDir a) => Digest StorePathHashAlgo -> MonadStore (Maybe (StorePath a)) +queryPathFromHashPart storePathHash = do + runOpArgs QueryPathFromHashPart $ + --putText $ printAsBase32 @PathHashAlgo digest + putByteStringLen $ LBS.fromStrict $ encodeUtf8 $ encodeBase32 storePathHash + sockGetPath + +addToStoreNar :: (KnownStoreDir a) => ValidPath a -> Nar -> RepairFlag -> CheckSigsFlag -> MonadStore () +addToStoreNar ValidPath{..} nar repair checkSigs = do + void $ runOpArgs AddToStoreNar $ do + putPath path + maybe (return ()) (putPath) deriver + putText narHash -- info.narHash.to_string(Base16, false) + putPaths references + putTime registrationTime + putInt narSize + putBool ultimate + putTexts sigs + putText ca + + -- << repair << !checkSigs; + putBool repair + putBool (not checkSigs) + + -- reference uses copyNAR here to just parse & dump existing NAR from path + -- TUNNEL + -- putNar nar + +--type PathFilter = (StorePath a) -> Bool + +addToStore + :: forall p a. (KnownStoreDir p, ValidAlgo a, NamedAlgo a) + => LBS.ByteString + -> FilePath + -> Bool + -> Proxy a + -> ((StorePath p) -> Bool) + -> RepairFlag + -> MonadStore (StorePath p) +addToStore name pth recursive algoProxy pfilter repair = do + + -- TODO: Is this lazy enough? We need `B.putLazyByteString bs` to stream `bs` + bs :: LBS.ByteString <- liftIO $ B.runPut . putNar <$> localPackNar narEffectsIO pth + + runOpArgs AddToStore $ do + putByteStringLen name + if algoName @a `elem` ["sha256"] && recursive -- , Truncated 20 SHA256] && recursive + then putInt 0 + else putInt 1 + if recursive + then putInt 1 + else putInt 0 + + putByteStringLen (T.encodeUtf8 $ T.fromStrict $ algoName @a) + + B.putLazyByteString bs + + fmap (fromMaybe $ error "TODO: Error") sockGetPath + +-- reference accepts repair but only uses it to throw error in case of nix daemon +addTextToStore :: (KnownStoreDir a) + => Text + -> Text + -> (StorePathSet a) + -> RepairFlag + -> MonadStore (Maybe (StorePath a)) +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 + +buildPaths :: (KnownStoreDir a) => (StorePathSet a) -> Build.BuildMode -> MonadStore () +buildPaths ps bm = do + void $ simpleOpArgs BuildPaths $ do + putPaths ps + putInt $ fromEnum bm + +{- +buildDerivation :: (KnownStoreDir a) => (StorePath a) -> Drv.Derivation -> Build.BuildMode -> MonadStore Build.BuildResult +buildDerivation p drv buildMode = do + runOpArgs BuildDerivation $ do + putPath p + putDerivation drv + putEnum buildMode + putInt 0 -- ?????? + + res <- getSocketIncremental $ getBuildResult + return res +-} + +ensurePath :: (KnownStoreDir a) => (StorePath a) -> MonadStore () +ensurePath pn = do + void $ simpleOpArgs EnsurePath $ putPath pn + +addTempRoot :: (KnownStoreDir a) => (StorePath a) -> MonadStore () +addTempRoot pn = do + void $ simpleOpArgs AddTempRoot $ putPath pn + +addIndirectRoot :: (KnownStoreDir a) => (StorePath a) -> MonadStore () +addIndirectRoot pn = do + void $ simpleOpArgs AddIndirectRoot $ putPath pn syncWithGC :: MonadStore () syncWithGC = void $ simpleOp SyncWithGC +{- +findRoots :: MonadStore Roots +findRoots = do + runOp FindRoots + res <- getSocketIncremental (do + count <- getInt + res <- sequence $ replicate count ((,) <$> getPath <*> getPath) + return res + ) + + return $ M.fromList $ catMaybesTupled res + where + catMaybesTupled :: [(Maybe a, Maybe b)] -> [(a, b)] + catMaybesTupled ls = map (\(Just x, Just y) -> (x, y)) $ filter (\(x,y) -> isJust x && isJust y) ls + +collectGarbage :: GC.Options -> MonadStore GC.Result +collectGarbage opts = do + runOpArgs CollectGarbage $ do + putInt $ fromEnum $ GC.operation opts + putPaths $ GC.pathsToDelete opts + putBool $ GC.ignoreLiveness opts + putInt $ GC.maxFreed opts + -- removed options + -- drop when collectGarbage drops these from nix/src/libstore/remote-store.cc + forM_ [(0 :: Int)..2] $ pure $ putInt (0 :: Int) + + paths <- sockGetPaths + freed <- sockGetInt + _obsolete <- sockGetInt :: MonadStore Int + + return $ GC.Result paths freed +-} + optimiseStore :: MonadStore () optimiseStore = void $ simpleOp OptimiseStore +queryMissing :: (KnownStoreDir a) => (StorePathSet a) -> MonadStore (StorePathSet a, StorePathSet a, StorePathSet a, Integer, Integer) +queryMissing ps = do + runOpArgs QueryMissing $ do + putPaths ps + + willBuild <- sockGetPaths + willSubstitute <- sockGetPaths + unknown <- sockGetPaths + downloadSize' <- sockGetInt + narSize' <- sockGetInt + return (willBuild, willSubstitute, unknown, downloadSize', narSize') + -- returns True on errors verifyStore :: CheckFlag -> RepairFlag -> MonadStore Bool verifyStore check repair = simpleOpArgs VerifyStore $ do putBool check putBool repair + +addSignatures :: (KnownStoreDir a) => (StorePath a) -> [LBS.ByteString] -> MonadStore () +addSignatures p signatures = do + void $ simpleOpArgs AddSignatures $ do + putPath p + putByteStrings signatures 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..fac11098 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs @@ -5,11 +5,14 @@ module System.Nix.Store.Remote.Logger ( where import Control.Monad.Reader (ask, liftIO) +import Control.Monad.State (get) import Data.Binary.Get import Network.Socket.ByteString (recv) +import qualified Data.ByteString.Lazy as LBS import System.Nix.Store.Remote.Types +import System.Nix.Store.Remote.Util import System.Nix.Util controlParser :: Get Logger @@ -34,12 +37,23 @@ processOutput = go decoder case ctrl of e@(Error _ _) -> return [e] Last -> return [Last] + Read n -> do + (mhandle, _) <- get + case mhandle of + Nothing -> fail "No handle provided" + Just handle -> do + part <- liftIO $ LBS.hGet handle n + sockPut $ putByteStringLen part + + 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/Protocol.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs index e0e724cd..07faed46 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,12 @@ +{-# LANGUAGE DataKinds #-} module System.Nix.Store.Remote.Protocol ( WorkerOp(..) , simpleOp , simpleOpArgs , runOp , runOpArgs - , runStore) where + , runStore + , runStoreOpts) where import Control.Exception (bracket) import Control.Monad.Except @@ -15,6 +17,7 @@ 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.Text as T import Network.Socket hiding (send, sendTo, recv, recvFrom) import Network.Socket.ByteString (recv) @@ -23,6 +26,10 @@ import System.Nix.Store.Remote.Logger import System.Nix.Store.Remote.Types import System.Nix.Store.Remote.Util import System.Nix.Util +import System.Nix.StorePath + +import GHC.TypeLits +import Data.Proxy protoVersion :: Int protoVersion = 0x115 @@ -34,8 +41,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 @@ -139,25 +146,35 @@ 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 runStore :: MonadStore a -> IO (Either String a, [Logger]) -runStore code = do - bracket (open sockPath) close run +runStore = runStoreOpts defaultSockPath "/nix/store" + +--oo :: StoreDir "lal" +--oo = Proxy + +--lal str = (Proxy :: someSymbolVal str) + --case someSymbolVal str of + -- SomeSymbol user_proxy -> user_proxy + +runStoreOpts :: FilePath -> FilePath -> MonadStore a -> IO (Either String a, [Logger]) +runStoreOpts sockPath storePath code = do + bracket (open sockPath) (close . storeSocket) run where open path = do soc <- socket AF_UNIX Stream 0 connect soc (SockAddrUnix path) - return soc + return $ StoreConfig { storeSocket = soc } -- , storeDir = oo } 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 (LBS.fromStrict vermagic) $ (,) <$> (getInt :: Get Int) <*> (getInt :: Get Int) unless (magic2 == workerMagic2) $ error "Worker magic 2 mismatch" sockPut $ putInt protoVersion -- clientVersion @@ -167,4 +184,7 @@ runStore code = do processOutput run sock = - flip runReaderT sock $ flip runStateT [] $ runExceptT (greet >> code) + fmap (\(res, (handle, 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..0fc3e2d7 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs @@ -1,7 +1,9 @@ module System.Nix.Store.Remote.Types ( MonadStore + , StoreConfig(..) , Logger(..) , Field(..) + , getStoreDir , getLog , flushLog , gotError @@ -13,8 +15,15 @@ import Network.Socket (Socket) import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State +import System.IO (Handle) +import System.Nix.StorePath -type MonadStore a = ExceptT String (StateT [Logger] (ReaderT Socket IO)) a +data StoreConfig = StoreConfig { + storeDir :: StoreDir + , storeSocket :: Socket + } + +type MonadStore a = ExceptT String (StateT (Maybe Handle, [Logger]) (ReaderT StoreConfig IO)) a type ActivityID = Int type ActivityParentID = Int @@ -41,13 +50,16 @@ 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, [])) + +getStoreDir :: MonadStore (StoreDir) +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..8f2090fc 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs @@ -1,23 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RecordWildCards #-} module System.Nix.Store.Remote.Util where import Control.Monad.Reader +import Prelude hiding (FilePath) + import Data.Maybe import Data.Binary.Get import Data.Binary.Put import Data.Text (Text) import qualified Data.Text as T +import Data.Time +import Data.Time.Clock.POSIX import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy as BSL +import qualified Data.Map.Strict as M +import qualified Data.Set as S +import qualified Data.HashMap.Strict as HashMap import qualified Data.HashSet as HashSet +import qualified Data.Vector + +import qualified Filesystem.Path.CurrentOS +import Filesystem.Path.CurrentOS (FilePath) import Network.Socket.ByteString (recv, sendAll) +import Nix.Derivation + import System.Nix.Store.Remote.Types +import System.Nix.Build +import System.Nix.StorePath +import System.Nix.Internal.Hash (Digest(..)) import System.Nix.Hash import System.Nix.Util +import System.FilePath.Posix (takeBaseName, takeDirectory) + genericIncremental :: (MonadIO m) => m (Maybe B.ByteString) -> Get a -> m a genericIncremental getsome parser = go decoder @@ -31,17 +52,20 @@ genericIncremental getsome parser = go decoder 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 +73,108 @@ sockGetInt = getSocketIncremental getInt sockGetBool :: MonadStore Bool sockGetBool = (== (1 :: Int)) <$> sockGetInt -sockGetStr :: MonadStore LBS.ByteString +sockGetStr :: MonadStore BSL.ByteString sockGetStr = getSocketIncremental getByteStringLen -sockGetStrings :: MonadStore [LBS.ByteString] +sockGetStrings :: MonadStore [BSL.ByteString] sockGetStrings = getSocketIncremental getByteStrings -lBSToText :: LBS.ByteString -> Text -lBSToText = T.pack . BSC.unpack . LBS.toStrict +sockGetPath :: (KnownStoreDir a) => MonadStore (Maybe (StorePath a)) +sockGetPath = getSocketIncremental getPath + +sockGetPaths :: (KnownStoreDir a) => MonadStore (StorePathSet a) +sockGetPaths = getSocketIncremental getPaths + + +lBSToText :: BSL.ByteString -> Text +lBSToText = T.pack . BSC.unpack . BSL.toStrict + +textToBSL :: Text -> BSL.ByteString +textToBSL = BSL.fromStrict . BSC.pack . T.unpack -textToLBS :: Text -> LBS.ByteString -textToLBS = LBS.fromStrict . BSC.pack . T.unpack +putText :: Text -> Put +putText = putByteStringLen . textToBSL + +putTexts :: [Text] -> Put +putTexts = putByteStrings . (map textToBSL) + +parsePath :: (KnownStoreDir storeDir) => BSL.ByteString -> Maybe (StorePath storeDir) +parsePath p = case name of + Nothing -> Nothing + Just n -> Just $ StorePath digest n + where + base = T.pack . takeBaseName . BSC.unpack . BSL.toStrict $ p + parts = T.breakOn "-" base + digest = Digest . BSC.pack . T.unpack . fst $ parts + name = makeStorePathName . T.drop 1 . snd $ parts + +getPath :: (KnownStoreDir storeDir) => Get (Maybe (StorePath storeDir)) +getPath = parsePath <$> getByteStringLen + +getPaths :: (KnownStoreDir storeDir) => Get (StorePathSet storeDir) +getPaths = HashSet.fromList . catMaybes . map parsePath <$> getByteStrings + +putPath :: (KnownStoreDir storeDir) => StorePath storeDir -> Put +putPath = putByteStringLen . BSL.fromStrict . storePathToRawFilePath + +putPaths :: (KnownStoreDir storeDir) => StorePathSet storeDir -> Put +putPaths = putByteStrings . HashSet.toList . 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 . lBSToText <$> getByteStringLen) + <*> getInt + <*> getBool + <*> getTime + <*> getTime + +{- +putDerivation :: (NamedAlgo a) => Derivation -> Put +putDerivation Derivation{..} = do + putInt $ M.size outputs + forM_ (M.toList outputs) $ \(outputName, DerivationOutput{..}) -> do + putText outputName + putFP path + putText algoName + putText hash + --putText $ printAsBase32 @PathHashAlgo digest + + putFPs $ S.toList inputSrcs + putText platform + putText builder + putTexts $ Data.Vector.toList args + + putInt $ M.size env + forM_ (M.toList env) $ \(first, second) -> putText first >> putText second +-} + +putFP :: FilePath -> Put +putFP p = putText (printFP p) + +printFP :: FilePath -> Text +printFP p = case Filesystem.Path.CurrentOS.toText p of + Left t -> t + Right t -> t + +putFPs :: [FilePath] -> Put +putFPs = putTexts . (map printFP) diff --git a/hnix-store-remote/tests/Driver.hs b/hnix-store-remote/tests/Driver.hs new file mode 100644 index 00000000..249a69b8 --- /dev/null +++ b/hnix-store-remote/tests/Driver.hs @@ -0,0 +1,7 @@ +--{-# OPTIONS_GHC -F -pgmF tasty-discover #-} + +import Test.Tasty.Hspec + +import NixDaemon +main = enterNamespaces >> hspec spec_protocol +--main = 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..49da3214 --- /dev/null +++ b/hnix-store-remote/tests/NixDaemon.hs @@ -0,0 +1,355 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module NixDaemon where + +import Prelude hiding (FilePath) +import Control.Monad +import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Exception (bracket) +import Control.Concurrent (threadDelay) +import Data.Either (isRight, isLeft) +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.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 --(doesFileExist, createDirectory, copyFile) +import System.IO.Temp -- (withSystemTempDirectory, writeSystemTempFile, createTempDirectory) +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 Filesystem.Path +import Filesystem.Path.CurrentOS +import System.Nix.Build +import System.Nix.Hash +import System.Nix.StorePath +import System.Nix.Nar +import qualified System.Nix.ValidPath 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 qualified System.Nix.GC as GC + +import Data.Proxy + +-- derivation parsing +import qualified Nix.Derivation as Drv +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as TIO +import qualified Data.Attoparsec.Text.Lazy as A + +createProcessEnv :: FilePath -> String -> [String] -> IO P.ProcessHandle +createProcessEnv fp proc args =do + (_, _, _, ph) <- P.createProcess (P.proc proc args) { P.cwd = Just $ encodeString fp + , P.env = Just $ mockedEnv fp } + return ph + +mockedEnv :: FilePath -> [(String, String)] +mockedEnv fp = map (\(a, b) -> (a, encodeString 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") + ] + +waitSocket :: FilePath -> Int -> IO () +waitSocket fp 0 = fail "No socket" +waitSocket fp x = do + ex <- doesFileExist (encodeString fp) + case ex of + True -> return () + False -> threadDelay 100000 >> waitSocket fp (x - 1) + +writeConf fp = do + TIO.writeFile fp $ TL.unlines [ + "build-users-group = " + , "trusted-users = root" + , "allowed-users = *" + ] + +{- + - 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 (encodeString $ fp "etc" "nix.conf") + p <- createProcessEnv fp "nix-daemon" [] + waitSocket sockFp 30 + return (p, runStoreOpts (encodeString sockFp) (encodeString (fp "store"))) + where + sockFp = fp "var/nix/daemon-socket/socket" + +enterNamespaces = do + uid <- getEffectiveUserID + unshare [User, Network, Mount] + writeUserMappings Nothing [UserMapping 0 uid 1] + -- permission denied :( + --writeGroupMappings Nothing [GroupMapping 65534 ? 1] True + +withNixDaemon action = do + withSystemTempDirectory "test-nix-store" $ \pth -> do + let path = decodeString pth -- oh my + + mapM_ (createDirectory . snd) (filter ((/= "NIX_REMOTE") . fst) $ mockedEnv path) + + ini <- createProcessEnv path "nix-store" ["--init"] + P.waitForProcess ini + + bracket (startDaemon path) + (P.terminateProcess . fst) + (action . snd) + +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 + (Just path) <- addTextToStore "hnix-store" "test" (HS.fromList []) False + action path + +invalidPath = StorePath (hash "invalid") $ fromJust $ makeStorePathName "invalid" +{- + - broken + +withDrv action = withBuilder $ \builder -> withBash $ \bash -> do + path <- addTextToStore "wannabe-output" "" (HS.fromList []) False + + let unPath (Path digest pname) = pathNameContents pname + d = drvSample (unPath bash) (fromText $ unPath builder) (decodeString $ ((T.unpack $ unPath path) ++ "-out")) + + (Just path) <- addTextToStore "hnix-store-derivation" ( + TL.toStrict $ Data.Text.Lazy.Builder.toLazyText $ Drv.buildDerivation d) + (HS.fromList []) False + liftIO $ print d + action path d +-} + +{- +lal = do + --fp <- fmap init <$> liftIO $ P.readProcess "which" ["bash"] "" + --parent <- liftIO getCanonicalTemporaryDirectory + --pth <- liftIO $ createTempDirectory parent "test-nix-store-import" + --liftIO $ copyFile fp (pth ++ "/bash") + nar <- liftIO $ localPackNar narEffectsIO "src" + now <- liftIO $ getCurrentTime + + -- makeOutputPath "myout" digest "out" (StoreLocation) + (Just path) <- addTextToStore "wannabe-output" "" (HS.fromList []) False + let unPath (Path digest pname) = pathNameContents pname + + let vp = VP.ValidPath + { VP.path = path + , VP.deriver = Nothing + , VP.narHash = (printAsBase32 @PathHashAlgo (hash "dunno")) + , VP.references = HS.empty + , VP.registrationTime = now + , VP.narSize = 100 + , VP.ultimate = True + , VP.sigs = [] + , VP.ca = "" + } + + addToStoreNar vp nar False False + + --liftIO $ removeDirectoryRecursive pth + +-} +{- +withBash action = do + fp <- fmap init <$> liftIO $ P.readProcess "which" ["bash"] "" + path <- addToStore "bash" fp False (Proxy :: Proxy 'SHA256) (pure True) False + action path +-} + +withBuilder action = do + (Just path) <- addTextToStore "builder" builderSh (HS.fromList []) False + action path + +builderSh = T.concat [ "declare -xp", "export > $out" ] + +drvSample builder buildScript out = Drv.Derivation { + Drv.outputs = M.fromList [ ("out", Drv.DerivationOutput out "sha256" "lal") ] + , Drv.inputDrvs = M.empty -- Map FilePath (Set Text) + , Drv.inputSrcs = S.fromList [ buildScript ] + , Drv.platform = "x86_64-linux" + , Drv.builder = builder + , Drv.args = V.fromList ["-e", printFP buildScript ] +-- , Drv.env = M.empty + , Drv.env = M.fromList [("testEnv", "true")] + } + +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 + (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 +-} + {- + 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 "collectGarbage" $ do + itRights "simple collect nothing" $ do + gc <- collectGarbage $ GC.Options + { GC.operation = GC.DeleteDead + , GC.pathsToDelete = HS.empty + , GC.ignoreLiveness = False + , GC.maxFreed = -1 } + + gc `shouldBe` (GC.Result {GC.paths = HS.empty, GC.bytesFreed = 0}) + + itLefts "cannot gargabe collect live path" $ withPath $ \path -> do + ensurePath path + + collectGarbage $ GC.Options + { GC.operation = GC.DeleteSpecific + , GC.pathsToDelete = HS.fromList [path] + , GC.ignoreLiveness = False + , GC.maxFreed = -1 } + -} + + {- + 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 "addToStore" $ do + itRights "adds file to store" $ do + fp <- liftIO $ writeSystemTempFile "addition" "lal" + res <- addToStore "test" fp False SHA256 (pure True) False + liftIO $ print res + + itRights "adds bash to store" $ withBash $ const return () + + itRights "build derivation" $ do + withDrv $ \path drv -> do + res <- buildDerivation path drv Normal + res `shouldSatisfy` ((==TransientFailure) . status) + liftIO $ print res + + --liftIO $ forever $ threadDelay 1000000 + + return () + + itRights "matches paths" $ do + (Just path) <- addTextToStore "lal" "Hello World" (HS.fromList []) False + liftIO $ print path + return () + -- /nix/store/fnxqxrjyhksy7x3ilzz9lixrynwcnz3q-lal + + + -} + {- + itRights "nars" $ lal + drv <- liftIO $ do + text <- TIO.readFile drvFP' + case A.parse Drv.parseDerivation text of + A.Fail _uncomsumed _contexts error -> fail $ "Derivation parsing error " ++ error + A.Done _unconsumed result -> return result + -} + + +{- +pec_lol :: Spec +pec_lol = around withNixDaemon $ do + describe "store" $ do + it "addsText" $ \run -> do + (run $ addTextToStore "hnix-store" "test" (HS.fromList []) False) `checks` () +-}