Use original ttl for ReqTx and ReqDec

TxInvalid is only produced after the ttl reaches zero. Some end to end
tests (and hence users) might depend on that happening after ~500ms as
before.

Author: ch1bo

hydra-cluster/test/Test/EndToEndSpec.hs

@@ -713,8 +713,7 @@ timedTx tmpDir tracer node@RunningNode{networkId, nodeSocket} hydraScriptsTxId =
     waitFor hydraTracer 3 [n1] $ output "HeadIsOpen" ["utxo" .= committedUTxOByAlice, "headId" .= headId]
 
     -- Acquire a current point in time
-    genesisParams <- queryGenesisParameters networkId nodeSocket QueryTip
-    let slotLengthSec = protocolParamSlotLength genesisParams
+    slotLengthSec <- protocolParamSlotLength <$> queryGenesisParameters networkId nodeSocket QueryTip
     currentSlot <- queryTipSlotNo networkId nodeSocket
 
     -- Create an arbitrary transaction using some input.

hydra-node/src/Hydra/Node.hs

@@ -53,7 +53,7 @@ import Hydra.Ledger (Ledger)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Network (Network (..), NetworkCallback (..))
 import Hydra.Network.Authenticate (Authenticated (..))
-import Hydra.Network.Message (Message, NetworkEvent (..))
+import Hydra.Network.Message (Message (..), NetworkEvent (..))
 import Hydra.Node.Environment (Environment (..))
 import Hydra.Node.InputQueue (InputQueue (..), Queued (..), createInputQueue)
 import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..))
@@ -230,14 +230,22 @@ wireClientInput node = enqueue . ClientInput
 wireNetworkInput :: DraftHydraNode tx m -> NetworkCallback (Authenticated (Message tx)) m
 wireNetworkInput node =
   NetworkCallback
-    { deliver = \Authenticated{payload, party} ->
-        enqueue $ NetworkInput defaultTTL $ ReceivedMessage{sender = party, msg = payload}
+    { deliver = \Authenticated{party = sender, payload = msg} ->
+        enqueue $ mkNetworkInput sender msg
     , onConnectivity =
-        enqueue . NetworkInput defaultTTL . ConnectivityEvent
+        enqueue . NetworkInput 1 . ConnectivityEvent
     }
  where
   DraftHydraNode{inputQueue = InputQueue{enqueue}} = node
 
+-- | Create a network input with corresponding default ttl from given sender.
+mkNetworkInput :: Party -> Message tx -> Input tx
+mkNetworkInput sender msg =
+  case msg of
+    ReqTx{} -> NetworkInput defaultTxTTL $ ReceivedMessage{sender, msg}
+    ReqDec{} -> NetworkInput defaultTxTTL $ ReceivedMessage{sender, msg}
+    _ -> NetworkInput defaultTTL $ ReceivedMessage{sender, msg}
+
 -- | Connect chain, network and API to a hydrated 'DraftHydraNode' to get a fully
 -- connected 'HydraNode'.
 connect ::
@@ -312,10 +320,16 @@ stepHydraNode node = do
 
   HydraNode{tracer, inputQueue = InputQueue{dequeue, reenqueue}, env} = node
 
--- | The maximum number of times to re-enqueue a 'Wait' outcome.
+-- | The maximum number of times to re-enqueue a network messages upon 'Wait'.
+-- outcome.
 defaultTTL :: TTL
 defaultTTL = 6000
 
+-- | The maximum number of times to re-enqueue 'ReqTx' and 'ReqDec' network
+-- messages upon 'Wait'.
+defaultTxTTL :: TTL
+defaultTxTTL = 5
+
 -- | The time to wait between re-enqueuing a 'Wait' outcome.
 waitDelay :: DiffTime
 waitDelay = 0.1

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -42,8 +42,8 @@ import Hydra.Ledger (Ledger, nextChainSlot)
 import Hydra.Ledger.Simple (SimpleChainState (..), SimpleTx (..), aValidTx, simpleLedger, utxoRef, utxoRefs)
 import Hydra.Logging (Tracer)
 import Hydra.Network (Network (..))
-import Hydra.Network.Message (Message, NetworkEvent (..))
-import Hydra.Node (DraftHydraNode (..), HydraNode (..), HydraNodeLog (..), connect, createNodeState, defaultTTL, queryHeadState, runHydraNode, waitDelay)
+import Hydra.Network.Message (Message)
+import Hydra.Node (DraftHydraNode (..), HydraNode (..), HydraNodeLog (..), connect, createNodeState, defaultTxTTL, mkNetworkInput, queryHeadState, runHydraNode, waitDelay)
 import Hydra.Node.DepositPeriod (DepositPeriod (..))
 import Hydra.Node.DepositPeriod qualified as DP
 import Hydra.Node.Environment (Environment (..))
@@ -338,7 +338,7 @@ spec = parallel $ do
                 -- Expect secondTx to be valid, but not applicable and stay pending
                 send n2 (NewTx secondTx)
                 -- If we wait too long, secondTx will expire
-                threadDelay $ fromIntegral defaultTTL * waitDelay + 1
+                threadDelay $ fromIntegral defaultTxTTL * waitDelay + 1
                 waitUntilMatch [n1, n2] $ \case
                   TxInvalid{transaction} -> guard $ transaction == secondTx
                   _ -> Nothing
@@ -1176,7 +1176,7 @@ createMockNetwork node nodes =
     mapM_ (`handleMessage` msg) allNodes
 
   handleMessage HydraNode{inputQueue} msg =
-    enqueue inputQueue . NetworkInput defaultTTL $ ReceivedMessage{sender, msg}
+    enqueue inputQueue $ mkNetworkInput sender msg
 
   sender = getParty node
 

hydra-node/test/Hydra/HeadLogicSpec.hs

@@ -55,7 +55,7 @@ import Hydra.Ledger.Cardano.TimeSpec (genUTCTime)
 import Hydra.Ledger.Simple (SimpleChainState (..), SimpleTx (..), aValidTx, simpleLedger, utxoRef, utxoRefs)
 import Hydra.Network (Connectivity)
 import Hydra.Network.Message (Message (..), NetworkEvent (..))
-import Hydra.Node (defaultTTL)
+import Hydra.Node (mkNetworkInput)
 import Hydra.Node.Environment (Environment (..))
 import Hydra.Options (defaultContestationPeriod, defaultDepositPeriod)
 import Hydra.Prelude qualified as Prelude
@@ -1015,16 +1015,15 @@ genClosedState = do
 
 -- * Utilities
 
--- | Create a network input about a received protocol message with 'defaultTTL'
+-- | Create a network input about a received protocol message with default ttl
 -- and 'alice' as the sender.
 receiveMessage :: Message tx -> Input tx
 receiveMessage = receiveMessageFrom alice
 
--- | Create a network input about a received protocol message with 'defaultTTL'
+-- | Create a network input about a received protocol message with default ttl
 -- from given sender.
 receiveMessageFrom :: Party -> Message tx -> Input tx
-receiveMessageFrom sender msg =
-  NetworkInput defaultTTL $ ReceivedMessage{sender, msg}
+receiveMessageFrom = mkNetworkInput
 
 -- | Create a chain effect with fixed chain state and slot.
 chainEffect :: PostChainTx SimpleTx -> Effect SimpleTx

hydra-node/test/Hydra/Model/MockChain.hs

@@ -70,8 +70,8 @@ import Hydra.Ledger.Cardano.Evaluate (eraHistoryWithoutHorizon, evaluateTx, rend
 import Hydra.Logging (Tracer)
 import Hydra.Model.Payment (CardanoSigningKey (..))
 import Hydra.Network (Network (..))
-import Hydra.Network.Message (Message, NetworkEvent (..))
-import Hydra.Node (DraftHydraNode (..), HydraNode (..), NodeState (..), connect, defaultTTL)
+import Hydra.Network.Message (Message (..))
+import Hydra.Node (DraftHydraNode (..), HydraNode (..), NodeState (..), connect, mkNetworkInput)
 import Hydra.Node.Environment (Environment (Environment, participants, party))
 import Hydra.Node.InputQueue (InputQueue (..))
 import Hydra.NodeSpec (mockServer)
@@ -360,8 +360,8 @@ createMockNetwork draftNode nodes =
     allNodes <- fmap node <$> readTVarIO nodes
     mapM_ (`handleMessage` msg) allNodes
 
-  handleMessage HydraNode{inputQueue} msg =
-    enqueue inputQueue . NetworkInput defaultTTL $ ReceivedMessage{sender, msg}
+  handleMessage HydraNode{inputQueue} msg = do
+    enqueue inputQueue $ mkNetworkInput sender msg
 
   sender = getParty draftNode