Skip to content

Commit b14a949

Browse files
crocodile-dentistcrocodile-dentist
committed
o-network integration
1 parent 314e9af commit b14a949

File tree

3 files changed

+56
-31
lines changed

3 files changed

+56
-31
lines changed

‎cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs‎

Lines changed: 18 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -33,12 +33,13 @@ import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion
3333
simpleSingletonVersions)
3434
import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket,
3535
localAddressFromPath, localSnocket, makeLocalBearer)
36-
import Ouroboros.Network.Socket (ConnectionId (..), HandshakeCallbacks (..),
37-
connectToNode, nullNetworkConnectTracers)
36+
import Ouroboros.Network.Socket (ConnectionId (..), ConnectToArgs (..),
37+
HandshakeCallbacks (..), connectToNode, nullNetworkConnectTracers)
3838

39+
import Control.Exception (throwIO)
3940
import Codec.CBOR.Term (Term)
4041
import qualified Data.ByteString.Lazy as LBS
41-
import Data.Void (Void)
42+
import Data.Void (Void, absurd)
4243
import Data.Word (Word32)
4344
import qualified System.Metrics.Configuration as EKGF
4445
import System.Metrics.Network.Acceptor (acceptEKGMetricsInit)
@@ -99,22 +100,30 @@ doConnectToForwarder
99100
LBS.ByteString IO () Void
100101
-> IO ()
101102
doConnectToForwarder snocket address netMagic timeLimits app =
102-
connectToNode
103+
done <- connectToNode
103104
snocket
104105
makeLocalBearer
106+
args
105107
mempty -- LocalSocket does not require to be configured
106-
(codecHandshake forwardingVersionCodec)
107-
timeLimits
108-
(cborTermVersionDataCodec forwardingCodecCBORTerm)
109-
nullNetworkConnectTracers
110-
(HandshakeCallbacks acceptableVersion queryVersion)
111108
(simpleSingletonVersions
112109
ForwardingV_1
113110
(ForwardingVersionData $ NetworkMagic netMagic)
114111
app
115112
)
116113
Nothing
117114
address
115+
case done of
116+
Left err -> throwIO err
117+
Right choice -> case choice of
118+
Left () -> return ()
119+
Right void -> absurd void
120+
where
121+
args = ConnectToArgs {
122+
ctaHandshakeCodec = codecHandshake forwardingVersionCodec,
123+
ctaHandshakeTimeLimits = timeLimits,
124+
ctaVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm,
125+
ctaConnectTracers = nullNetworkConnectTracers,
126+
ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion }
118127

119128
runEKGAcceptorInit
120129
:: TracerEnv

‎cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs‎

Lines changed: 19 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -33,21 +33,22 @@ import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion
3333
simpleSingletonVersions)
3434
import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket,
3535
makeLocalBearer)
36-
import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), HandshakeCallbacks (..),
37-
SomeResponderApplication (..), cleanNetworkMutableState, connectToNode,
38-
newNetworkMutableState, nullNetworkConnectTracers, nullNetworkServerTracers,
39-
withServerNode)
36+
import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectToArgs (..),
37+
HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState,
38+
connectToNode, newNetworkMutableState, nullNetworkConnectTracers,
39+
nullNetworkServerTracers, withServerNode)
4040

4141
import Codec.CBOR.Term (Term)
4242
import Control.Concurrent (threadDelay)
4343
import Control.Concurrent.Async
4444
import Control.DeepSeq (NFData)
45+
import Control.Exception (throwIO)
4546
import Control.Monad (forever)
4647
import "contra-tracer" Control.Tracer (contramap, nullTracer, stdoutTracer)
4748
import Data.Aeson (FromJSON, ToJSON)
4849
import qualified Data.ByteString.Lazy as LBS
4950
import Data.Time.Clock (getCurrentTime)
50-
import Data.Void (Void)
51+
import Data.Void (Void, absurd)
5152
import Data.Word (Word16)
5253
import GHC.Generics
5354
import System.Directory
@@ -157,15 +158,11 @@ doConnectToAcceptor TestSetup{..} snocket muxBearer address timeLimits (ekgConfi
157158
dpStore <- initDataPointStore
158159
writeToStore dpStore "test.data.point" $ DataPoint mkTestDataPoint
159160
withAsync (traceObjectsWriter sink) $ \_ -> do
160-
connectToNode
161+
done <- connectToNode
161162
snocket
162163
muxBearer
164+
args
163165
mempty
164-
(codecHandshake forwardingVersionCodec)
165-
timeLimits
166-
(cborTermVersionDataCodec forwardingCodecCBORTerm)
167-
nullNetworkConnectTracers
168-
(HandshakeCallbacks acceptableVersion queryVersion)
169166
(simpleSingletonVersions
170167
ForwardingV_1
171168
(ForwardingVersionData $ unI tsNetworkMagic)
@@ -177,7 +174,18 @@ doConnectToAcceptor TestSetup{..} snocket muxBearer address timeLimits (ekgConfi
177174
)
178175
Nothing
179176
address
177+
case done of
178+
Left err -> throwIO err
179+
Right choice -> case choice of
180+
Left () -> return ()
181+
Right void -> absurd void
180182
where
183+
args = ConnectToArgs {
184+
ctaHandshakeCodec = codecHandshake forwardingVersionCodec,
185+
ctaHandshakeTimeLimits = timeLimits,
186+
ctaVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm,
187+
ctaConnectTracers = nullNetworkConnectTracers,
188+
ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion }
181189
forwarderApp
182190
:: [(RunMiniProtocol 'InitiatorMode initCtx respCtx LBS.ByteString IO () Void, Word16)]
183191
-> OuroborosApplication 'InitiatorMode initCtx respCtx LBS.ByteString IO () Void

‎trace-dispatcher/src/Cardano/Logging/Forwarding.hs‎

Lines changed: 19 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -32,18 +32,19 @@ import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion
3232
simpleSingletonVersions)
3333
import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket,
3434
makeLocalBearer)
35-
import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), HandshakeCallbacks (..),
36-
SomeResponderApplication (..), cleanNetworkMutableState, connectToNode,
37-
newNetworkMutableState, nullNetworkConnectTracers, nullNetworkServerTracers,
38-
withServerNode)
35+
import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectToArgs (..),
36+
HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState,
37+
connectToNode, newNetworkMutableState, nullNetworkConnectTracers,
38+
nullNetworkServerTracers, withServerNode)
3939

4040
import Codec.CBOR.Term (Term)
4141
import Control.Concurrent.Async (async, race_, wait)
4242
import Control.Monad (void)
43+
import Control.Exception (throwIO)
4344
import Control.Monad.IO.Class
4445
import "contra-tracer" Control.Tracer (Tracer, contramap, nullTracer, stdoutTracer)
4546
import qualified Data.ByteString.Lazy as LBS
46-
import Data.Void (Void)
47+
import Data.Void (Void, absurd)
4748
import Data.Word (Word16)
4849
import System.IO (hPutStrLn, stderr)
4950
import qualified System.Metrics as EKG
@@ -197,15 +198,11 @@ doConnectToAcceptor
197198
-> IO ()
198199
doConnectToAcceptor magic snocket makeBearer configureSocket address timeLimits
199200
ekgConfig tfConfig dpfConfig sink ekgStore dpStore = do
200-
connectToNode
201+
done <- connectToNode
201202
snocket
202203
makeBearer
204+
args
203205
configureSocket
204-
(codecHandshake forwardingVersionCodec)
205-
timeLimits
206-
(cborTermVersionDataCodec forwardingCodecCBORTerm)
207-
nullNetworkConnectTracers
208-
(HandshakeCallbacks acceptableVersion queryVersion)
209206
(simpleSingletonVersions
210207
ForwardingV_1
211208
(ForwardingVersionData magic)
@@ -217,7 +214,18 @@ doConnectToAcceptor magic snocket makeBearer configureSocket address timeLimits
217214
)
218215
Nothing
219216
address
217+
case done of
218+
Left err -> throwIO err
219+
Right choice -> case choice of
220+
Left () -> return ()
221+
Right void -> absurd void
220222
where
223+
args = ConnectToArgs {
224+
ctaHandshakeCodec = codecHandshake forwardingVersionCodec,
225+
ctaHandshakeTimeLimits = timeLimits,
226+
ctaVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm,
227+
ctaConnectTracers = nullNetworkConnectTracers,
228+
ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion }
221229
forwarderApp
222230
:: [(RunMiniProtocol 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void, Word16)]
223231
-> OuroborosApplication 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void

0 commit comments

Comments
 (0)