diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs index deff7407fd1..9a79524a84f 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs @@ -33,12 +33,13 @@ import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion simpleSingletonVersions) import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket, localAddressFromPath, localSnocket, makeLocalBearer) -import Ouroboros.Network.Socket (ConnectionId (..), HandshakeCallbacks (..), - connectToNode, nullNetworkConnectTracers) +import Ouroboros.Network.Socket (ConnectionId (..), ConnectToArgs (..), + HandshakeCallbacks (..), connectToNode, nullNetworkConnectTracers) import Codec.CBOR.Term (Term) +import Control.Exception (throwIO) import qualified Data.ByteString.Lazy as LBS -import Data.Void (Void) +import Data.Void (Void, absurd) import Data.Word (Word32) import qualified System.Metrics.Configuration as EKGF import System.Metrics.Network.Acceptor (acceptEKGMetricsInit) @@ -99,15 +100,11 @@ doConnectToForwarder LBS.ByteString IO () Void -> IO () doConnectToForwarder snocket address netMagic timeLimits app = - connectToNode + done <- connectToNode snocket makeLocalBearer + args mempty -- LocalSocket does not require to be configured - (codecHandshake forwardingVersionCodec) - timeLimits - (cborTermVersionDataCodec forwardingCodecCBORTerm) - nullNetworkConnectTracers - (HandshakeCallbacks acceptableVersion queryVersion) (simpleSingletonVersions ForwardingV_1 (ForwardingVersionData $ NetworkMagic netMagic) @@ -115,6 +112,18 @@ doConnectToForwarder snocket address netMagic timeLimits app = ) Nothing address + case done of + Left err -> throwIO err + Right choice -> case choice of + Left () -> return () + Right void -> absurd void + where + args = ConnectToArgs { + ctaHandshakeCodec = codecHandshake forwardingVersionCodec, + ctaHandshakeTimeLimits = timeLimits, + ctaVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, + ctaConnectTracers = nullNetworkConnectTracers, + ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion } runEKGAcceptorInit :: TracerEnv diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs index 661816863cf..14a04330987 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs @@ -33,21 +33,22 @@ 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 (..), ConnectToArgs (..), + HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState, + connectToNode, newNetworkMutableState, nullNetworkConnectTracers, + nullNetworkServerTracers, withServerNode) import Codec.CBOR.Term (Term) import Control.Concurrent (threadDelay) import Control.Concurrent.Async import Control.DeepSeq (NFData) +import Control.Exception (throwIO) import Control.Monad (forever) import "contra-tracer" Control.Tracer (contramap, nullTracer, stdoutTracer) import Data.Aeson (FromJSON, ToJSON) import qualified Data.ByteString.Lazy as LBS import Data.Time.Clock (getCurrentTime) -import Data.Void (Void) +import Data.Void (Void, absurd) import Data.Word (Word16) import GHC.Generics import System.Directory @@ -157,15 +158,11 @@ doConnectToAcceptor TestSetup{..} snocket muxBearer address timeLimits (ekgConfi dpStore <- initDataPointStore writeToStore dpStore "test.data.point" $ DataPoint mkTestDataPoint withAsync (traceObjectsWriter sink) $ \_ -> do - connectToNode + done <- connectToNode snocket muxBearer + args mempty - (codecHandshake forwardingVersionCodec) - timeLimits - (cborTermVersionDataCodec forwardingCodecCBORTerm) - nullNetworkConnectTracers - (HandshakeCallbacks acceptableVersion queryVersion) (simpleSingletonVersions ForwardingV_1 (ForwardingVersionData $ unI tsNetworkMagic) @@ -177,7 +174,18 @@ doConnectToAcceptor TestSetup{..} snocket muxBearer address timeLimits (ekgConfi ) Nothing address + case done of + Left err -> throwIO err + Right choice -> case choice of + Left () -> return () + Right void -> absurd void where + args = ConnectToArgs { + ctaHandshakeCodec = codecHandshake forwardingVersionCodec, + ctaHandshakeTimeLimits = timeLimits, + ctaVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, + ctaConnectTracers = nullNetworkConnectTracers, + ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion } forwarderApp :: [(RunMiniProtocol 'InitiatorMode initCtx respCtx LBS.ByteString IO () Void, Word16)] -> OuroborosApplication 'InitiatorMode initCtx respCtx LBS.ByteString IO () Void diff --git a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs index a27c172b65f..02c620e9428 100644 --- a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs +++ b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs @@ -32,18 +32,19 @@ 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 (..), ConnectToArgs (..), + HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState, + connectToNode, newNetworkMutableState, nullNetworkConnectTracers, + nullNetworkServerTracers, withServerNode) import Codec.CBOR.Term (Term) import Control.Concurrent.Async (async, race_, wait) import Control.Monad (void) +import Control.Exception (throwIO) 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 +198,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 +214,18 @@ doConnectToAcceptor magic snocket makeBearer configureSocket address timeLimits ) Nothing address + case done of + Left err -> throwIO err + Right choice -> case choice of + Left () -> return () + Right void -> absurd void 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