remote: move StoreConfig to Types.StoreConfig, extend, add PreStoreConfig

hnix-store-remote/hnix-store-remote.cabal

@@ -69,6 +69,7 @@ library
     , System.Nix.Store.Remote.Protocol
     , System.Nix.Store.Remote.Types
     , System.Nix.Store.Remote.Types.ProtoVersion
+    , System.Nix.Store.Remote.Types.StoreConfig
     , System.Nix.Store.Remote.Types.WorkerOp
     , System.Nix.Store.Remote.Util
 

hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs

@@ -6,12 +6,8 @@ module System.Nix.Store.Remote.Logger
   ) where
 
 import Control.Monad.Except (throwError)
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Reader (asks)
 import Control.Monad.State.Strict (get)
-import Data.ByteString (ByteString)
 import Data.Serialize.Get (Get, Result(..))
-import Network.Socket.ByteString (recv)
 import System.Nix.Store.Remote.Serialize.Prim
 import System.Nix.Store.Remote.Types
 import System.Nix.Store.Remote.Util
@@ -45,10 +41,6 @@ processOutput :: MonadStore [Logger]
 processOutput = do
  sockGet8 >>= go . decoder
  where
-  sockGet8 :: MonadStore ByteString
-  sockGet8 = do
-    soc <- asks storeSocket
-    liftIO $ recv soc 8
   decoder = Data.Serialize.Get.runGetPartial controlParser
   go :: Result Logger -> MonadStore [Logger]
   go (Done ctrl _leftover) = do

hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs

@@ -89,7 +89,7 @@ runOpArgsIO op encoder = do
 
   sockPut $ putEnum op
 
-  soc <- asks storeSocket
+  soc <- asks storeConfig_socket
   encoder (liftIO . sendAll soc)
 
   out <- processOutput
@@ -116,20 +116,21 @@ runStoreOptsTCP host port storeRootDir code = do
 runStoreOpts'
   :: S.Family -> S.SockAddr -> StoreDir -> MonadStore a -> IO (Either String a, [Logger])
 runStoreOpts' sockFamily sockAddr storeRootDir code =
-  bracket open (S.close . storeSocket) run
+  bracket open (S.close . storeConfig_socket) run
 
  where
   open = do
     soc <- S.socket sockFamily S.Stream 0
     S.connect soc sockAddr
     pure StoreConfig
-        { storeSocket = soc
-        , storeDir = storeRootDir
+        { storeConfig_dir = storeRootDir
+        , storeConfig_protoVersion = ourProtoVersion
+        , storeConfig_socket = soc
         }
 
   greet = do
     sockPut $ putInt workerMagic1
-    soc      <- asks storeSocket
+    soc      <- asks storeConfig_socket
     vermagic <- liftIO $ recv soc 16
     let
       eres =

hnix-store-remote/src/System/Nix/Store/Remote/Types.hs

@@ -29,22 +29,16 @@ import Control.Monad.Reader (ReaderT, asks)
 import Control.Monad.Reader.Class (MonadReader)
 import Control.Monad.State.Strict (StateT, gets, modify)
 import Data.ByteString (ByteString)
-import Network.Socket (Socket)
 
 import Control.Monad.Trans.State.Strict (mapStateT)
 import Control.Monad.Trans.Except (mapExceptT)
 import Control.Monad.Trans.Reader (withReaderT)
 
 import System.Nix.Store.Remote.Types.ProtoVersion
+import System.Nix.Store.Remote.Types.StoreConfig
 import System.Nix.Store.Remote.Types.WorkerOp
 import System.Nix.StorePath (HasStoreDir(..), StoreDir)
 
-
-data StoreConfig = StoreConfig
-  { storeDir    :: StoreDir
-  , storeSocket :: Socket
-  }
-
 -- | Check flag, used by @verifyStore@
 newtype CheckFlag = CheckFlag { unCheckFlag :: Bool }
   deriving (Eq, Ord, Show)
@@ -73,7 +67,8 @@ type MonadStore a
 
 -- | For lying about the store dir in tests
 mapStoreDir :: (StoreDir -> StoreDir) -> (MonadStore a -> MonadStore a)
-mapStoreDir f = mapExceptT . mapStateT . withReaderT $ \c@StoreConfig { storeDir = sd } -> c { storeDir = f sd }
+mapStoreDir f = mapExceptT . mapStateT . withReaderT
+  $ \c@StoreConfig { storeConfig_dir = sd } -> c { storeConfig_dir = f sd }
 
 type ActivityID = Int
 type ActivityParentID = Int
@@ -118,4 +113,4 @@ clearData :: MonadStore ()
 clearData = modify (\(_, b) -> (Nothing, b))
 
 getStoreDir :: MonadStore StoreDir
-getStoreDir = asks storeDir
+getStoreDir = asks storeConfig_dir

hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs

@@ -0,0 +1,41 @@
+module System.Nix.Store.Remote.Types.StoreConfig
+  ( PreStoreConfig(..)
+  , StoreConfig(..)
+  , HasStoreSocket(..)
+  ) where
+
+import Network.Socket (Socket)
+import System.Nix.StorePath (HasStoreDir(..), StoreDir)
+import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion)
+
+data PreStoreConfig = PreStoreConfig
+  { preStoreConfig_dir    :: StoreDir
+  , preStoreConfig_socket :: Socket
+  }
+
+instance HasStoreDir PreStoreConfig where
+  hasStoreDir = preStoreConfig_dir
+
+class HasStoreSocket r where
+  storeSocket :: r -> Socket
+
+instance HasStoreSocket Socket where
+  storeSocket = id
+
+instance HasStoreSocket PreStoreConfig where
+  storeSocket = preStoreConfig_socket
+
+data StoreConfig = StoreConfig
+  { storeConfig_dir         :: StoreDir
+  , storeConfig_protoVersion :: ProtoVersion
+  , storeConfig_socket      :: Socket
+  }
+
+instance HasStoreDir StoreConfig where
+  hasStoreDir = storeConfig_dir
+
+instance HasProtoVersion StoreConfig where
+  protoVersion = storeConfig_protoVersion
+
+instance HasStoreSocket StoreConfig where
+  storeSocket = storeConfig_socket

hnix-store-remote/src/System/Nix/Store/Remote/Util.hs

@@ -33,15 +33,15 @@ genericIncremental getsome parser = do
 
 getSocketIncremental :: Get a -> MonadStore a
 getSocketIncremental = genericIncremental sockGet8
- where
-  sockGet8 :: MonadStore ByteString
-  sockGet8 = do
-    soc <- asks storeSocket
-    liftIO $ recv soc 8
+
+sockGet8 :: MonadStore ByteString
+sockGet8 = do
+  soc <- asks storeConfig_socket
+  liftIO $ recv soc 8
 
 sockPut :: Put -> MonadStore ()
 sockPut p = do
-  soc <- asks storeSocket
+  soc <- asks storeConfig_socket
   liftIO $ sendAll soc $ runPut p
 
 sockGet :: Get a -> MonadStore a