Add more tests on event ids being strictly monotonic

hydra-node/test/Hydra/API/ServerSpec.hs

@@ -46,6 +46,7 @@ import Test.Hydra.Fixture (alice, testHeadId)
 import Test.Network.Ports (withFreePort)
 import Test.QuickCheck (checkCoverage, cover, generate)
 import Test.QuickCheck.Monadic (monadicIO, monitor, pick, run)
+import Test.Util (isContinuous)
 
 spec :: Spec
 spec =
@@ -212,7 +213,7 @@ spec =
               waitMatch 5 conn $ \v ->
                 guard $ isNothing $ v ^? key "utxo"
 
-    it "sequence numbers are continuous and strictly monotonically increasing" $
+    it "sequence numbers are continuous" $
       monadicIO $ do
         outputs :: [ServerOutput SimpleTx] <- pick arbitrary
         run $
@@ -226,7 +227,7 @@ spec =
                   case traverse Aeson.eitherDecode received of
                     Left{} -> failure $ "Failed to decode messages:\n" <> show received
                     Right (timedOutputs :: [TimedServerOutput SimpleTx]) ->
-                      seq <$> timedOutputs `shouldSatisfy` strictlyMonotonic
+                      seq <$> timedOutputs `shouldSatisfy` isContinuous
 
     it "displays correctly headStatus and snapshotUtxo in a Greeting message" $
       showLogsOnFailure "ServerSpec" $ \tracer ->
@@ -305,12 +306,6 @@ spec =
         withFreePort $
           \port -> sendsAnErrorWhenInputCannotBeDecoded port
 
-strictlyMonotonic :: (Eq a, Enum a) => [a] -> Bool
-strictlyMonotonic = \case
-  [] -> True
-  [_] -> True
-  (a : b : as) -> succ a == b && strictlyMonotonic (b : as)
-
 sendsAnErrorWhenInputCannotBeDecoded :: PortNumber -> Expectation
 sendsAnErrorWhenInputCannotBeDecoded port = do
   showLogsOnFailure "ServerSpec" $ \tracer ->

hydra-node/test/Hydra/Node/InputQueueSpec.hs

@@ -3,11 +3,11 @@ module Hydra.Node.InputQueueSpec where
 import Hydra.Prelude
 
 import Control.Monad.IOSim (IOSim, runSimOrThrow)
-import Hydra.API.ServerSpec (strictlyMonotonic)
 import Hydra.Node.InputQueue (Queued (queuedId), createInputQueue, dequeue, enqueue)
 import Test.Hspec (Spec)
 import Test.Hspec.QuickCheck (prop)
 import Test.QuickCheck (NonEmptyList (NonEmpty), Property, counterexample)
+import Test.Util (isContinuous)
 
 spec :: Spec
 spec =
@@ -25,5 +25,5 @@ prop_identify_enqueued_items (NonEmpty inputs) =
           enqueue q i
           queuedId <$> dequeue q
       ids = runSimOrThrow test
-   in strictlyMonotonic ids
+   in isContinuous ids
         & counterexample ("queued ids: " <> show ids)

hydra-node/test/Hydra/NodeSpec.hs

@@ -15,7 +15,7 @@ import Hydra.ContestationPeriod (ContestationPeriod (..))
 import Hydra.Crypto (HydraKey, sign)
 import Hydra.Environment (Environment (..))
 import Hydra.Environment qualified as Environment
-import Hydra.Events (EventSink (..), EventSource (..))
+import Hydra.Events (EventSink (..), EventSource (..), getEventId)
 import Hydra.HeadLogic (Input (..), defaultTTL)
 import Hydra.HeadLogic.Outcome (StateChanged (HeadInitialized), genStateChanged)
 import Hydra.HeadLogicSpec (inInitialState, testSnapshot)
@@ -42,7 +42,8 @@ import Hydra.Options (defaultContestationPeriod)
 import Hydra.Party (Party, deriveParty)
 import Hydra.Persistence (PersistenceIncremental (..), eventPairFromPersistenceIncremental)
 import Test.Hydra.Fixture (alice, aliceSk, bob, bobSk, carol, carolSk, cperiod, deriveOnChainId, testEnvironment, testHeadId, testHeadSeed)
-import Test.QuickCheck (elements, forAllBlind, forAllShrink, listOf, listOf1, (==>))
+import Test.QuickCheck (classify, counterexample, elements, forAllBlind, forAllShrink, idempotentIOProperty, listOf, listOf1, (==>))
+import Test.Util (isStrictlyMonotonic)
 
 spec :: Spec
 spec = parallel $ do
@@ -63,6 +64,16 @@ spec = parallel $ do
             getMockSinkEvents1 `shouldReturn` someEvents
             getMockSinkEvents2 `shouldReturn` someEvents
 
+      it "event ids are consistent" $ \node ->
+        forAllShrink (listOf $ genStateChanged testEnvironment) shrink $
+          \someEvents -> do
+            (sink, getSinkEvents) <- createRecordingSink
+
+            void $ hydrate (mockSource someEvents) [sink] node
+
+            seenEvents <- getSinkEvents
+            getEventId <$> seenEvents `shouldBe` getEventId <$> someEvents
+
       it "fails if one sink fails" $ \node ->
         forAllShrink (listOf1 $ genStateChanged testEnvironment) shrink $
           \someEvents -> do
@@ -97,6 +108,25 @@ spec = parallel $ do
         events `shouldNotBe` []
         getMockSinkEvents2 `shouldReturn` events
 
+      it "event ids are strictly monotonic" $ \dryNode -> do
+        forAllShrink arbitrary shrink $ \someInputs ->
+          idempotentIOProperty $ do
+            (sink, getSinkEvents) <- createRecordingSink
+
+            hydrate (mockSource []) [sink] dryNode
+              >>= notConnect
+              >>= primeWith (inputsToOpenHead <> someInputs)
+              >>= runToCompletion
+
+            events <- getSinkEvents
+            let eventIds = getEventId <$> events
+            pure $
+              isStrictlyMonotonic eventIds
+                & counterexample "Not strictly monotonic"
+                & counterexample ("Event ids: " <> show eventIds)
+                & counterexample ("Events: " <> show events)
+                & classify (null eventIds) "empty list of events"
+
       it "can continue after re-hydration" $ \dryNode ->
         failAfter 1 $ do
           persistence <- createPersistenceInMemory

hydra-node/test/Test/Util.hs

@@ -107,3 +107,24 @@ propCollisionResistant name gen =
       forAll gen $ \a ->
         forAll gen $ \b ->
           a /= b
+
+-- | Predicate which decides whether given list is continuous.
+isContinuous :: (Eq a, Enum a) => [a] -> Bool
+isContinuous = \case
+  [] -> True
+  [_] -> True
+  (a : b : as) -> succ a == b && isContinuous (b : as)
+
+-- | Predicate which decides whether given list is monotonic.
+isMonotonic :: Ord a => [a] -> Bool
+isMonotonic = \case
+  [] -> True
+  [_] -> True
+  (a : b : as) -> a <= b && isMonotonic (b : as)
+
+-- | Predicate which decides whether given list is strictly monotonic.
+isStrictlyMonotonic :: Ord a => [a] -> Bool
+isStrictlyMonotonic = \case
+  [] -> True
+  [_] -> True
+  (a : b : as) -> a < b && isStrictlyMonotonic (b : as)