remote: add StoreConnection, reclaim runStoreSocket, now greetServer

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

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

@@ -10,11 +10,11 @@ module System.Nix.Store.Remote
   , MonadStore
   -- * Runners
   , runStore
-  , runStoreOpts
+  , runStoreConnection
-  , runStoreOptsTCP
+  , 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
+runStoreConnection
-defaultSockPath = "/nix/var/nix/daemon-socket/socket"
-
-runStoreOpts
   :: ( MonadIO m
      , MonadMask m
      )
-  => FilePath
+  => StoreConnection
   -> RemoteStoreT m a
   -> Run m a
-runStoreOpts socketPath =
+runStoreConnection sc k =
-  runStoreOpts'
+  connectionToSocket sc
-    Network.Socket.AF_UNIX
+  >>= \case
-    (SockAddrUnix socketPath)
+    Left e -> pure (Left e, mempty)
+    Right (fam, sock) -> runStoreSocket fam sock k
 
-runStoreOptsTCP
+runStoreSocket
-  :: ( 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'
   :: ( 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" $
+  runDaemonConnection handler (StoreConnection_Socket "/tmp/dsock") $
-    runStoreOpts "/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
+runDaemonConnection workerHelper sc k =
-  (liftIO
+  connectionToSocket sc
-    $ Network.Socket.socket
+  >>= \case
-        Network.Socket.AF_UNIX
+    Left e -> error $ show e
-        Network.Socket.Stream
+    Right (fam, sock) -> runDaemonSocket workerHelper fam sock k
-        Network.Socket.defaultProtocol
+
-  )
+-- | Run an emulated nix daemon using given @StoreConnection@
-  (\lsock -> liftIO $ Network.Socket.close lsock *> System.Directory.removeFile f)
+-- the deamon will close when the continuation returns.
-  $ \lsock -> do
+runDaemonSocket
-  --                                                                 ^^^^^^^^^^^^
+  :: forall m a
-  -- TODO:  this: --------------------------------------------------////////////
+  . ( MonadIO m
-  liftIO $ Network.Socket.bind lsock (SockAddrUnix f)
+    , MonadConc m
-  runDaemonSocket workerHelper lsock k
+    )
+  => 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)

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 ClientHandshakeOutput
-  -> m a
+greetServer = do
-runStoreSocket code = do
+  sockPutS
-    ClientHandshakeOutput{..}
+    (mapErrorS
-      <- greet
+      RemoteStoreError_SerializerHandshake
+      workerMagic
+    )
+    WorkerMagic_One
 
-    setProtoVersion clientHandshakeOutputLeastCommonVersion
+  magic <-
-    code
+    sockGetS
+    $ mapErrorS
+        RemoteStoreError_SerializerHandshake
+        workerMagic
 
-  where
+  unless
-    greet
+    (magic == WorkerMagic_Two)
-      :: MonadRemoteStore m
+    $ throwError RemoteStoreError_WorkerMagic2Mismatch
-      => m ClientHandshakeOutput
-    greet = do
 
-      sockPutS
+  daemonVersion <- sockGetS protoVersion
-        (mapErrorS
-          RemoteStoreError_SerializerHandshake
-          workerMagic
-        )
-        WorkerMagic_One
 
-      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
+          $ mapErrorS
-            RemoteStoreError_SerializerHandshake
+              RemoteStoreError_SerializerGet
-            workerMagic
+              text
+      pure $ Just txtVer
+    else pure Nothing
 
-      unless
+  remoteTrustsUs <- if leastCommonVersion >= ProtoVersion 1 35
-        (magic == WorkerMagic_Two)
+    then do
-        $ throwError RemoteStoreError_WorkerMagic2Mismatch
+      sockGetS
+        $ mapErrorS RemoteStoreError_SerializerHandshake trustedFlag
+    else pure Nothing
 
-      daemonVersion <- sockGetS protoVersion
+  setProtoVersion leastCommonVersion
+  processOutput
 
-      when (daemonVersion < ProtoVersion 1 10)
+  pure ClientHandshakeOutput
-        $ throwError RemoteStoreError_ClientVersionTooOld
+    { clientHandshakeOutputNixVersion = daemonNixVersion
-
+    , clientHandshakeOutputTrust = remoteTrustsUs
-      pv <- getProtoVersion
+    , clientHandshakeOutputLeastCommonVersion = leastCommonVersion
-      sockPutS protoVersion pv
+    , clientHandshakeOutputServerVersion = daemonVersion
-
+    }
-      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
-        }

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

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
+newtype StoreSocketPath = StoreSocketPath
-  { storeConfigDir :: Maybe StoreDir
+  { unStoreSocketPath :: FilePath
-  , storeConfigSocketPath :: 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

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