Add BehaviourSpec test for incremental commits

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -125,6 +125,66 @@ spec = parallel $ do
             waitUntil [n1] $ ReadyToFanout testHeadId
             send n1 Fanout
             waitUntil [n1] $ HeadIsFinalized{headId = testHeadId, utxo = utxoRef 1}
+    it "can request commit" $ shouldRunInSim $ do
+      withSimulatedChainAndNetwork $ \chain ->
+        withHydraNode aliceSk [bob] chain $ \n1 ->
+          withHydraNode bobSk [alice] chain $ \n2 -> do
+            openHead chain n1 n2
+
+            send n1 (Commit (utxoRef 42))
+            waitUntil [n1, n2] $
+              CommitRequested{headId = testHeadId, utxoToCommit = utxoRefs [42]}
+    it "requested commits get approved" $ shouldRunInSim $ do
+      withSimulatedChainAndNetwork $ \chain ->
+        withHydraNode aliceSk [bob] chain $ \n1 ->
+          withHydraNode bobSk [alice] chain $ \n2 -> do
+            openHead chain n1 n2
+            send n2 (Commit (utxoRef 33))
+            waitUntil [n1, n2] $
+              CommitRequested{headId = testHeadId, utxoToCommit = utxoRefs [33]}
+
+            waitUntilMatch [n1] $
+              \case
+                SnapshotConfirmed{snapshot = Snapshot{utxoToCommit}} ->
+                  maybe False (33 `member`) utxoToCommit
+                _ -> False
+
+            waitUntil [n1, n2] $ CommitApproved testHeadId (utxoRefs [33])
+
+            simulateIncrementalCommit chain
+
+            waitUntil [n1, n2] $ CommitFinalized testHeadId
+
+            send n1 GetUTxO
+            waitUntilMatch [n1] $
+              \case
+                GetUTxOResponse{headId, utxo} -> headId == testHeadId && member 33 utxo
+                _ -> False
+    it "can only process one commit at once" $ shouldRunInSim $ do
+      withSimulatedChainAndNetwork $ \chain ->
+        withHydraNode aliceSk [bob] chain $ \n1 ->
+          withHydraNode bobSk [alice] chain $ \n2 -> do
+            openHead chain n1 n2
+            let commitUTxO1 = utxoRef 1
+            send n2 (Commit{commitUTxO = commitUTxO1})
+            waitUntil [n1, n2] $
+              CommitRequested{headId = testHeadId, utxoToCommit = utxoRefs [1]}
+
+            let commitUTxO2 = utxoRef 2
+            send n1 (Commit{commitUTxO = commitUTxO2})
+            waitUntil [n1] $
+              CommitInvalid{headId = testHeadId, commitInvalidReason = UTxOAlreadyInFlight{incrementUTxO = commitUTxO1}}
+
+            simulateIncrementalCommit chain
+
+            waitUntil [n1, n2] $ CommitFinalized{headId = testHeadId}
+
+            send n1 (Commit{commitUTxO = commitUTxO2})
+            waitUntil [n1, n2] $ CommitApproved{headId = testHeadId, utxoToCommit = utxoRefs [2]}
+
+            simulateIncrementalCommit chain
+
+            waitUntil [n1, n2] $ CommitFinalized{headId = testHeadId}
 
   describe "Two participant Head" $ do
     it "only opens the head after all nodes committed" $