remote: add postGreet so we setStoreDir in Server as well

This commit is contained in:
sorki 2023-12-10 17:06:44 +01:00
parent 4651980047
commit 3dc7ab6f06
3 changed files with 19 additions and 9 deletions

View File

@ -94,7 +94,7 @@ runStoreSocket sockFamily sockAddr code =
justdoit :: Run IO (Bool, Bool) justdoit :: Run IO (Bool, Bool)
justdoit = do justdoit = do
runDaemonConnection handler (StoreConnection_Socket "/tmp/dsock") $ runDaemonConnection handler (pure ()) (StoreConnection_Socket "/tmp/dsock") $
runStoreConnection (StoreConnection_Socket "/tmp/dsock") runStoreConnection (StoreConnection_Socket "/tmp/dsock")
$ do $ do
a <- isValidPath pth a <- isValidPath pth
@ -124,6 +124,7 @@ runDaemon
runDaemon workerHelper = runDaemon workerHelper =
runDaemonConnection runDaemonConnection
workerHelper workerHelper
(pure ())
def def
-- | Run an emulated nix daemon using given @StoreConnection@ -- | Run an emulated nix daemon using given @StoreConnection@
@ -134,14 +135,15 @@ runDaemonConnection
, MonadConc m , MonadConc m
) )
=> WorkerHelper m => WorkerHelper m
-> RemoteStoreT m ()
-> StoreConnection -> StoreConnection
-> m a -> m a
-> m a -> m a
runDaemonConnection workerHelper sc k = runDaemonConnection workerHelper postGreet sc k =
connectionToSocket sc connectionToSocket sc
>>= \case >>= \case
Left e -> error $ show e 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@ -- | Run an emulated nix daemon using given @StoreConnection@
-- the deamon will close when the continuation returns. -- the deamon will close when the continuation returns.
@ -151,11 +153,12 @@ runDaemonSocket
, MonadConc m , MonadConc m
) )
=> WorkerHelper m => WorkerHelper m
-> RemoteStoreT m ()
-> Family -> Family
-> SockAddr -> SockAddr
-> m a -> m a
-> m a -> m a
runDaemonSocket workerHelper sockFamily sockAddr k = runDaemonSocket workerHelper postGreet sockFamily sockAddr k =
Control.Monad.Catch.bracket Control.Monad.Catch.bracket
(liftIO (liftIO
$ Network.Socket.socket $ Network.Socket.socket
@ -177,7 +180,7 @@ runDaemonSocket workerHelper sockFamily sockAddr k =
-- set up the listening socket -- set up the listening socket
liftIO $ Network.Socket.bind lsock sockAddr liftIO $ Network.Socket.bind lsock sockAddr
runProxyDaemon workerHelper lsock k runProxyDaemon workerHelper postGreet lsock k
connectionToSocket connectionToSocket
:: MonadIO m :: MonadIO m

View File

@ -50,10 +50,11 @@ runProxyDaemon
, MonadConc m , MonadConc m
) )
=> WorkerHelper m => WorkerHelper m
-> RemoteStoreT m ()
-> Socket -> Socket
-> m a -> m a
-> m a -> m a
runProxyDaemon workerHelper lsock k = do runProxyDaemon workerHelper postGreet lsock k = do
liftIO $ listen lsock maxListenQueue liftIO $ listen lsock maxListenQueue
liftIO $ Data.Text.IO.putStrLn "listening" liftIO $ Data.Text.IO.putStrLn "listening"
@ -66,7 +67,7 @@ runProxyDaemon workerHelper lsock k = do
-- TODO: this, but without the space leak -- TODO: this, but without the space leak
fmap fst fmap fst
$ concurrently listener $ concurrently listener
$ processConnection workerHelper sock $ processConnection workerHelper postGreet sock
either absurd id <$> race listener k either absurd id <$> race listener k
@ -77,9 +78,10 @@ processConnection
:: forall m :: forall m
. MonadIO m . MonadIO m
=> WorkerHelper m => WorkerHelper m
-> RemoteStoreT m ()
-> Socket -> Socket
-> m () -> m ()
processConnection workerHelper sock = do processConnection workerHelper postGreet sock = do
~() <- void $ runRemoteStoreT sock $ do ~() <- void $ runRemoteStoreT sock $ do
ServerHandshakeOutput{..} ServerHandshakeOutput{..}
@ -101,6 +103,9 @@ processConnection workerHelper sock = do
--authHook(*store); --authHook(*store);
stopWork tunnelLogger stopWork tunnelLogger
-- so we can set store dir
postGreet
let perform let perform
:: ( Show a :: ( Show a
, StoreReply a , StoreReply a

View File

@ -216,7 +216,9 @@ withManInTheMiddleNixDaemon action =
. doReq . doReq
in action $ \(mstore :: RemoteStoreT m a) -> in action $ \(mstore :: RemoteStoreT m a) ->
runDaemonConnection handler storeConn2 runDaemonConnection handler
(setStoreDir storeDir)
storeConn2
$ runStoreConnection storeConn2 $ runStoreConnection storeConn2
( setStoreDir storeDir ( setStoreDir storeDir
>> mstore >> mstore