Add HeadLogicSpec tests for incremental commits

hydra-node/test/Hydra/HeadLogicSpec.hs

@@ -123,6 +123,92 @@ spec =
             getState
         getConfirmedSnapshot snapshotConfirmed `shouldBe` Just snapshot1
 
+        describe "Commit" $ do
+          it "observes CommitRequested and ReqInc in an Open state" $
+            let utxo = utxoRef 1
+                reqInc = ReqInc{incrementUTxO = utxo, commitRequester = alice}
+                event = NetworkEvent defaultTTL alice reqInc
+                st = inOpenState threeParties
+                outcome = update aliceEnv ledger st event
+             in outcome
+                  `hasEffectSatisfying` \case
+                    ClientEffect CommitRequested{headId, utxoToCommit} ->
+                      headId == testHeadId && utxoToCommit == utxo
+                    NetworkEffect ReqInc{incrementUTxO, commitRequester} ->
+                      incrementUTxO == utxo && commitRequester == alice
+                    _ -> False
+
+          it "ignores ReqInc when not in Open state" $ monadicIO $ do
+            let reqInc = ReqInc{incrementUTxO = utxoRef 1, commitRequester = alice}
+            let event = NetworkEvent defaultTTL alice reqInc
+            st <- pickBlind $ oneof $ pure <$> [inInitialState threeParties, inIdleState, inClosedState threeParties]
+            pure $
+              update aliceEnv ledger st event
+                `shouldNotBe` Effects [NetworkEffect reqInc]
+
+          it "cannot request commit when another one is in flight" $ do
+            let utxo1 = utxoRef 1
+                utxo2 = utxoRef 2
+                reqInc1 = ReqInc{incrementUTxO = utxo1, commitRequester = alice}
+                reqInc2 = ReqInc{incrementUTxO = utxo2, commitRequester = bob}
+                reqIncEvent1 = NetworkEvent defaultTTL alice reqInc1
+                reqIncEvent2 = NetworkEvent defaultTTL bob reqInc2
+                s0 = inOpenState threeParties
+
+            s1 <- runEvents aliceEnv ledger s0 $ do
+              step reqIncEvent1
+              getState
+
+            let outcome = update bobEnv ledger s1 reqIncEvent2
+
+            outcome `shouldSatisfy` \case
+              Error (RequireFailed CommitInFlight{commitUTxO = commitUTxO''}) ->
+                utxo1 == commitUTxO''
+              _ -> False
+
+          it "updates commitTx on valid ReqInc" $ do
+            let utxo = utxoRef 1
+            let reqInc = ReqInc{incrementUTxO = utxo, commitRequester = alice}
+                reqIncEvent = NetworkEvent defaultTTL alice reqInc
+                s0 = inOpenState threeParties
+
+            s0 `shouldSatisfy` \case
+              (Open OpenState{coordinatedHeadState = CoordinatedHeadState{commitUTxO}}) -> isNothing commitUTxO
+              _ -> False
+
+            s1 <- runEvents aliceEnv ledger s0 $ do
+              step reqIncEvent
+              getState
+
+            s1 `shouldSatisfy` \case
+              (Open OpenState{coordinatedHeadState = CoordinatedHeadState{commitUTxO}}) -> commitUTxO == Just utxo
+              _ -> False
+
+            -- running the 'ReqDec' again should not alter the recorded state
+            s2 <- runEvents aliceEnv ledger s1 $ do
+              step reqIncEvent
+              getState
+
+            s2 `shouldSatisfy` \case
+              (Open OpenState{coordinatedHeadState = CoordinatedHeadState{commitUTxO}}) -> commitUTxO == Just utxo
+              _ -> False
+
+          it "emits ReqSn on valid RecInc" $ do
+            let utxo = utxoRefs [4]
+            let s0 = inOpenState threeParties
+
+            s0 `shouldSatisfy` \case
+              (Open OpenState{coordinatedHeadState = CoordinatedHeadState{commitUTxO}}) -> isNothing commitUTxO
+              _ -> False
+
+            let reqIncEvent = NetworkEvent defaultTTL alice ReqInc{incrementUTxO = utxo, commitRequester = alice}
+            let reqSn = ReqSn{snapshotNumber = 1, transactionIds = [], commitUTxO = Just utxo, decommitTx = Nothing}
+
+            let s1 = update aliceEnv ledger s0 reqIncEvent
+            s1 `hasEffect` NetworkEffect reqSn
+
+
+
       describe "Tracks Transaction Ids" $ do
         it "keeps transactions in allTxs given it receives a ReqTx" $ do
           let s0 = inOpenState threeParties