From 8078f0f07ffd9f46a2beffae8ec6a34cd653f0e3 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Fri, 8 Dec 2023 11:56:18 +0100
Subject: [PATCH 01/27] remote: drop common tests cabal stanza

---
 hnix-store-remote/hnix-store-remote.cabal | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal
index 5546c10..74a0869 100644
--- a/hnix-store-remote/hnix-store-remote.cabal
+++ b/hnix-store-remote/hnix-store-remote.cabal
@@ -46,11 +46,6 @@ common commons
     , ViewPatterns
   default-language: Haskell2010
 
-common tests
-  import: commons
-  build-tool-depends:
-      tasty-discover:tasty-discover
-
 flag io-testsuite
   default:
     False
@@ -163,7 +158,7 @@ executable remote-readme
   ghc-options: -pgmL markdown-unlit -Wall
 
 test-suite remote
-  import: tests
+  import: commons
   type:              exitcode-stdio-1.0
   main-is:           Driver.hs
   hs-source-dirs:    tests
@@ -187,7 +182,7 @@ test-suite remote
     , QuickCheck
 
 test-suite remote-io
-  import: tests
+  import: commons
 
   if !flag(io-testsuite) || os(darwin)
     buildable: False

From 2bdd171d224723a6cdc912939e5c3b211946d42a Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Fri, 8 Dec 2023 11:57:38 +0100
Subject: [PATCH 02/27] wip/remote: add daemon runners, simplify server using
 StoreReply

---
 hnix-store-remote/hnix-store-remote.cabal     |   3 +
 .../src/System/Nix/Store/Remote.hs            |  94 +++++++++++-
 .../src/System/Nix/Store/Remote/Server.hs     | 135 +++++++-----------
 3 files changed, 147 insertions(+), 85 deletions(-)

diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal
index 74a0869..9cee10a 100644
--- a/hnix-store-remote/hnix-store-remote.cabal
+++ b/hnix-store-remote/hnix-store-remote.cabal
@@ -114,13 +114,16 @@ library
     , data-default-class
     , dependent-sum > 0.7
     , dependent-sum-template >= 0.2.0.1 && < 0.3
+    , directory
     , dlist >= 1.0
+    , exceptions
     , generic-arbitrary < 1.1
     , hashable
     , text
     , time
     , transformers
     , network
+    , monad-control
     , mtl
     , QuickCheck
     , unordered-containers
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs
index cf4b23e..63560c3 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Rank2Types #-}
+
 module System.Nix.Store.Remote
-  (
-    module System.Nix.Store.Types
+  ( module System.Nix.Store.Types
   , module System.Nix.Store.Remote.Client
   , module System.Nix.Store.Remote.MonadStore
   , module System.Nix.Store.Remote.Types
@@ -10,6 +12,10 @@ module System.Nix.Store.Remote
   , runStore
   , runStoreOpts
   , runStoreOptsTCP
+  -- ** Daemon
+  , runDaemon
+  , runDaemonOpts
+  , justdoit
   ) where
 
 import Data.Default.Class (Default(def))
@@ -23,6 +29,16 @@ import System.Nix.Store.Remote.Types
 import qualified Control.Exception
 import qualified Network.Socket
 
+-- wip daemon
+import Control.Monad.Conc.Class (MonadConc)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Trans.Control (MonadBaseControl)
+import System.Nix.StorePath (StorePath)
+import System.Nix.Store.Remote.Server (WorkerHelper, runDaemonSocket)
+import qualified System.Directory
+import qualified System.Nix.StorePath
+import qualified Control.Monad.Catch
+
 -- * Compat
 
 type MonadStore = RemoteStoreT StoreConfig IO
@@ -31,9 +47,9 @@ type MonadStore = RemoteStoreT StoreConfig IO
 
 runStore :: MonadStore a -> Run IO a
 runStore = runStoreOpts defaultSockPath def
-  where
-    defaultSockPath :: String
-    defaultSockPath = "/nix/var/nix/daemon-socket/socket"
+
+defaultSockPath :: String
+defaultSockPath = "/nix/var/nix/daemon-socket/socket"
 
 runStoreOpts
   :: FilePath
@@ -84,3 +100,71 @@ runStoreOpts' sockFamily sockAddr storeRootDir code =
           { preStoreConfig_socket = soc
           , preStoreConfig_dir = storeRootDir
           }
+
+justdoit :: Run IO (Bool, Bool)
+justdoit = do
+  runDaemonOpts def handler "/tmp/dsock" $
+    runStoreOpts "/tmp/dsock" def
+      $ do
+        a <- isValidPath pth
+        b <- isValidPath pth
+        pure (a, b)
+  where
+    pth :: StorePath
+    pth =
+      either (error . show) id
+      $ System.Nix.StorePath.parsePathFromText
+        def
+        "/nix/store/yyznqbwam67cmp7zfwk0rkgmi9yqsdsm-hnix-store-core-0.8.0.0"
+
+    handler :: MonadIO m => WorkerHelper m
+    handler k = do
+      x <- liftIO $ runStore $ doReq k
+      either (error . show) pure (fst x)
+
+runDaemon
+  :: forall m a
+  . ( MonadIO m
+    , MonadBaseControl IO m
+    , MonadConc m
+    )
+  => WorkerHelper m
+  -> m a
+  -> m a
+runDaemon workerHelper k = runDaemonOpts def workerHelper defaultSockPath k
+
+-- | Run an emulated nix daemon on given socket address.
+-- the deamon will close when the continuation returns.
+runDaemonOpts
+  :: forall m a
+  . ( MonadIO m
+    , MonadBaseControl IO m
+    , MonadConc m
+    )
+  => StoreDir
+  -> WorkerHelper m
+  -> FilePath
+  -> m a
+  -> m a
+runDaemonOpts sd workerHelper f k = Control.Monad.Catch.bracket
+  (liftIO
+    $ Network.Socket.socket
+        Network.Socket.AF_UNIX
+        Network.Socket.Stream
+        Network.Socket.defaultProtocol
+  )
+  (\lsock -> liftIO $ Network.Socket.close lsock *> System.Directory.removeFile f)
+  $ \lsock -> do
+  --                                                                 ^^^^^^^^^^^^
+  -- TODO:  this: --------------------------------------------------////////////
+  -- should really be
+  -- a file lock followed by unlink *before* bind rather than after close.  If
+  -- the program crashes (or loses power or something) then a stale unix
+  -- socket will stick around and prevent the daemon from starting.  using a
+  -- lock file instead means only one "copy" of the daemon can hold the lock,
+  -- and can safely unlink the socket before binding no matter how shutdown
+  -- occured.
+
+  -- set up the listening socket
+  liftIO $ Network.Socket.bind lsock (SockAddrUnix f)
+  runDaemonSocket sd workerHelper lsock k
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
index 41cd473..54e1aa8 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
@@ -22,16 +22,25 @@ import System.Nix.StorePath (StoreDir)
 import System.Nix.Store.Remote.Serializer as RB
 import System.Nix.Store.Remote.Socket
 import System.Nix.Store.Remote.Types.StoreRequest as R
+import System.Nix.Store.Remote.Types.StoreReply
 import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket(..), StoreConfig(..), PreStoreConfig(..), preStoreConfigToStoreConfig)
 import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion(..))
 import System.Nix.Store.Remote.Types.Logger (BasicError(..), ErrorInfo, Logger(..))
-
 import System.Nix.Store.Remote.MonadStore (WorkerError(..), WorkerException(..), RemoteStoreError(..), RemoteStoreT, runRemoteStoreT, mapStoreConfig)
 import System.Nix.Store.Remote.Types.Handshake (ServerHandshakeInput(..), ServerHandshakeOutput(..))
 import System.Nix.Store.Remote.Types.ProtoVersion (ourProtoVersion)
 import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
 
-type WorkerHelper m = forall a. StoreRequest a -> m a
+-- wip
+-- import Data.Some (traverseSome)
+import Data.Functor.Identity
+
+type WorkerHelper m
+  = forall a
+  . ( Show a
+    , StoreReply a
+    )
+  => StoreRequest a -> m a
 
 -- | Run an emulated nix daemon on given socket address.
 -- The deamon will close when the continuation returns.
@@ -39,8 +48,6 @@ runDaemonSocket
   :: forall m a
   . ( MonadIO m
     , MonadConc m
-    , MonadError RemoteStoreError m
-    , MonadReader StoreConfig m
     )
   => StoreDir
   -> WorkerHelper m
@@ -63,7 +70,9 @@ runDaemonSocket sd workerHelper lsock k = do
               }
 
         -- TODO: this, but without the space leak
-        fmap fst $ concurrently listener $ processConnection workerHelper preStoreConfig
+        fmap fst
+          $ concurrently listener
+          $ processConnection workerHelper preStoreConfig
 
   either absurd id <$> race listener k
 
@@ -71,10 +80,8 @@ runDaemonSocket sd workerHelper lsock k = do
 --
 -- this function should take care to not throw errors from client connections.
 processConnection
-  :: ( MonadIO m
-     , MonadError RemoteStoreError m
-     , MonadReader StoreConfig m
-     )
+  :: forall m
+  .  MonadIO m
   => WorkerHelper m
   -> PreStoreConfig
   -> m ()
@@ -103,6 +110,22 @@ processConnection workerHelper preStoreConfig = do
         --authHook(*store);
         stopWork tunnelLogger
 
+        let perform
+              :: ( Show a
+                 , StoreReply a
+                 )
+              => StoreRequest a
+              -> RemoteStoreT StoreConfig m (Identity a)
+            perform req = do
+              resp <- bracketLogger tunnelLogger $ lift $ workerHelper req
+              sockPutS
+                (mapErrorS
+                   RemoteStoreError_SerializerReply
+                   $ getReplyS
+                )
+                resp
+              pure (Identity resp)
+
         -- Process client requests.
         let loop = do
               someReq <-
@@ -111,7 +134,26 @@ processConnection workerHelper preStoreConfig = do
                       RemoteStoreError_SerializerRequest
                       storeRequest
 
-              lift $ performOp' workerHelper tunnelLogger someReq
+              -- • Could not deduce (Show a) arising from a use of ‘perform’
+              -- and also (StoreReply a)
+              -- traverseSome perform someReq
+              void $ do
+                case someReq of
+                  Some req@(IsValidPath {}) -> do
+                    --  • Couldn't match type ‘a0’ with ‘Bool’
+                    --    Expected: StoreRequest a0
+                    --      Actual: StoreRequest a
+                    --  • ‘a0’ is untouchable
+                    --      inside the constraints: a ~ Bool
+                    --      bound by a pattern with constructor:
+                    --                 IsValidPath :: StorePath -> StoreRequest Bool
+                    -- runIdentity <$> perform req
+
+                    void $ perform req
+                    pure undefined
+
+                  _ -> throwError unimplemented
+
               loop
         loop
 
@@ -189,48 +231,9 @@ processConnection workerHelper preStoreConfig = do
         , serverHandshakeOutputClientVersion = clientVersion
         }
 
-simpleOp
-  :: ( MonadIO m
-     , HasStoreSocket r
-     , HasProtoVersion r
-     , MonadError RemoteStoreError m
-     , MonadReader r m
-     )
-  => (StoreRequest () -> m ())
-  -> TunnelLogger r
-  -> m (StoreRequest ())
-  -> m ()
-simpleOp workerHelper tunnelLogger m = do
-  req <- m
-  bracketLogger tunnelLogger $ workerHelper req
-  sockPutS
-    (mapErrorS
-       RemoteStoreError_SerializerPut
-       bool
-    )
-    True
-
-simpleOpRet
-  :: ( MonadIO m
-     , HasStoreSocket r
-     , HasProtoVersion r
-     , MonadError RemoteStoreError m
-     , MonadReader r m
-     )
-  => (StoreRequest a -> m a)
-  -> TunnelLogger r
-  -> NixSerializer r SError a
-  -> m (StoreRequest a)
-  -> m ()
-simpleOpRet workerHelper tunnelLogger s m = do
-  req <- m
-  resp <- bracketLogger tunnelLogger $ workerHelper req
-  sockPutS
-    (mapErrorS
-       RemoteStoreError_SerializerPut
-       s
-    )
-    resp
+{-# WARNING unimplemented "not yet implemented" #-}
+unimplemented :: RemoteStoreError
+unimplemented = RemoteStoreError_WorkerException $ WorkerException_Error $ WorkerError_NotYetImplemented
 
 bracketLogger
   :: ( MonadIO m
@@ -248,34 +251,6 @@ bracketLogger tunnelLogger m = do
   stopWork tunnelLogger
   pure a
 
-{-# WARNING unimplemented "not yet implemented" #-}
-unimplemented :: WorkerException
-unimplemented = WorkerException_Error $ WorkerError_NotYetImplemented
-
-performOp'
-  :: forall m
-   . ( MonadIO m
-     , MonadError RemoteStoreError m
-     , MonadReader StoreConfig m
-     )
-  => WorkerHelper m
-  -> TunnelLogger StoreConfig
-  -> Some StoreRequest
-  -> m ()
-performOp' workerHelper tunnelLogger op = do
-  let _simpleOp' = simpleOp workerHelper tunnelLogger
-  let simpleOpRet'
-        :: NixSerializer StoreConfig SError a
-        -> m (StoreRequest a)
-        -> m ()
-      simpleOpRet' = simpleOpRet workerHelper tunnelLogger
-
-  case op of
-    Some (IsValidPath path) -> simpleOpRet' bool $ do
-      pure $ R.IsValidPath path
-
-    _ -> undefined
-
 ---
 
 data TunnelLogger r = TunnelLogger

From 3576273c8a09ddcb08119489d94d98b4479bc34e Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Fri, 8 Dec 2023 12:29:11 +0100
Subject: [PATCH 03/27] core,json: wrap (DerivationOutput OutputName,
 Realisation) tuple into newtype

---
 hnix-store-core/src/System/Nix/Realisation.hs     | 15 +++++++++++++--
 hnix-store-json/src/System/Nix/JSON.hs            | 12 ++++++------
 .../src/System/Nix/Store/Remote/Serializer.hs     |  8 ++++----
 3 files changed, 23 insertions(+), 12 deletions(-)

diff --git a/hnix-store-core/src/System/Nix/Realisation.hs b/hnix-store-core/src/System/Nix/Realisation.hs
index 383fd17..353fe5e 100644
--- a/hnix-store-core/src/System/Nix/Realisation.hs
+++ b/hnix-store-core/src/System/Nix/Realisation.hs
@@ -8,6 +8,7 @@ module System.Nix.Realisation (
   , derivationOutputBuilder
   , derivationOutputParser
   , Realisation(..)
+  , RealisationWithId(..)
   ) where
 
 import Crypto.Hash (Digest)
@@ -80,8 +81,7 @@ derivationOutputBuilder outputName DerivationOutput{..} =
 --
 -- realisationId is ommited since it is a key
 -- of type @DerivationOutput OutputName@ so
--- we will use a tuple like @(DerivationOutput OutputName, Realisation)@
--- instead.
+-- we will use @RealisationWithId@ newtype
 data Realisation = Realisation
   { realisationOutPath :: StorePath
   -- ^ Output path
@@ -90,3 +90,14 @@ data Realisation = Realisation
   , realisationDependencies :: Map (DerivationOutput OutputName) StorePath
   -- ^ Dependent realisations required for this one to be valid
   } deriving (Eq, Generic, Ord, Show)
+
+-- | For wire protocol
+--
+-- We store this normalized in @Build.buildResultBuiltOutputs@
+-- as @Map (DerivationOutput OutputName) Realisation@
+-- but wire protocol needs it de-normalized so we
+-- need a special (From|To)JSON instances for it
+newtype RealisationWithId = RealisationWithId
+  { unRealisationWithId :: (DerivationOutput OutputName, Realisation)
+  }
+  deriving (Eq, Generic, Ord, Show)
diff --git a/hnix-store-json/src/System/Nix/JSON.hs b/hnix-store-json/src/System/Nix/JSON.hs
index 12a951d..b4d037b 100644
--- a/hnix-store-json/src/System/Nix/JSON.hs
+++ b/hnix-store-json/src/System/Nix/JSON.hs
@@ -13,7 +13,7 @@ import Data.Aeson
 import Deriving.Aeson
 import System.Nix.Base (BaseEncoding(NixBase32))
 import System.Nix.OutputName (OutputName)
-import System.Nix.Realisation (DerivationOutput, Realisation)
+import System.Nix.Realisation (DerivationOutput, Realisation, RealisationWithId(..))
 import System.Nix.Signature (Signature)
 import System.Nix.StorePath (StoreDir(..), StorePath, StorePathName, StorePathHashPart)
 
@@ -159,18 +159,18 @@ deriving
   instance FromJSON Realisation
 
 -- For a keyed version of Realisation
--- we use (DerivationOutput OutputName, Realisation)
+-- we use RealisationWithId (DerivationOutput OutputName, Realisation)
 -- instead of Realisation.id :: (DerivationOutput OutputName)
 -- field.
-instance {-# OVERLAPPING #-} ToJSON (DerivationOutput OutputName, Realisation) where
-  toJSON (drvOut, r) =
+instance ToJSON RealisationWithId where
+  toJSON (RealisationWithId (drvOut, r)) =
     case toJSON r of
       Object o -> Object $ Data.Aeson.KeyMap.insert "id" (toJSON drvOut) o
       _ -> error "absurd"
 
-instance {-# OVERLAPPING #-} FromJSON (DerivationOutput OutputName, Realisation) where
+instance FromJSON RealisationWithId where
   parseJSON v@(Object o) = do
     r <- parseJSON @Realisation v
     drvOut <- o .: "id"
-    pure (drvOut, r)
+    pure (RealisationWithId (drvOut, r))
   parseJSON x = fail $ "Expected Object but got " ++ show x
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs
index 42f3255..7d25d15 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs
@@ -131,7 +131,7 @@ import System.Nix.DerivedPath (DerivedPath(..), ParseOutputsError)
 import System.Nix.Hash (HashAlgo(..))
 import System.Nix.JSON ()
 import System.Nix.OutputName (OutputName)
-import System.Nix.Realisation (DerivationOutputError, Realisation(..))
+import System.Nix.Realisation (DerivationOutputError, Realisation(..), RealisationWithId(..))
 import System.Nix.Signature (Signature, NarSignature)
 import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
 import System.Nix.StorePath (HasStoreDir(..), InvalidNameError, InvalidPathError, StorePath, StorePathHashPart, StorePathName)
@@ -1398,7 +1398,7 @@ derivationOutputTyped = mapErrorS ReplySError_DerivationOutput $
 realisation :: NixSerializer r ReplySError Realisation
 realisation = mapErrorS ReplySError_Realisation json
 
-realisationWithId :: NixSerializer r ReplySError (System.Nix.Realisation.DerivationOutput OutputName, Realisation)
+realisationWithId :: NixSerializer r ReplySError RealisationWithId
 realisationWithId = mapErrorS ReplySError_RealisationWithId json
 
 -- *** BuildResult
@@ -1434,7 +1434,7 @@ buildResult = Serializer
         then
             pure
           . Data.Map.Strict.fromList
-          . map (\(_, (a, b)) -> (a, b))
+          . map (\(_, RealisationWithId (a, b)) -> (a, b))
           . Data.Map.Strict.toList
           <$> getS (mapS derivationOutputTyped realisationWithId)
         else pure Nothing
@@ -1453,7 +1453,7 @@ buildResult = Serializer
       Control.Monad.when (protoVersion_minor pv >= 28)
         $ putS (mapS derivationOutputTyped realisationWithId)
         $ Data.Map.Strict.fromList
-        $ map (\(a, b) -> (a, (a, b)))
+        $ map (\(a, b) -> (a, RealisationWithId (a, b)))
         $ Data.Map.Strict.toList
         $ Data.Maybe.fromMaybe mempty buildResultBuiltOutputs
   }

From da9b46cdc331bd37595f9a4a653b6b88a59cf2e1 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Fri, 8 Dec 2023 13:16:34 +0100
Subject: [PATCH 04/27] core: add some haddocks to OutputSpec, DerivedPath

---
 hnix-store-core/src/System/Nix/DerivedPath.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/hnix-store-core/src/System/Nix/DerivedPath.hs b/hnix-store-core/src/System/Nix/DerivedPath.hs
index c53831f..2cfbdd0 100644
--- a/hnix-store-core/src/System/Nix/DerivedPath.hs
+++ b/hnix-store-core/src/System/Nix/DerivedPath.hs
@@ -25,12 +25,17 @@ import qualified System.Nix.StorePath
 
 data OutputsSpec =
     OutputsSpec_All
+  -- ^ Wildcard spec (!*) meaning all outputs
   | OutputsSpec_Names (Set OutputName)
+  -- ^ Set of specific outputs
   deriving (Eq, Generic, Ord, Show)
 
 data DerivedPath =
     DerivedPath_Opaque StorePath
+  -- ^ Fully evaluated store path that can't be built
+  -- but can be fetched
   | DerivedPath_Built StorePath OutputsSpec
+  -- ^ Derivation path and the outputs built from it
   deriving (Eq, Generic, Ord, Show)
 
 data ParseOutputsError =

From 696f9e8421d7c488bb96753111b9a88880b24583 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Fri, 8 Dec 2023 13:26:49 +0100
Subject: [PATCH 05/27] remote: simplify buildDerivation

---
 hnix-store-remote/app/BuildDerivation.hs      | 16 ---------------
 hnix-store-remote/hnix-store-remote.cabal     |  1 -
 .../src/System/Nix/Store/Remote/Client.hs     | 20 +++++++++++++++----
 .../src/System/Nix/Store/Remote/MonadStore.hs |  1 +
 4 files changed, 17 insertions(+), 21 deletions(-)

diff --git a/hnix-store-remote/app/BuildDerivation.hs b/hnix-store-remote/app/BuildDerivation.hs
index ee4d4cb..1d321c7 100644
--- a/hnix-store-remote/app/BuildDerivation.hs
+++ b/hnix-store-remote/app/BuildDerivation.hs
@@ -2,39 +2,23 @@
 module Main where
 
 import Data.Default.Class (Default(def))
-import Data.Text (Text)
-import System.Nix.Derivation (Derivation)
-import System.Nix.StorePath (StorePath)
 
 import qualified Data.Text
-import qualified Data.Text.IO
-import qualified Data.Attoparsec.Text
 import qualified System.Environment
 import qualified System.Nix.Build
-import qualified System.Nix.Derivation
 import qualified System.Nix.StorePath
 import qualified System.Nix.Store.Remote
 
-parseDerivation :: FilePath -> IO (Derivation StorePath Text)
-parseDerivation source = do
-  contents <- Data.Text.IO.readFile source
-  case Data.Attoparsec.Text.parseOnly
-    (System.Nix.Derivation.parseDerivation def) contents of
-      Left e -> error e
-      Right drv -> pure drv
-
 main :: IO ()
 main = System.Environment.getArgs >>= \case
   [filename] -> do
     case System.Nix.StorePath.parsePathFromText def (Data.Text.pack filename) of
       Left e -> error $ show e
       Right p -> do
-        d <- parseDerivation filename
         out <-
             System.Nix.Store.Remote.runStore
           $ System.Nix.Store.Remote.buildDerivation
               p
-              d
               System.Nix.Build.BuildMode_Normal
         print out
   _ -> error "No input derivation file"
diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal
index 9cee10a..91e826b 100644
--- a/hnix-store-remote/hnix-store-remote.cabal
+++ b/hnix-store-remote/hnix-store-remote.cabal
@@ -137,7 +137,6 @@ executable build-derivation
     buildable: False
   build-depends:
       base >=4.12 && <5
-    , attoparsec
     , hnix-store-core
     , hnix-store-remote
     , data-default-class
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Client.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Client.hs
index 820747d..0b744d8 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Client.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Client.hs
@@ -32,10 +32,8 @@ import Data.HashSet (HashSet)
 import Data.Map (Map)
 import Data.Set (Set)
 import Data.Some (Some)
-import Data.Text (Text)
 
 import System.Nix.Build (BuildMode, BuildResult)
-import System.Nix.Derivation (Derivation)
 import System.Nix.DerivedPath (DerivedPath)
 import System.Nix.Hash (HashAlgo(..))
 import System.Nix.Nar (NarSource)
@@ -52,6 +50,12 @@ import System.Nix.Store.Remote.Types.SubstituteMode (SubstituteMode)
 import System.Nix.Store.Remote.Client.Core
 import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
 
+import qualified Control.Monad.IO.Class
+import qualified Data.Attoparsec.Text
+import qualified Data.Text.IO
+import qualified System.Nix.Derivation
+import qualified System.Nix.StorePath
+
 -- | Add `NarSource` to the store
 addToStore
   :: MonadRemoteStore m
@@ -114,10 +118,18 @@ addIndirectRoot = doReq . AddIndirectRoot
 buildDerivation
   :: MonadRemoteStore m
   => StorePath
-  -> Derivation StorePath Text
   -> BuildMode
   -> m BuildResult
-buildDerivation a b c = doReq (BuildDerivation a b c)
+buildDerivation sp mode = do
+  sd <- getStoreDir
+  drvContents <-
+    Control.Monad.IO.Class.liftIO
+    $ Data.Text.IO.readFile
+    $ System.Nix.StorePath.storePathToFilePath sd sp
+  case Data.Attoparsec.Text.parseOnly
+    (System.Nix.Derivation.parseDerivation sd) drvContents of
+      Left e -> throwError $ RemoteStoreError_DerivationParse e
+      Right drv -> doReq (BuildDerivation sp drv mode)
 
 -- | Build paths if they are an actual derivations.
 --
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs b/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
index debe4e7..084e691 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
@@ -55,6 +55,7 @@ data RemoteStoreError
   = RemoteStoreError_Fixme String
   | RemoteStoreError_BuildFailed
   | RemoteStoreError_ClientVersionTooOld
+  | RemoteStoreError_DerivationParse String
   | RemoteStoreError_Disconnected
   | RemoteStoreError_GetAddrInfoFailed
   | RemoteStoreError_GenericIncrementalLeftovers String ByteString -- when there are bytes left over after genericIncremental parser is done, (Done x leftover), first param is show x

From 5e909dbbd5abc14444a6136695fc42ab7dcbce03 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sat, 9 Dec 2023 07:27:18 +0100
Subject: [PATCH 06/27] remote: fix verison/version typo

---
 hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs    | 2 +-
 .../src/System/Nix/Store/Remote/Types/Handshake.hs              | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs
index 8837c06..f313841 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs
@@ -169,6 +169,6 @@ runStoreSocket preStoreConfig code =
       pure ClientHandshakeOutput
         { clientHandshakeOutputNixVersion = daemonNixVersion
         , clientHandshakeOutputTrust = remoteTrustsUs
-        , clientHandshakeOutputLeastCommonVerison = leastCommonVersion
+        , clientHandshakeOutputLeastCommonVersion = leastCommonVersion
         , clientHandshakeOutputServerVersion = daemonVersion
         }
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types/Handshake.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types/Handshake.hs
index 3f3fa90..b8ef2e3 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Types/Handshake.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types/Handshake.hs
@@ -19,7 +19,7 @@ data ClientHandshakeInput = ClientHandshakeInput
 data ClientHandshakeOutput = ClientHandshakeOutput
   { clientHandshakeOutputNixVersion :: Maybe Text -- ^ Textual version, since 1.33
   , clientHandshakeOutputTrust :: Maybe TrustedFlag -- ^ Whether remote side trusts us
-  , clientHandshakeOutputLeastCommonVerison :: ProtoVersion -- ^ Minimum protocol version supported by both sides
+  , clientHandshakeOutputLeastCommonVersion :: ProtoVersion -- ^ Minimum protocol version supported by both sides
   , clientHandshakeOutputServerVersion :: ProtoVersion -- ^ Protocol version supported by the server
   } deriving (Eq, Generic, Ord, Show)
 

From 4562922d7e27703b7b6a627d173943921a92be61 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sat, 9 Dec 2023 16:42:36 +0100
Subject: [PATCH 07/27] remote: neaten readme

---
 hnix-store-remote/README.md | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/hnix-store-remote/README.md b/hnix-store-remote/README.md
index cb545cd..566ef50 100644
--- a/hnix-store-remote/README.md
+++ b/hnix-store-remote/README.md
@@ -14,17 +14,14 @@ via `nix-daemon`.
 ```haskell
 {-# LANGUAGE OverloadedStrings #-}
 
-import Control.Monad (void)
-import Control.Monad.IO.Class (liftIO)
 import System.Nix.StorePath (mkStorePathName)
 import System.Nix.Store.Remote
 
 main :: IO ()
 main = do
-  void $ runStore $ do
+  runStore $ do
     syncWithGC
     roots <- findRoots
-    liftIO $ print roots
 
     res <- case mkStorePathName "hnix-store" of
       Left e -> error (show e)
@@ -33,5 +30,7 @@ main = do
          (StoreText name "Hello World!")
          mempty
          RepairMode_DontRepair
-    liftIO $ print res
+
+    pure (roots, res)
+  >>= print
 ```

From 7b41967cc81c909149283eb4b034d15f19fa400e Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Fri, 8 Dec 2023 07:40:48 +0100
Subject: [PATCH 08/27] remote: monadic collapse

---
 hnix-store-remote/hnix-store-remote.cabal     |   2 +-
 .../src/System/Nix/Store/Remote.hs            | 108 +++++-----
 .../System/Nix/Store/Remote/Client/Core.hs    |  50 ++---
 .../src/System/Nix/Store/Remote/MonadStore.hs | 175 ++++++++-------
 .../src/System/Nix/Store/Remote/Server.hs     | 200 ++++++++----------
 .../src/System/Nix/Store/Remote/Socket.hs     |  44 ++--
 .../Nix/Store/Remote/Types/ProtoVersion.hs    |  18 +-
 .../Nix/Store/Remote/Types/StoreConfig.hs     |  53 ++---
 .../Nix/Store/Remote/Types/StoreReply.hs      |  10 +-
 hnix-store-remote/tests-io/NixDaemonSpec.hs   |  41 ++--
 10 files changed, 324 insertions(+), 377 deletions(-)

diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal
index 91e826b..1dd8116 100644
--- a/hnix-store-remote/hnix-store-remote.cabal
+++ b/hnix-store-remote/hnix-store-remote.cabal
@@ -123,7 +123,6 @@ library
     , time
     , transformers
     , network
-    , monad-control
     , mtl
     , QuickCheck
     , unordered-containers
@@ -206,6 +205,7 @@ test-suite remote-io
     , containers
     , crypton
     , directory
+    , exceptions
     , filepath
     , hspec
     , hspec-expectations-lifted
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs
index 63560c3..6c1fe7d 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs
@@ -18,93 +18,102 @@ module System.Nix.Store.Remote
   , justdoit
   ) where
 
+import Control.Monad.Catch (MonadMask)
+import Control.Monad.Conc.Class (MonadConc)
+import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Default.Class (Default(def))
 import Network.Socket (Family, SockAddr(SockAddrUnix))
 import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
-import System.Nix.StorePath (StoreDir)
-import System.Nix.Store.Remote.MonadStore (RemoteStoreT, getStoreDir, RemoteStoreError(RemoteStoreError_GetAddrInfoFailed))
+import System.Nix.Store.Remote.MonadStore
+  ( runRemoteStoreT
+  , MonadRemoteStore(..)
+  , RemoteStoreT
+  , RemoteStoreError(RemoteStoreError_GetAddrInfoFailed))
 import System.Nix.Store.Remote.Client
 import System.Nix.Store.Remote.Types
 
-import qualified Control.Exception
+import qualified Control.Monad.Catch
 import qualified Network.Socket
+import qualified System.Directory
 
 -- wip daemon
-import Control.Monad.Conc.Class (MonadConc)
-import Control.Monad.IO.Class (MonadIO, liftIO)
-import Control.Monad.Trans.Control (MonadBaseControl)
 import System.Nix.StorePath (StorePath)
 import System.Nix.Store.Remote.Server (WorkerHelper, runDaemonSocket)
-import qualified System.Directory
 import qualified System.Nix.StorePath
-import qualified Control.Monad.Catch
 
 -- * Compat
 
-type MonadStore = RemoteStoreT StoreConfig IO
+type MonadStore = RemoteStoreT IO
 
 -- * Runners
 
-runStore :: MonadStore a -> Run IO a
-runStore = runStoreOpts defaultSockPath def
+runStore
+  :: ( MonadIO m
+     , MonadMask m
+     )
+  => RemoteStoreT m a
+  -> Run m a
+runStore = runStoreOpts defaultSockPath
 
 defaultSockPath :: String
 defaultSockPath = "/nix/var/nix/daemon-socket/socket"
 
 runStoreOpts
-  :: FilePath
-  -> StoreDir
-  -> MonadStore a
-  -> Run IO a
+  :: ( MonadIO m
+     , MonadMask m
+     )
+  => FilePath
+  -> RemoteStoreT m a
+  -> Run m a
 runStoreOpts socketPath =
   runStoreOpts'
     Network.Socket.AF_UNIX
     (SockAddrUnix socketPath)
 
 runStoreOptsTCP
-  :: String
+  :: ( MonadIO m
+     , MonadMask m
+     )
+  => String
   -> Int
-  -> StoreDir
-  -> MonadStore a
-  -> Run IO a
-runStoreOptsTCP host port sd code = do
-  Network.Socket.getAddrInfo
+  -> RemoteStoreT m a
+  -> Run m a
+runStoreOptsTCP host port code = do
+  addrInfo <- liftIO $ Network.Socket.getAddrInfo
     (Just Network.Socket.defaultHints)
     (Just host)
     (Just $ show port)
-    >>= \case
+  case addrInfo of
       (sockAddr:_) ->
         runStoreOpts'
           (Network.Socket.addrFamily sockAddr)
           (Network.Socket.addrAddress sockAddr)
-          sd
           code
       _ -> pure (Left RemoteStoreError_GetAddrInfoFailed, mempty)
 
 runStoreOpts'
-  :: Family
+  :: ( MonadIO m
+     , MonadMask m
+     )
+  => Family
   -> SockAddr
-  -> StoreDir
-  -> MonadStore a
-  -> Run IO a
-runStoreOpts' sockFamily sockAddr storeRootDir code =
-  Control.Exception.bracket
-    open
-    (Network.Socket.close . hasStoreSocket)
-    (flip runStoreSocket code)
+  -> RemoteStoreT m a
+  -> Run m a
+runStoreOpts' sockFamily sockAddr code =
+  Control.Monad.Catch.bracket
+    (liftIO open)
+    (liftIO . Network.Socket.close . hasStoreSocket)
+    (\s -> runRemoteStoreT s $ 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
-          }
+      pure soc
 
 justdoit :: Run IO (Bool, Bool)
 justdoit = do
-  runDaemonOpts def handler "/tmp/dsock" $
-    runStoreOpts "/tmp/dsock" def
+  runDaemonOpts handler "/tmp/dsock" $
+    runStoreOpts "/tmp/dsock"
       $ do
         a <- isValidPath pth
         b <- isValidPath pth
@@ -125,28 +134,28 @@ justdoit = do
 runDaemon
   :: forall m a
   . ( MonadIO m
-    , MonadBaseControl IO m
     , MonadConc m
     )
   => WorkerHelper m
   -> m a
   -> m a
-runDaemon workerHelper k = runDaemonOpts def workerHelper defaultSockPath k
+runDaemon workerHelper =
+  runDaemonOpts
+    workerHelper
+    defaultSockPath
 
 -- | Run an emulated nix daemon on given socket address.
 -- the deamon will close when the continuation returns.
 runDaemonOpts
   :: forall m a
   . ( MonadIO m
-    , MonadBaseControl IO m
     , MonadConc m
     )
-  => StoreDir
-  -> WorkerHelper m
+  => WorkerHelper m
   -> FilePath
   -> m a
   -> m a
-runDaemonOpts sd workerHelper f k = Control.Monad.Catch.bracket
+runDaemonOpts  workerHelper f k = Control.Monad.Catch.bracket
   (liftIO
     $ Network.Socket.socket
         Network.Socket.AF_UNIX
@@ -157,14 +166,5 @@ runDaemonOpts sd workerHelper f k = Control.Monad.Catch.bracket
   $ \lsock -> do
   --                                                                 ^^^^^^^^^^^^
   -- TODO:  this: --------------------------------------------------////////////
-  -- should really be
-  -- a file lock followed by unlink *before* bind rather than after close.  If
-  -- the program crashes (or loses power or something) then a stale unix
-  -- socket will stick around and prevent the daemon from starting.  using a
-  -- lock file instead means only one "copy" of the daemon can hold the lock,
-  -- and can safely unlink the socket before binding no matter how shutdown
-  -- occured.
-
-  -- set up the listening socket
   liftIO $ Network.Socket.bind lsock (SockAddrUnix f)
-  runDaemonSocket sd workerHelper lsock k
+  runDaemonSocket workerHelper lsock k
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs
index f313841..055220b 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs
@@ -12,13 +12,8 @@ import Data.Some (Some(Some))
 import System.Nix.Nar (NarSource)
 import System.Nix.Store.Remote.Logger (processOutput)
 import System.Nix.Store.Remote.MonadStore
-  ( MonadRemoteStore
+  ( MonadRemoteStore(..)
   , RemoteStoreError(..)
-  , RemoteStoreT
-  , runRemoteStoreT
-  , mapStoreConfig
-  , takeNarSource
-  , getStoreSocket
   )
 import System.Nix.Store.Remote.Socket (sockPutS, sockGetS)
 import System.Nix.Store.Remote.Serializer
@@ -31,10 +26,9 @@ import System.Nix.Store.Remote.Serializer
   , trustedFlag
   , workerMagic
   )
-import System.Nix.Store.Remote.Types.Handshake (ClientHandshakeInput(..), ClientHandshakeOutput(..))
+import System.Nix.Store.Remote.Types.Handshake (ClientHandshakeOutput(..))
 import System.Nix.Store.Remote.Types.Logger (Logger)
-import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion(..), ourProtoVersion)
-import System.Nix.Store.Remote.Types.StoreConfig (PreStoreConfig, StoreConfig, preStoreConfigToStoreConfig)
+import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion(..))
 import System.Nix.Store.Remote.Types.StoreRequest (StoreRequest(..))
 import System.Nix.Store.Remote.Types.StoreReply (StoreReply(..))
 import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
@@ -85,31 +79,21 @@ doReq = \case
       )
 
 runStoreSocket
-  :: ( Monad m
-     , MonadIO m
-     )
-  => PreStoreConfig
-  -> RemoteStoreT StoreConfig m a
-  -> Run m a
-runStoreSocket preStoreConfig code =
-  runRemoteStoreT preStoreConfig $ do
+  :: MonadRemoteStore m
+  => m a
+  -> m a
+runStoreSocket code = do
     ClientHandshakeOutput{..}
       <- greet
-          ClientHandshakeInput
-          { clientHandshakeInputOurVersion = ourProtoVersion
-          }
 
-    mapStoreConfig
-      (preStoreConfigToStoreConfig
-        clientHandshakeOutputLeastCommonVerison)
-      code
+    setProtoVersion clientHandshakeOutputLeastCommonVersion
+    code
 
   where
     greet
-      :: MonadIO m
-      => ClientHandshakeInput
-      -> RemoteStoreT PreStoreConfig m ClientHandshakeOutput
-    greet ClientHandshakeInput{..} = do
+      :: MonadRemoteStore m
+      => m ClientHandshakeOutput
+    greet = do
 
       sockPutS
         (mapErrorS
@@ -133,9 +117,10 @@ runStoreSocket preStoreConfig code =
       when (daemonVersion < ProtoVersion 1 10)
         $ throwError RemoteStoreError_ClientVersionTooOld
 
-      sockPutS protoVersion clientHandshakeInputOurVersion
+      pv <- getProtoVersion
+      sockPutS protoVersion pv
 
-      let leastCommonVersion = min daemonVersion ourProtoVersion
+      let leastCommonVersion = min daemonVersion pv
 
       when (leastCommonVersion >= ProtoVersion 1 14)
         $ sockPutS int (0 :: Int) -- affinity, obsolete
@@ -162,9 +147,8 @@ runStoreSocket preStoreConfig code =
             $ mapErrorS RemoteStoreError_SerializerHandshake trustedFlag
         else pure Nothing
 
-      mapStoreConfig
-        (preStoreConfigToStoreConfig leastCommonVersion)
-        processOutput
+      setProtoVersion leastCommonVersion
+      processOutput
 
       pure ClientHandshakeOutput
         { clientHandshakeOutputNixVersion = daemonNixVersion
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs b/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
index 084e691..29214d7 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
@@ -8,22 +8,21 @@ module System.Nix.Store.Remote.MonadStore
   , WorkerException(..)
   , RemoteStoreT
   , runRemoteStoreT
-  , mapStoreConfig
-  , MonadRemoteStoreR(..)
-  , MonadRemoteStore
-  , getProtoVersion
+  , MonadRemoteStore(..)
   ) where
 
 import Control.Exception (SomeException)
+import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
 import Control.Monad.Except (MonadError)
 import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.Reader (MonadReader, ask, asks)
-import Control.Monad.State.Strict (get, modify)
+import Control.Monad.Reader (MonadReader, ask)
+import Control.Monad.State.Strict (get, gets, 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 Control.Monad.Trans.State.Strict (StateT, runStateT)
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT)
 import Data.ByteString (ByteString)
+import Data.Default.Class (Default(def))
 import Data.DList (DList)
 import Data.Word (Word64)
 import Network.Socket (Socket)
@@ -32,13 +31,13 @@ import System.Nix.StorePath (HasStoreDir(..), StoreDir)
 import System.Nix.Store.Remote.Serializer (HandshakeSError, LoggerSError, RequestSError, ReplySError, SError)
 import System.Nix.Store.Remote.Types.Logger (Logger, BasicError, ErrorInfo)
 import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion)
-import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket(..), StoreConfig)
+import System.Nix.Store.Remote.Types.StoreConfig (ProtoStoreConfig(..))
 
 import qualified Data.DList
 
 data RemoteStoreState = RemoteStoreState {
-    remoteStoreState_logs :: DList Logger
-  , remoteStoreState_gotError :: Bool
+    remoteStoreState_config :: ProtoStoreConfig
+  , remoteStoreState_logs :: DList Logger
   , remoteStoreState_mDataSource :: Maybe (Word64 -> IO (Maybe ByteString))
   -- ^ Source for @Logger_Read@, this will be called repeatedly
   -- as the daemon requests chunks of size @Word64@.
@@ -51,6 +50,12 @@ data RemoteStoreState = RemoteStoreState {
   , remoteStoreState_mNarSource :: Maybe (NarSource IO)
   }
 
+instance HasStoreDir RemoteStoreState where
+  hasStoreDir = hasStoreDir . remoteStoreState_config
+
+instance HasProtoVersion RemoteStoreState where
+  hasProtoVersion = hasProtoVersion . remoteStoreState_config
+
 data RemoteStoreError
   = RemoteStoreError_Fixme String
   | RemoteStoreError_BuildFailed
@@ -101,91 +106,116 @@ data WorkerError
   | WorkerError_UnsupportedOperation
   deriving (Eq, Ord, Show)
 
-newtype RemoteStoreT r m a = RemoteStoreT
+newtype RemoteStoreT m a = RemoteStoreT
   { _unRemoteStoreT
       :: ExceptT RemoteStoreError
           (StateT RemoteStoreState
-            (ReaderT r m)) a
+            (ReaderT Socket m)) a
   }
   deriving
     ( Functor
     , Applicative
     , Monad
-    , MonadReader r
+    , MonadReader Socket
     --, MonadState StoreState -- Avoid making the internal state explicit
     , MonadError RemoteStoreError
+    , MonadCatch
+    , MonadMask
+    , MonadThrow
     , MonadIO
     )
 
-instance MonadTrans (RemoteStoreT r) where
+instance MonadTrans RemoteStoreT where
   lift = RemoteStoreT . lift . lift . lift
 
 -- | Runner for @RemoteStoreT@
 runRemoteStoreT
-  :: ( HasStoreDir r
-     , HasStoreSocket r
-     , Monad m
-     )
-  => r
-  -> RemoteStoreT r m a
+  :: Monad m
+  => Socket
+  -> RemoteStoreT m a
   -> m (Either RemoteStoreError a, DList Logger)
-runRemoteStoreT r =
+runRemoteStoreT sock =
     fmap (\(res, RemoteStoreState{..}) -> (res, remoteStoreState_logs))
-  . (`runReaderT` r)
+  . (`runReaderT` sock)
   . (`runStateT` emptyState)
   . runExceptT
   . _unRemoteStoreT
   where
     emptyState = RemoteStoreState
-      { remoteStoreState_logs = mempty
-      , remoteStoreState_gotError = False
+      { remoteStoreState_config = def
+      , remoteStoreState_logs = mempty
       , remoteStoreState_mDataSource = Nothing
       , remoteStoreState_mDataSink = Nothing
       , remoteStoreState_mNarSource = Nothing
       }
 
-mapStoreConfig
-  :: (rb -> ra)
-  -> (RemoteStoreT ra m a -> RemoteStoreT rb m a)
-mapStoreConfig f =
-  RemoteStoreT
-  . ( mapExceptT
-    . mapStateT
-    . withReaderT
-    ) f
-  . _unRemoteStoreT
-
 class ( MonadIO m
       , MonadError RemoteStoreError m
-      , HasStoreSocket r
-      , HasStoreDir r
-      , MonadReader r m
       )
-      => MonadRemoteStoreR r m where
+      => MonadRemoteStore m where
 
   appendLog :: Logger -> m ()
   default appendLog
     :: ( MonadTrans t
-       , MonadRemoteStoreR r m'
+       , MonadRemoteStore m'
        , m ~ t m'
        )
     => Logger
     -> m ()
   appendLog = lift . appendLog
 
+  getConfig :: m ProtoStoreConfig
+  default getConfig
+    :: ( MonadTrans t
+       , MonadRemoteStore m'
+       , m ~ t m'
+       )
+    => m ProtoStoreConfig
+  getConfig = lift getConfig
+
   getStoreDir :: m StoreDir
   default getStoreDir
     :: ( MonadTrans t
-       , MonadRemoteStoreR r m'
+       , MonadRemoteStore m'
        , m ~ t m'
        )
     => m StoreDir
   getStoreDir = lift getStoreDir
 
+  setStoreDir :: StoreDir -> m ()
+  default setStoreDir
+    :: ( MonadTrans t
+       , MonadRemoteStore m'
+       , m ~ t m'
+       )
+    => StoreDir
+    -> m ()
+  setStoreDir = lift . setStoreDir
+
+  -- | Get @ProtoVersion@ from state
+  getProtoVersion :: m ProtoVersion
+  default getProtoVersion
+    :: ( MonadTrans t
+       , MonadRemoteStore m'
+       , m ~ t m'
+       )
+    => m ProtoVersion
+  getProtoVersion = lift getProtoVersion
+
+  setProtoVersion :: ProtoVersion -> m ()
+  default setProtoVersion
+    :: ( MonadTrans t
+       , MonadRemoteStore m'
+       , m ~ t m'
+       )
+    => ProtoVersion
+    -> m ()
+  setProtoVersion = lift . setProtoVersion
+
   getStoreSocket :: m Socket
   default getStoreSocket
     :: ( MonadTrans t
-       , MonadRemoteStoreR r m'
+       , MonadRemoteStore m'
        , m ~ t m'
        )
     => m Socket
@@ -194,7 +224,7 @@ class ( MonadIO m
   setNarSource :: NarSource IO -> m ()
   default setNarSource
    :: ( MonadTrans t
-      , MonadRemoteStoreR r m'
+      , MonadRemoteStore m'
       , m ~ t m'
       )
    => NarSource IO
@@ -204,7 +234,7 @@ class ( MonadIO m
   takeNarSource :: m (Maybe (NarSource IO))
   default takeNarSource
    :: ( MonadTrans t
-      , MonadRemoteStoreR r m'
+      , MonadRemoteStore m'
       , m ~ t m'
       )
    => m (Maybe (NarSource IO))
@@ -213,7 +243,7 @@ class ( MonadIO m
   setDataSource :: (Word64 -> IO (Maybe ByteString)) -> m ()
   default setDataSource
    :: ( MonadTrans t
-      , MonadRemoteStoreR r m'
+      , MonadRemoteStore m'
       , m ~ t m'
       )
    => (Word64 -> IO (Maybe ByteString))
@@ -223,7 +253,7 @@ class ( MonadIO m
   getDataSource :: m (Maybe (Word64 -> IO (Maybe ByteString)))
   default getDataSource
    :: ( MonadTrans t
-      , MonadRemoteStoreR r m'
+      , MonadRemoteStore m'
       , m ~ t m'
       )
    => m (Maybe (Word64 -> IO (Maybe ByteString)))
@@ -232,7 +262,7 @@ class ( MonadIO m
   clearDataSource :: m ()
   default clearDataSource
     :: ( MonadTrans t
-       , MonadRemoteStoreR r m'
+       , MonadRemoteStore m'
        , m ~ t m'
        )
     => m ()
@@ -241,7 +271,7 @@ class ( MonadIO m
   setDataSink :: (ByteString -> IO ()) -> m ()
   default setDataSink
    :: ( MonadTrans t
-      , MonadRemoteStoreR r m'
+      , MonadRemoteStore m'
       , m ~ t m'
       )
    => (ByteString -> IO ())
@@ -251,7 +281,7 @@ class ( MonadIO m
   getDataSink :: m (Maybe (ByteString -> IO ()))
   default getDataSink
    :: ( MonadTrans t
-      , MonadRemoteStoreR r m'
+      , MonadRemoteStore m'
       , m ~ t m'
       )
    => m (Maybe (ByteString -> IO ()))
@@ -260,26 +290,33 @@ class ( MonadIO m
   clearDataSink :: m ()
   default clearDataSink
     :: ( MonadTrans t
-       , MonadRemoteStoreR r m'
+       , MonadRemoteStore m'
        , m ~ t m'
        )
     => m ()
   clearDataSink = lift clearDataSink
 
-instance MonadRemoteStoreR r m => MonadRemoteStoreR r (StateT s m)
-instance MonadRemoteStoreR r m => MonadRemoteStoreR r (ReaderT r m)
-instance MonadRemoteStoreR r m => MonadRemoteStoreR r (ExceptT RemoteStoreError m)
+instance MonadRemoteStore m => MonadRemoteStore (StateT s m)
+instance MonadRemoteStore m => MonadRemoteStore (ReaderT r m)
+instance MonadRemoteStore m => MonadRemoteStore (ExceptT RemoteStoreError m)
 
-type MonadRemoteStore m = MonadRemoteStoreR StoreConfig m
+instance MonadIO m => MonadRemoteStore (RemoteStoreT m) where
 
-instance ( MonadIO m
-         , HasStoreDir r
-         , HasStoreSocket r
-         )
-         => MonadRemoteStoreR r (RemoteStoreT r m) where
+  getConfig = RemoteStoreT $ gets remoteStoreState_config
+  getProtoVersion = RemoteStoreT $ gets hasProtoVersion
+  setProtoVersion pv =
+    RemoteStoreT $ modify $ \s ->
+      s { remoteStoreState_config =
+            (remoteStoreState_config s) { protoStoreConfig_protoVersion = pv }
+      }
+  getStoreDir = RemoteStoreT $ gets hasStoreDir
+  setStoreDir sd =
+    RemoteStoreT $ modify $ \s ->
+      s { remoteStoreState_config =
+            (remoteStoreState_config s) { protoStoreConfig_dir = sd }
+      }
 
-  getStoreDir = hasStoreDir <$> RemoteStoreT ask
-  getStoreSocket = hasStoreSocket <$> RemoteStoreT ask
+  getStoreSocket = RemoteStoreT ask
 
   appendLog x =
     RemoteStoreT
@@ -287,11 +324,11 @@ instance ( MonadIO m
     $ \s -> s { remoteStoreState_logs = remoteStoreState_logs s `Data.DList.snoc` x }
 
   setDataSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSource = pure x }
-  getDataSource = remoteStoreState_mDataSource <$> RemoteStoreT get
+  getDataSource = RemoteStoreT (gets remoteStoreState_mDataSource)
   clearDataSource = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSource = Nothing }
 
   setDataSink x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSink = pure x }
-  getDataSink = remoteStoreState_mDataSink <$> RemoteStoreT get
+  getDataSink = RemoteStoreT (gets remoteStoreState_mDataSink)
   clearDataSink = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSink = Nothing }
 
   setNarSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mNarSource = pure x }
@@ -299,11 +336,3 @@ instance ( MonadIO m
     x <- remoteStoreState_mNarSource <$> get
     modify $ \s -> s { remoteStoreState_mNarSource = Nothing }
     pure x
-
--- | Ask for a @StoreDir@
-getProtoVersion
-  :: ( MonadRemoteStoreR r m
-     , HasProtoVersion r
-     )
-  => m ProtoVersion
-getProtoVersion = asks hasProtoVersion
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
index 54e1aa8..b8a30af 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
@@ -6,9 +6,9 @@ import Control.Concurrent.Classy.Async
 import Control.Monad (join, void, when)
 import Control.Monad.Conc.Class (MonadConc)
 import Control.Monad.Except (MonadError, throwError)
-import Control.Monad.Reader (MonadReader, asks)
 import Control.Monad.Trans (lift)
 import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.Default.Class (Default(def))
 import Data.Foldable (traverse_)
 import Data.IORef (IORef, atomicModifyIORef, newIORef)
 import Data.Some (Some(Some))
@@ -18,17 +18,14 @@ import Data.Word (Word32)
 import qualified Data.Text
 import qualified Data.Text.IO
 import Network.Socket (Socket, accept, close, listen, maxListenQueue)
-import System.Nix.StorePath (StoreDir)
-import System.Nix.Store.Remote.Serializer as RB
+import System.Nix.Store.Remote.Serializer (LoggerSError, mapErrorS, storeRequest, workerMagic, protoVersion, int, logger, text, trustedFlag)
 import System.Nix.Store.Remote.Socket
 import System.Nix.Store.Remote.Types.StoreRequest as R
 import System.Nix.Store.Remote.Types.StoreReply
-import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket(..), StoreConfig(..), PreStoreConfig(..), preStoreConfigToStoreConfig)
-import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion(..))
+import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion(..))
 import System.Nix.Store.Remote.Types.Logger (BasicError(..), ErrorInfo, Logger(..))
-import System.Nix.Store.Remote.MonadStore (WorkerError(..), WorkerException(..), RemoteStoreError(..), RemoteStoreT, runRemoteStoreT, mapStoreConfig)
+import System.Nix.Store.Remote.MonadStore (MonadRemoteStore(..), WorkerError(..), WorkerException(..), RemoteStoreError(..), RemoteStoreT, runRemoteStoreT)
 import System.Nix.Store.Remote.Types.Handshake (ServerHandshakeInput(..), ServerHandshakeOutput(..))
-import System.Nix.Store.Remote.Types.ProtoVersion (ourProtoVersion)
 import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
 
 -- wip
@@ -49,12 +46,11 @@ runDaemonSocket
   . ( MonadIO m
     , MonadConc m
     )
-  => StoreDir
-  -> WorkerHelper m
+  => WorkerHelper m
   -> Socket
   -> m a
   -> m a
-runDaemonSocket sd workerHelper lsock k = do
+runDaemonSocket workerHelper lsock k = do
   liftIO $ listen lsock maxListenQueue
 
   liftIO $ Data.Text.IO.putStrLn "listening"
@@ -64,15 +60,10 @@ runDaemonSocket sd workerHelper lsock k = do
         (sock, _) <- liftIO $ accept lsock
         liftIO $ Data.Text.IO.putStrLn "accepting"
 
-        let preStoreConfig = PreStoreConfig
-              { preStoreConfig_socket = sock
-              , preStoreConfig_dir = sd
-              }
-
         -- TODO: this, but without the space leak
         fmap fst
           $ concurrently listener
-          $ processConnection workerHelper preStoreConfig
+          $ processConnection workerHelper sock
 
   either absurd id <$> race listener k
 
@@ -83,89 +74,86 @@ processConnection
   :: forall m
   .  MonadIO m
   => WorkerHelper m
-  -> PreStoreConfig
+  -> Socket
   -> m ()
-processConnection workerHelper preStoreConfig = do
-  ~() <- void $ runRemoteStoreT preStoreConfig $ do
+processConnection workerHelper sock = do
+  ~() <- void $ runRemoteStoreT sock $ do
 
     ServerHandshakeOutput{..}
       <- greet
           ServerHandshakeInput
           { serverHandshakeInputNixVersion = "nixVersion (hnix-store-remote)"
-          , serverHandshakeInputOurVersion= ourProtoVersion
+          , serverHandshakeInputOurVersion = def
           , serverHandshakeInputTrust = Nothing
           }
 
-    mapStoreConfig
-      (preStoreConfigToStoreConfig
-        serverHandshakeOutputLeastCommonVersion)
-      $ do
+    setProtoVersion serverHandshakeOutputLeastCommonVersion
 
-        tunnelLogger <- liftIO $ newTunnelLogger
-        -- Send startup error messages to the client.
-        startWork tunnelLogger
+    tunnelLogger <- liftIO $ newTunnelLogger
+    -- Send startup error messages to the client.
+    startWork tunnelLogger
 
-        -- TODO: do we need auth at all? probably?
-        -- If we can't accept clientVersion, then throw an error *here* (not above).
-        --authHook(*store);
-        stopWork tunnelLogger
+    -- TODO: do we need auth at all? probably?
+    -- If we can't accept clientVersion, then throw an error *here* (not above).
+    --authHook(*store);
+    stopWork tunnelLogger
 
-        let perform
-              :: ( Show a
-                 , StoreReply a
-                 )
-              => StoreRequest a
-              -> RemoteStoreT StoreConfig m (Identity a)
-            perform req = do
-              resp <- bracketLogger tunnelLogger $ lift $ workerHelper req
-              sockPutS
-                (mapErrorS
-                   RemoteStoreError_SerializerReply
-                   $ getReplyS
-                )
-                resp
-              pure (Identity resp)
+    let perform
+          :: ( Show a
+             , StoreReply a
+             )
+          => StoreRequest a
+          -> RemoteStoreT m (Identity a)
+        perform req = do
+          resp <- bracketLogger tunnelLogger $ lift $ workerHelper req
+          sockPutS
+            (mapErrorS
+               RemoteStoreError_SerializerReply
+               $ getReplyS
+            )
+            resp
+          pure (Identity resp)
 
-        -- Process client requests.
-        let loop = do
-              someReq <-
-                sockGetS
-                  $ mapErrorS
-                      RemoteStoreError_SerializerRequest
-                      storeRequest
+    -- Process client requests.
+    let loop = do
+          someReq <-
+            sockGetS
+              $ mapErrorS
+                  RemoteStoreError_SerializerRequest
+                  storeRequest
 
-              -- • Could not deduce (Show a) arising from a use of ‘perform’
-              -- and also (StoreReply a)
-              -- traverseSome perform someReq
-              void $ do
-                case someReq of
-                  Some req@(IsValidPath {}) -> do
-                    --  • Couldn't match type ‘a0’ with ‘Bool’
-                    --    Expected: StoreRequest a0
-                    --      Actual: StoreRequest a
-                    --  • ‘a0’ is untouchable
-                    --      inside the constraints: a ~ Bool
-                    --      bound by a pattern with constructor:
-                    --                 IsValidPath :: StorePath -> StoreRequest Bool
-                    -- runIdentity <$> perform req
+          -- • Could not deduce (Show a) arising from a use of ‘perform’
+          -- and also (StoreReply a)
+          -- traverseSome perform someReq
+          void $ do
+            case someReq of
+              Some req@(IsValidPath {}) -> do
+                --  • Couldn't match type ‘a0’ with ‘Bool’
+                --    Expected: StoreRequest a0
+                --      Actual: StoreRequest a
+                --  • ‘a0’ is untouchable
+                --      inside the constraints: a ~ Bool
+                --      bound by a pattern with constructor:
+                --                 IsValidPath :: StorePath -> StoreRequest Bool
+                -- runIdentity <$> perform req
 
-                    void $ perform req
-                    pure undefined
+                void $ perform req
+                pure undefined
 
-                  _ -> throwError unimplemented
+              _ -> throwError unimplemented
 
-              loop
-        loop
+          loop
+    loop
 
   liftIO $ Data.Text.IO.putStrLn "daemon connection done"
-  liftIO $ close $ preStoreConfig_socket preStoreConfig
+  liftIO $ close sock
 
   where
     -- Exchange the greeting.
     greet
       :: MonadIO m
       => ServerHandshakeInput
-      -> RemoteStoreT PreStoreConfig m ServerHandshakeOutput
+      -> RemoteStoreT m ServerHandshakeOutput
     greet ServerHandshakeInput{..} = do
       magic <-
         sockGetS
@@ -190,7 +178,7 @@ processConnection workerHelper preStoreConfig = do
 
       clientVersion <- sockGetS protoVersion
 
-      let leastCommonVersion = min clientVersion ourProtoVersion
+      let leastCommonVersion = min clientVersion serverHandshakeInputOurVersion
 
       liftIO $ print ("Versions client, min" :: Text, clientVersion, leastCommonVersion)
 
@@ -236,13 +224,8 @@ unimplemented :: RemoteStoreError
 unimplemented = RemoteStoreError_WorkerException $ WorkerException_Error $ WorkerError_NotYetImplemented
 
 bracketLogger
-  :: ( MonadIO m
-     , HasStoreSocket r
-     , HasProtoVersion r
-     , MonadReader r m
-     , MonadError RemoteStoreError m
-     )
-  => TunnelLogger r
+  :: MonadRemoteStore m
+  => TunnelLogger
   -> m a
   -> m a
 bracketLogger tunnelLogger m = do
@@ -253,26 +236,23 @@ bracketLogger tunnelLogger m = do
 
 ---
 
-data TunnelLogger r = TunnelLogger
-  { _tunnelLogger_state :: IORef (TunnelLoggerState r)
+data TunnelLogger = TunnelLogger
+  { _tunnelLogger_state :: IORef TunnelLoggerState
   }
 
-data TunnelLoggerState r = TunnelLoggerState
+data TunnelLoggerState = TunnelLoggerState
   { _tunnelLoggerState_canSendStderr :: Bool
   , _tunnelLoggerState_pendingMsgs :: [Logger]
   }
 
-newTunnelLogger :: IO (TunnelLogger r)
+newTunnelLogger :: IO TunnelLogger
 newTunnelLogger = TunnelLogger <$> newIORef (TunnelLoggerState False [])
 
 enqueueMsg
-  :: ( MonadIO m
-     , MonadReader r m
+  :: ( MonadRemoteStore m
      , MonadError LoggerSError m
-     , HasProtoVersion r
-     , HasStoreSocket r
      )
-  => TunnelLogger r
+  => TunnelLogger
   -> Logger
   -> m ()
 enqueueMsg x l = updateLogger x $ \st@(TunnelLoggerState c p) -> case c of
@@ -280,24 +260,17 @@ enqueueMsg x l = updateLogger x $ \st@(TunnelLoggerState c p) -> case c of
   False -> (TunnelLoggerState c (l:p), pure ())
 
 log
-  :: ( MonadIO m
-     , MonadReader r m
-     , HasStoreSocket r
+  :: ( MonadRemoteStore m
      , MonadError LoggerSError m
-     , HasProtoVersion r
      )
-  => TunnelLogger r
+  => TunnelLogger
   -> Text
   -> m ()
 log l s = enqueueMsg l (Logger_Next s)
 
 startWork
-  :: (MonadIO m, MonadReader r m, HasStoreSocket r
-
-     , MonadError RemoteStoreError m
-     , HasProtoVersion r
-  )
-  => TunnelLogger r
+  :: MonadRemoteStore m
+  => TunnelLogger
   -> m ()
 startWork x = updateLogger x $ \(TunnelLoggerState _ p) -> (,)
   (TunnelLoggerState True []) $
@@ -305,12 +278,8 @@ startWork x = updateLogger x $ \(TunnelLoggerState _ p) -> (,)
   where logger' = mapErrorS RemoteStoreError_SerializerLogger logger
 
 stopWork
-  :: (MonadIO m, MonadReader r m, HasStoreSocket r
-
-     , MonadError RemoteStoreError m
-     , HasProtoVersion r
-  )
-  => TunnelLogger r
+  :: MonadRemoteStore m
+  => TunnelLogger
   -> m ()
 stopWork x = updateLogger x $ \_ -> (,)
   (TunnelLoggerState False [])
@@ -324,26 +293,23 @@ stopWork x = updateLogger x $ \_ -> (,)
 -- Unlike 'stopWork', this function may be called at any time to (try) to end a
 -- session with an error.
 stopWorkOnError
-  :: (MonadIO m, MonadReader r m, HasStoreSocket r, HasProtoVersion r
-
-    , MonadError RemoteStoreError m
-  )
-  => TunnelLogger r
+  :: MonadRemoteStore m
+  => TunnelLogger
   -> ErrorInfo
   -> m Bool
 stopWorkOnError x ex = updateLogger x $ \st ->
   case _tunnelLoggerState_canSendStderr st of
     False -> (st, pure False)
     True -> (,) (TunnelLoggerState False []) $ do
-      asks hasProtoVersion >>= \pv -> if protoVersion_minor pv >= 26
+      getProtoVersion >>= \pv -> if protoVersion_minor pv >= 26
         then sockPutS logger' (Logger_Error (Right ex))
         else sockPutS logger' (Logger_Error (Left (BasicError 0 (Data.Text.pack $ show ex))))
       pure True
   where logger' = mapErrorS RemoteStoreError_SerializerLogger logger
 
 updateLogger
-  :: (MonadIO m, MonadReader r m, HasStoreSocket r)
-  => TunnelLogger r
-  -> (TunnelLoggerState r -> (TunnelLoggerState r, m a))
+  :: MonadRemoteStore m
+  => TunnelLogger
+  -> (TunnelLoggerState -> (TunnelLoggerState, m a))
   -> m a
 updateLogger x = join . liftIO . atomicModifyIORef (_tunnelLogger_state x)
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Socket.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Socket.hs
index ac76f80..8c32152 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Socket.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Socket.hs
@@ -2,14 +2,13 @@ module System.Nix.Store.Remote.Socket where
 
 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.Serialize.Get (Get, Result(..))
 import Data.Serialize.Put (Put, runPut)
 import Network.Socket.ByteString (recv, sendAll)
-import System.Nix.Store.Remote.MonadStore (MonadRemoteStoreR, RemoteStoreError(..))
+import System.Nix.Store.Remote.MonadStore (MonadRemoteStore(..), RemoteStoreError(..))
 import System.Nix.Store.Remote.Serializer (NixSerializer, runP, runSerialT)
-import System.Nix.Store.Remote.Types (HasStoreSocket(..))
+import System.Nix.Store.Remote.Types (ProtoStoreConfig)
 
 import qualified Control.Exception
 import qualified Data.ByteString
@@ -47,14 +46,10 @@ genericIncremental getsome parser = do
         leftover
 
 sockGet8
-  :: ( MonadIO m
-     , MonadError RemoteStoreError m
-     , MonadReader r m
-     , HasStoreSocket r
-     )
+  :: MonadRemoteStore m
   => m ByteString
 sockGet8 = do
-  soc <- asks hasStoreSocket
+  soc <- getStoreSocket
   eresult <- liftIO $ Control.Exception.try $ recv soc 8
   case eresult of
     Left e ->
@@ -67,46 +62,39 @@ sockGet8 = do
       pure result
 
 sockPut
-  :: ( MonadRemoteStoreR r m
-     , HasStoreSocket r
-     )
+  :: MonadRemoteStore m
   => Put
   -> m ()
 sockPut p = do
-  soc <- asks hasStoreSocket
+  soc <- getStoreSocket
   liftIO $ sendAll soc $ runPut p
 
 sockPutS
-  :: ( MonadReader r m
+  :: ( MonadRemoteStore m
      , MonadError e m
-     , MonadIO m
-     , HasStoreSocket r
      )
-  => NixSerializer r e a
+  => NixSerializer ProtoStoreConfig e a
   -> a
   -> m ()
 sockPutS s a = do
-  r <- ask
-  case runP s r a of
-    Right x -> liftIO $ sendAll (hasStoreSocket r) x
+  cfg <- getConfig
+  sock <- getStoreSocket
+  case runP s cfg a of
+    Right x -> liftIO $ sendAll sock x
     Left e -> throwError e
 
 sockGetS
-  :: forall r e m a
-   . ( HasStoreSocket r
-     , MonadError RemoteStoreError m
+  :: ( MonadRemoteStore m
      , MonadError e m
-     , MonadReader r m
-     , MonadIO m
      , Show a
      , Show e
      )
-  => NixSerializer r e a
+  => NixSerializer ProtoStoreConfig e a
   -> m a
 sockGetS s = do
-  r <- ask
+  cfg <- getConfig
   res <- genericIncremental sockGet8
-    $ runSerialT r $ Data.Serializer.getS s
+    $ runSerialT cfg $ Data.Serializer.getS s
 
   case res of
     Right x -> pure x
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types/ProtoVersion.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types/ProtoVersion.hs
index 766a83f..484ba41 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Types/ProtoVersion.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types/ProtoVersion.hs
@@ -1,11 +1,11 @@
 module System.Nix.Store.Remote.Types.ProtoVersion
   ( ProtoVersion(..)
   , HasProtoVersion(..)
-  , ourProtoVersion
   ) where
 
+import Data.Default.Class (Default(def))
 import Data.Word (Word8, Word16)
-import GHC.Generics
+import GHC.Generics (Generic)
 
 data ProtoVersion = ProtoVersion
   { protoVersion_major :: Word16
@@ -13,15 +13,15 @@ data ProtoVersion = ProtoVersion
   }
   deriving (Eq, Generic, Ord, Show)
 
+-- | The protocol version we support
+instance Default ProtoVersion where
+  def = ProtoVersion
+    { protoVersion_major = 1
+    , protoVersion_minor = 24
+    }
+
 class HasProtoVersion r where
   hasProtoVersion :: r -> ProtoVersion
 
 instance HasProtoVersion ProtoVersion where
   hasProtoVersion = id
-
--- | The protocol version we support
-ourProtoVersion :: ProtoVersion
-ourProtoVersion = ProtoVersion
-  { protoVersion_major = 1
-  , protoVersion_minor = 24
-  }
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
index 4735fa8..20611d3 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
@@ -1,52 +1,46 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 module System.Nix.Store.Remote.Types.StoreConfig
-  ( PreStoreConfig(..)
+  ( ProtoStoreConfig(..)
   , StoreConfig(..)
   , TestStoreConfig(..)
   , HasStoreSocket(..)
-  , preStoreConfigToStoreConfig
   ) where
 
+import Data.Default.Class (Default(def))
 import GHC.Generics (Generic)
 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
   hasStoreSocket :: r -> Socket
 
 instance HasStoreSocket Socket where
   hasStoreSocket = id
 
-instance HasStoreSocket PreStoreConfig where
-  hasStoreSocket = preStoreConfig_socket
-
-data StoreConfig = StoreConfig
-  { storeConfig_dir :: StoreDir
-  , storeConfig_protoVersion :: ProtoVersion
-  , storeConfig_socket :: Socket
+data ProtoStoreConfig = ProtoStoreConfig
+  { protoStoreConfig_dir :: StoreDir
+  , protoStoreConfig_protoVersion :: ProtoVersion
   }
 
+instance Default ProtoStoreConfig where
+  def = ProtoStoreConfig def def
+
 instance HasStoreDir StoreDir where
   hasStoreDir = id
 
-instance HasStoreDir StoreConfig where
-  hasStoreDir = storeConfig_dir
+instance HasStoreDir ProtoStoreConfig where
+  hasStoreDir = protoStoreConfig_dir
 
-instance HasProtoVersion StoreConfig where
-  hasProtoVersion = storeConfig_protoVersion
+instance HasProtoVersion ProtoStoreConfig where
+  hasProtoVersion = protoStoreConfig_protoVersion
 
-instance HasStoreSocket StoreConfig where
-  hasStoreSocket = storeConfig_socket
+data StoreConfig = StoreConfig
+  { storeConfig_dir :: StoreDir
+  , storeConfig_socketPath :: FilePath
+  }
 
+-- TODO: del
 data TestStoreConfig = TestStoreConfig
   { testStoreConfig_dir :: StoreDir
   , testStoreConfig_protoVersion :: ProtoVersion
@@ -57,16 +51,3 @@ instance HasProtoVersion TestStoreConfig where
 
 instance HasStoreDir TestStoreConfig where
   hasStoreDir = testStoreConfig_dir
-
--- | Convert @PreStoreConfig@ to @StoreConfig@
--- adding @ProtoVersion@ to latter
-preStoreConfigToStoreConfig
-  :: ProtoVersion
-  -> PreStoreConfig
-  -> StoreConfig
-preStoreConfigToStoreConfig pv PreStoreConfig{..} =
-  StoreConfig
-    { storeConfig_dir = preStoreConfig_dir
-    , storeConfig_protoVersion = pv
-    , storeConfig_socket = preStoreConfig_socket
-    }
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreReply.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreReply.hs
index c6a475d..1f254c3 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreReply.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreReply.hs
@@ -5,12 +5,12 @@ module System.Nix.Store.Remote.Types.StoreReply
 import Data.HashSet (HashSet)
 import Data.Map (Map)
 import System.Nix.Build (BuildResult)
-import System.Nix.StorePath (HasStoreDir(..), StorePath, StorePathName)
+import System.Nix.StorePath (StorePath, StorePathName)
 import System.Nix.StorePath.Metadata (Metadata)
 import System.Nix.Store.Remote.Serializer
 import System.Nix.Store.Remote.Types.GC (GCResult, GCRoot)
 import System.Nix.Store.Remote.Types.Query.Missing (Missing)
-import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion)
+import System.Nix.Store.Remote.Types.StoreConfig (ProtoStoreConfig)
 
 -- | Get @NixSerializer@ for some type @a@
 -- This could also be generalized for every type
@@ -18,11 +18,7 @@ import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion)
 -- this for replies and it would make look serializers
 -- quite hodor, like @a <- getS get; b <- getS get@
 class StoreReply a where
-  getReplyS
-    :: ( HasStoreDir r
-       , HasProtoVersion r
-       )
-    => NixSerializer r ReplySError a
+  getReplyS :: NixSerializer ProtoStoreConfig ReplySError a
 
 instance StoreReply () where
   getReplyS = opSuccess
diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs
index 3e8aec1..2616c2f 100644
--- a/hnix-store-remote/tests-io/NixDaemonSpec.hs
+++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs
@@ -6,7 +6,8 @@ module NixDaemonSpec
   ) where
 
 import Control.Monad (forM_, unless, void)
-import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Catch (MonadMask)
+import Control.Monad.IO.Class (MonadIO, liftIO)
 import Crypto.Hash (SHA256)
 import Data.Some (Some(Some))
 import Data.Text (Text)
@@ -21,7 +22,6 @@ import System.Nix.DerivedPath (DerivedPath(..))
 import System.Nix.StorePath (StoreDir(..), StorePath)
 import System.Nix.StorePath.Metadata (Metadata(..))
 import System.Nix.Store.Remote
-import System.Nix.Store.Remote.MonadStore (MonadRemoteStore)
 import System.Process (CreateProcess(..), ProcessHandle)
 import qualified Control.Concurrent
 import qualified Control.Exception
@@ -38,7 +38,6 @@ import qualified System.IO.Temp
 import qualified System.Linux.Namespaces
 import qualified System.Nix.StorePath
 import qualified System.Nix.Nar
-import qualified System.Nix.Store.Remote.MonadStore
 import qualified System.Posix.User
 import qualified System.Process
 import qualified Test.Hspec
@@ -106,19 +105,20 @@ error: changing ownership of path '/run/user/1000/test-nix-store-06b0d249e561612
 -}
 
 startDaemon
-  :: FilePath
-  -> IO (ProcessHandle, MonadStore a -> Run IO a)
+  :: ( MonadIO m
+     , MonadMask m
+     )
+  => FilePath
+  -> IO (ProcessHandle, RemoteStoreT m a -> Run m a)
 startDaemon fp = do
   writeConf (fp </> "etc" </> "nix.conf")
   procHandle <- createProcessEnv fp "nix-daemon" []
   waitSocket sockFp 30
   pure ( procHandle
-       , runStoreOpts
-          sockFp
-          (StoreDir
-            $ Data.ByteString.Char8.pack
-            $ fp </> "store"
-          )
+       , runStoreOpts sockFp
+         . (setStoreDir (StoreDir $ Data.ByteString.Char8.pack $ fp </> "store")
+            >>
+           )
        )
  where
   sockFp = fp </> "var/nix/daemon-socket/socket"
@@ -147,7 +147,10 @@ enterNamespaces = do
     True
 
 withNixDaemon
-  :: ((MonadStore a -> Run IO a) -> IO a)
+  :: ( MonadIO m
+     , MonadMask m
+     )
+  => ((RemoteStoreT m a -> Run m a) -> IO a)
   -> IO a
 withNixDaemon action =
   System.IO.Temp.withSystemTempDirectory "test-nix-store" $ \path -> do
@@ -211,8 +214,9 @@ itLefts
 itLefts name action = it name action Data.Either.isLeft
 
 withPath
-  :: (StorePath -> MonadStore a)
-  -> MonadStore a
+  :: MonadRemoteStore m
+  => (StorePath -> m a)
+  -> m a
 withPath action = do
   path <-
     addTextToStore
@@ -225,7 +229,7 @@ withPath action = do
   action path
 
 -- | dummy path, adds <tmp>/dummy with "Hello World" contents
-dummy :: MonadStore StorePath
+dummy :: MonadRemoteStore m => m StorePath
 dummy = do
   addToStore
     (forceRight $ System.Nix.StorePath.mkStorePathName "dummy")
@@ -293,10 +297,9 @@ spec = around withNixDaemon $
       itRights "validates path" $ withPath $ \path -> do
         liftIO $ print path
         isValidPath path `shouldReturn` True
-      itLefts "fails on invalid path"
-        $ System.Nix.Store.Remote.MonadStore.mapStoreConfig
-            (\sc -> sc { storeConfig_dir = StoreDir "/asdf" })
-            $ isValidPath invalidPath
+      itLefts "fails on invalid path" $ do
+        setStoreDir (StoreDir "/asdf")
+        isValidPath invalidPath
 
     context "queryAllValidPaths" $ do
       itRights "empty query" queryAllValidPaths

From 656d4dd72dabd0f03866c80f5fb67b8b0329a50b Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sat, 9 Dec 2023 17:25:26 +0100
Subject: [PATCH 09/27] remote: TestStoreConfig no longer needed

---
 .../src/System/Nix/Store/Remote/Arbitrary.hs    |  4 ++--
 .../Nix/Store/Remote/Types/StoreConfig.hs       | 17 ++---------------
 hnix-store-remote/tests/NixSerializerSpec.hs    | 10 +++++-----
 3 files changed, 9 insertions(+), 22 deletions(-)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Arbitrary.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Arbitrary.hs
index 0b9386f..3a08a87 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Arbitrary.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Arbitrary.hs
@@ -17,8 +17,8 @@ deriving via GenericArbitrary CheckMode
 deriving via GenericArbitrary SubstituteMode
   instance Arbitrary SubstituteMode
 
-deriving via GenericArbitrary TestStoreConfig
-  instance Arbitrary TestStoreConfig
+deriving via GenericArbitrary ProtoStoreConfig
+  instance Arbitrary ProtoStoreConfig
 
 deriving via GenericArbitrary ProtoVersion
   instance Arbitrary ProtoVersion
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
index 20611d3..59f5523 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
@@ -2,7 +2,6 @@
 module System.Nix.Store.Remote.Types.StoreConfig
   ( ProtoStoreConfig(..)
   , StoreConfig(..)
-  , TestStoreConfig(..)
   , HasStoreSocket(..)
   ) where
 
@@ -21,7 +20,7 @@ instance HasStoreSocket Socket where
 data ProtoStoreConfig = ProtoStoreConfig
   { protoStoreConfig_dir :: StoreDir
   , protoStoreConfig_protoVersion :: ProtoVersion
-  }
+  } deriving (Eq, Generic, Ord, Show)
 
 instance Default ProtoStoreConfig where
   def = ProtoStoreConfig def def
@@ -36,18 +35,6 @@ instance HasProtoVersion ProtoStoreConfig where
   hasProtoVersion = protoStoreConfig_protoVersion
 
 data StoreConfig = StoreConfig
-  { storeConfig_dir :: StoreDir
+  { storeConfig_dir :: Maybe StoreDir
   , storeConfig_socketPath :: FilePath
-  }
-
--- TODO: del
-data TestStoreConfig = TestStoreConfig
-  { testStoreConfig_dir :: StoreDir
-  , testStoreConfig_protoVersion :: ProtoVersion
   } deriving (Eq, Generic, Ord, Show)
-
-instance HasProtoVersion TestStoreConfig where
-  hasProtoVersion = testStoreConfig_protoVersion
-
-instance HasStoreDir TestStoreConfig where
-  hasStoreDir = testStoreConfig_dir
diff --git a/hnix-store-remote/tests/NixSerializerSpec.hs b/hnix-store-remote/tests/NixSerializerSpec.hs
index 0fa2115..e229fff 100644
--- a/hnix-store-remote/tests/NixSerializerSpec.hs
+++ b/hnix-store-remote/tests/NixSerializerSpec.hs
@@ -17,7 +17,7 @@ import System.Nix.Store.Remote.Arbitrary ()
 import System.Nix.Store.Remote.Serializer
 import System.Nix.Store.Remote.Types.Logger (Logger(..))
 import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion(..))
-import System.Nix.Store.Remote.Types.StoreConfig (TestStoreConfig(..))
+import System.Nix.Store.Remote.Types.StoreConfig (ProtoStoreConfig(..))
 import System.Nix.Store.Remote.Types.StoreRequest (StoreRequest(..))
 
 -- | Test for roundtrip using @NixSerializer@
@@ -71,7 +71,7 @@ spec = parallel $ do
       prop "< 1.28"
         $ \sd -> forAll (arbitrary `suchThat` ((< 28) . protoVersion_minor))
         $ \pv ->
-            roundtripSReader @TestStoreConfig buildResult (TestStoreConfig sd pv)
+            roundtripSReader @ProtoStoreConfig buildResult (ProtoStoreConfig sd pv)
             . (\x -> x { buildResultBuiltOutputs = Nothing })
             . (\x -> x { buildResultTimesBuilt = Nothing
                        , buildResultIsNonDeterministic = Nothing
@@ -81,7 +81,7 @@ spec = parallel $ do
               )
       prop "= 1.28"
         $ \sd ->
-            roundtripSReader @TestStoreConfig buildResult (TestStoreConfig sd (ProtoVersion 1 28))
+            roundtripSReader @ProtoStoreConfig buildResult (ProtoStoreConfig sd (ProtoVersion 1 28))
             . (\x -> x { buildResultTimesBuilt = Nothing
                        , buildResultIsNonDeterministic = Nothing
                        , buildResultStartTime = Nothing
@@ -91,7 +91,7 @@ spec = parallel $ do
       prop "> 1.28"
         $ \sd -> forAll (arbitrary `suchThat` ((> 28) . protoVersion_minor))
         $ \pv ->
-            roundtripSReader @TestStoreConfig buildResult (TestStoreConfig sd pv)
+            roundtripSReader @ProtoStoreConfig buildResult (ProtoStoreConfig sd pv)
 
     prop "StorePath" $
       roundtripSReader @StoreDir storePath
@@ -147,7 +147,7 @@ spec = parallel $ do
     prop "StoreRequest"
       $ \testStoreConfig ->
           forAll (arbitrary `suchThat` (restrictProtoVersion (hasProtoVersion testStoreConfig)))
-          $ roundtripSReader @TestStoreConfig storeRequest testStoreConfig
+          $ roundtripSReader @ProtoStoreConfig storeRequest testStoreConfig
 
   describe "StoreReply" $ do
     prop "()" $ roundtripS opSuccess

From 1f1d437a402368c314195fd11b1ba637de5148de Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sat, 9 Dec 2023 17:29:35 +0100
Subject: [PATCH 10/27] remote: align record field naming

---
 .../src/System/Nix/Store/Remote/MonadStore.hs | 62 +++++++++----------
 .../Nix/Store/Remote/Types/StoreConfig.hs     | 12 ++--
 2 files changed, 37 insertions(+), 37 deletions(-)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs b/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
index 29214d7..12b3c9e 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
@@ -36,25 +36,25 @@ import System.Nix.Store.Remote.Types.StoreConfig (ProtoStoreConfig(..))
 import qualified Data.DList
 
 data RemoteStoreState = RemoteStoreState {
-    remoteStoreState_config :: ProtoStoreConfig
-  , remoteStoreState_logs :: DList Logger
-  , remoteStoreState_mDataSource :: Maybe (Word64 -> IO (Maybe ByteString))
+    remoteStoreStateConfig :: ProtoStoreConfig
+  , remoteStoreStateLogs :: DList Logger
+  , remoteStoreStateMDataSource :: Maybe (Word64 -> IO (Maybe ByteString))
   -- ^ Source for @Logger_Read@, this will be called repeatedly
   -- as the daemon requests chunks of size @Word64@.
   -- If the function returns Nothing and daemon tries to read more
   -- data an error is thrown.
   -- Used by @AddToStoreNar@ and @ImportPaths@ operations.
-  , remoteStoreState_mDataSink :: Maybe (ByteString -> IO ())
+  , remoteStoreStateMDataSink :: Maybe (ByteString -> IO ())
   -- ^ Sink for @Logger_Write@, called repeatedly by the daemon
   -- to dump us some data. Used by @ExportPath@ operation.
-  , remoteStoreState_mNarSource :: Maybe (NarSource IO)
+  , remoteStoreStateMNarSource :: Maybe (NarSource IO)
   }
 
 instance HasStoreDir RemoteStoreState where
-  hasStoreDir = hasStoreDir . remoteStoreState_config
+  hasStoreDir = hasStoreDir . remoteStoreStateConfig
 
 instance HasProtoVersion RemoteStoreState where
-  hasProtoVersion = hasProtoVersion . remoteStoreState_config
+  hasProtoVersion = hasProtoVersion . remoteStoreStateConfig
 
 data RemoteStoreError
   = RemoteStoreError_Fixme String
@@ -75,9 +75,9 @@ data RemoteStoreError
   | RemoteStoreError_LoggerError (Either BasicError ErrorInfo)
   | RemoteStoreError_LoggerLeftovers String ByteString -- when there are bytes left over after incremental logger parser is done, (Done x leftover), first param is show x
   | RemoteStoreError_LoggerParserFail String ByteString -- when incremental parser returns ((Fail msg leftover) :: Result)
-  | RemoteStoreError_NoDataSourceProvided -- remoteStoreState_mDataSource is required but it is Nothing
-  | RemoteStoreError_DataSourceExhausted -- remoteStoreState_mDataSource returned Nothing but more data was requested
-  | RemoteStoreError_NoDataSinkProvided -- remoteStoreState_mDataSink is required but it is Nothing
+  | RemoteStoreError_NoDataSourceProvided -- remoteStoreStateMDataSource is required but it is Nothing
+  | RemoteStoreError_DataSourceExhausted -- remoteStoreStateMDataSource returned Nothing but more data was requested
+  | RemoteStoreError_NoDataSinkProvided -- remoteStoreStateMDataSink is required but it is Nothing
   | RemoteStoreError_NoNarSourceProvided
   | RemoteStoreError_OperationFailed
   | RemoteStoreError_ProtocolMismatch
@@ -135,18 +135,18 @@ runRemoteStoreT
   -> RemoteStoreT m a
   -> m (Either RemoteStoreError a, DList Logger)
 runRemoteStoreT sock =
-    fmap (\(res, RemoteStoreState{..}) -> (res, remoteStoreState_logs))
+    fmap (\(res, RemoteStoreState{..}) -> (res, remoteStoreStateLogs))
   . (`runReaderT` sock)
   . (`runStateT` emptyState)
   . runExceptT
   . _unRemoteStoreT
   where
     emptyState = RemoteStoreState
-      { remoteStoreState_config = def
-      , remoteStoreState_logs = mempty
-      , remoteStoreState_mDataSource = Nothing
-      , remoteStoreState_mDataSink = Nothing
-      , remoteStoreState_mNarSource = Nothing
+      { remoteStoreStateConfig = def
+      , remoteStoreStateLogs = mempty
+      , remoteStoreStateMDataSource = Nothing
+      , remoteStoreStateMDataSink = Nothing
+      , remoteStoreStateMNarSource = Nothing
       }
 
 class ( MonadIO m
@@ -302,18 +302,18 @@ instance MonadRemoteStore m => MonadRemoteStore (ExceptT RemoteStoreError m)
 
 instance MonadIO m => MonadRemoteStore (RemoteStoreT m) where
 
-  getConfig = RemoteStoreT $ gets remoteStoreState_config
+  getConfig = RemoteStoreT $ gets remoteStoreStateConfig
   getProtoVersion = RemoteStoreT $ gets hasProtoVersion
   setProtoVersion pv =
     RemoteStoreT $ modify $ \s ->
-      s { remoteStoreState_config =
-            (remoteStoreState_config s) { protoStoreConfig_protoVersion = pv }
+      s { remoteStoreStateConfig =
+            (remoteStoreStateConfig s) { protoStoreConfigProtoVersion = pv }
       }
   getStoreDir = RemoteStoreT $ gets hasStoreDir
   setStoreDir sd =
     RemoteStoreT $ modify $ \s ->
-      s { remoteStoreState_config =
-            (remoteStoreState_config s) { protoStoreConfig_dir = sd }
+      s { remoteStoreStateConfig =
+            (remoteStoreStateConfig s) { protoStoreConfigDir = sd }
       }
 
   getStoreSocket = RemoteStoreT ask
@@ -321,18 +321,18 @@ instance MonadIO m => MonadRemoteStore (RemoteStoreT m) where
   appendLog x =
     RemoteStoreT
     $ modify
-    $ \s -> s { remoteStoreState_logs = remoteStoreState_logs s `Data.DList.snoc` x }
+    $ \s -> s { remoteStoreStateLogs = remoteStoreStateLogs s `Data.DList.snoc` x }
 
-  setDataSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSource = pure x }
-  getDataSource = RemoteStoreT (gets remoteStoreState_mDataSource)
-  clearDataSource = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSource = Nothing }
+  setDataSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreStateMDataSource = pure x }
+  getDataSource = RemoteStoreT (gets remoteStoreStateMDataSource)
+  clearDataSource = RemoteStoreT $ modify $ \s -> s { remoteStoreStateMDataSource = Nothing }
 
-  setDataSink x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSink = pure x }
-  getDataSink = RemoteStoreT (gets remoteStoreState_mDataSink)
-  clearDataSink = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSink = Nothing }
+  setDataSink x = RemoteStoreT $ modify $ \s -> s { remoteStoreStateMDataSink = pure x }
+  getDataSink = RemoteStoreT (gets remoteStoreStateMDataSink)
+  clearDataSink = RemoteStoreT $ modify $ \s -> s { remoteStoreStateMDataSink = Nothing }
 
-  setNarSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mNarSource = pure x }
+  setNarSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreStateMNarSource = pure x }
   takeNarSource = RemoteStoreT $ do
-    x <- remoteStoreState_mNarSource <$> get
-    modify $ \s -> s { remoteStoreState_mNarSource = Nothing }
+    x <- remoteStoreStateMNarSource <$> get
+    modify $ \s -> s { remoteStoreStateMNarSource = Nothing }
     pure x
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
index 59f5523..b590643 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
@@ -18,8 +18,8 @@ instance HasStoreSocket Socket where
   hasStoreSocket = id
 
 data ProtoStoreConfig = ProtoStoreConfig
-  { protoStoreConfig_dir :: StoreDir
-  , protoStoreConfig_protoVersion :: ProtoVersion
+  { protoStoreConfigDir :: StoreDir
+  , protoStoreConfigProtoVersion :: ProtoVersion
   } deriving (Eq, Generic, Ord, Show)
 
 instance Default ProtoStoreConfig where
@@ -29,12 +29,12 @@ instance HasStoreDir StoreDir where
   hasStoreDir = id
 
 instance HasStoreDir ProtoStoreConfig where
-  hasStoreDir = protoStoreConfig_dir
+  hasStoreDir = protoStoreConfigDir
 
 instance HasProtoVersion ProtoStoreConfig where
-  hasProtoVersion = protoStoreConfig_protoVersion
+  hasProtoVersion = protoStoreConfigProtoVersion
 
 data StoreConfig = StoreConfig
-  { storeConfig_dir :: Maybe StoreDir
-  , storeConfig_socketPath :: FilePath
+  { storeConfigDir :: Maybe StoreDir
+  , storeConfigSocketPath :: FilePath
   } deriving (Eq, Generic, Ord, Show)

From 960407b0a1e88cfd6a3f07f4bfc9e5e2654d72a4 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sat, 9 Dec 2023 18:36:49 +0100
Subject: [PATCH 11/27] remote: add StoreConnection, reclaim runStoreSocket,
 now greetServer

---
 hnix-store-remote/hnix-store-remote.cabal     |   2 +-
 .../src/System/Nix/Store/Remote.hs            | 154 +++++++++++-------
 .../System/Nix/Store/Remote/Client/Core.hs    | 127 +++++++--------
 .../src/System/Nix/Store/Remote/Server.hs     |  18 +-
 .../Nix/Store/Remote/Types/StoreConfig.hs     |  29 +++-
 hnix-store-remote/tests-io/NixDaemonSpec.hs   |   2 +-
 6 files changed, 188 insertions(+), 144 deletions(-)

diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal
index 1dd8116..831b820 100644
--- a/hnix-store-remote/hnix-store-remote.cabal
+++ b/hnix-store-remote/hnix-store-remote.cabal
@@ -114,7 +114,7 @@ library
     , data-default-class
     , dependent-sum > 0.7
     , dependent-sum-template >= 0.2.0.1 && < 0.3
-    , directory
+--    , directory
     , dlist >= 1.0
     , exceptions
     , generic-arbitrary < 1.1
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs
index 6c1fe7d..6b38841 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs
@@ -10,11 +10,11 @@ module System.Nix.Store.Remote
   , MonadStore
   -- * Runners
   , runStore
-  , runStoreOpts
-  , runStoreOptsTCP
+  , runStoreConnection
+  , runStoreSocket
   -- ** Daemon
   , runDaemon
-  , runDaemonOpts
+  , runDaemonConnection
   , justdoit
   ) where
 
@@ -30,15 +30,16 @@ import System.Nix.Store.Remote.MonadStore
   , RemoteStoreT
   , RemoteStoreError(RemoteStoreError_GetAddrInfoFailed))
 import System.Nix.Store.Remote.Client
+import System.Nix.Store.Remote.Server (WorkerHelper, runProxyDaemon)
 import System.Nix.Store.Remote.Types
 
 import qualified Control.Monad.Catch
 import qualified Network.Socket
-import qualified System.Directory
+-- see TODO bellow
+--import qualified System.Directory
 
--- wip daemon
+-- wip justdoit
 import System.Nix.StorePath (StorePath)
-import System.Nix.Store.Remote.Server (WorkerHelper, runDaemonSocket)
 import qualified System.Nix.StorePath
 
 -- * Compat
@@ -53,45 +54,22 @@ runStore
      )
   => RemoteStoreT m a
   -> Run m a
-runStore = runStoreOpts defaultSockPath
+runStore = runStoreConnection def
 
-defaultSockPath :: String
-defaultSockPath = "/nix/var/nix/daemon-socket/socket"
-
-runStoreOpts
+runStoreConnection
   :: ( MonadIO m
      , MonadMask m
      )
-  => FilePath
+  => StoreConnection
   -> RemoteStoreT m a
   -> Run m a
-runStoreOpts socketPath =
-  runStoreOpts'
-    Network.Socket.AF_UNIX
-    (SockAddrUnix socketPath)
+runStoreConnection sc k =
+  connectionToSocket sc
+  >>= \case
+    Left e -> pure (Left e, mempty)
+    Right (fam, sock) -> runStoreSocket fam sock k
 
-runStoreOptsTCP
-  :: ( MonadIO m
-     , MonadMask m
-     )
-  => String
-  -> Int
-  -> RemoteStoreT m a
-  -> Run m a
-runStoreOptsTCP host port code = do
-  addrInfo <- liftIO $ Network.Socket.getAddrInfo
-    (Just Network.Socket.defaultHints)
-    (Just host)
-    (Just $ show port)
-  case addrInfo of
-      (sockAddr:_) ->
-        runStoreOpts'
-          (Network.Socket.addrFamily sockAddr)
-          (Network.Socket.addrAddress sockAddr)
-          code
-      _ -> pure (Left RemoteStoreError_GetAddrInfoFailed, mempty)
-
-runStoreOpts'
+runStoreSocket
   :: ( MonadIO m
      , MonadMask m
      )
@@ -99,21 +77,25 @@ runStoreOpts'
   -> SockAddr
   -> RemoteStoreT m a
   -> Run m a
-runStoreOpts' sockFamily sockAddr code =
+runStoreSocket sockFamily sockAddr code =
   Control.Monad.Catch.bracket
     (liftIO open)
     (liftIO . Network.Socket.close . hasStoreSocket)
-    (\s -> runRemoteStoreT s $ runStoreSocket code)
+    (\s -> runRemoteStoreT s $ greetServer >> code)
   where
     open = do
-      soc <- Network.Socket.socket sockFamily Network.Socket.Stream 0
+      soc <-
+        Network.Socket.socket
+          sockFamily
+          Network.Socket.Stream
+          Network.Socket.defaultProtocol
       Network.Socket.connect soc sockAddr
       pure soc
 
 justdoit :: Run IO (Bool, Bool)
 justdoit = do
-  runDaemonOpts handler "/tmp/dsock" $
-    runStoreOpts "/tmp/dsock"
+  runDaemonConnection handler (StoreConnection_Socket "/tmp/dsock") $
+    runStoreConnection (StoreConnection_Socket "/tmp/dsock")
       $ do
         a <- isValidPath pth
         b <- isValidPath pth
@@ -140,31 +122,81 @@ runDaemon
   -> m a
   -> m a
 runDaemon workerHelper =
-  runDaemonOpts
+  runDaemonConnection
     workerHelper
-    defaultSockPath
+    def
 
--- | Run an emulated nix daemon on given socket address.
+-- | Run an emulated nix daemon using given @StoreConnection@
 -- the deamon will close when the continuation returns.
-runDaemonOpts
+runDaemonConnection
   :: forall m a
   . ( MonadIO m
     , MonadConc m
     )
   => WorkerHelper m
-  -> FilePath
+  -> StoreConnection
   -> m a
   -> m a
-runDaemonOpts  workerHelper f k = Control.Monad.Catch.bracket
-  (liftIO
-    $ Network.Socket.socket
-        Network.Socket.AF_UNIX
-        Network.Socket.Stream
-        Network.Socket.defaultProtocol
-  )
-  (\lsock -> liftIO $ Network.Socket.close lsock *> System.Directory.removeFile f)
-  $ \lsock -> do
-  --                                                                 ^^^^^^^^^^^^
-  -- TODO:  this: --------------------------------------------------////////////
-  liftIO $ Network.Socket.bind lsock (SockAddrUnix f)
-  runDaemonSocket workerHelper lsock k
+runDaemonConnection workerHelper sc k =
+  connectionToSocket sc
+  >>= \case
+    Left e -> error $ show e
+    Right (fam, sock) -> runDaemonSocket workerHelper fam sock k
+
+-- | Run an emulated nix daemon using given @StoreConnection@
+-- the deamon will close when the continuation returns.
+runDaemonSocket
+  :: forall m a
+  . ( MonadIO m
+    , MonadConc m
+    )
+  => WorkerHelper m
+  -> Family
+  -> SockAddr
+  -> m a
+  -> m a
+runDaemonSocket workerHelper sockFamily sockAddr k =
+  Control.Monad.Catch.bracket
+    (liftIO
+      $ Network.Socket.socket
+          sockFamily
+          Network.Socket.Stream
+          Network.Socket.defaultProtocol
+    )
+    (\lsock -> liftIO $ Network.Socket.close lsock) -- *> System.Directory.removeFile f)
+    $ \lsock -> do
+    --                                                                     ^^^^^^^^^^^^
+    -- TODO:  this: -------------------------------------------------------////////////
+    -- should really be
+    -- a file lock followed by unlink *before* bind rather than after close.  If
+    -- the program crashes (or loses power or something) then a stale unix
+    -- socket will stick around and prevent the daemon from starting.  using a
+    -- lock file instead means only one "copy" of the daemon can hold the lock,
+    -- and can safely unlink the socket before binding no matter how shutdown
+    -- occured.
+
+    -- set up the listening socket
+    liftIO $ Network.Socket.bind lsock sockAddr
+    runProxyDaemon workerHelper lsock k
+
+connectionToSocket
+  :: MonadIO m
+  => StoreConnection
+  -> m (Either RemoteStoreError (Family, SockAddr))
+connectionToSocket (StoreConnection_Socket (StoreSocketPath f)) =
+  pure $ pure
+    ( Network.Socket.AF_UNIX
+    , SockAddrUnix f
+    )
+connectionToSocket (StoreConnection_TCP StoreTCP{..}) = do
+  addrInfo <- liftIO $ Network.Socket.getAddrInfo
+    (Just Network.Socket.defaultHints)
+    (Just storeTCPHost)
+    (Just $ show storeTCPPort)
+  case addrInfo of
+      (sockAddr:_) ->
+        pure $ pure
+          ( Network.Socket.addrFamily sockAddr
+          , Network.Socket.addrAddress sockAddr
+          )
+      _ -> pure (Left RemoteStoreError_GetAddrInfoFailed)
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs
index 055220b..e16da08 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs
@@ -1,6 +1,6 @@
 module System.Nix.Store.Remote.Client.Core
   ( Run
-  , runStoreSocket
+  , greetServer
   , doReq
   ) where
 
@@ -78,81 +78,68 @@ doReq = \case
         $ getReplyS @a
       )
 
-runStoreSocket
+greetServer
   :: MonadRemoteStore m
-  => m a
-  -> m a
-runStoreSocket code = do
-    ClientHandshakeOutput{..}
-      <- greet
+  => m ClientHandshakeOutput
+greetServer = do
+  sockPutS
+    (mapErrorS
+      RemoteStoreError_SerializerHandshake
+      workerMagic
+    )
+    WorkerMagic_One
 
-    setProtoVersion clientHandshakeOutputLeastCommonVersion
-    code
+  magic <-
+    sockGetS
+    $ mapErrorS
+        RemoteStoreError_SerializerHandshake
+        workerMagic
 
-  where
-    greet
-      :: MonadRemoteStore m
-      => m ClientHandshakeOutput
-    greet = do
+  unless
+    (magic == WorkerMagic_Two)
+    $ throwError RemoteStoreError_WorkerMagic2Mismatch
 
-      sockPutS
-        (mapErrorS
-          RemoteStoreError_SerializerHandshake
-          workerMagic
-        )
-        WorkerMagic_One
+  daemonVersion <- sockGetS protoVersion
 
-      magic <-
+  when (daemonVersion < ProtoVersion 1 10)
+    $ throwError RemoteStoreError_ClientVersionTooOld
+
+  pv <- getProtoVersion
+  sockPutS protoVersion pv
+
+  let leastCommonVersion = min daemonVersion pv
+
+  when (leastCommonVersion >= ProtoVersion 1 14)
+    $ sockPutS int (0 :: Int) -- affinity, obsolete
+
+  when (leastCommonVersion >= ProtoVersion 1 11) $ do
+    sockPutS
+      (mapErrorS RemoteStoreError_SerializerPut bool)
+      False -- reserveSpace, obsolete
+
+  daemonNixVersion <- if leastCommonVersion >= ProtoVersion 1 33
+    then do
+      -- If we were buffering I/O, we would flush the output here.
+      txtVer <-
         sockGetS
-        $ mapErrorS
-            RemoteStoreError_SerializerHandshake
-            workerMagic
+          $ mapErrorS
+              RemoteStoreError_SerializerGet
+              text
+      pure $ Just txtVer
+    else pure Nothing
 
-      unless
-        (magic == WorkerMagic_Two)
-        $ throwError RemoteStoreError_WorkerMagic2Mismatch
+  remoteTrustsUs <- if leastCommonVersion >= ProtoVersion 1 35
+    then do
+      sockGetS
+        $ mapErrorS RemoteStoreError_SerializerHandshake trustedFlag
+    else pure Nothing
 
-      daemonVersion <- sockGetS protoVersion
+  setProtoVersion leastCommonVersion
+  processOutput
 
-      when (daemonVersion < ProtoVersion 1 10)
-        $ throwError RemoteStoreError_ClientVersionTooOld
-
-      pv <- getProtoVersion
-      sockPutS protoVersion pv
-
-      let leastCommonVersion = min daemonVersion pv
-
-      when (leastCommonVersion >= ProtoVersion 1 14)
-        $ sockPutS int (0 :: Int) -- affinity, obsolete
-
-      when (leastCommonVersion >= ProtoVersion 1 11) $ do
-        sockPutS
-          (mapErrorS RemoteStoreError_SerializerPut bool)
-          False -- reserveSpace, obsolete
-
-      daemonNixVersion <- if leastCommonVersion >= ProtoVersion 1 33
-        then do
-          -- If we were buffering I/O, we would flush the output here.
-          txtVer <-
-            sockGetS
-              $ mapErrorS
-                  RemoteStoreError_SerializerGet
-                  text
-          pure $ Just txtVer
-        else pure Nothing
-
-      remoteTrustsUs <- if leastCommonVersion >= ProtoVersion 1 35
-        then do
-          sockGetS
-            $ mapErrorS RemoteStoreError_SerializerHandshake trustedFlag
-        else pure Nothing
-
-      setProtoVersion leastCommonVersion
-      processOutput
-
-      pure ClientHandshakeOutput
-        { clientHandshakeOutputNixVersion = daemonNixVersion
-        , clientHandshakeOutputTrust = remoteTrustsUs
-        , clientHandshakeOutputLeastCommonVersion = leastCommonVersion
-        , clientHandshakeOutputServerVersion = daemonVersion
-        }
+  pure ClientHandshakeOutput
+    { clientHandshakeOutputNixVersion = daemonNixVersion
+    , clientHandshakeOutputTrust = remoteTrustsUs
+    , clientHandshakeOutputLeastCommonVersion = leastCommonVersion
+    , clientHandshakeOutputServerVersion = daemonVersion
+    }
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
index b8a30af..94c0036 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
@@ -1,6 +1,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Rank2Types #-}
-module System.Nix.Store.Remote.Server where
+module System.Nix.Store.Remote.Server
+  ( runProxyDaemon
+  , WorkerHelper
+  )
+  where
 
 import Control.Concurrent.Classy.Async
 import Control.Monad (join, void, when)
@@ -41,7 +45,7 @@ type WorkerHelper m
 
 -- | Run an emulated nix daemon on given socket address.
 -- The deamon will close when the continuation returns.
-runDaemonSocket
+runProxyDaemon
   :: forall m a
   . ( MonadIO m
     , MonadConc m
@@ -50,7 +54,7 @@ runDaemonSocket
   -> Socket
   -> m a
   -> m a
-runDaemonSocket workerHelper lsock k = do
+runProxyDaemon workerHelper lsock k = do
   liftIO $ listen lsock maxListenQueue
 
   liftIO $ Data.Text.IO.putStrLn "listening"
@@ -259,14 +263,14 @@ enqueueMsg x l = updateLogger x $ \st@(TunnelLoggerState c p) -> case c of
   True -> (st, sockPutS logger l)
   False -> (TunnelLoggerState c (l:p), pure ())
 
-log
+_log
   :: ( MonadRemoteStore m
      , MonadError LoggerSError m
      )
   => TunnelLogger
   -> Text
   -> m ()
-log l s = enqueueMsg l (Logger_Next s)
+_log l s = enqueueMsg l (Logger_Next s)
 
 startWork
   :: MonadRemoteStore m
@@ -292,12 +296,12 @@ stopWork x = updateLogger x $ \_ -> (,)
 --
 -- Unlike 'stopWork', this function may be called at any time to (try) to end a
 -- session with an error.
-stopWorkOnError
+_stopWorkOnError
   :: MonadRemoteStore m
   => TunnelLogger
   -> ErrorInfo
   -> m Bool
-stopWorkOnError x ex = updateLogger x $ \st ->
+_stopWorkOnError x ex = updateLogger x $ \st ->
   case _tunnelLoggerState_canSendStderr st of
     False -> (st, pure False)
     True -> (,) (TunnelLoggerState False []) $ do
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
index b590643..86e71b4 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreConfig.hs
@@ -1,11 +1,15 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module System.Nix.Store.Remote.Types.StoreConfig
   ( ProtoStoreConfig(..)
-  , StoreConfig(..)
+  , StoreSocketPath(..)
+  , StoreTCP(..)
+  , StoreConnection(..)
   , HasStoreSocket(..)
   ) where
 
 import Data.Default.Class (Default(def))
+import Data.String (IsString)
 import GHC.Generics (Generic)
 import Network.Socket (Socket)
 import System.Nix.StorePath (HasStoreDir(..), StoreDir)
@@ -34,7 +38,24 @@ instance HasStoreDir ProtoStoreConfig where
 instance HasProtoVersion ProtoStoreConfig where
   hasProtoVersion = protoStoreConfigProtoVersion
 
-data StoreConfig = StoreConfig
-  { storeConfigDir :: Maybe StoreDir
-  , storeConfigSocketPath :: FilePath
+newtype StoreSocketPath = StoreSocketPath
+  { unStoreSocketPath :: FilePath
+  }
+  deriving newtype (IsString)
+  deriving stock (Eq, Generic, Ord, Show)
+
+instance Default StoreSocketPath where
+  def = StoreSocketPath "/nix/var/nix/daemon-socket/socket"
+
+data StoreTCP = StoreTCP
+  { storeTCPHost :: String
+  , storeTCPPort :: Int
   } deriving (Eq, Generic, Ord, Show)
+
+data StoreConnection
+  = StoreConnection_Socket StoreSocketPath
+  | StoreConnection_TCP StoreTCP
+  deriving (Eq, Generic, Ord, Show)
+
+instance Default StoreConnection where
+  def = StoreConnection_Socket def
diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs
index 2616c2f..3d56e65 100644
--- a/hnix-store-remote/tests-io/NixDaemonSpec.hs
+++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs
@@ -115,7 +115,7 @@ startDaemon fp = do
   procHandle <- createProcessEnv fp "nix-daemon" []
   waitSocket sockFp 30
   pure ( procHandle
-       , runStoreOpts sockFp
+       , runStoreConnection (StoreConnection_Socket (StoreSocketPath sockFp))
          . (setStoreDir (StoreDir $ Data.ByteString.Char8.pack $ fp </> "store")
             >>
            )

From bb9bc1705ad7ae87afcae4f804ed0fcb83c99fe7 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 14:45:12 +0100
Subject: [PATCH 12/27] server: -funroll-gadt

---
 .../src/System/Nix/Store/Remote/Server.hs     | 62 ++++++++++---------
 1 file changed, 34 insertions(+), 28 deletions(-)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
index 94c0036..313f35d 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
@@ -15,7 +15,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Default.Class (Default(def))
 import Data.Foldable (traverse_)
 import Data.IORef (IORef, atomicModifyIORef, newIORef)
-import Data.Some (Some(Some))
+--import Data.Some (Some(Some))
 import Data.Text (Text)
 import Data.Void (Void, absurd)
 import Data.Word (Word32)
@@ -33,8 +33,7 @@ import System.Nix.Store.Remote.Types.Handshake (ServerHandshakeInput(..), Server
 import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
 
 -- wip
--- import Data.Some (traverseSome)
-import Data.Functor.Identity
+import Data.Some (withSome)
 
 type WorkerHelper m
   = forall a
@@ -107,7 +106,7 @@ processConnection workerHelper sock = do
              , StoreReply a
              )
           => StoreRequest a
-          -> RemoteStoreT m (Identity a)
+          -> RemoteStoreT m ()
         perform req = do
           resp <- bracketLogger tunnelLogger $ lift $ workerHelper req
           sockPutS
@@ -116,7 +115,6 @@ processConnection workerHelper sock = do
                $ getReplyS
             )
             resp
-          pure (Identity resp)
 
     -- Process client requests.
     let loop = do
@@ -126,26 +124,34 @@ processConnection workerHelper sock = do
                   RemoteStoreError_SerializerRequest
                   storeRequest
 
-          -- • Could not deduce (Show a) arising from a use of ‘perform’
-          -- and also (StoreReply a)
-          -- traverseSome perform someReq
-          void $ do
-            case someReq of
-              Some req@(IsValidPath {}) -> do
-                --  • Couldn't match type ‘a0’ with ‘Bool’
-                --    Expected: StoreRequest a0
-                --      Actual: StoreRequest a
-                --  • ‘a0’ is untouchable
-                --      inside the constraints: a ~ Bool
-                --      bound by a pattern with constructor:
-                --                 IsValidPath :: StorePath -> StoreRequest Bool
-                -- runIdentity <$> perform req
-
-                void $ perform req
-                pure undefined
-
-              _ -> throwError unimplemented
-
+          -- have to be explicit here
+          -- because otherwise GHC can't conjure Show a, StoreReply a
+          -- out of thin air
+          () <- withSome someReq $ \case
+            r@AddToStore {} -> perform r
+            r@AddTextToStore {} -> perform r
+            r@AddSignatures {} -> perform r
+            r@AddTempRoot {} -> perform r
+            r@AddIndirectRoot {} -> perform r
+            r@BuildDerivation {} -> perform r
+            r@BuildPaths {} -> perform r
+            r@CollectGarbage {} -> perform r
+            r@EnsurePath {} -> perform r
+            r@FindRoots {} -> perform r
+            r@IsValidPath {} -> perform r
+            r@QueryValidPaths {} -> perform r
+            r@QueryAllValidPaths {} -> perform r
+            r@QuerySubstitutablePaths {} -> perform r
+            r@QueryPathInfo {} -> perform r
+            r@QueryReferrers {} -> perform r
+            r@QueryValidDerivers {} -> perform r
+            r@QueryDerivationOutputs {} -> perform r
+            r@QueryDerivationOutputNames {} -> perform r
+            r@QueryPathFromHashPart {} -> perform r
+            r@QueryMissing {} -> perform r
+            r@OptimiseStore {} -> perform r
+            r@SyncWithGC {} -> perform r
+            r@VerifyStore {} -> perform r
           loop
     loop
 
@@ -223,9 +229,9 @@ processConnection workerHelper sock = do
         , serverHandshakeOutputClientVersion = clientVersion
         }
 
-{-# WARNING unimplemented "not yet implemented" #-}
-unimplemented :: RemoteStoreError
-unimplemented = RemoteStoreError_WorkerException $ WorkerException_Error $ WorkerError_NotYetImplemented
+{-# WARNING _unimplemented "not yet implemented" #-}
+_unimplemented :: RemoteStoreError
+_unimplemented = RemoteStoreError_WorkerException $ WorkerException_Error $ WorkerError_NotYetImplemented
 
 bracketLogger
   :: MonadRemoteStore m

From 8eb0059576c6c9b1550348db2a9a997dc90154bd Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 15:50:37 +0100
Subject: [PATCH 13/27] remote: neaten NixDaemonSpec, silence nix-store and
 daemon with grep -v

---
 hnix-store-remote/tests-io/NixDaemonSpec.hs | 260 +++++++++++---------
 1 file changed, 140 insertions(+), 120 deletions(-)

diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs
index 3d56e65..0acf87c 100644
--- a/hnix-store-remote/tests-io/NixDaemonSpec.hs
+++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs
@@ -11,7 +11,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO)
 import Crypto.Hash (SHA256)
 import Data.Some (Some(Some))
 import Data.Text (Text)
-import Test.Hspec (Spec, SpecWith, around, describe, context)
+import Test.Hspec (ActionWith, Spec, SpecWith, around, describe, context)
 import Test.Hspec.Expectations.Lifted
 import Test.Hspec.Nix (forceRight)
 import System.FilePath ((</>))
@@ -44,14 +44,13 @@ import qualified Test.Hspec
 
 createProcessEnv
   :: FilePath
-  -> String
-  -> [String]
+  -> CreateProcess
   -> IO ProcessHandle
-createProcessEnv fp proc args = do
+createProcessEnv fp cp = do
   mPath         <- System.Environment.lookupEnv "PATH"
 
   (_, _, _, ph) <-
-    System.Process.createProcess (System.Process.proc proc args)
+    System.Process.createProcess cp
       { cwd = Just fp
       , env = Just $ mockedEnv mPath fp
       }
@@ -112,7 +111,12 @@ startDaemon
   -> IO (ProcessHandle, RemoteStoreT m a -> Run m a)
 startDaemon fp = do
   writeConf (fp </> "etc" </> "nix.conf")
-  procHandle <- createProcessEnv fp "nix-daemon" []
+  procHandle <-
+    createProcessEnv
+      fp
+      $ System.Process.shell
+         "nix-daemon 2>&1 | grep -v 'accepted connection'"
+
   waitSocket sockFp 30
   pure ( procHandle
        , runStoreConnection (StoreConnection_Socket (StoreSocketPath sockFp))
@@ -160,7 +164,13 @@ withNixDaemon action =
             ((/= "NIX_REMOTE") . fst)
             $ mockedEnv Nothing path)
 
-    ini <- createProcessEnv path "nix-store" ["--init"]
+    ini <-
+      createProcessEnv
+        path
+        $ System.Process.shell
+            -- see long note above @startDaemon@
+            "nix-store --init 2>&1 | grep -v 'error: changing ownership'"
+
     void $ System.Process.waitForProcess ini
 
     writeFile (path </> "dummy") "Hello World"
@@ -254,7 +264,10 @@ _withBuilder
 _withBuilder action = do
   path <-
     addTextToStore
-      (StoreText (forceRight $ System.Nix.StorePath.mkStorePathName "builder") builderSh)
+      (StoreText
+        (forceRight $ System.Nix.StorePath.mkStorePathName "builder")
+        builderSh
+      )
       mempty
       RepairMode_DontRepair
   action path
@@ -263,138 +276,145 @@ builderSh :: Text
 builderSh = "declare -xpexport > $out"
 
 spec :: Spec
-spec = around withNixDaemon $
+spec = do
+  describe "Remote store protocol" $ do
+    describe "Direct" $ makeProtoSpec withNixDaemon
 
-  describe "store" $ do
+makeProtoSpec
+  :: (ActionWith
+       (RemoteStoreT IO () -> Run IO ())
+       -> IO ()
+     )
+  -> Spec
+makeProtoSpec f = around f $ do
+  context "syncWithGC" $
+    itRights "syncs with garbage collector" syncWithGC
 
-    context "syncWithGC" $
-      itRights "syncs with garbage collector" syncWithGC
+  context "verifyStore" $ do
+    itRights "check=False repair=False" $
+      verifyStore
+        CheckMode_DontCheck
+        RepairMode_DontRepair
+      `shouldReturn` False
 
-    context "verifyStore" $ do
-      itRights "check=False repair=False" $
-        verifyStore
-          CheckMode_DontCheck
-          RepairMode_DontRepair
-        `shouldReturn` False
+    itRights "check=True repair=False" $
+      verifyStore
+        CheckMode_DoCheck
+        RepairMode_DontRepair
+      `shouldReturn` False
 
-      itRights "check=True repair=False" $
-        verifyStore
-          CheckMode_DoCheck
-          RepairMode_DontRepair
-        `shouldReturn` False
+    --privileged
+    itRights "check=True repair=True" $
+      verifyStore
+        CheckMode_DoCheck
+        RepairMode_DoRepair
+      `shouldReturn` False
 
-      --privileged
-      itRights "check=True repair=True" $
-        verifyStore
-          CheckMode_DoCheck
-          RepairMode_DoRepair
-        `shouldReturn` False
+  context "addTextToStore" $
+    itRights "adds text to store" $ withPath pure
 
-    context "addTextToStore" $
-      itRights "adds text to store" $ withPath pure
+  context "isValidPath" $ do
+    itRights "validates path" $ withPath $ \path -> do
+      isValidPath path `shouldReturn` True
 
-    context "isValidPath" $ do
-      itRights "validates path" $ withPath $ \path -> do
-        liftIO $ print path
-        isValidPath path `shouldReturn` True
-      itLefts "fails on invalid path" $ do
-        setStoreDir (StoreDir "/asdf")
-        isValidPath invalidPath
+    itLefts "fails on invalid path" $ do
+      setStoreDir (StoreDir "/asdf")
+      isValidPath invalidPath
 
-    context "queryAllValidPaths" $ do
-      itRights "empty query" queryAllValidPaths
-      itRights "non-empty query" $ withPath $ \path ->
-        queryAllValidPaths `shouldReturn` Data.HashSet.fromList [path]
+  context "queryAllValidPaths" $ do
+    itRights "empty query" queryAllValidPaths
+    itRights "non-empty query" $ withPath $ \path ->
+      queryAllValidPaths `shouldReturn` Data.HashSet.fromList [path]
 
-    context "queryPathInfo" $
-      itRights "queries path info" $ withPath $ \path -> do
-        meta <- queryPathInfo path
-        (metadataReferences <$> meta) `shouldBe` (Just mempty)
+  context "queryPathInfo" $
+    itRights "queries path info" $ withPath $ \path -> do
+      meta <- queryPathInfo path
+      (metadataReferences <$> meta) `shouldBe` (Just mempty)
 
-    context "ensurePath" $
-      itRights "simple ensure" $ withPath ensurePath
+  context "ensurePath" $
+    itRights "simple ensure" $ withPath ensurePath
 
-    context "addTempRoot" $
-      itRights "simple addition" $ withPath addTempRoot
+  context "addTempRoot" $
+    itRights "simple addition" $ withPath addTempRoot
 
-    context "addIndirectRoot" $
-      itRights "simple addition" $ withPath addIndirectRoot
+  context "addIndirectRoot" $
+    itRights "simple addition" $ withPath addIndirectRoot
 
-    let toDerivedPathSet p = Data.Set.fromList [DerivedPath_Opaque p]
+  let toDerivedPathSet p = Data.Set.fromList [DerivedPath_Opaque p]
 
-    context "buildPaths" $ do
-      itRights "build Normal" $ withPath $ \path -> do
-        buildPaths (toDerivedPathSet path) BuildMode_Normal
+  context "buildPaths" $ do
+    itRights "build Normal" $ withPath $ \path -> do
+      buildPaths (toDerivedPathSet path) BuildMode_Normal
 
-      itRights "build Check" $ withPath $ \path -> do
-        buildPaths (toDerivedPathSet path) BuildMode_Check
+    itRights "build Check" $ withPath $ \path -> do
+      buildPaths (toDerivedPathSet path) BuildMode_Check
 
-      itLefts "build Repair" $ withPath $ \path -> do
-        buildPaths (toDerivedPathSet path) BuildMode_Repair
+    itLefts "build Repair" $ withPath $ \path -> do
+      buildPaths (toDerivedPathSet path) BuildMode_Repair
 
-    context "roots" $ context "findRoots" $ do
-        itRights "empty roots" (findRoots `shouldReturn` mempty)
+  context "roots" $ context "findRoots" $ do
+      itRights "empty roots" (findRoots `shouldReturn` mempty)
 
-        itRights "path added as a temp root" $ withPath $ \_ -> do
-          roots <- findRoots
-          roots `shouldSatisfy` ((== 1) . Data.Map.size)
+      itRights "path added as a temp root" $ withPath $ \_ -> do
+        roots <- findRoots
+        roots `shouldSatisfy` ((== 1) . Data.Map.size)
 
-    context "optimiseStore" $ itRights "optimises" optimiseStore
+  context "optimiseStore" $ itRights "optimises" optimiseStore
 
-    context "queryMissing" $
-      itRights "queries" $ withPath $ \path -> do
-        queryMissing (toDerivedPathSet path)
-        `shouldReturn`
-        Missing
-          { missingWillBuild = mempty
-          , missingWillSubstitute = mempty
-          , missingUnknownPaths = mempty
-          , missingDownloadSize = 0
-          , missingNarSize = 0
-          }
+  context "queryMissing" $
+    itRights "queries" $ withPath $ \path -> do
+      queryMissing (toDerivedPathSet path)
+      `shouldReturn`
+      Missing
+        { missingWillBuild = mempty
+        , missingWillSubstitute = mempty
+        , missingUnknownPaths = mempty
+        , missingDownloadSize = 0
+        , missingNarSize = 0
+        }
 
-    context "addToStore" $
-      itRights "adds file to store" $ do
-        fp <-
+  context "addToStore" $
+    itRights "adds file to store" $ do
+      fp <-
+        liftIO
+        $ System.IO.Temp.writeSystemTempFile
+            "addition"
+            "yolo"
+
+      addToStore
+        (forceRight $ System.Nix.StorePath.mkStorePathName "tmp-addition")
+        (System.Nix.Nar.dumpPath fp)
+        FileIngestionMethod_Flat
+        (Some HashAlgo_SHA256)
+        RepairMode_DontRepair
+
+  context "with dummy" $ do
+    itRights "adds dummy" dummy
+
+    itRights "valid dummy" $ do
+      path <- dummy
+      isValidPath path `shouldReturn` True
+
+  context "collectGarbage" $ do
+    itRights "deletes a specific path from the store" $ withPath $ \path -> do
+        -- clear temp gc roots so the delete works. restarting the nix daemon should also do this...
+        storeDir <- getStoreDir
+        let tempRootsDir = Data.Text.unpack $ mconcat [ Data.Text.Encoding.decodeUtf8 (unStoreDir storeDir), "/../var/nix/temproots/" ]
+        tempRootList <-
           liftIO
-          $ System.IO.Temp.writeSystemTempFile
-              "addition"
-              "yolo"
+          $ System.Directory.listDirectory
+              tempRootsDir
+        liftIO $ forM_ tempRootList $ \entry -> do
+          System.Directory.removeFile
+            $ mconcat [ tempRootsDir, "/", entry ]
 
-        addToStore
-          (forceRight $ System.Nix.StorePath.mkStorePathName "tmp-addition")
-          (System.Nix.Nar.dumpPath fp)
-          FileIngestionMethod_Flat
-          (Some HashAlgo_SHA256)
-          RepairMode_DontRepair
-
-    context "with dummy" $ do
-      itRights "adds dummy" dummy
-
-      itRights "valid dummy" $ do
-        path <- dummy
-        isValidPath path `shouldReturn` True
-
-    context "collectGarbage" $ do
-      itRights "delete a specific path from the store" $ withPath $ \path -> do
-          -- clear temp gc roots so the delete works. restarting the nix daemon should also do this...
-          storeDir <- getStoreDir
-          let tempRootsDir = Data.Text.unpack $ mconcat [ Data.Text.Encoding.decodeUtf8 (unStoreDir storeDir), "/../var/nix/temproots/" ]
-          tempRootList <-
-            liftIO
-            $ System.Directory.listDirectory
-                tempRootsDir
-          liftIO $ forM_ tempRootList $ \entry -> do
-            System.Directory.removeFile
-              $ mconcat [ tempRootsDir, "/", entry ]
-
-          GCResult{..} <-
-            collectGarbage
-              GCOptions
-                { gcOptionsOperation = GCAction_DeleteSpecific
-                , gcOptionsIgnoreLiveness = False
-                , gcOptionsPathsToDelete = Data.HashSet.fromList [path]
-                , gcOptionsMaxFreed = maxBound
-                }
-          gcResultDeletedPaths `shouldBe` Data.HashSet.fromList [path]
-          gcResultBytesFreed `shouldBe` 4
+        GCResult{..} <-
+          collectGarbage
+            GCOptions
+              { gcOptionsOperation = GCAction_DeleteSpecific
+              , gcOptionsIgnoreLiveness = False
+              , gcOptionsPathsToDelete = Data.HashSet.fromList [path]
+              , gcOptionsMaxFreed = maxBound
+              }
+        gcResultDeletedPaths `shouldBe` Data.HashSet.fromList [path]
+        gcResultBytesFreed `shouldBe` 4

From 30baaf3db22dd15019dc988c7e49fcd82848990f Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 16:32:20 +0100
Subject: [PATCH 14/27] remote: NixDaemonSpec pass StoreConnection, StoreDir

---
 hnix-store-remote/tests-io/NixDaemonSpec.hs | 42 +++++++++++++--------
 1 file changed, 26 insertions(+), 16 deletions(-)

diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs
index 0acf87c..171aaf6 100644
--- a/hnix-store-remote/tests-io/NixDaemonSpec.hs
+++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs
@@ -104,11 +104,8 @@ error: changing ownership of path '/run/user/1000/test-nix-store-06b0d249e561612
 -}
 
 startDaemon
-  :: ( MonadIO m
-     , MonadMask m
-     )
-  => FilePath
-  -> IO (ProcessHandle, RemoteStoreT m a -> Run m a)
+  :: FilePath -- ^ Temporary directory
+  -> IO (ProcessHandle, StoreConnection)
 startDaemon fp = do
   writeConf (fp </> "etc" </> "nix.conf")
   procHandle <-
@@ -119,10 +116,8 @@ startDaemon fp = do
 
   waitSocket sockFp 30
   pure ( procHandle
-       , runStoreConnection (StoreConnection_Socket (StoreSocketPath sockFp))
-         . (setStoreDir (StoreDir $ Data.ByteString.Char8.pack $ fp </> "store")
-            >>
-           )
+       , StoreConnection_Socket
+          $ StoreSocketPath sockFp
        )
  where
   sockFp = fp </> "var/nix/daemon-socket/socket"
@@ -150,13 +145,10 @@ enterNamespaces = do
     [ GroupMapping 0 gid 1 ]
     True
 
-withNixDaemon
-  :: ( MonadIO m
-     , MonadMask m
-     )
-  => ((RemoteStoreT m a -> Run m a) -> IO a)
+withNixDaemon'
+  :: (FilePath -> StoreDir -> StoreConnection -> IO a)
   -> IO a
-withNixDaemon action =
+withNixDaemon' action =
   System.IO.Temp.withSystemTempDirectory "test-nix-store" $ \path -> do
 
     mapM_ (System.Directory.createDirectory . snd)
@@ -176,11 +168,29 @@ withNixDaemon action =
     writeFile (path </> "dummy") "Hello World"
 
     System.Directory.setCurrentDirectory path
+    let storeDir =
+          StoreDir
+          $ Data.ByteString.Char8.pack
+          $ path </> "store"
 
     Control.Exception.bracket
       (startDaemon path)
       (System.Process.terminateProcess . fst)
-      (action . snd)
+      (action path storeDir . snd)
+
+withNixDaemon
+  :: ( MonadIO m
+     , MonadMask m
+     )
+  => ((RemoteStoreT m a -> Run m a) -> IO a)
+  -> IO a
+withNixDaemon action =
+  withNixDaemon' $ \_tmpPath storeDir storeConn ->
+    action $ \a ->
+      runStoreConnection storeConn
+        ( setStoreDir storeDir
+          >> a
+        )
 
 checks
   :: ( Show a

From 46519800470231157fc05ed79c34a10ea2246301 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 16:47:04 +0100
Subject: [PATCH 15/27] remote: NixDaemonSpec MITM

---
 hnix-store-remote/hnix-store-remote.cabal   |  1 +
 hnix-store-remote/tests-io/NixDaemonSpec.hs | 37 +++++++++++++++++++--
 2 files changed, 35 insertions(+), 3 deletions(-)

diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal
index 831b820..b4c8c73 100644
--- a/hnix-store-remote/hnix-store-remote.cabal
+++ b/hnix-store-remote/hnix-store-remote.cabal
@@ -202,6 +202,7 @@ test-suite remote-io
     , hnix-store-remote
     , hnix-store-tests
     , bytestring
+    , concurrency
     , containers
     , crypton
     , directory
diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs
index 171aaf6..13cac76 100644
--- a/hnix-store-remote/tests-io/NixDaemonSpec.hs
+++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs
@@ -5,8 +5,9 @@ module NixDaemonSpec
   , spec
   ) where
 
-import Control.Monad (forM_, unless, void)
+import Control.Monad (forM_, unless, void, (<=<))
 import Control.Monad.Catch (MonadMask)
+import Control.Monad.Conc.Class (MonadConc)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Crypto.Hash (SHA256)
 import Data.Some (Some(Some))
@@ -22,6 +23,7 @@ import System.Nix.DerivedPath (DerivedPath(..))
 import System.Nix.StorePath (StoreDir(..), StorePath)
 import System.Nix.StorePath.Metadata (Metadata(..))
 import System.Nix.Store.Remote
+import System.Nix.Store.Remote.Server (WorkerHelper)
 import System.Process (CreateProcess(..), ProcessHandle)
 import qualified Control.Concurrent
 import qualified Control.Exception
@@ -186,12 +188,40 @@ withNixDaemon
   -> IO a
 withNixDaemon action =
   withNixDaemon' $ \_tmpPath storeDir storeConn ->
-    action $ \a ->
+    action $ \(mstore :: RemoteStoreT m a) ->
       runStoreConnection storeConn
         ( setStoreDir storeDir
-          >> a
+          >> mstore
         )
 
+withManInTheMiddleNixDaemon
+  :: forall m a
+   . ( MonadIO m
+     , MonadMask m
+     , MonadConc m
+     )
+  => ((RemoteStoreT m a -> Run m a) -> IO a)
+  -> IO a
+withManInTheMiddleNixDaemon action =
+  withNixDaemon' $ \tmpPath storeDir storeConn ->
+  let
+    sockFp2 = tmpPath </> "var/nix/daemon-socket/socket2"
+    storeConn2 = StoreConnection_Socket $ StoreSocketPath sockFp2
+
+    handler :: WorkerHelper m
+    handler = either (error . show) pure
+      <=< fmap fst
+      . runStoreConnection storeConn
+      . (setStoreDir storeDir >>)
+      . doReq
+
+  in action $ \(mstore :: RemoteStoreT m a) ->
+    runDaemonConnection handler storeConn2
+      $ runStoreConnection storeConn2
+          ( setStoreDir storeDir
+            >> mstore
+          )
+
 checks
   :: ( Show a
      , Show b
@@ -289,6 +319,7 @@ spec :: Spec
 spec = do
   describe "Remote store protocol" $ do
     describe "Direct" $ makeProtoSpec withNixDaemon
+    describe "MITM" $ makeProtoSpec withManInTheMiddleNixDaemon
 
 makeProtoSpec
   :: (ActionWith

From 3dc7ab6f0614679057410c6ace375132f486b12e Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 17:06:44 +0100
Subject: [PATCH 16/27] remote: add postGreet so we setStoreDir in Server as
 well

---
 hnix-store-remote/src/System/Nix/Store/Remote.hs    | 13 ++++++++-----
 .../src/System/Nix/Store/Remote/Server.hs           | 11 ++++++++---
 hnix-store-remote/tests-io/NixDaemonSpec.hs         |  4 +++-
 3 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs
index 6b38841..fab180b 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs
@@ -94,7 +94,7 @@ runStoreSocket sockFamily sockAddr code =
 
 justdoit :: Run IO (Bool, Bool)
 justdoit = do
-  runDaemonConnection handler (StoreConnection_Socket "/tmp/dsock") $
+  runDaemonConnection handler (pure ()) (StoreConnection_Socket "/tmp/dsock") $
     runStoreConnection (StoreConnection_Socket "/tmp/dsock")
       $ do
         a <- isValidPath pth
@@ -124,6 +124,7 @@ runDaemon
 runDaemon workerHelper =
   runDaemonConnection
     workerHelper
+    (pure ())
     def
 
 -- | Run an emulated nix daemon using given @StoreConnection@
@@ -134,14 +135,15 @@ runDaemonConnection
     , MonadConc m
     )
   => WorkerHelper m
+  -> RemoteStoreT m ()
   -> StoreConnection
   -> m a
   -> m a
-runDaemonConnection workerHelper sc k =
+runDaemonConnection workerHelper postGreet sc k =
   connectionToSocket sc
   >>= \case
     Left e -> error $ show e
-    Right (fam, sock) -> runDaemonSocket workerHelper fam sock k
+    Right (fam, sock) -> runDaemonSocket workerHelper postGreet fam sock k
 
 -- | Run an emulated nix daemon using given @StoreConnection@
 -- the deamon will close when the continuation returns.
@@ -151,11 +153,12 @@ runDaemonSocket
     , MonadConc m
     )
   => WorkerHelper m
+  -> RemoteStoreT m ()
   -> Family
   -> SockAddr
   -> m a
   -> m a
-runDaemonSocket workerHelper sockFamily sockAddr k =
+runDaemonSocket workerHelper postGreet sockFamily sockAddr k =
   Control.Monad.Catch.bracket
     (liftIO
       $ Network.Socket.socket
@@ -177,7 +180,7 @@ runDaemonSocket workerHelper sockFamily sockAddr k =
 
     -- set up the listening socket
     liftIO $ Network.Socket.bind lsock sockAddr
-    runProxyDaemon workerHelper lsock k
+    runProxyDaemon workerHelper postGreet lsock k
 
 connectionToSocket
   :: MonadIO m
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
index 313f35d..6124075 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
@@ -50,10 +50,11 @@ runProxyDaemon
     , MonadConc m
     )
   => WorkerHelper m
+  -> RemoteStoreT m ()
   -> Socket
   -> m a
   -> m a
-runProxyDaemon workerHelper lsock k = do
+runProxyDaemon workerHelper postGreet lsock k = do
   liftIO $ listen lsock maxListenQueue
 
   liftIO $ Data.Text.IO.putStrLn "listening"
@@ -66,7 +67,7 @@ runProxyDaemon workerHelper lsock k = do
         -- TODO: this, but without the space leak
         fmap fst
           $ concurrently listener
-          $ processConnection workerHelper sock
+          $ processConnection workerHelper postGreet sock
 
   either absurd id <$> race listener k
 
@@ -77,9 +78,10 @@ processConnection
   :: forall m
   .  MonadIO m
   => WorkerHelper m
+  -> RemoteStoreT m ()
   -> Socket
   -> m ()
-processConnection workerHelper sock = do
+processConnection workerHelper postGreet sock = do
   ~() <- void $ runRemoteStoreT sock $ do
 
     ServerHandshakeOutput{..}
@@ -101,6 +103,9 @@ processConnection workerHelper sock = do
     --authHook(*store);
     stopWork tunnelLogger
 
+    -- so we can set store dir
+    postGreet
+
     let perform
           :: ( Show a
              , StoreReply a
diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs
index 13cac76..1daa5bb 100644
--- a/hnix-store-remote/tests-io/NixDaemonSpec.hs
+++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs
@@ -216,7 +216,9 @@ withManInTheMiddleNixDaemon action =
       . doReq
 
   in action $ \(mstore :: RemoteStoreT m a) ->
-    runDaemonConnection handler storeConn2
+    runDaemonConnection handler
+      (setStoreDir storeDir)
+      storeConn2
       $ runStoreConnection storeConn2
           ( setStoreDir storeDir
             >> mstore

From e2381c89d5390071dc439b2db94054e702da32b8 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 17:11:11 +0100
Subject: [PATCH 17/27] remote: less chatty server

---
 .../src/System/Nix/Store/Remote/Server.hs         | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
index 6124075..0a17331 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
@@ -42,6 +42,12 @@ type WorkerHelper m
     )
   => StoreRequest a -> m a
 
+chatty :: Bool
+chatty = False
+
+dbg :: MonadIO m => Text -> m ()
+dbg = when chatty . liftIO . Data.Text.IO.putStrLn
+
 -- | Run an emulated nix daemon on given socket address.
 -- The deamon will close when the continuation returns.
 runProxyDaemon
@@ -57,12 +63,12 @@ runProxyDaemon
 runProxyDaemon workerHelper postGreet lsock k = do
   liftIO $ listen lsock maxListenQueue
 
-  liftIO $ Data.Text.IO.putStrLn "listening"
+  dbg "listening"
 
   let listener :: m Void
       listener = do
         (sock, _) <- liftIO $ accept lsock
-        liftIO $ Data.Text.IO.putStrLn "accepting"
+        dbg "accepting"
 
         -- TODO: this, but without the space leak
         fmap fst
@@ -160,7 +166,7 @@ processConnection workerHelper postGreet sock = do
           loop
     loop
 
-  liftIO $ Data.Text.IO.putStrLn "daemon connection done"
+  dbg "daemon connection done"
   liftIO $ close sock
 
   where
@@ -176,7 +182,6 @@ processConnection workerHelper postGreet sock = do
             RemoteStoreError_SerializerHandshake
             workerMagic
 
-      liftIO $ print ("magic" :: Text, magic)
       when (magic /= WorkerMagic_One)
         $ throwError
         $ RemoteStoreError_WorkerException
@@ -195,8 +200,6 @@ processConnection workerHelper postGreet sock = do
 
       let leastCommonVersion = min clientVersion serverHandshakeInputOurVersion
 
-      liftIO $ print ("Versions client, min" :: Text, clientVersion, leastCommonVersion)
-
       when (clientVersion < ProtoVersion 1 10)
         $ throwError
         $ RemoteStoreError_WorkerException

From 3d774b81873a7e153bf42e873306c4635a95e6a4 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 17:50:02 +0100
Subject: [PATCH 18/27] remote/server: add proxyNarSource

---
 .../src/System/Nix/Store/Remote.hs            |  4 +--
 .../src/System/Nix/Store/Remote/Server.hs     | 32 +++++++++++++++++--
 hnix-store-remote/tests-io/NixDaemonSpec.hs   |  1 -
 3 files changed, 32 insertions(+), 5 deletions(-)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs
index fab180b..e43e2d7 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs
@@ -108,9 +108,9 @@ justdoit = do
         def
         "/nix/store/yyznqbwam67cmp7zfwk0rkgmi9yqsdsm-hnix-store-core-0.8.0.0"
 
-    handler :: MonadIO m => WorkerHelper m
+    handler :: RemoteStoreT IO a -> IO a
     handler k = do
-      x <- liftIO $ runStore $ doReq k
+      x <- runStore k
       either (error . show) pure (fst x)
 
 runDaemon
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
index 0a17331..d55d604 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
@@ -22,6 +22,8 @@ import Data.Word (Word32)
 import qualified Data.Text
 import qualified Data.Text.IO
 import Network.Socket (Socket, accept, close, listen, maxListenQueue)
+import System.Nix.Nar (NarSource)
+import System.Nix.Store.Remote.Client (doReq)
 import System.Nix.Store.Remote.Serializer (LoggerSError, mapErrorS, storeRequest, workerMagic, protoVersion, int, logger, text, trustedFlag)
 import System.Nix.Store.Remote.Socket
 import System.Nix.Store.Remote.Types.StoreRequest as R
@@ -34,13 +36,16 @@ import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
 
 -- wip
 import Data.Some (withSome)
+import qualified System.Timeout
+import qualified Network.Socket.ByteString
 
 type WorkerHelper m
   = forall a
   . ( Show a
     , StoreReply a
     )
-  => StoreRequest a -> m a
+  => RemoteStoreT m a
+  -> m a
 
 chatty :: Bool
 chatty = False
@@ -119,7 +124,30 @@ processConnection workerHelper postGreet sock = do
           => StoreRequest a
           -> RemoteStoreT m ()
         perform req = do
-          resp <- bracketLogger tunnelLogger $ lift $ workerHelper req
+
+          special <- case req of
+            AddToStore {} -> do
+              let proxyNarSource :: NarSource IO
+                  proxyNarSource f =
+                    liftIO
+                      (System.Timeout.timeout
+                         1000000
+                         (Network.Socket.ByteString.recv sock 8)
+                      )
+                    >>= \case
+                      Nothing -> pure ()
+                      Just x -> f x >> proxyNarSource f
+
+              pure $ setNarSource proxyNarSource
+            _ -> pure $ pure ()
+
+          resp <-
+            bracketLogger
+              tunnelLogger
+              $ lift
+              $ workerHelper
+              $ special >> doReq req
+
           sockPutS
             (mapErrorS
                RemoteStoreError_SerializerReply
diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs
index 1daa5bb..3f578a7 100644
--- a/hnix-store-remote/tests-io/NixDaemonSpec.hs
+++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs
@@ -213,7 +213,6 @@ withManInTheMiddleNixDaemon action =
       <=< fmap fst
       . runStoreConnection storeConn
       . (setStoreDir storeDir >>)
-      . doReq
 
   in action $ \(mstore :: RemoteStoreT m a) ->
     runDaemonConnection handler

From 4aeee1ee334152aa486033910323bb374d8dde56 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 17:51:20 +0100
Subject: [PATCH 19/27] remote/server: tidy

---
 .../src/System/Nix/Store/Remote/Server.hs             | 11 ++++-------
 1 file changed, 4 insertions(+), 7 deletions(-)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
index d55d604..3b8020c 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
@@ -15,12 +15,9 @@ import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Default.Class (Default(def))
 import Data.Foldable (traverse_)
 import Data.IORef (IORef, atomicModifyIORef, newIORef)
---import Data.Some (Some(Some))
 import Data.Text (Text)
 import Data.Void (Void, absurd)
 import Data.Word (Word32)
-import qualified Data.Text
-import qualified Data.Text.IO
 import Network.Socket (Socket, accept, close, listen, maxListenQueue)
 import System.Nix.Nar (NarSource)
 import System.Nix.Store.Remote.Client (doReq)
@@ -33,9 +30,9 @@ import System.Nix.Store.Remote.Types.Logger (BasicError(..), ErrorInfo, Logger(.
 import System.Nix.Store.Remote.MonadStore (MonadRemoteStore(..), WorkerError(..), WorkerException(..), RemoteStoreError(..), RemoteStoreT, runRemoteStoreT)
 import System.Nix.Store.Remote.Types.Handshake (ServerHandshakeInput(..), ServerHandshakeOutput(..))
 import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
-
--- wip
-import Data.Some (withSome)
+import qualified Data.Some
+import qualified Data.Text
+import qualified Data.Text.IO
 import qualified System.Timeout
 import qualified Network.Socket.ByteString
 
@@ -166,7 +163,7 @@ processConnection workerHelper postGreet sock = do
           -- have to be explicit here
           -- because otherwise GHC can't conjure Show a, StoreReply a
           -- out of thin air
-          () <- withSome someReq $ \case
+          () <- Data.Some.withSome someReq $ \case
             r@AddToStore {} -> perform r
             r@AddTextToStore {} -> perform r
             r@AddSignatures {} -> perform r

From dea03e0f72408a265631e95bf4bf3438eb922b69 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 18:05:38 +0100
Subject: [PATCH 20/27] remote/server: propagate errors from proxy handler

---
 .../src/System/Nix/Store/Remote.hs            |  7 +------
 .../src/System/Nix/Store/Remote/Server.hs     | 21 +++++++++++--------
 hnix-store-remote/tests-io/NixDaemonSpec.hs   |  7 +++----
 3 files changed, 16 insertions(+), 19 deletions(-)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs
index e43e2d7..896e2d8 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs
@@ -94,7 +94,7 @@ runStoreSocket sockFamily sockAddr code =
 
 justdoit :: Run IO (Bool, Bool)
 justdoit = do
-  runDaemonConnection handler (pure ()) (StoreConnection_Socket "/tmp/dsock") $
+  runDaemonConnection runStore (pure ()) (StoreConnection_Socket "/tmp/dsock") $
     runStoreConnection (StoreConnection_Socket "/tmp/dsock")
       $ do
         a <- isValidPath pth
@@ -108,11 +108,6 @@ justdoit = do
         def
         "/nix/store/yyznqbwam67cmp7zfwk0rkgmi9yqsdsm-hnix-store-core-0.8.0.0"
 
-    handler :: RemoteStoreT IO a -> IO a
-    handler k = do
-      x <- runStore k
-      either (error . show) pure (fst x)
-
 runDaemon
   :: forall m a
   . ( MonadIO m
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
index 3b8020c..f6d1387 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
@@ -20,7 +20,7 @@ import Data.Void (Void, absurd)
 import Data.Word (Word32)
 import Network.Socket (Socket, accept, close, listen, maxListenQueue)
 import System.Nix.Nar (NarSource)
-import System.Nix.Store.Remote.Client (doReq)
+import System.Nix.Store.Remote.Client (Run, doReq)
 import System.Nix.Store.Remote.Serializer (LoggerSError, mapErrorS, storeRequest, workerMagic, protoVersion, int, logger, text, trustedFlag)
 import System.Nix.Store.Remote.Socket
 import System.Nix.Store.Remote.Types.StoreRequest as R
@@ -42,7 +42,7 @@ type WorkerHelper m
     , StoreReply a
     )
   => RemoteStoreT m a
-  -> m a
+  -> Run m a
 
 chatty :: Bool
 chatty = False
@@ -138,19 +138,22 @@ processConnection workerHelper postGreet sock = do
               pure $ setNarSource proxyNarSource
             _ -> pure $ pure ()
 
-          resp <-
+          res <-
             bracketLogger
               tunnelLogger
               $ lift
               $ workerHelper
               $ special >> doReq req
 
-          sockPutS
-            (mapErrorS
-               RemoteStoreError_SerializerReply
-               $ getReplyS
-            )
-            resp
+          case fst res of
+            Left e -> throwError e
+            Right reply ->
+              sockPutS
+                (mapErrorS
+                   RemoteStoreError_SerializerReply
+                   $ getReplyS
+                )
+                reply
 
     -- Process client requests.
     let loop = do
diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs
index 3f578a7..67eb140 100644
--- a/hnix-store-remote/tests-io/NixDaemonSpec.hs
+++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs
@@ -5,7 +5,7 @@ module NixDaemonSpec
   , spec
   ) where
 
-import Control.Monad (forM_, unless, void, (<=<))
+import Control.Monad (forM_, unless, void)
 import Control.Monad.Catch (MonadMask)
 import Control.Monad.Conc.Class (MonadConc)
 import Control.Monad.IO.Class (MonadIO, liftIO)
@@ -209,9 +209,8 @@ withManInTheMiddleNixDaemon action =
     storeConn2 = StoreConnection_Socket $ StoreSocketPath sockFp2
 
     handler :: WorkerHelper m
-    handler = either (error . show) pure
-      <=< fmap fst
-      . runStoreConnection storeConn
+    handler =
+      runStoreConnection storeConn
       . (setStoreDir storeDir >>)
 
   in action $ \(mstore :: RemoteStoreT m a) ->

From 3eb346699bcb10686debb538ced280c1eec0c6f2 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 18:48:50 +0100
Subject: [PATCH 21/27] remote: fix roots test for MITM vs Direct

---
 hnix-store-remote/tests-io/NixDaemonSpec.hs | 39 +++++++++++++++++----
 1 file changed, 32 insertions(+), 7 deletions(-)

diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs
index 67eb140..ff810b0 100644
--- a/hnix-store-remote/tests-io/NixDaemonSpec.hs
+++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs
@@ -318,16 +318,28 @@ builderSh = "declare -xpexport > $out"
 spec :: Spec
 spec = do
   describe "Remote store protocol" $ do
-    describe "Direct" $ makeProtoSpec withNixDaemon
-    describe "MITM" $ makeProtoSpec withManInTheMiddleNixDaemon
+    describe "Direct"
+      $ makeProtoSpec
+          withNixDaemon
+          SpecFlavor_Direct
+    describe "MITM"
+      $ makeProtoSpec
+          withManInTheMiddleNixDaemon
+          SpecFlavor_MITM
+
+data SpecFlavor
+  = SpecFlavor_Direct
+  | SpecFlavor_MITM
+  deriving (Eq, Ord, Show)
 
 makeProtoSpec
   :: (ActionWith
        (RemoteStoreT IO () -> Run IO ())
        -> IO ()
      )
+  -> SpecFlavor
   -> Spec
-makeProtoSpec f = around f $ do
+makeProtoSpec f flavor = around f $ do
   context "syncWithGC" $
     itRights "syncs with garbage collector" syncWithGC
 
@@ -394,11 +406,24 @@ makeProtoSpec f = around f $ do
       buildPaths (toDerivedPathSet path) BuildMode_Repair
 
   context "roots" $ context "findRoots" $ do
-      itRights "empty roots" (findRoots `shouldReturn` mempty)
+    itRights "empty roots" (findRoots `shouldReturn` mempty)
 
-      itRights "path added as a temp root" $ withPath $ \_ -> do
-        roots <- findRoots
-        roots `shouldSatisfy` ((== 1) . Data.Map.size)
+    itRights "path added as a temp root" $ withPath $ \_ -> do
+      let expectRoots =
+            if flavor == SpecFlavor_MITM
+            then 0 -- nested client closes its connection so temp root gets removed
+            else 1
+      roots <- findRoots
+      roots `shouldSatisfy` ((== expectRoots) . Data.Map.size)
+
+    itRights "indirect root" $ withPath $ \path -> do
+      let expectRoots =
+            if flavor == SpecFlavor_MITM
+            then 1 -- nested client closes its connection so temp root gets removed
+            else 2
+      addIndirectRoot path
+      roots <- findRoots
+      roots `shouldSatisfy` ((== expectRoots) . Data.Map.size)
 
   context "optimiseStore" $ itRights "optimises" optimiseStore
 

From 29f58f46e77af161b34600080ad1aa9301aeb5be Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 18:53:47 +0100
Subject: [PATCH 22/27] remote: fix pretty TODO failing to parse on old GHC

---
 hnix-store-remote/src/System/Nix/Store/Remote.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs
index 896e2d8..53c3737 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs
@@ -161,11 +161,10 @@ runDaemonSocket workerHelper postGreet sockFamily sockAddr k =
           Network.Socket.Stream
           Network.Socket.defaultProtocol
     )
-    (\lsock -> liftIO $ Network.Socket.close lsock) -- *> System.Directory.removeFile f)
+    (\lsock -> liftIO $ Network.Socket.close lsock)
     $ \lsock -> do
-    --                                                                     ^^^^^^^^^^^^
-    -- TODO:  this: -------------------------------------------------------////////////
-    -- should really be
+    -- TODO: the: (\lsock -> liftIO $ Network.Socket.close lsock *> System.Directory.removeFile f)
+    -- branch should really be (and even removeFile is currently omitted)
     -- a file lock followed by unlink *before* bind rather than after close.  If
     -- the program crashes (or loses power or something) then a stale unix
     -- socket will stick around and prevent the daemon from starting.  using a

From 6840a2d9058fb873ba02a3812c7aaaa73846e429 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 19:21:42 +0100
Subject: [PATCH 23/27] Add danbornside to contributors

Contributed to daemon-server-side branch
but not listed as author or co-author in any of the commits. Fixed!
---
 docs/01-Contributors.org | 1 +
 1 file changed, 1 insertion(+)

diff --git a/docs/01-Contributors.org b/docs/01-Contributors.org
index 20d88bf..eefc7eb 100644
--- a/docs/01-Contributors.org
+++ b/docs/01-Contributors.org
@@ -31,3 +31,4 @@ in order of appearance:
 + Ryan Trinkle @ryantrinkle
 + Travis Whitaker @TravisWhitaker
 + Andrea Bedini @andreabedini
++ Dan Bornside @danbornside

From b754f3aa6ddc6c425b40eb3a7482b5bfd920d4c1 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Sun, 10 Dec 2023 19:22:30 +0100
Subject: [PATCH 24/27] remote: NixDaemonSpec, shell -> proc for nix-daemon so
 it gets terminated

---
 hnix-store-remote/tests-io/NixDaemonSpec.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs
index ff810b0..d91848a 100644
--- a/hnix-store-remote/tests-io/NixDaemonSpec.hs
+++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs
@@ -113,8 +113,7 @@ startDaemon fp = do
   procHandle <-
     createProcessEnv
       fp
-      $ System.Process.shell
-         "nix-daemon 2>&1 | grep -v 'accepted connection'"
+      $ System.Process.proc "nix-daemon" mempty
 
   waitSocket sockFp 30
   pure ( procHandle

From fbc55992fa36ad5719586b4bc356774f14395491 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Mon, 11 Dec 2023 15:27:54 +0100
Subject: [PATCH 25/27] core: fix Wildcard spec haddock

---
 hnix-store-core/src/System/Nix/DerivedPath.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/hnix-store-core/src/System/Nix/DerivedPath.hs b/hnix-store-core/src/System/Nix/DerivedPath.hs
index 2cfbdd0..16c8f93 100644
--- a/hnix-store-core/src/System/Nix/DerivedPath.hs
+++ b/hnix-store-core/src/System/Nix/DerivedPath.hs
@@ -25,7 +25,7 @@ import qualified System.Nix.StorePath
 
 data OutputsSpec =
     OutputsSpec_All
-  -- ^ Wildcard spec (!*) meaning all outputs
+  -- ^ Wildcard spec (^*) meaning all outputs
   | OutputsSpec_Names (Set OutputName)
   -- ^ Set of specific outputs
   deriving (Eq, Generic, Ord, Show)

From e374687467a6e0c32594d37f9531e9f1ba7965d9 Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Mon, 11 Dec 2023 15:29:13 +0100
Subject: [PATCH 26/27] remote/server: add note that proxyNarSource is a hack

---
 hnix-store-remote/src/System/Nix/Store/Remote/Server.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
index f6d1387..e22b3a7 100644
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Server.hs
@@ -124,6 +124,8 @@ processConnection workerHelper postGreet sock = do
 
           special <- case req of
             AddToStore {} -> do
+              -- This is a hack (but a pretty neat and fast one!)
+              -- it should parse nad stream NAR instead
               let proxyNarSource :: NarSource IO
                   proxyNarSource f =
                     liftIO

From 619687b4469d54192a1586dee13eeb7ebf697b2f Mon Sep 17 00:00:00 2001
From: sorki <srk@48.io>
Date: Tue, 12 Dec 2023 07:08:17 +0100
Subject: [PATCH 27/27] remote: fix flaky collectGarbage for MITM test

---
 hnix-store-remote/tests-io/NixDaemonSpec.hs | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/hnix-store-remote/tests-io/NixDaemonSpec.hs b/hnix-store-remote/tests-io/NixDaemonSpec.hs
index d91848a..ee2e4e7 100644
--- a/hnix-store-remote/tests-io/NixDaemonSpec.hs
+++ b/hnix-store-remote/tests-io/NixDaemonSpec.hs
@@ -5,6 +5,7 @@ module NixDaemonSpec
   , spec
   ) where
 
+import Control.Exception (catch, SomeException)
 import Control.Monad (forM_, unless, void)
 import Control.Monad.Catch (MonadMask)
 import Control.Monad.Conc.Class (MonadConc)
@@ -465,13 +466,17 @@ makeProtoSpec f flavor = around f $ do
         -- clear temp gc roots so the delete works. restarting the nix daemon should also do this...
         storeDir <- getStoreDir
         let tempRootsDir = Data.Text.unpack $ mconcat [ Data.Text.Encoding.decodeUtf8 (unStoreDir storeDir), "/../var/nix/temproots/" ]
-        tempRootList <-
-          liftIO
-          $ System.Directory.listDirectory
-              tempRootsDir
-        liftIO $ forM_ tempRootList $ \entry -> do
-          System.Directory.removeFile
-            $ mconcat [ tempRootsDir, "/", entry ]
+        liftIO $ do
+          tempRootList <-
+            System.Directory.listDirectory tempRootsDir
+          forM_ tempRootList $ \entry -> do
+            System.Directory.removeFile
+              $ mconcat [ tempRootsDir, "/", entry ]
+            -- for MITM, the temp root will get deleted
+            -- by the daemon as our nested client exists
+            -- but the listDirectory might still see it
+            -- causing TOC/TOU flakiness
+            `catch` (\(_e :: SomeException) -> pure ())
 
         GCResult{..} <-
           collectGarbage