Wait on applicable decommit tx

If there is another decommit _in flight_ wait for TTL to expire before erroring out. Also remove the red color from the spec
input-output-hk · May 7, 2024 · cc883ed · cc883ed
1 parent 384f923
commit cc883ed
Show file tree

Hide file tree

Showing 4 changed files with 26 additions and 21 deletions.
diff --git a/hydra-node/src/Hydra/HeadLogic.hs b/hydra-node/src/Hydra/HeadLogic.hs
@@ -684,25 +684,31 @@ onOpenClientDecommit env headId ledger currentSlot coordinatedHeadState decommit
 onOpenNetworkReqDec ::
   IsTx tx =>
   Environment ->
+  TTL ->
   OpenState tx ->
   tx ->
   Outcome tx
-onOpenNetworkReqDec env openState decommitTx =
-  case mExistingDecommitTx of
-    Just existingDecommitTx ->
-      Error $ RequireFailed $ DecommitTxInFlight{decommitTx = existingDecommitTx}
-    Nothing ->
-      let decommitUTxO = utxoFromTx decommitTx
-       in newState (DecommitRecorded decommitTx)
-            <> causes
-              [ ClientEffect $ ServerOutput.DecommitRequested headId decommitUTxO
-              ]
-            <> if isLeader parameters party nextSn
-              then
-                causes
-                  [NetworkEffect (ReqSn nextSn (txId <$> localTxs) (Just decommitTx))]
-              else Error $ RequireFailed $ ReqSnNotLeader{requestedSn = nextSn, leader = party}
+onOpenNetworkReqDec env ttl openState decommitTx =
+  waitOnApplicableDecommit $
+    let decommitUTxO = utxoFromTx decommitTx
+     in StateChanged (DecommitRecorded decommitTx)
+          <> Effects
+            [ ClientEffect $ ServerOutput.DecommitRequested headId decommitUTxO
+            ]
+          <> if isLeader parameters party nextSn
+            then
+              Effects
+                [NetworkEffect (ReqSn nextSn (txId <$> localTxs) (Just decommitTx))]
+            else Error $ RequireFailed $ ReqSnNotLeader{requestedSn = nextSn, leader = party}
  where
+  waitOnApplicableDecommit cont =
+    case mExistingDecommitTx of
+      Nothing -> cont
+      Just existingDecommitTx
+        | ttl > 0 ->
+            Wait $ WaitOnNotApplicableDecommitTx decommitTx
+        | otherwise ->
+            Error $ RequireFailed $ DecommitTxInFlight{decommitTx = existingDecommitTx}
   Environment{party} = env
 
   Snapshot{number} = getSnapshot confirmedSnapshot
@@ -906,7 +912,7 @@ update env ledger st ev = case (st, ev) of
   (Open OpenState{headId, coordinatedHeadState, currentSlot}, ClientInput Decommit{decommitTx}) -> do
     onOpenClientDecommit env headId ledger currentSlot coordinatedHeadState decommitTx
   (Open openState, NetworkInput _ _ (ReqDec{transaction})) ->
-    onOpenNetworkReqDec env openState transaction
+    onOpenNetworkReqDec env ttl openState transaction
   ( Open OpenState{headId = ourHeadId}
     , ChainInput Observation{observedTx = OnDecrementTx{headId}}
     )

diff --git a/hydra-node/src/Hydra/HeadLogic/Outcome.hs b/hydra-node/src/Hydra/HeadLogic/Outcome.hs
@@ -158,6 +158,7 @@ data WaitReason tx
   | WaitOnSeenSnapshot
   | WaitOnTxs {waitingForTxIds :: [TxIdType tx]}
   | WaitOnContestationDeadline
+  | WaitOnNotApplicableDecommitTx { waitingOnDecommitTx :: tx}
   deriving stock (Generic)
 
 deriving stock instance IsTx tx => Eq (WaitReason tx)

diff --git a/hydra-node/test/Hydra/HeadLogicSpec.hs b/hydra-node/test/Hydra/HeadLogicSpec.hs
@@ -158,7 +158,7 @@ spec =
                 NetworkEffect reqDec' -> reqDec' == reqDec
                 _ -> False
 
-        it "cannot request decommit when another one is in flight" $ do
+        it "wait for second decommit when another one is in flight" $ do
           let decommitTx1 = SimpleTx 1 mempty (utxoRef 1)
               decommitTx2 = SimpleTx 2 mempty (utxoRef 2)
               reqDec1 = ReqDec{transaction = decommitTx1, decommitRequester = alice}
@@ -174,8 +174,8 @@ spec =
           let outcome = update bobEnv ledger s1 reqDecEvent2
 
           outcome `shouldSatisfy` \case
-            Error (RequireFailed DecommitTxInFlight{decommitTx = decommitTx''}) ->
-              decommitTx1 == decommitTx''
+            Wait (WaitOnNotApplicableDecommitTx{waitingOnDecommitTx = decommitTx''}) ->
+              decommitTx2 == decommitTx''
             _ -> False
 
         it "updates decommitTx on valid ReqDec" $ do

diff --git a/spec/fig_offchain_prot.tex b/spec/fig_offchain_prot.tex
@@ -136,7 +136,6 @@
 
 						%%% REC DEC
 						\On{$(\mathtt{reqDec},\tx)$ from $\party_j$}{
-						    \textcolor{red}{
 							\Wait{$\tx_\omega = \bot ~ \land ~ \barmU \applytx \tx \not= \bot$}{
 							  \textcolor{black}{
 								$\tx_\omega \gets \tx$ \;
@@ -147,7 +146,6 @@
 								}
 							  }
 							}
-							}
 						}
 
 						\vspace{12pt}