o-network integration

IntersectMBO · Dec 5, 2024 · abd035b · abd035b
1 parent 314e9af
commit abd035b
Show file tree

Hide file tree

Showing 3 changed files with 56 additions and 31 deletions.
diff --git 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,22 +100,30 @@ 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)
        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
@@ -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
@@ -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