simulation: fix Relay protocol message size, now runs on ChanTCP too

input-output-hk · Dec 19, 2024 · 518cfd9 · 518cfd9
1 parent 58063dd
commit 518cfd9
Show file tree

Hide file tree

Showing 3 changed files with 14 additions and 14 deletions.
diff --git a/simulation/src/ChanTCP.hs b/simulation/src/ChanTCP.hs
@@ -172,7 +172,7 @@ transport tracer tcpprops sendbuf recvbuf = do
             }
           , tcpforecasts
           , tcpstate''
-          ) = forecastTcpMsgSend tcpprops tcpstate' now' msgsize
+          ) = assert (msgsize > 0) $ forecastTcpMsgSend tcpprops tcpstate' now' msgsize
 
     -- schedule the arrival, and wait until it has finished sending
     atomically $ modifyTVar' recvbuf (PQ.insert msgRecvTrailingEdge msg)

diff --git a/simulation/src/LeiosProtocol/Relay.hs b/simulation/src/LeiosProtocol/Relay.hs
@@ -356,10 +356,10 @@ instance
   where
   messageSizeBytes MsgInit = 1
   messageSizeBytes (MsgRequestHeaders blocking expand shrink) =
-    messageSizeBytes blocking + finiteByteSize expand + finiteByteSize shrink
-  messageSizeBytes (MsgRespondHeaders headers) = messageSizeBytes headers
-  messageSizeBytes (MsgRequestBodies ids) = sum $ map messageSizeBytes ids
-  messageSizeBytes (MsgRespondBodies bodies) = sum $ map messageSizeBytes bodies
+    1 + messageSizeBytes blocking + finiteByteSize expand + finiteByteSize shrink
+  messageSizeBytes (MsgRespondHeaders headers) = 1 + messageSizeBytes headers
+  messageSizeBytes (MsgRequestBodies ids) = 1 + sum (map messageSizeBytes ids)
+  messageSizeBytes (MsgRespondBodies bodies) = 1 + sum (map messageSizeBytes bodies)
   messageSizeBytes MsgDone = 1
 
 relayMessageLabel :: Message (RelayState id header body) st st' -> String

diff --git a/simulation/src/LeiosProtocol/SimTestRelay.hs b/simulation/src/LeiosProtocol/SimTestRelay.hs
@@ -286,7 +286,7 @@ traceRelayLink1 tcpprops generationPattern =
           ( Set.fromList
               [(NodeId 0, NodeId 1), (NodeId 1, NodeId 0)]
           )
-      (TestRelayBundle inChan, TestRelayBundle outChan) <- newConnectionBundleTCP (linkTracer na nb) tcpprops
+      (inChan, outChan) <- newConnectionTCP (linkTracer na nb) tcpprops
       concurrently_
         (relayNode (nodeTracer na) configNode0 [] [inChan])
         (relayNode (nodeTracer nb) configNode1 [outChan] [])
@@ -339,10 +339,10 @@ traceRelayLink4 tcpprops generationPattern =
                 , (NodeId 2, NodeId 3)
                 ]
           )
-      (TestRelayBundle a2bInChan, TestRelayBundle a2bOutChan) <- newConnectionBundleTCP (linkTracer na nb) tcpprops
-      (TestRelayBundle a2cInChan, TestRelayBundle a2cOutChan) <- newConnectionBundleTCP (linkTracer na nc) tcpprops
-      (TestRelayBundle b2dInChan, TestRelayBundle b2dOutChan) <- newConnectionBundleTCP (linkTracer nb nd) tcpprops
-      (TestRelayBundle c2dInChan, TestRelayBundle c2dOutChan) <- newConnectionBundleTCP (linkTracer nc nd) tcpprops
+      (a2bInChan, a2bOutChan) <- newConnectionTCP (linkTracer na nb) tcpprops
+      (a2cInChan, a2cOutChan) <- newConnectionTCP (linkTracer na nc) tcpprops
+      (b2dInChan, b2dOutChan) <- newConnectionTCP (linkTracer nb nd) tcpprops
+      (c2dInChan, c2dOutChan) <- newConnectionTCP (linkTracer nc nd) tcpprops
       let generator n = relayNode (nodeTracer n) configGen
           relay n = relayNode (nodeTracer n) configRelay
       runConcurrently $
@@ -401,10 +401,10 @@ traceRelayLink4Asymmetric tcppropsShort tcppropsLong generationPattern =
                 , (NodeId 2, NodeId 3)
                 ]
           )
-      (TestRelayBundle a2bInChan, TestRelayBundle a2bOutChan) <- newConnectionBundleTCP (linkTracer na nb) tcppropsLong
-      (TestRelayBundle a2cInChan, TestRelayBundle a2cOutChan) <- newConnectionBundleTCP (linkTracer na nc) tcppropsShort
-      (TestRelayBundle b2dInChan, TestRelayBundle b2dOutChan) <- newConnectionBundleTCP (linkTracer nb nd) tcppropsLong
-      (TestRelayBundle c2dInChan, TestRelayBundle c2dOutChan) <- newConnectionBundleTCP (linkTracer nc nd) tcppropsShort
+      (a2bInChan, a2bOutChan) <- newConnectionTCP (linkTracer na nb) tcppropsLong
+      (a2cInChan, a2cOutChan) <- newConnectionTCP (linkTracer na nc) tcppropsShort
+      (b2dInChan, b2dOutChan) <- newConnectionTCP (linkTracer nb nd) tcppropsLong
+      (c2dInChan, c2dOutChan) <- newConnectionTCP (linkTracer nc nd) tcppropsShort
       let generator n = relayNode (nodeTracer n) configGen
           relay n = relayNode (nodeTracer n) configRelay
       runConcurrently $