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
-  , 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,67 +54,48 @@ runStore
      )
   => RemoteStoreT m a
   -> Run m a
-runStore = runStoreOpts defaultSockPath
+runStore = runStoreConnection def
 
-defaultSockPath :: String
-defaultSockPath = "/nix/var/nix/daemon-socket/socket"
-
-runStoreOpts
-  :: ( MonadIO m
-     , MonadMask m
-     )
-  => FilePath
-  -> RemoteStoreT m a
-  -> Run m a
-runStoreOpts socketPath =
-  runStoreOpts'
-    Network.Socket.AF_UNIX
-    (SockAddrUnix socketPath)
-
-runStoreOptsTCP
+runStoreConnection
   :: ( MonadIO m
      , MonadMask m
      )
-  => String
-  -> Int
+  => StoreConnection
   -> 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)
+runStoreConnection sc k =
+  connectionToSocket sc
+  >>= \case
+    Left e -> pure (Left e, mempty)
+    Right (fam, sock) -> runStoreSocket fam sock k
 
-runStoreOpts'
+runStoreSocket
   :: ( MonadIO m
      , MonadMask m
      )
   => Family
   -> 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 using given @StoreConnection@
+-- the deamon will close when the continuation returns.
+runDaemonConnection
+  :: forall m a
+  . ( MonadIO m
+    , MonadConc m
+    )
+  => WorkerHelper m
+  -> StoreConnection
+  -> m a
+  -> m a
+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 on given socket address.
+-- | Run an emulated nix daemon using given @StoreConnection@
 -- the deamon will close when the continuation returns.
-runDaemonOpts
+runDaemonSocket
   :: forall m a
   . ( MonadIO m
     , MonadConc m
     )
   => WorkerHelper m
-  -> FilePath
+  -> Family
+  -> SockAddr
   -> 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
+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 a
-runStoreSocket code = do
-    ClientHandshakeOutput{..}
-      <- greet
-
-    setProtoVersion clientHandshakeOutputLeastCommonVersion
-    code
-
-  where
-    greet
-      :: MonadRemoteStore m
-      => m ClientHandshakeOutput
-    greet = do
-
-      sockPutS
-        (mapErrorS
-          RemoteStoreError_SerializerHandshake
-          workerMagic
-        )
-        WorkerMagic_One
-
-      magic <-
+  => m ClientHandshakeOutput
+greetServer = do
+  sockPutS
+    (mapErrorS
+      RemoteStoreError_SerializerHandshake
+      workerMagic
+    )
+    WorkerMagic_One
+
+  magic <-
+    sockGetS
+    $ mapErrorS
+        RemoteStoreError_SerializerHandshake
+        workerMagic
+
+  unless
+    (magic == WorkerMagic_Two)
+    $ throwError RemoteStoreError_WorkerMagic2Mismatch
+
+  daemonVersion <- sockGetS protoVersion
+
+  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
-
-      unless
-        (magic == WorkerMagic_Two)
-        $ throwError RemoteStoreError_WorkerMagic2Mismatch
-
-      daemonVersion <- sockGetS protoVersion
-
-      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
-        }
+          $ 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
+    }