diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index 4c9f63c..cbbe663 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -10,7 +10,6 @@ module System.Nix.Store.Remote ( addToStore - , addToStoreNar , addTextToStore , addSignatures , addIndirectRoot @@ -45,7 +44,6 @@ 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) import System.Nix.StorePath (StorePath, StorePathName, StorePathSet, StorePathHashAlgo) import System.Nix.StorePathMetadata (StorePathMetadata(..), StorePathTrust(..)) @@ -83,74 +81,22 @@ addToStore :: forall a. (ValidAlgo a, NamedAlgo a) -> 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 + runOpArgsIO AddToStore $ \yield -> do + yield $ Data.ByteString.Lazy.toStrict $ Data.Binary.Put.runPut $ do + putText $ System.Nix.StorePath.unStorePathName name - runOpArgs AddToStore $ do - putText $ System.Nix.StorePath.unStorePathName name + putBool + $ not + $ System.Nix.Hash.algoName @a == "sha256" && recursive - putBool - $ not - $ System.Nix.Hash.algoName @a == "sha256" && recursive + putBool recursive - putBool recursive + putText $ System.Nix.Hash.algoName @a - putText $ System.Nix.Hash.algoName @a - - Data.Binary.Put.putLazyByteString nar + System.Nix.Nar.streamNarIO yield System.Nix.Nar.narEffectsIO pth 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 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 52f0dcb..4c32b0a 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs @@ -7,6 +7,7 @@ module System.Nix.Store.Remote.Protocol ( , simpleOpArgs , runOp , runOpArgs + , runOpArgsIO , runStore , runStoreOpts) where @@ -17,12 +18,13 @@ 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 Network.Socket.ByteString (recv) +import Network.Socket.ByteString (recv, sendAll) import System.Nix.Store.Remote.Binary import System.Nix.Store.Remote.Logger @@ -131,17 +133,16 @@ runOp :: WorkerOp -> MonadStore () runOp op = runOpArgs op $ return () runOpArgs :: WorkerOp -> Put -> MonadStore () -runOpArgs op args = do +runOpArgs op args = runOpArgsIO op (\encode -> encode $ Data.ByteString.Lazy.toStrict $ runPut args) - -- Temporary hack for printing the messages destined for nix-daemon socket - when False $ - liftIO $ Data.ByteString.Lazy.writeFile "mytestfile2" $ runPut $ do - putInt $ opNum op - args +runOpArgsIO :: WorkerOp -> ((Data.ByteString.ByteString -> MonadStore ()) -> MonadStore ()) -> MonadStore () +runOpArgsIO op encoder = do sockPut $ do putInt $ opNum op - args + + soc <- storeSocket <$> ask + encoder (liftIO . sendAll soc) out <- processOutput modify (\(a, b) -> (a, b++out)) diff --git a/hnix-store-remote/tests/NixDaemon.hs b/hnix-store-remote/tests/NixDaemon.hs index caca472..a595ad5 100644 --- a/hnix-store-remote/tests/NixDaemon.hs +++ b/hnix-store-remote/tests/NixDaemon.hs @@ -163,39 +163,6 @@ 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 @@ -275,12 +242,6 @@ spec_protocol = Hspec.around withNixDaemon $ 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"