diff --git a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs index a27c172b65f..ae764ea7c97 100644 --- a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs +++ b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs @@ -32,10 +32,10 @@ import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion simpleSingletonVersions) import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket, makeLocalBearer) -import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), HandshakeCallbacks (..), - SomeResponderApplication (..), cleanNetworkMutableState, connectToNode, - newNetworkMutableState, nullNetworkConnectTracers, nullNetworkServerTracers, - withServerNode) +import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectToNode (..), + HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState, + connectToNode, newNetworkMutableState, nullNetworkConnectTracers, + nullNetworkServerTracers, withServerNode) import Codec.CBOR.Term (Term) import Control.Concurrent.Async (async, race_, wait) @@ -43,7 +43,7 @@ import Control.Monad (void) import Control.Monad.IO.Class import "contra-tracer" Control.Tracer (Tracer, contramap, nullTracer, stdoutTracer) import qualified Data.ByteString.Lazy as LBS -import Data.Void (Void) +import Data.Void (Void, absurd) import Data.Word (Word16) import System.IO (hPutStrLn, stderr) import qualified System.Metrics as EKG @@ -197,15 +197,11 @@ doConnectToAcceptor -> IO () doConnectToAcceptor magic snocket makeBearer configureSocket address timeLimits ekgConfig tfConfig dpfConfig sink ekgStore dpStore = do - connectToNode + done <- connectToNode snocket makeBearer + args configureSocket - (codecHandshake forwardingVersionCodec) - timeLimits - (cborTermVersionDataCodec forwardingCodecCBORTerm) - nullNetworkConnectTracers - (HandshakeCallbacks acceptableVersion queryVersion) (simpleSingletonVersions ForwardingV_1 (ForwardingVersionData magic) @@ -217,7 +213,18 @@ doConnectToAcceptor magic snocket makeBearer configureSocket address timeLimits ) Nothing address + case done of + Left err -> throwIO err + Right choice -> case choice of + Left void -> absurd void + Right () -> return () where + args = ConnectToArgs { + ctaHandshakeCodec = codecHandshake forwardingVersionCodec, + ctaHandshakeTimeLimits = timeLimits, + ctaVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, + ctaConnectTracers = nullNetworkConnectTracers, + ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion } forwarderApp :: [(RunMiniProtocol 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void, Word16)] -> OuroborosApplication 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void