remote: heavy lifting

- By layus - `RemoteStoreT`, `RemoteStoreState` from #72 - By Ericson2314 - Reorg, `MonadRemoteStore0`, `MonadRemoteStoreHandshake`, `PreStoreConfig`, better `greet` - By ryantrinkle - Correctly detect when other side has hung up, throws `RemoteStoreError_Disconnected` Co-Authored-By: Guillaume Maudoux <layus.on@gmail.com> Co-Authored-By: John Ericson <John.Ericson@Obsidian.Systems> Co-Authored-By: Ryan Trinkle <ryan@trinkle.org>
2024-09-11 18:05:56 +03:00 · 2023-11-30 13:50:57 +01:00 · 2023-11-30 13:50:57 +01:00 · a3c9530198
commit a3c9530198
parent 1bc4d0575d
7 changed files with 423 additions and 179 deletions
--- 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
--- 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
--- 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
--- a/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
@ -1,58 +1,171 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module System.Nix.Store.Remote.MonadStore
-  ( MonadStore
-  , mapStoreDir
+  ( RemoteStoreState(..)
+  , RemoteStoreError(..)
+  , WorkerError(..)
+  , RemoteStoreT
+  , runRemoteStoreT
+  , mapStoreConfig
+  , MonadRemoteStore0
+  , MonadRemoteStore
+  , MonadRemoteStoreHandshake
+  -- *
  , getStoreDir
-  , getLog
-  , flushLog
+  , getStoreSocket
+  , getProtoVersion
+  -- *
+  , appendLogs
+  , getLogs
+  , flushLogs
  , gotError
  , getErrors
+  -- *
+  , getData
  , setData
  , clearData
  ) where

-import Control.Monad.Except (ExceptT)
-import Control.Monad.Reader (ReaderT, asks)
-import Control.Monad.Reader.Class (MonadReader)
-import Control.Monad.State.Strict (StateT, gets, modify)
+
+import Control.Monad.Except (MonadError)
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Reader (MonadReader, ask)
+import Control.Monad.State.Strict (get, modify)
+import Control.Monad.Trans (MonadTrans, lift)
+import Control.Monad.Trans.State.Strict (StateT, runStateT, mapStateT)
+import Control.Monad.Trans.Except (ExceptT, runExceptT, mapExceptT)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT)
 import Data.ByteString (ByteString)
-
-import Control.Monad.Trans.State.Strict (mapStateT)
-import Control.Monad.Trans.Except (mapExceptT)
-import Control.Monad.Trans.Reader (withReaderT)
-
+import Data.Word (Word64)
+import Network.Socket (Socket)
 import System.Nix.StorePath (HasStoreDir(..), StoreDir)
+import System.Nix.Store.Remote.Serializer (SError)
 import System.Nix.Store.Remote.Types.Logger (Logger, isError)
-import System.Nix.Store.Remote.Types.StoreConfig (StoreConfig(..))
+import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion)
+import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket(..), PreStoreConfig, StoreConfig)
+
+data RemoteStoreState = RemoteStoreState {
+    remoteStoreState_logs :: [Logger]
+  , remoteStoreState_mData :: Maybe ByteString
+  } deriving (Eq, Ord, Show)
+
+data RemoteStoreError
+  = RemoteStoreError_Fixme String
+  | RemoteStoreError_BuildFailed
+  | RemoteStoreError_ClientVersionTooOld
+  | RemoteStoreError_Disconnected
+  | RemoteStoreError_GetAddrInfoFailed
+  | RemoteStoreError_SerializerGet SError
+  | RemoteStoreError_SerializerPut SError
+  | RemoteStoreError_NoDataProvided
+  | RemoteStoreError_ProtocolMismatch
+  | RemoteStoreError_WorkerMagic2Mismatch
+  | RemoteStoreError_WorkerError WorkerError
+  deriving (Eq, Show, Ord)
+
+-- | Non-fatal (to server) errors in worker interaction
+data WorkerError
+  = WorkerError_SendClosed
+  | WorkerError_InvalidOperation Word64
+  | WorkerError_NotYetImplemented
+  deriving (Eq, Ord, Show)
+
+newtype RemoteStoreT r m a = RemoteStoreT
+  { _unRemoteStoreT
+      :: ExceptT RemoteStoreError
+          (StateT RemoteStoreState
+            (ReaderT r m)) a
+  }
+  deriving
+    ( Functor
+    , Applicative
+    , Monad
+    , MonadReader r
+    --, MonadState StoreState   -- Avoid making the internal state explicit
+    --, MonadFail
+    , MonadError RemoteStoreError
+    , MonadIO
+    )
+
+instance MonadTrans (RemoteStoreT r) where
+  lift = RemoteStoreT . lift . lift . lift
+
+-- | Runner for @RemoteStoreT@
+runRemoteStoreT
+  :: ( HasStoreDir r
+     , HasStoreSocket r
+     , Monad m
+     )
+  => r
+  -> RemoteStoreT r m a
+  -> m (Either RemoteStoreError a, [Logger])
+runRemoteStoreT r =
+    fmap (\(res, RemoteStoreState{..}) -> (res, remoteStoreState_logs))
+  . (`runReaderT` r)
+  . (`runStateT` emptyState)
+  . runExceptT
+  . _unRemoteStoreT
+  where
+    emptyState = RemoteStoreState
+      { remoteStoreState_logs = mempty
+      , remoteStoreState_mData = Nothing
+      }
+
+type MonadRemoteStore0 r = RemoteStoreT r IO
+
+type MonadRemoteStore = MonadRemoteStore0 StoreConfig
+
+type MonadRemoteStoreHandshake = MonadRemoteStore0 PreStoreConfig
+
+mapStoreConfig
+  :: (rb -> ra)
+  -> (MonadRemoteStore0 ra a -> MonadRemoteStore0 rb a)
+mapStoreConfig f =
+  RemoteStoreT
+  . ( mapExceptT
+    . mapStateT
+    . withReaderT
+    ) f
+  . _unRemoteStoreT

 -- | Ask for a @StoreDir@
-getStoreDir :: (HasStoreDir r, MonadReader r m) => m StoreDir
-getStoreDir = asks hasStoreDir
+getStoreDir :: HasStoreDir r => MonadRemoteStore0 r StoreDir
+getStoreDir = hasStoreDir <$> RemoteStoreT ask

-type MonadStore a
-  = ExceptT
-      String
-      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
-      a
+-- | Ask for a @StoreDir@
+getStoreSocket :: HasStoreSocket r => MonadRemoteStore0 r Socket
+getStoreSocket = hasStoreSocket <$> RemoteStoreT ask

-- | For lying about the store dir in tests
-mapStoreDir :: (StoreDir -> StoreDir) -> (MonadStore a -> MonadStore a)
-mapStoreDir f = mapExceptT . mapStateT . withReaderT
-  $ \c@StoreConfig { storeConfig_dir = sd } -> c { storeConfig_dir = f sd }
+-- | Ask for a @StoreDir@
+getProtoVersion :: HasProtoVersion r => MonadRemoteStore0 r ProtoVersion
+getProtoVersion = hasProtoVersion <$> RemoteStoreT ask

-gotError :: MonadStore Bool
-gotError = gets (any isError . snd)
+gotError :: MonadRemoteStore0 r Bool
+gotError = any isError <$> getLogs

-getErrors :: MonadStore [Logger]
-getErrors = gets (filter isError . snd)
+getErrors :: MonadRemoteStore0 r [Logger]
+getErrors = filter isError <$> getLogs

-getLog :: MonadStore [Logger]
-getLog = gets snd
+-- *

-flushLog :: MonadStore ()
-flushLog = modify (\(a, _b) -> (a, []))
+appendLogs :: [Logger] -> MonadRemoteStore0 r ()
+appendLogs x = RemoteStoreT
+  $ modify
+  $ \s -> s { remoteStoreState_logs = remoteStoreState_logs s <> x }

-setData :: ByteString -> MonadStore ()
-setData x = modify (\(_, b) -> (Just x, b))
+getLogs :: MonadRemoteStore0 r [Logger]
+getLogs = remoteStoreState_logs <$> RemoteStoreT get

-clearData :: MonadStore ()
-clearData = modify (\(_, b) -> (Nothing, b))
+flushLogs :: MonadRemoteStore0 r ()
+flushLogs = RemoteStoreT $ modify $ \s -> s { remoteStoreState_logs = mempty }
+
+-- *
+
+getData :: MonadRemoteStore0 r (Maybe ByteString)
+getData = remoteStoreState_mData <$> RemoteStoreT get
+
+setData :: ByteString -> MonadRemoteStore0 r ()
+setData x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mData = pure x }
+
+clearData :: MonadRemoteStore0 r ()
+clearData = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mData = Nothing }
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs
@ -1,42 +1,29 @@
 {-# LANGUAGE OverloadedStrings #-}

 module System.Nix.Store.Remote.Protocol
-  ( WorkerOp(..)
+  ( Run
  , simpleOp
  , simpleOpArgs
  , runOp
  , runOpArgs
  , runOpArgsIO
-  , runStore
-  , runStoreOpts
-  , runStoreOptsTCP
-  , runStoreOpts'
+  , runStoreSocket
  , ourProtoVersion
-  , GCAction(..)
  ) where

-import qualified Control.Monad
-import Control.Exception              ( bracket )
-import Control.Monad.Except
-import Control.Monad.Reader (asks, runReaderT)
-import Control.Monad.State.Strict
+import Control.Monad (unless, when)
+import Control.Monad.Except (throwError)
+import Control.Monad.IO.Class (liftIO)
+import Data.Serialize.Put (Put, runPut)

-import Data.Default.Class (Default(def))
 import qualified Data.Bool
-import Data.Serialize.Get
-import Data.Serialize.Put
 import qualified Data.ByteString
+import qualified Network.Socket.ByteString

-import Network.Socket (SockAddr(SockAddrUnix))
-import qualified Network.Socket as S
-import Network.Socket.ByteString (recv, sendAll)
-
-import System.Nix.StorePath (StoreDir(..))
-import System.Nix.Store.Remote.Serialize.Prim
-import System.Nix.Store.Remote.Logger
+import System.Nix.Store.Remote.Logger (processOutput)
 import System.Nix.Store.Remote.MonadStore
-import System.Nix.Store.Remote.Socket
-import System.Nix.Store.Remote.Serializer (protoVersion)
+import System.Nix.Store.Remote.Socket (sockPutS, sockGetS)
+import System.Nix.Store.Remote.Serializer (bool, enum, int, protoVersion, text)
 import System.Nix.Store.Remote.Types

 ourProtoVersion :: ProtoVersion
@ -50,28 +37,27 @@ workerMagic1 = 0x6e697863
 workerMagic2 :: Int
 workerMagic2 = 0x6478696f

-defaultSockPath :: String
-defaultSockPath = "/nix/var/nix/daemon-socket/socket"
+type Run a = IO (Either RemoteStoreError a, [Logger])

-simpleOp :: WorkerOp -> MonadStore Bool
+simpleOp :: WorkerOp -> MonadRemoteStore Bool
 simpleOp op = simpleOpArgs op $ pure ()

-simpleOpArgs :: WorkerOp -> Put -> MonadStore Bool
+simpleOpArgs :: WorkerOp -> Put -> MonadRemoteStore Bool
 simpleOpArgs op args = do
  runOpArgs op args
  err <- gotError
  Data.Bool.bool
-    sockGetBool
+    (sockGetS bool)
    (do
      -- TODO: don't use show
-      getErrors >>= throwError . show
+      getErrors >>= throwError . RemoteStoreError_Fixme . show
    )
    err

-runOp :: WorkerOp -> MonadStore ()
+runOp :: WorkerOp -> MonadRemoteStore ()
 runOp op = runOpArgs op $ pure ()

-runOpArgs :: WorkerOp -> Put -> MonadStore ()
+runOpArgs :: WorkerOp -> Put -> MonadRemoteStore ()
 runOpArgs op args =
  runOpArgsIO
    op
@ -79,76 +65,70 @@ runOpArgs op args =

 runOpArgsIO
  :: WorkerOp
-  -> ((Data.ByteString.ByteString -> MonadStore ()) -> MonadStore ())
-  -> MonadStore ()
+  -> ((Data.ByteString.ByteString -> MonadRemoteStore ())
+       -> MonadRemoteStore ()
+     )
+  -> MonadRemoteStore ()
 runOpArgsIO op encoder = do
+  sockPutS enum op

-  sockPut $ putEnum op
-
-  soc <- asks storeConfig_socket
-  encoder (liftIO . sendAll soc)
+  soc <- getStoreSocket
+  encoder (liftIO . Network.Socket.ByteString.sendAll soc)

  out <- processOutput
-  modify (\(a, b) -> (a, b <> out))
+  appendLogs out
  err <- gotError
-  Control.Monad.when err $ do
+  when err $ do
    -- TODO: don't use show
-    getErrors >>= throwError . show
+    getErrors >>= throwError . RemoteStoreError_Fixme . show

-runStore :: MonadStore a -> IO (Either String a, [Logger])
-runStore = runStoreOpts defaultSockPath def
+runStoreSocket
+  :: PreStoreConfig
+  -> MonadRemoteStore a
+  -> Run a
+runStoreSocket preStoreConfig code =
+  runRemoteStoreT preStoreConfig $ do
+    pv <- greet
+    mapStoreConfig
+      (\(PreStoreConfig a b) -> StoreConfig a pv b)
+      code

-runStoreOpts
-  :: FilePath -> StoreDir -> MonadStore a -> IO (Either String a, [Logger])
-runStoreOpts path = runStoreOpts' S.AF_UNIX (SockAddrUnix path)
+  where
+    greet :: MonadRemoteStoreHandshake ProtoVersion
+    greet = do
+      sockPutS int workerMagic1

-runStoreOptsTCP
-  :: String -> Int -> StoreDir -> MonadStore a -> IO (Either String a, [Logger])
-runStoreOptsTCP host port storeRootDir code = do
-  S.getAddrInfo (Just S.defaultHints) (Just host) (Just $ show port) >>= \case
-    (sockAddr:_) -> runStoreOpts' (S.addrFamily sockAddr) (S.addrAddress sockAddr) storeRootDir code
-    _ -> pure (Left "Couldn't resolve host and port with getAddrInfo.", [])
+      magic <- sockGetS int
+      unless
+        (magic == workerMagic2)
+        $ throwError RemoteStoreError_WorkerMagic2Mismatch

-runStoreOpts'
-  :: S.Family -> S.SockAddr -> StoreDir -> MonadStore a -> IO (Either String a, [Logger])
-runStoreOpts' sockFamily sockAddr storeRootDir code =
-  bracket open (S.close . storeConfig_socket) run
+      daemonVersion <- sockGetS protoVersion

- where
-  open = do
-    soc <- S.socket sockFamily S.Stream 0
-    S.connect soc sockAddr
-    pure StoreConfig
-        { storeConfig_dir = storeRootDir
-        , storeConfig_protoVersion = ourProtoVersion
-        , storeConfig_socket = soc
-        }
+      when (daemonVersion < ProtoVersion 1 10)
+        $ throwError RemoteStoreError_ClientVersionTooOld

-  greet = do
-    sockPut $ putInt workerMagic1
-    soc      <- asks hasStoreSocket
-    vermagic <- liftIO $ recv soc 16
-    let
-      eres =
-        flip runGet vermagic
-          $ (,)
-            <$> (getInt :: Get Int)
-            <*> (getInt :: Get Int)
+      sockPutS protoVersion ourProtoVersion

-    case eres of
-      Left err -> error $ "Error parsing vermagic " ++ err
-      Right (magic2, _daemonProtoVersion) -> do
-        Control.Monad.unless (magic2 == workerMagic2) $ error "Worker magic 2 mismatch"
+      when (daemonVersion >= ProtoVersion 1 14)
+        $ sockPutS int (0 :: Int) -- affinity, obsolete

-    pv <- asks hasProtoVersion
-    sockPutS @() protoVersion pv -- clientVersion
-    sockPut $ putInt (0 :: Int)   -- affinity
-    sockPut $ putInt (0 :: Int)   -- obsolete reserveSpace
+      when (daemonVersion >= ProtoVersion 1 11) $ do
+        sockPutS bool False  -- reserveSpace, obsolete

-    processOutput
+      -- not quite right, should be min of the two
+      -- as well as two ^ above
+      when (ourProtoVersion >= ProtoVersion 1 33) $ do
+        -- If we were buffering I/O, we would flush the output here.
+        _daemonNixVersion <- sockGetS text
+        return ()

-  run sock =
-    fmap (\(res, (_data, logs)) -> (res, logs))
-      $ (`runReaderT` sock)
-      $ (`runStateT` (Nothing, []))
-      $ runExceptT (greet >> code)
+      -- TODO do something with it
+      -- TODO patter match better
+      _ <- mapStoreConfig
+            (\(PreStoreConfig a b) -> StoreConfig a ourProtoVersion b)
+            processOutput
+
+      -- TODO should be minimum of
+      -- ourProtoVersion vs daemonVersion
+      pure ourProtoVersion
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Socket.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Socket.hs
@ -1,19 +1,21 @@
 module System.Nix.Store.Remote.Socket where

-import Control.Monad.Except (throwError)
-import Control.Monad.Reader (asks)
+import Control.Monad.Except (MonadError, throwError)
 import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Reader (MonadReader, ask, asks)
 import Data.ByteString (ByteString)
 import Data.HashSet (HashSet)
 import Data.Serialize.Get (Get, Result(..))
-import Data.Serialize.Put
+import Data.Serialize.Put (Put, runPut)
 import Network.Socket.ByteString (recv, sendAll)
-import System.Nix.StorePath (StorePath)
-import System.Nix.Store.Remote.MonadStore
-import System.Nix.Store.Remote.Serializer (NixSerializer, runP)
-import System.Nix.Store.Remote.Serialize.Prim
-import System.Nix.Store.Remote.Types
+import System.Nix.StorePath (HasStoreDir, StorePath)
+import System.Nix.Store.Remote.MonadStore (MonadRemoteStore0, RemoteStoreError(..), getStoreDir, getStoreSocket)
+import System.Nix.Store.Remote.Serializer (NixSerializer, SError, runP, runSerialT)
+import System.Nix.Store.Remote.Serialize.Prim (getInt, getByteString, getByteStrings, getPath, getPathsOrFail)
+import System.Nix.Store.Remote.Types (HasStoreSocket(..))

+import qualified Data.ByteString
+import qualified Data.Serializer
 import qualified Data.Serialize.Get

 genericIncremental
@ -31,57 +33,116 @@ genericIncremental getsome parser = do
    go (k chunk)
  go (Fail msg _leftover) = error msg

-getSocketIncremental :: Get a -> MonadStore a
-getSocketIncremental = genericIncremental sockGet8
-
-sockGet8 :: MonadStore ByteString
+sockGet8
+  :: HasStoreSocket r
+  => MonadRemoteStore0 r ByteString
 sockGet8 = do
-  soc <- asks hasStoreSocket
+  soc <- getStoreSocket
  liftIO $ recv soc 8

-sockPut :: Put -> MonadStore ()
+sockPut
+  :: HasStoreSocket r
+  => Put
+  -> MonadRemoteStore0 r ()
 sockPut p = do
-  soc <- asks hasStoreSocket
+  soc <- getStoreSocket
  liftIO $ sendAll soc $ runPut p

 sockPutS
-  :: Show e
-  => NixSerializer ProtoVersion e a
+  :: ( MonadReader r m
+     , MonadError RemoteStoreError m
+     , MonadIO m
+     , HasStoreSocket r
+     )
+  => NixSerializer r SError a
  -> a
-  -> MonadStore ()
+  -> m ()
 sockPutS s a = do
-  soc <- asks hasStoreSocket
-  pv <- asks hasProtoVersion
-  case runP s pv a of
-    Right x -> liftIO $ sendAll soc x
-    -- TODO: errors
-    Left e -> throwError $ show e
+  r <- ask
+  case runP s r a of
+    Right x -> liftIO $ sendAll (hasStoreSocket r) x
+    Left e -> throwError $ RemoteStoreError_SerializerPut e

-sockGet :: Get a -> MonadStore a
+sockGetS
+  :: forall r m a
+   . ( HasStoreSocket r
+     , MonadError RemoteStoreError m
+     , MonadReader r m
+     , MonadIO m
+     )
+  => NixSerializer r SError a
+  -> m a
+sockGetS s = do
+  r <- ask
+  res <- genericIncremental sockGet8'
+    $ runSerialT r $ Data.Serializer.getS s
+
+  case res of
+    Right x -> pure x
+    Left e -> throwError $ RemoteStoreError_SerializerGet e
+ where
+  sockGet8' :: MonadError RemoteStoreError m => m ByteString
+  sockGet8' = do
+    soc <- asks hasStoreSocket
+    result <- liftIO $ recv soc 8
+    if Data.ByteString.length result == 0
+      then throwError RemoteStoreError_Disconnected
+      else pure result
+
+-- * Obsolete
+
+getSocketIncremental
+  :: HasStoreSocket r
+  => Get a
+  -> MonadRemoteStore0 r a
+getSocketIncremental = genericIncremental sockGet8
+
+sockGet
+  :: HasStoreSocket r
+  => Get a
+  -> MonadRemoteStore0 r a
 sockGet = getSocketIncremental

-sockGetInt :: Integral a => MonadStore a
+sockGetInt
+  :: ( HasStoreSocket r
+     , Integral a
+     )
+  => MonadRemoteStore0 r a
 sockGetInt = getSocketIncremental getInt

-sockGetBool :: MonadStore Bool
+sockGetBool
+  :: HasStoreSocket r
+  => MonadRemoteStore0 r Bool
 sockGetBool = (== (1 :: Int)) <$> sockGetInt

-sockGetStr :: MonadStore ByteString
+sockGetStr
+  :: HasStoreSocket r
+  => MonadRemoteStore0 r ByteString
 sockGetStr = getSocketIncremental getByteString

-sockGetStrings :: MonadStore [ByteString]
+sockGetStrings
+  :: HasStoreSocket r
+  => MonadRemoteStore0 r [ByteString]
 sockGetStrings = getSocketIncremental getByteStrings

-sockGetPath :: MonadStore StorePath
+sockGetPath
+  :: ( HasStoreDir r
+     , HasStoreSocket r
+     )
+  => MonadRemoteStore0 r StorePath
 sockGetPath = do
  sd  <- getStoreDir
  pth <- getSocketIncremental (getPath sd)
  either
-    (throwError . show)
+    (throwError . RemoteStoreError_Fixme . show)
    pure
    pth

-sockGetPathMay :: MonadStore (Maybe StorePath)
+sockGetPathMay
+  :: ( HasStoreDir r
+     , HasStoreSocket r
+     )
+  => MonadRemoteStore0 r (Maybe StorePath)
 sockGetPathMay = do
  sd  <- getStoreDir
  pth <- getSocketIncremental (getPath sd)
@ -91,7 +152,11 @@ sockGetPathMay = do
      Just
      pth

-sockGetPaths :: MonadStore (HashSet StorePath)
+sockGetPaths
+  :: ( HasStoreDir r
+     , HasStoreSocket r
+     )
+  => MonadRemoteStore0 r (HashSet StorePath)
 sockGetPaths = do
  sd <- getStoreDir
  getSocketIncremental (getPathsOrFail sd)
--- a/hnix-store-remote/tests-io/NixDaemon.hs
+++ b/hnix-store-remote/tests-io/NixDaemon.hs
@ -29,7 +29,6 @@ import System.Nix.Build
 import System.Nix.StorePath
 import System.Nix.StorePath.Metadata
 import System.Nix.Store.Remote
-import System.Nix.Store.Remote.Protocol

 import Crypto.Hash (SHA256)
 import System.Nix.Nar (dumpPath)
@ -89,7 +88,7 @@ error: changing ownership of path '/run/user/1000/test-nix-store-06b0d249e561612

 startDaemon
  :: FilePath
-  -> IO (P.ProcessHandle, MonadStore a -> IO (Either String a, [Logger]))
+  -> IO (P.ProcessHandle, MonadStore a -> IO (Either RemoteStoreError a, [Logger]))
 startDaemon fp = do
  writeConf (fp </> "etc" </> "nix.conf")
  p <- createProcessEnv fp "nix-daemon" []
@ -110,7 +109,7 @@ enterNamespaces = do
  writeGroupMappings Nothing [GroupMapping 0 gid 1] True

 withNixDaemon
-  :: ((MonadStore a -> IO (Either String a, [Logger])) -> IO a) -> IO a
+  :: ((MonadStore a -> IO (Either RemoteStoreError a, [Logger])) -> IO a) -> IO a
 withNixDaemon action =
  withSystemTempDirectory "test-nix-store" $ \path -> do

@ -213,7 +212,10 @@ spec_protocol = Hspec.around withNixDaemon $
      itRights "validates path" $ withPath $ \path -> do
        liftIO $ print path
        isValidPathUncached path `shouldReturn` True
-      itLefts "fails on invalid path" $ mapStoreDir (\_ -> StoreDir "/asdf") $ isValidPathUncached invalidPath
+      itLefts "fails on invalid path"
+        $ mapStoreConfig
+            (\sc -> sc { storeConfig_dir = StoreDir "/asdf" })
+            $ isValidPathUncached invalidPath

    context "queryAllValidPaths" $ do
      itRights "empty query" queryAllValidPaths