From 2a1d836068c7578e9aa6ba8cd41c9e6364e4a1a8 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Tue, 12 Mar 2024 10:16:01 +0100 Subject: [PATCH] Add more tests on event ids being strictly monotonic --- hydra-node/test/Hydra/API/ServerSpec.hs | 11 ++----- hydra-node/test/Hydra/Node/InputQueueSpec.hs | 4 +-- hydra-node/test/Hydra/NodeSpec.hs | 34 ++++++++++++++++++-- hydra-node/test/Test/Util.hs | 21 ++++++++++++ 4 files changed, 58 insertions(+), 12 deletions(-) diff --git a/hydra-node/test/Hydra/API/ServerSpec.hs b/hydra-node/test/Hydra/API/ServerSpec.hs index 28aa176360e..d7ae7d4962e 100644 --- a/hydra-node/test/Hydra/API/ServerSpec.hs +++ b/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 -> diff --git a/hydra-node/test/Hydra/Node/InputQueueSpec.hs b/hydra-node/test/Hydra/Node/InputQueueSpec.hs index ada9f5aae87..c14c2a9bf3b 100644 --- a/hydra-node/test/Hydra/Node/InputQueueSpec.hs +++ b/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) diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs index ffcde6fa250..f88bf50fb46 100644 --- a/hydra-node/test/Hydra/NodeSpec.hs +++ b/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 diff --git a/hydra-node/test/Test/Util.hs b/hydra-node/test/Test/Util.hs index 0dd79670faa..11938b01ec0 100644 --- a/hydra-node/test/Test/Util.hs +++ b/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)