mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
remote: less chatty server
This commit is contained in:
parent
3dc7ab6f06
commit
e2381c89d5
@ -42,6 +42,12 @@ type WorkerHelper m
|
|||||||
)
|
)
|
||||||
=> StoreRequest a -> m a
|
=> 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.
|
-- | Run an emulated nix daemon on given socket address.
|
||||||
-- The deamon will close when the continuation returns.
|
-- The deamon will close when the continuation returns.
|
||||||
runProxyDaemon
|
runProxyDaemon
|
||||||
@ -57,12 +63,12 @@ runProxyDaemon
|
|||||||
runProxyDaemon workerHelper postGreet lsock k = do
|
runProxyDaemon workerHelper postGreet lsock k = do
|
||||||
liftIO $ listen lsock maxListenQueue
|
liftIO $ listen lsock maxListenQueue
|
||||||
|
|
||||||
liftIO $ Data.Text.IO.putStrLn "listening"
|
dbg "listening"
|
||||||
|
|
||||||
let listener :: m Void
|
let listener :: m Void
|
||||||
listener = do
|
listener = do
|
||||||
(sock, _) <- liftIO $ accept lsock
|
(sock, _) <- liftIO $ accept lsock
|
||||||
liftIO $ Data.Text.IO.putStrLn "accepting"
|
dbg "accepting"
|
||||||
|
|
||||||
-- TODO: this, but without the space leak
|
-- TODO: this, but without the space leak
|
||||||
fmap fst
|
fmap fst
|
||||||
@ -160,7 +166,7 @@ processConnection workerHelper postGreet sock = do
|
|||||||
loop
|
loop
|
||||||
loop
|
loop
|
||||||
|
|
||||||
liftIO $ Data.Text.IO.putStrLn "daemon connection done"
|
dbg "daemon connection done"
|
||||||
liftIO $ close sock
|
liftIO $ close sock
|
||||||
|
|
||||||
where
|
where
|
||||||
@ -176,7 +182,6 @@ processConnection workerHelper postGreet sock = do
|
|||||||
RemoteStoreError_SerializerHandshake
|
RemoteStoreError_SerializerHandshake
|
||||||
workerMagic
|
workerMagic
|
||||||
|
|
||||||
liftIO $ print ("magic" :: Text, magic)
|
|
||||||
when (magic /= WorkerMagic_One)
|
when (magic /= WorkerMagic_One)
|
||||||
$ throwError
|
$ throwError
|
||||||
$ RemoteStoreError_WorkerException
|
$ RemoteStoreError_WorkerException
|
||||||
@ -195,8 +200,6 @@ processConnection workerHelper postGreet sock = do
|
|||||||
|
|
||||||
let leastCommonVersion = min clientVersion serverHandshakeInputOurVersion
|
let leastCommonVersion = min clientVersion serverHandshakeInputOurVersion
|
||||||
|
|
||||||
liftIO $ print ("Versions client, min" :: Text, clientVersion, leastCommonVersion)
|
|
||||||
|
|
||||||
when (clientVersion < ProtoVersion 1 10)
|
when (clientVersion < ProtoVersion 1 10)
|
||||||
$ throwError
|
$ throwError
|
||||||
$ RemoteStoreError_WorkerException
|
$ RemoteStoreError_WorkerException
|
||||||
|
Loading…
Reference in New Issue
Block a user