From 81ce4ed688f2142994b591e0c7cd9e68616b33b4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= <marcin.wojtowicz@iohk.io>
Date: Tue, 13 Aug 2024 11:36:28 +0200
Subject: [PATCH] TxSubmission - delay initial request for transactions

This change delays initial request for transactions from the client,
whom may disconnect relatively quickly for reasons described in
IntersectMBO/ouroboros-network issue #4927.
---
 .../src/Ouroboros/Network/TxSubmission/Inbound.hs      | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound.hs b/ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound.hs
index a9c1f64652c..645a79e5bb5 100644
--- a/ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound.hs
+++ b/ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE KindSignatures      #-}
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
 
 {-# OPTIONS_GHC -Wno-partial-fields #-}
 
@@ -20,6 +21,7 @@ import Data.Foldable (foldl', toList)
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
+import Data.Maybe
 import Data.Sequence.Strict (StrictSeq)
 import Data.Sequence.Strict qualified as Seq
 import Data.Set qualified as Set
@@ -34,11 +36,13 @@ import Control.Exception (assert)
 import Control.Monad (unless)
 import Control.Monad.Class.MonadSTM
 import Control.Monad.Class.MonadThrow
+import Control.Monad.Class.MonadTimer
 import Control.Tracer (Tracer, traceWith)
 
 import Network.TypedProtocol.Pipelined (N, Nat (..), natToInt)
 
 import Ouroboros.Network.NodeToNode.Version (NodeToNodeVersion)
+import Ouroboros.Network.Protocol.Limits
 import Ouroboros.Network.Protocol.TxSubmission2.Server
 import Ouroboros.Network.TxSubmission.Mempool.Reader (MempoolSnapshot (..),
            TxSubmissionMempoolReader (..))
@@ -175,6 +179,7 @@ txSubmissionInbound
      , NoThunks tx
      , MonadSTM m
      , MonadThrow m
+     , MonadDelay m
      )
   => Tracer m (TraceTxSubmissionInbound txid tx)
   -> Word16         -- ^ Maximum number of unacknowledged txids allowed
@@ -183,7 +188,10 @@ txSubmissionInbound
   -> NodeToNodeVersion
   -> TxSubmissionServerPipelined txid tx m ()
 txSubmissionInbound tracer maxUnacked mpReader mpWriter _version =
-    TxSubmissionServerPipelined $
+    TxSubmissionServerPipelined $ do
+      -- make the client linger before asking for tx's and expending
+      -- our resources as well, as he may disconnect for some reason
+      threadDelay (round @Double . realToFrac . fromMaybe (-1) $ longWait)
       continueWithStateM (serverIdle Zero) initialServerState
   where
     -- TODO #1656: replace these fixed limits by policies based on