add commit observation test

hydra-node/test/Hydra/Chain/Direct/StateSpec.hs

@@ -200,6 +200,37 @@ spec = parallel $ do
     propBelowSizeLimit maxTxSize forAllCommit
     propIsValid forAllCommit
 
+    it "only proper head is observed" $
+      forAllCommit' $ \ctx st committedUtxo tx ->
+        monadicIO $ do
+          let originalIsObserved = property $ isJust $ observeCommit ctx st tx
+--          (mutation, cex, expected) <- pickBlind $ genInitTxMutation seedInput tx
+          let utxo = getKnownUTxO st <> committedUtxo
+          let (tx', utxo') = id (tx, utxo)
+              -- We expected mutated transaction to still be valid, but not observed.
+              mutatedIsValid =
+                case evaluateTx tx' utxo' of
+                  Left err -> property False & counterexample (show err)
+                  Right ok
+                    | all isRight ok -> property True
+                    | otherwise -> property False & counterexample (show ok)
+              mutatedIsNotObserved =
+                observeCommit ctx st tx' === Nothing
+
+          pure $
+            conjoin
+              [ originalIsObserved
+                  & counterexample (renderTx tx)
+                  & counterexample "Original transaction is not observed."
+              , mutatedIsValid
+                  & counterexample (renderTx tx')
+                  & counterexample "Mutated transaction is not valid."
+              , mutatedIsNotObserved
+                  & counterexample (renderTx tx')
+                  & counterexample "Should not observe mutated transaction"
+              ]
+
+
     prop "consumes all inputs that are committed" $
       forAllCommit' $ \ctx st _ tx ->
         case observeCommit ctx st tx of
@@ -432,9 +463,9 @@ forAllCommit' ::
   (ChainContext -> InitialState -> UTxO -> Tx -> property) ->
   Property
 forAllCommit' action = do
-  forAll (genHydraContext maximumNumberOfParties) $ \hctx ->
-    forAll (genStInitial hctx) $ \(ctx, stInitial) ->
-      forAllShow genCommit renderUTxO $ \toCommit ->
+  forAllBlind (genHydraContext maximumNumberOfParties) $ \hctx ->
+    forAllBlind (genStInitial hctx) $ \(ctx, stInitial) ->
+      forAllBlind genCommit $ \toCommit ->
         -- TODO: generate script inputs here?
         let tx = unsafeCommit ctx stInitial toCommit
          in action ctx stInitial toCommit tx
@@ -444,7 +475,6 @@ forAllCommit' action = do
               & classify
                 (not (null toCommit))
                 "Non-empty commit"
-              & counterexample ("tx: " <> renderTx tx)
 
 forAllAbort ::
   Testable property =>