remote: heavy lifting

Co-Authored-By: Guillaume Maudoux <[email protected]> - `RemoteStoreT`, `RemoteStoreState` from #72 Co-Authored-By: John Ericson <[email protected]> - Reorg, `MonadRemoteStore0`, `MonadRemoteStoreHandshake`, `PreStoreConfig`, better `greet` Co-Authored-By: Ryan Trinkle <[email protected]> - Correctly detect when other side has hung up, throws `RemoteStoreError_Disconnected`
haskell-nix · Dec 1, 2023 · 6b1f0c5 · 6b1f0c5
1 parent 70eb0d3
commit 6b1f0c5
Show file tree

Hide file tree

Showing 7 changed files with 434 additions and 190 deletions.
diff --git a/hnix-store-remote/src/Data/Serializer.hs b/hnix-store-remote/src/Data/Serializer.hs
@@ -193,7 +193,7 @@ tup a b = Serializer
 data GetSerializerError customGetError
   = SerializerError_GetFail String
   | SerializerError_Get customGetError
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)
 
 -- | Helper for transforming nested Eithers
 -- into @GetSerializerError@ wrapper

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs
@@ -3,7 +3,9 @@
 {-# LANGUAGE OverloadedStrings   #-}
 
 module System.Nix.Store.Remote
-  ( addToStore
+  (
+  -- * Operations
+    addToStore
   , addTextToStore
   , addSignatures
   , addIndirectRoot
@@ -25,51 +27,124 @@ module System.Nix.Store.Remote
   , queryPathFromHashPart
   , queryMissing
   , optimiseStore
-  , runStore
   , syncWithGC
   , verifyStore
   , module System.Nix.Store.Types
   , module System.Nix.Store.Remote.MonadStore
   , module System.Nix.Store.Remote.Types
+  -- * Compat
+  , MonadStore
+  -- * Runners
+  , runStore
+  , runStoreOpts
+  , runStoreOptsTCP
   ) where
 
 import Crypto.Hash (SHA256)
 import Data.ByteString (ByteString)
+import Data.Default.Class (Default(def))
 import Data.Dependent.Sum (DSum((:=>)))
 import Data.HashSet (HashSet)
 import Data.Map (Map)
 import Data.Text (Text)
 import Data.Word (Word64)
+import Network.Socket (Family, SockAddr(SockAddrUnix))
 import System.Nix.Nar (NarSource)
 import System.Nix.Derivation (Derivation)
 import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
 import System.Nix.Build (BuildMode, BuildResult)
 import System.Nix.Hash (NamedAlgo(..), BaseEncoding(Base16), decodeDigestWith)
-import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart, InvalidPathError)
+import System.Nix.StorePath (StoreDir(..), StorePath, StorePathName, StorePathHashPart, InvalidPathError)
 import System.Nix.StorePath.Metadata  (Metadata(..), StorePathTrust(..))
 
 import qualified Data.Text
+import qualified Control.Exception
 import qualified Control.Monad
 import qualified Data.Attoparsec.Text
 import qualified Data.Text.Encoding
 import qualified Data.Map.Strict
 import qualified Data.Serialize.Put
 import qualified Data.Set
+import qualified Network.Socket
 
 import qualified System.Nix.ContentAddress
 import qualified System.Nix.Hash
 import qualified System.Nix.Signature
 import qualified System.Nix.StorePath
 
-import System.Nix.Store.Remote.MonadStore
-import System.Nix.Store.Remote.Protocol
+import System.Nix.Store.Remote.MonadStore (MonadRemoteStore, getStoreDir, RemoteStoreError(RemoteStoreError_GetAddrInfoFailed))
+import System.Nix.Store.Remote.Protocol (Run, runStoreSocket, runOp, runOpArgs, runOpArgsIO, simpleOp, simpleOpArgs)
 import System.Nix.Store.Remote.Socket
 import System.Nix.Store.Remote.Types
 
 import Data.Serialize (get)
-import System.Nix.Store.Remote.Serialize
+import System.Nix.Store.Remote.Serialize (putDerivation)
 import System.Nix.Store.Remote.Serialize.Prim
 
+-- * Compat
+
+type MonadStore = MonadRemoteStore
+
+-- * Runners
+
+runStore :: MonadStore a -> Run a
+runStore = runStoreOpts defaultSockPath def
+  where
+    defaultSockPath :: String
+    defaultSockPath = "/nix/var/nix/daemon-socket/socket"
+
+runStoreOpts
+  :: FilePath
+  -> StoreDir
+  -> MonadStore a
+  -> Run a
+runStoreOpts socketPath =
+  runStoreOpts'
+    Network.Socket.AF_UNIX
+    (SockAddrUnix socketPath)
+
+runStoreOptsTCP
+  :: String
+  -> Int
+  -> StoreDir
+  -> MonadStore a
+  -> Run a
+runStoreOptsTCP host port sd code = do
+  Network.Socket.getAddrInfo
+    (Just Network.Socket.defaultHints)
+    (Just host)
+    (Just $ show port)
+    >>= \case
+      (sockAddr:_) ->
+        runStoreOpts'
+          (Network.Socket.addrFamily sockAddr)
+          (Network.Socket.addrAddress sockAddr)
+          sd
+          code
+      _ -> pure (Left RemoteStoreError_GetAddrInfoFailed, [])
+
+runStoreOpts'
+  :: Family
+  -> SockAddr
+  -> StoreDir
+  -> MonadStore a
+  -> Run a
+runStoreOpts' sockFamily sockAddr storeRootDir code =
+  Control.Exception.bracket
+    open
+    (Network.Socket.close . hasStoreSocket)
+    (flip runStoreSocket code)
+  where
+    open = do
+      soc <- Network.Socket.socket sockFamily Network.Socket.Stream 0
+      Network.Socket.connect soc sockAddr
+      pure PreStoreConfig
+          { preStoreConfig_socket = soc
+          , preStoreConfig_dir = storeRootDir
+          }
+
+-- * Operations
+
 -- | Pack `Nar` and add it to the store.
 addToStore
   :: forall a

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs
@@ -8,18 +8,22 @@ import Data.Serialize (Result(..))
 import System.Nix.Store.Remote.Serialize.Prim (putByteString)
 import System.Nix.Store.Remote.Serializer (LoggerSError, logger, runSerialT)
 import System.Nix.Store.Remote.Socket (sockGet8, sockPut)
-import System.Nix.Store.Remote.MonadStore (MonadStore, clearData)
-import System.Nix.Store.Remote.Types (Logger(..), ProtoVersion, hasProtoVersion)
+import System.Nix.Store.Remote.MonadStore (MonadRemoteStore0, RemoteStoreError(..), clearData, getData, getProtoVersion)
+import System.Nix.Store.Remote.Types.Logger (Logger(..))
+import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion)
+import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket(..))
 
 import qualified Control.Monad
-import qualified Control.Monad.Reader
-import qualified Control.Monad.State.Strict
 import qualified Data.Serialize.Get
 import qualified Data.Serializer
 
-processOutput :: MonadStore [Logger]
+processOutput
+  :: ( HasProtoVersion r
+     , HasStoreSocket r
+     )
+  => MonadRemoteStore0 r [Logger]
 processOutput = do
- protoVersion <- Control.Monad.Reader.asks hasProtoVersion
+ protoVersion <- getProtoVersion
  sockGet8 >>= go . (decoder protoVersion)
  where
   decoder
@@ -30,14 +34,19 @@ processOutput = do
     Data.Serialize.Get.runGetPartial
       (runSerialT protoVersion $ Data.Serializer.getS logger)
 
-  go :: Result (Either LoggerSError Logger) -> MonadStore [Logger]
+  go
+    :: ( HasProtoVersion r
+       , HasStoreSocket r
+       )
+    => Result (Either LoggerSError Logger)
+    -> MonadRemoteStore0 r [Logger]
   go (Done ectrl leftover) = do
 
     Control.Monad.unless (leftover == mempty) $
       -- TODO: throwError
       error $ "Leftovers detected: '" ++ show leftover ++ "'"
 
-    protoVersion <- Control.Monad.Reader.asks hasProtoVersion
+    protoVersion <- getProtoVersion
     case ectrl of
       -- TODO: tie this with throwError and better error type
       Left e -> error $ show e
@@ -46,9 +55,9 @@ processOutput = do
           e@(Logger_Error _) -> pure [e]
           Logger_Last -> pure [Logger_Last]
           Logger_Read _n -> do
-            (mdata, _) <- Control.Monad.State.Strict.get
+            mdata <- getData
             case mdata of
-              Nothing   -> throwError "No data to read provided"
+              Nothing   -> throwError RemoteStoreError_NoDataProvided
               Just part -> do
                 -- XXX: we should check/assert part size against n of (Read n)
                 sockPut $ putByteString part