Add headId to OnChainTx

This was the last step to make all e2e tests green (two heads on the same network turned out to be flaky).
cardano-scaling · Dec 8, 2023 · 6b5f8c4 · 6b5f8c4
1 parent ce00931
commit 6b5f8c4
Show file tree

Hide file tree

Showing 9 changed files with 23 additions and 19 deletions.
diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs
@@ -145,8 +145,8 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
 
                 externalCommit node aliceChain aliceExternalSk aliceHeadId aliceUTxO
 
-                aliceChain `observesInTime` OnCommitTx alice aliceUTxO
-                bobChain `observesInTime` OnCommitTx alice aliceUTxO
+                aliceChain `observesInTime` OnCommitTx aliceHeadId alice aliceUTxO
+                bobChain `observesInTime` OnCommitTx bobHeadId alice aliceUTxO
 
                 postTx $ AbortTx{utxo = aliceUTxO, headSeed = aliceHeadSeed}
                 --
@@ -226,7 +226,7 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
             newAliceUTxO <- seedFromFaucet node aliceExternalVk 1_000_000 (contramap FromFaucet tracer)
 
             externalCommit node aliceChain aliceExternalSk headId newAliceUTxO
-            aliceChain `observesInTime` OnCommitTx alice newAliceUTxO
+            aliceChain `observesInTime` OnCommitTx headId alice newAliceUTxO
 
   it "can commit empty UTxO" $ \tracer -> do
     withTempDir "hydra-cluster" $ \tmp -> do
@@ -247,7 +247,7 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
 
             (_, aliceExternalSk) <- generate genKeyPair
             externalCommit node aliceChain aliceExternalSk headId mempty
-            aliceChain `observesInTime` OnCommitTx alice mempty
+            aliceChain `observesInTime` OnCommitTx headId alice mempty
 
   it "can open, close & fanout a Head" $ \tracer -> do
     withTempDir "hydra-cluster" $ \tmp -> do
@@ -269,7 +269,7 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
             (headId, headSeed) <- aliceChain `observesInTimeSatisfying` hasInitTxWith headParameters participants
 
             externalCommit node aliceChain aliceExternalSk headId someUTxO
-            aliceChain `observesInTime` OnCommitTx alice someUTxO
+            aliceChain `observesInTime` OnCommitTx headId alice someUTxO
 
             postTx $ CollectComTx someUTxO headId headParameters
             aliceChain `observesInTime` OnCollectComTx{headId}
@@ -397,7 +397,7 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
             headId <- fst <$> aliceChain `observesInTimeSatisfying` hasInitTxWith headParameters participants
 
             externalCommit node aliceChain aliceExternalSk headId someUTxO
-            aliceChain `observesInTime` OnCommitTx alice someUTxO
+            aliceChain `observesInTime` OnCommitTx headId alice someUTxO
 
             postTx $ CollectComTx someUTxO headId headParameters
             -- Head is open with someUTxO

diff --git a/hydra-node/json-schemas/logs.yaml b/hydra-node/json-schemas/logs.yaml
@@ -1757,6 +1757,7 @@ definitions:
         additionalProperties: false
         required:
           - tag
+          - headId
           - party
           - committed
         description: >-
@@ -1766,6 +1767,8 @@ definitions:
           tag:
             type: string
             enum: ["OnCommitTx"]
+          headId:
+            $ref: "api.yaml#/components/schemas/HeadId"
           party:
             $ref: "api.yaml#/components/schemas/Party"
           committed:

diff --git a/hydra-node/src/Hydra/Chain.hs b/hydra-node/src/Hydra/Chain.hs
@@ -95,7 +95,7 @@ data OnChainTx tx
       , headParameters :: HeadParameters
       , participants :: [OnChainId]
       }
-  | OnCommitTx {party :: Party, committed :: UTxOType tx}
+  | OnCommitTx {headId :: HeadId, party :: Party, committed :: UTxOType tx}
   | OnAbortTx {headId :: HeadId}
   | OnCollectComTx {headId :: HeadId}
   | OnCloseTx

diff --git a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs
@@ -320,8 +320,8 @@ convertObservation = \case
         }
   Abort AbortObservation{headId} ->
     pure OnAbortTx{headId}
-  Commit CommitObservation{party, committed} ->
-    pure OnCommitTx{party, committed}
+  Commit CommitObservation{headId, party, committed} ->
+    pure OnCommitTx{headId, party, committed}
   CollectCom CollectComObservation{headId} ->
     pure OnCollectComTx{headId}
   Close CloseObservation{headId, snapshotNumber, threadOutput = ClosedThreadOutput{closedContestationDeadline}} ->

diff --git a/hydra-node/src/Hydra/Chain/Direct/State.hs b/hydra-node/src/Hydra/Chain/Direct/State.hs
@@ -681,7 +681,7 @@ observeCommit ctx st tx = do
   observation <- observeCommitTx networkId utxo tx
   let CommitObservation{commitOutput, party, committed, headId = commitHeadId} = observation
   guard $ commitHeadId == headId
-  let event = OnCommitTx{party, committed}
+  let event = OnCommitTx{headId, party, committed}
   let st' =
         st
           { initialInitials =

diff --git a/hydra-node/src/Hydra/HeadLogic.hs b/hydra-node/src/Hydra/HeadLogic.hs
@@ -692,8 +692,9 @@ update env ledger st ev = case (st, ev) of
     onIdleClientInit env
   (Idle _, OnChainEvent Observation{observedTx = OnInitTx{headId, headSeed, headParameters, participants}, newChainState}) ->
     onIdleChainInitTx env newChainState headId headSeed headParameters participants
-  (Initial initialState, OnChainEvent Observation{observedTx = OnCommitTx{party = pt, committed = utxo}, newChainState}) ->
-    onInitialChainCommitTx initialState newChainState pt utxo
+  (Initial initialState@InitialState{headId = ourHeadId}, OnChainEvent Observation{observedTx = OnCommitTx{headId, party = pt, committed = utxo}, newChainState})
+    | ourHeadId == headId -> onInitialChainCommitTx initialState newChainState pt utxo
+    | otherwise -> Error NotOurHead{ourHeadId, otherHeadId = headId}
   (Initial initialState, ClientEvent Abort) ->
     onInitialClientAbort initialState
   (Initial initialState@InitialState{headId = ourHeadId}, OnChainEvent Observation{observedTx = OnCollectComTx{headId}, newChainState})

diff --git a/hydra-node/test/Hydra/BehaviorSpec.hs b/hydra-node/test/Hydra/BehaviorSpec.hs
@@ -616,7 +616,7 @@ simulatedChainAndNetwork initialChainState = do
       , tickThread
       , rollbackAndForward = rollbackAndForward nodes history localChainState
       , simulateCommit = \(party, committed) ->
-          createAndYieldEvent nodes history localChainState $ OnCommitTx{party, committed}
+          createAndYieldEvent nodes history localChainState $ OnCommitTx{headId = testHeadId, party, committed}
       }
  where
   -- seconds

diff --git a/hydra-node/test/Hydra/HeadLogicSpec.hs b/hydra-node/test/Hydra/HeadLogicSpec.hs
@@ -358,9 +358,9 @@ spec =
         update bobEnv ledger s0 event `shouldBe` Error (InvalidEvent event s0)
 
       it "everyone does collect on last commit after collect com" $ do
-        let aliceCommit = OnCommitTx alice (utxoRef 1)
-            bobCommit = OnCommitTx bob (utxoRef 2)
-            carolCommit = OnCommitTx carol (utxoRef 3)
+        let aliceCommit = OnCommitTx testHeadId alice (utxoRef 1)
+            bobCommit = OnCommitTx testHeadId bob (utxoRef 2)
+            carolCommit = OnCommitTx testHeadId carol (utxoRef 3)
         waitingForLastCommit <-
           runEvents bobEnv ledger (inInitialState threeParties) $ do
             step (observeEventAtSlot 1 aliceCommit)

diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs
@@ -206,9 +206,9 @@ isReqSn = \case
 eventsToOpenHead :: [Event SimpleTx]
 eventsToOpenHead =
   [ observationEvent $ OnInitTx testHeadId testHeadSeed headParameters participants
-  , observationEvent $ OnCommitTx carol (utxoRef 3)
-  , observationEvent $ OnCommitTx bob (utxoRef 2)
-  , observationEvent $ OnCommitTx alice (utxoRef 1)
+  , observationEvent $ OnCommitTx testHeadId carol (utxoRef 3)
+  , observationEvent $ OnCommitTx testHeadId bob (utxoRef 2)
+  , observationEvent $ OnCommitTx testHeadId alice (utxoRef 1)
   , observationEvent $ OnCollectComTx testHeadId
   ]
  where