Propagate Nar streaming to the remote store

Author: layus

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

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))

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"