From 784531d1389c64ee3d7917b782385c2f536d217c Mon Sep 17 00:00:00 2001 From: Luke Nadur <19835357+intricate@users.noreply.github.com> Date: Thu, 26 Mar 2020 18:23:17 -0500 Subject: [PATCH 1/2] Trace TraceTxSubmissionOutboundSendMsgReplyTxs events after txs are sent --- .../Ouroboros/Network/Protocol/TxSubmission/Direct.hs | 3 ++- .../Ouroboros/Network/Protocol/TxSubmission/Examples.hs | 2 +- .../src/Ouroboros/Network/Protocol/TxSubmission/Client.hs | 6 +++--- .../src/Ouroboros/Network/TxSubmission/Outbound.hs | 6 +++--- 4 files changed, 9 insertions(+), 8 deletions(-) diff --git a/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Direct.hs b/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Direct.hs index 8002351fc90..3a1c94d7b10 100644 --- a/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Direct.hs +++ b/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Direct.hs @@ -53,7 +53,8 @@ directPipelined (TxSubmissionServerPipelined mserver) directSender q (SendMsgRequestTxsPipelined txids serverNext) ClientStIdle{recvMsgRequestTxs} = do server' <- serverNext - SendMsgReplyTxs txs client' <- recvMsgRequestTxs txids + SendMsgReplyTxs txs onTxsSent client' <- recvMsgRequestTxs txids + _ <- onTxsSent txs directSender (enqueue (CollectTxs txids txs) q) server' client' directSender q (CollectPipelined (Just server') _) client = diff --git a/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Examples.hs b/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Examples.hs index 7e1dbf0061f..5b471e8dbbd 100644 --- a/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Examples.hs +++ b/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Examples.hs @@ -141,7 +141,7 @@ txSubmissionClient tracer txId txSize maxUnacked = traceWith tracer (EventRecvMsgRequestTxs unackedSeq unackedMap remainingTxs txids) case [ txid | txid <- txids, txid `Map.notMember` unackedMap ] of - [] -> pure (SendMsgReplyTxs txs client') + [] -> pure (SendMsgReplyTxs txs (const $ pure ()) client') where txs = map (unackedMap Map.!) txids client' = client unackedSeq unackedMap' remainingTxs diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/TxSubmission/Client.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/TxSubmission/Client.hs index 3826d6fcacd..6a38b0351b9 100644 --- a/ouroboros-network/src/Ouroboros/Network/Protocol/TxSubmission/Client.hs +++ b/ouroboros-network/src/Ouroboros/Network/Protocol/TxSubmission/Client.hs @@ -80,6 +80,7 @@ data ClientStTxIds blocking txid tx m a where data ClientStTxs txid tx m a where SendMsgReplyTxs :: [tx] + -> ([tx] -> m ()) -> ClientStIdle txid tx m a -> ClientStTxs txid tx m a @@ -110,8 +111,7 @@ txSubmissionClientPeer (TxSubmissionClient client) = (Done TokDone result) MsgRequestTxs txids -> Effect $ do - SendMsgReplyTxs txs k <- recvMsgRequestTxs txids + SendMsgReplyTxs txs onTxsSent k <- recvMsgRequestTxs txids return $ Yield (ClientAgency TokTxs) (MsgReplyTxs txs) - (go k) - + (Effect $ onTxsSent txs >> return (go k)) diff --git a/ouroboros-network/src/Ouroboros/Network/TxSubmission/Outbound.hs b/ouroboros-network/src/Ouroboros/Network/TxSubmission/Outbound.hs index 9a9027138e1..180b5efca5c 100644 --- a/ouroboros-network/src/Ouroboros/Network/TxSubmission/Outbound.hs +++ b/ouroboros-network/src/Ouroboros/Network/TxSubmission/Outbound.hs @@ -189,7 +189,7 @@ txSubmissionOutbound tracer maxUnacked TxSubmissionMempoolReader{..} = !unackedMap' = foldl' (flip Map.delete) unackedMap txids client' = client unackedSeq unackedMap' lastIdx - -- Trace the transactions to be sent in the response. - traceWith tracer (TraceTxSubmissionOutboundSendMsgReplyTxs txs) + -- Trace the transactions to be sent in the response. + traceTxsSent = traceWith tracer . TraceTxSubmissionOutboundSendMsgReplyTxs - return $ SendMsgReplyTxs txs client' + return $ SendMsgReplyTxs txs traceTxsSent client' From f3e301e81a57c69c8e946179c40f44edfccc37e0 Mon Sep 17 00:00:00 2001 From: Luke Nadur <19835357+intricate@users.noreply.github.com> Date: Fri, 27 Mar 2020 01:28:13 -0500 Subject: [PATCH 2/2] Style 2 --- .../Ouroboros/Network/Protocol/TxSubmission/Direct.hs | 4 ++-- .../Ouroboros/Network/Protocol/TxSubmission/Examples.hs | 2 +- .../src/Ouroboros/Network/Protocol/TxSubmission/Client.hs | 7 +++---- .../src/Ouroboros/Network/TxSubmission/Outbound.hs | 4 ++-- 4 files changed, 8 insertions(+), 9 deletions(-) diff --git a/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Direct.hs b/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Direct.hs index 3a1c94d7b10..50e7212cfe4 100644 --- a/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Direct.hs +++ b/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Direct.hs @@ -53,8 +53,8 @@ directPipelined (TxSubmissionServerPipelined mserver) directSender q (SendMsgRequestTxsPipelined txids serverNext) ClientStIdle{recvMsgRequestTxs} = do server' <- serverNext - SendMsgReplyTxs txs onTxsSent client' <- recvMsgRequestTxs txids - _ <- onTxsSent txs + SendMsgReplyTxs txs mClient' <- recvMsgRequestTxs txids + client' <- mClient' directSender (enqueue (CollectTxs txids txs) q) server' client' directSender q (CollectPipelined (Just server') _) client = diff --git a/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Examples.hs b/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Examples.hs index 5b471e8dbbd..16759ba2799 100644 --- a/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Examples.hs +++ b/ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Examples.hs @@ -141,7 +141,7 @@ txSubmissionClient tracer txId txSize maxUnacked = traceWith tracer (EventRecvMsgRequestTxs unackedSeq unackedMap remainingTxs txids) case [ txid | txid <- txids, txid `Map.notMember` unackedMap ] of - [] -> pure (SendMsgReplyTxs txs (const $ pure ()) client') + [] -> pure (SendMsgReplyTxs txs (pure client')) where txs = map (unackedMap Map.!) txids client' = client unackedSeq unackedMap' remainingTxs diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/TxSubmission/Client.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/TxSubmission/Client.hs index 6a38b0351b9..dc8a8e194e4 100644 --- a/ouroboros-network/src/Ouroboros/Network/Protocol/TxSubmission/Client.hs +++ b/ouroboros-network/src/Ouroboros/Network/Protocol/TxSubmission/Client.hs @@ -80,8 +80,7 @@ data ClientStTxIds blocking txid tx m a where data ClientStTxs txid tx m a where SendMsgReplyTxs :: [tx] - -> ([tx] -> m ()) - -> ClientStIdle txid tx m a + -> m (ClientStIdle txid tx m a) -> ClientStTxs txid tx m a @@ -111,7 +110,7 @@ txSubmissionClientPeer (TxSubmissionClient client) = (Done TokDone result) MsgRequestTxs txids -> Effect $ do - SendMsgReplyTxs txs onTxsSent k <- recvMsgRequestTxs txids + SendMsgReplyTxs txs k <- recvMsgRequestTxs txids return $ Yield (ClientAgency TokTxs) (MsgReplyTxs txs) - (Effect $ onTxsSent txs >> return (go k)) + (Effect $ k >>= return . go) diff --git a/ouroboros-network/src/Ouroboros/Network/TxSubmission/Outbound.hs b/ouroboros-network/src/Ouroboros/Network/TxSubmission/Outbound.hs index 180b5efca5c..2f720c1f8ce 100644 --- a/ouroboros-network/src/Ouroboros/Network/TxSubmission/Outbound.hs +++ b/ouroboros-network/src/Ouroboros/Network/TxSubmission/Outbound.hs @@ -190,6 +190,6 @@ txSubmissionOutbound tracer maxUnacked TxSubmissionMempoolReader{..} = client' = client unackedSeq unackedMap' lastIdx -- Trace the transactions to be sent in the response. - traceTxsSent = traceWith tracer . TraceTxSubmissionOutboundSendMsgReplyTxs + traceTxsSent = traceWith tracer (TraceTxSubmissionOutboundSendMsgReplyTxs txs) - return $ SendMsgReplyTxs txs traceTxsSent client' + return $ SendMsgReplyTxs txs (traceTxsSent >> pure client')