mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-10-26 21:56:29 +03:00
remote/server: propagate errors from proxy handler
This commit is contained in:
parent
4aeee1ee33
commit
dea03e0f72
@ -94,7 +94,7 @@ runStoreSocket sockFamily sockAddr code =
|
|||||||
|
|
||||||
justdoit :: Run IO (Bool, Bool)
|
justdoit :: Run IO (Bool, Bool)
|
||||||
justdoit = do
|
justdoit = do
|
||||||
runDaemonConnection handler (pure ()) (StoreConnection_Socket "/tmp/dsock") $
|
runDaemonConnection runStore (pure ()) (StoreConnection_Socket "/tmp/dsock") $
|
||||||
runStoreConnection (StoreConnection_Socket "/tmp/dsock")
|
runStoreConnection (StoreConnection_Socket "/tmp/dsock")
|
||||||
$ do
|
$ do
|
||||||
a <- isValidPath pth
|
a <- isValidPath pth
|
||||||
@ -108,11 +108,6 @@ justdoit = do
|
|||||||
def
|
def
|
||||||
"/nix/store/yyznqbwam67cmp7zfwk0rkgmi9yqsdsm-hnix-store-core-0.8.0.0"
|
"/nix/store/yyznqbwam67cmp7zfwk0rkgmi9yqsdsm-hnix-store-core-0.8.0.0"
|
||||||
|
|
||||||
handler :: RemoteStoreT IO a -> IO a
|
|
||||||
handler k = do
|
|
||||||
x <- runStore k
|
|
||||||
either (error . show) pure (fst x)
|
|
||||||
|
|
||||||
runDaemon
|
runDaemon
|
||||||
:: forall m a
|
:: forall m a
|
||||||
. ( MonadIO m
|
. ( MonadIO m
|
||||||
|
@ -20,7 +20,7 @@ import Data.Void (Void, absurd)
|
|||||||
import Data.Word (Word32)
|
import Data.Word (Word32)
|
||||||
import Network.Socket (Socket, accept, close, listen, maxListenQueue)
|
import Network.Socket (Socket, accept, close, listen, maxListenQueue)
|
||||||
import System.Nix.Nar (NarSource)
|
import System.Nix.Nar (NarSource)
|
||||||
import System.Nix.Store.Remote.Client (doReq)
|
import System.Nix.Store.Remote.Client (Run, doReq)
|
||||||
import System.Nix.Store.Remote.Serializer (LoggerSError, mapErrorS, storeRequest, workerMagic, protoVersion, int, logger, text, trustedFlag)
|
import System.Nix.Store.Remote.Serializer (LoggerSError, mapErrorS, storeRequest, workerMagic, protoVersion, int, logger, text, trustedFlag)
|
||||||
import System.Nix.Store.Remote.Socket
|
import System.Nix.Store.Remote.Socket
|
||||||
import System.Nix.Store.Remote.Types.StoreRequest as R
|
import System.Nix.Store.Remote.Types.StoreRequest as R
|
||||||
@ -42,7 +42,7 @@ type WorkerHelper m
|
|||||||
, StoreReply a
|
, StoreReply a
|
||||||
)
|
)
|
||||||
=> RemoteStoreT m a
|
=> RemoteStoreT m a
|
||||||
-> m a
|
-> Run m a
|
||||||
|
|
||||||
chatty :: Bool
|
chatty :: Bool
|
||||||
chatty = False
|
chatty = False
|
||||||
@ -138,19 +138,22 @@ processConnection workerHelper postGreet sock = do
|
|||||||
pure $ setNarSource proxyNarSource
|
pure $ setNarSource proxyNarSource
|
||||||
_ -> pure $ pure ()
|
_ -> pure $ pure ()
|
||||||
|
|
||||||
resp <-
|
res <-
|
||||||
bracketLogger
|
bracketLogger
|
||||||
tunnelLogger
|
tunnelLogger
|
||||||
$ lift
|
$ lift
|
||||||
$ workerHelper
|
$ workerHelper
|
||||||
$ special >> doReq req
|
$ special >> doReq req
|
||||||
|
|
||||||
sockPutS
|
case fst res of
|
||||||
(mapErrorS
|
Left e -> throwError e
|
||||||
RemoteStoreError_SerializerReply
|
Right reply ->
|
||||||
$ getReplyS
|
sockPutS
|
||||||
)
|
(mapErrorS
|
||||||
resp
|
RemoteStoreError_SerializerReply
|
||||||
|
$ getReplyS
|
||||||
|
)
|
||||||
|
reply
|
||||||
|
|
||||||
-- Process client requests.
|
-- Process client requests.
|
||||||
let loop = do
|
let loop = do
|
||||||
|
@ -5,7 +5,7 @@ module NixDaemonSpec
|
|||||||
, spec
|
, spec
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (forM_, unless, void, (<=<))
|
import Control.Monad (forM_, unless, void)
|
||||||
import Control.Monad.Catch (MonadMask)
|
import Control.Monad.Catch (MonadMask)
|
||||||
import Control.Monad.Conc.Class (MonadConc)
|
import Control.Monad.Conc.Class (MonadConc)
|
||||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||||
@ -209,9 +209,8 @@ withManInTheMiddleNixDaemon action =
|
|||||||
storeConn2 = StoreConnection_Socket $ StoreSocketPath sockFp2
|
storeConn2 = StoreConnection_Socket $ StoreSocketPath sockFp2
|
||||||
|
|
||||||
handler :: WorkerHelper m
|
handler :: WorkerHelper m
|
||||||
handler = either (error . show) pure
|
handler =
|
||||||
<=< fmap fst
|
runStoreConnection storeConn
|
||||||
. runStoreConnection storeConn
|
|
||||||
. (setStoreDir storeDir >>)
|
. (setStoreDir storeDir >>)
|
||||||
|
|
||||||
in action $ \(mstore :: RemoteStoreT m a) ->
|
in action $ \(mstore :: RemoteStoreT m a) ->
|
||||||
|
Loading…
Reference in New Issue
Block a user