mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
remote: add postGreet so we setStoreDir in Server as well
This commit is contained in:
parent
4651980047
commit
3dc7ab6f06
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user