diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal
index 878c90c7f67..8fc6d858810 100644
--- a/hydra-node/hydra-node.cabal
+++ b/hydra-node/hydra-node.cabal
@@ -290,6 +290,7 @@ test-suite tests
     Hydra.Chain.Direct.StateSpec
     Hydra.Chain.Direct.TimeHandleSpec
     Hydra.Chain.Direct.TxSpec
+    Hydra.Chain.Direct.TxTraceSpec
     Hydra.Chain.Direct.WalletSpec
     Hydra.ContestationPeriodSpec
     Hydra.CryptoSpec
@@ -363,6 +364,7 @@ test-suite tests
     , lens-aeson
     , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib}  >=1.1.1.0
     , plutus-tx
+    , pretty-simple
     , QuickCheck
     , quickcheck-dynamic                                                >=3.3.1   && <3.4
     , quickcheck-instances
diff --git a/hydra-node/src/Hydra/Chain/Direct/State.hs b/hydra-node/src/Hydra/Chain/Direct/State.hs
index 18d904e2089..adb8e4ec275 100644
--- a/hydra-node/src/Hydra/Chain/Direct/State.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/State.hs
@@ -479,12 +479,9 @@ collect ctx headId headParameters utxoToCollect spendableUTxO = do
 
   ChainContext{networkId, ownVerificationKey, scriptRegistry} = ctx
 
--- | Construct a close transaction based on the 'OpenState' and a confirmed
--- snapshot.
---  - 'SlotNo' parameter will be used as the 'Tx' lower bound.
---  - 'PointInTime' parameter will be used as an upper validity bound and
---       will define the start of the contestation period.
--- NB: lower and upper bound slot difference should not exceed contestation period
+-- | Construct a close transaction spending the head output in given 'UTxO',
+-- head parameters, and a confirmed snapshot. NOTE: Lower and upper bound slot
+-- difference should not exceed contestation period.
 close ::
   ChainContext ->
   -- | Spendable UTxO containing head, initial and commit outputs
@@ -533,6 +530,7 @@ contest ::
   HeadId ->
   ContestationPeriod ->
   ConfirmedSnapshot Tx ->
+  -- | Current slot and posix time to be used as the contestation time.
   PointInTime ->
   Either ContestTxError Tx
 contest ctx spendableUTxO headId contestationPeriod confirmedSnapshot pointInTime = do
diff --git a/hydra-node/src/Hydra/Snapshot.hs b/hydra-node/src/Hydra/Snapshot.hs
index b1066a45e5a..4cda9f05251 100644
--- a/hydra-node/src/Hydra/Snapshot.hs
+++ b/hydra-node/src/Hydra/Snapshot.hs
@@ -82,10 +82,12 @@ instance (Typeable tx, ToCBOR (UTxOType tx), ToCBOR (TxIdType tx)) => ToCBOR (Sn
 instance (Typeable tx, FromCBOR (UTxOType tx), FromCBOR (TxIdType tx)) => FromCBOR (Snapshot tx) where
   fromCBOR = Snapshot <$> fromCBOR <*> fromCBOR <*> fromCBOR <*> fromCBOR
 
--- | A snapshot that can be used to close a head with. Either the initial one, or when it was signed by all parties, i.e. it is confirmed.
+-- | A snapshot that can be used to close a head with. Either the initial one,
+-- or when it was signed by all parties, i.e. it is confirmed.
 data ConfirmedSnapshot tx
   = InitialSnapshot
-      { headId :: HeadId
+      { -- XXX: 'headId' is actually unused. Only 'getSnapshot' forces this to exist.
+        headId :: HeadId
       , initialUTxO :: UTxOType tx
       }
   | ConfirmedSnapshot
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Abort.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Abort.hs
index 812cb628712..3d7dee227f7 100644
--- a/hydra-node/test/Hydra/Chain/Direct/Contract/Abort.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Abort.hs
@@ -11,7 +11,6 @@ import Cardano.Api.UTxO qualified as UTxO
 import Data.List qualified as List
 import Data.Map qualified as Map
 import Hydra.Chain (HeadParameters (..))
-import Hydra.Chain.Direct.Contract.Gen (genForParty)
 import Hydra.Chain.Direct.Contract.Mutation (
   Mutation (..),
   SomeMutation (..),
@@ -42,7 +41,7 @@ import Hydra.Contract.Initial qualified as Initial
 import Hydra.Contract.InitialError (InitialError (STNotBurned))
 import Hydra.Ledger.Cardano (genAddressInEra, genVerificationKey)
 import Hydra.Party (Party, partyToChain)
-import Test.Hydra.Fixture (cperiod)
+import Test.Hydra.Fixture (cperiod, genForParty)
 import Test.QuickCheck (Property, choose, counterexample, elements, oneof, shuffle, suchThat)
 
 --
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs
index f274dd609b9..e74301fc128 100644
--- a/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs
@@ -8,7 +8,7 @@ import Hydra.Prelude hiding (label)
 
 import Cardano.Api.UTxO as UTxO
 import Data.Maybe (fromJust)
-import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue)
+import Hydra.Chain.Direct.Contract.Gen (genHash, genMintedOrBurnedValue)
 import Hydra.Chain.Direct.Contract.Mutation (
   Mutation (..),
   SomeMutation (..),
@@ -24,7 +24,6 @@ import Hydra.Chain.Direct.Contract.Mutation (
   replaceSnapshotNumber,
   replaceUtxoHash,
  )
-import Hydra.Chain.Direct.Fixture (testNetworkId)
 import Hydra.Chain.Direct.Fixture qualified as Fixture
 import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO)
 import Hydra.Chain.Direct.TimeHandle (PointInTime)
@@ -47,7 +46,7 @@ import Hydra.Plutus.Orphans ()
 import Hydra.Snapshot (Snapshot (..), SnapshotNumber)
 import PlutusLedgerApi.V1.Time (DiffMilliSeconds (..), fromMilliSeconds)
 import PlutusLedgerApi.V2 (BuiltinByteString, POSIXTime, PubKeyHash (PubKeyHash), toBuiltin)
-import Test.Hydra.Fixture (aliceSk, bobSk, carolSk)
+import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty)
 import Test.QuickCheck (arbitrarySizedNatural, choose, elements, listOf1, oneof, suchThat)
 import Test.QuickCheck.Instances ()
 
@@ -136,7 +135,7 @@ healthyOpenHeadTxIn = generateWith arbitrary 42
 
 healthyOpenHeadTxOut :: TxOut CtxUTxO
 healthyOpenHeadTxOut =
-  mkHeadOutput testNetworkId Fixture.testPolicyId headTxOutDatum
+  mkHeadOutput Fixture.testNetworkId Fixture.testPolicyId headTxOutDatum
     & addParticipationTokens healthyParticipants
  where
   headTxOutDatum = toUTxOContext (mkTxOutDatumInline healthyOpenHeadDatum)
@@ -293,7 +292,7 @@ genCloseMutation :: (Tx, UTxO) -> Gen SomeMutation
 genCloseMutation (tx, _utxo) =
   oneof
     [ SomeMutation (Just $ toErrorCode NotPayingToHead) NotContinueContract <$> do
-        mutatedAddress <- genAddressInEra testNetworkId
+        mutatedAddress <- genAddressInEra Fixture.testNetworkId
         pure $ ChangeOutput 0 (modifyTxOutAddress (const mutatedAddress) headTxOut)
     , SomeMutation (Just $ toErrorCode SignatureVerificationFailed) MutateSignatureButNotSnapshotNumber . ChangeHeadRedeemer <$> do
         Head.Close . toPlutusSignatures <$> (arbitrary :: Gen (MultiSignature (Snapshot Tx)))
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/CollectCom.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/CollectCom.hs
index 02989fd045e..4dd0f143024 100644
--- a/hydra-node/test/Hydra/Chain/Direct/Contract/CollectCom.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/Contract/CollectCom.hs
@@ -11,7 +11,7 @@ import Data.List qualified as List
 import Data.Map qualified as Map
 import Data.Maybe (fromJust)
 import Hydra.Chain (HeadParameters (..))
-import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue)
+import Hydra.Chain.Direct.Contract.Gen (genHash, genMintedOrBurnedValue)
 import Hydra.Chain.Direct.Contract.Mutation (
   Mutation (..),
   SomeMutation (..),
@@ -52,6 +52,7 @@ import Hydra.OnChainId (OnChainId)
 import Hydra.Party (Party, partyToChain)
 import Hydra.Plutus.Orphans ()
 import PlutusTx.Builtins (toBuiltin)
+import Test.Hydra.Fixture (genForParty)
 import Test.QuickCheck (choose, elements, oneof, suchThat)
 import Test.QuickCheck.Instances ()
 
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs
index 4ec5ab777f1..360c9a113ff 100644
--- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs
@@ -9,7 +9,7 @@ import Hydra.Prelude hiding (label)
 import Data.Maybe (fromJust)
 
 import Cardano.Api.UTxO as UTxO
-import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue)
+import Hydra.Chain.Direct.Contract.Gen (genHash, genMintedOrBurnedValue)
 import Hydra.Chain.Direct.Contract.Mutation (
   Mutation (..),
   SomeMutation (..),
@@ -48,7 +48,7 @@ import Hydra.Plutus.Orphans ()
 import Hydra.Snapshot (Snapshot (..), SnapshotNumber)
 import PlutusLedgerApi.V2 (BuiltinByteString, toBuiltin)
 import PlutusLedgerApi.V2 qualified as Plutus
-import Test.Hydra.Fixture (aliceSk, bobSk, carolSk)
+import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty)
 import Test.QuickCheck (arbitrarySizedNatural, elements, listOf, listOf1, oneof, suchThat, vectorOf)
 import Test.QuickCheck.Gen (choose)
 import Test.QuickCheck.Instances ()
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Gen.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Gen.hs
index b735c09b40c..b7df864bf68 100644
--- a/hydra-node/test/Hydra/Chain/Direct/Contract/Gen.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Gen.hs
@@ -1,37 +1,17 @@
 -- | Generators used in mutation testing framework
 module Hydra.Chain.Direct.Contract.Gen where
 
-import Cardano.Crypto.Hash (hashToBytes)
-import Codec.CBOR.Magic (uintegerFromBytes)
 import Data.ByteString qualified as BS
 import Hydra.Cardano.Api
 import Hydra.Chain.Direct.Fixture qualified as Fixtures
 import Hydra.Contract.HeadTokens (headPolicyId)
 import Hydra.Contract.Util (hydraHeadV1)
-import Hydra.Crypto (Hash (HydraKeyHash))
-import Hydra.Party (Party (..))
 import Hydra.Prelude
 import PlutusTx.Builtins (fromBuiltin)
 import Test.QuickCheck (oneof, suchThat, vector)
 
 -- * Party / key utilities
 
--- | Generate some 'a' given the Party as a seed. NOTE: While this is useful to
--- generate party-specific values, it DOES depend on the generator used. For
--- example, `genForParty genVerificationKey` and `genForParty (fst <$>
--- genKeyPair)` do not yield the same verification keys!
-genForParty :: Gen a -> Party -> a
-genForParty gen Party{vkey} =
-  generateWith gen seed
- where
-  seed =
-    fromIntegral
-      . uintegerFromBytes
-      . hydraKeyHashToBytes
-      $ verificationKeyHash vkey
-
-  hydraKeyHashToBytes (HydraKeyHash h) = hashToBytes h
-
 genBytes :: Gen ByteString
 genBytes = arbitrary
 
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Init.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Init.hs
index a5993d5b5f6..d376b47af08 100644
--- a/hydra-node/test/Hydra/Chain/Direct/Contract/Init.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Init.hs
@@ -10,7 +10,6 @@ import Hydra.Prelude
 import Cardano.Api.UTxO qualified as UTxO
 import Data.Maybe (fromJust)
 import Hydra.Chain (HeadParameters (..))
-import Hydra.Chain.Direct.Contract.Gen (genForParty)
 import Hydra.Chain.Direct.Contract.Mutation (
   Mutation (..),
   SomeMutation (..),
@@ -28,6 +27,7 @@ import Hydra.Ledger.Cardano (genOneUTxOFor, genValue)
 import Hydra.OnChainId (OnChainId, genOnChainId)
 import Hydra.Party (Party)
 import PlutusLedgerApi.Test.Examples qualified as Plutus
+import Test.Hydra.Fixture (genForParty)
 import Test.QuickCheck (choose, elements, oneof, suchThat, vectorOf)
 import Prelude qualified
 
diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs
index 801d17366b5..2c70d793b50 100644
--- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs
@@ -17,7 +17,6 @@ import Data.Map qualified as Map
 import Data.Text qualified as T
 import Hydra.Cardano.Api.Pretty (renderTx)
 import Hydra.Chain (HeadParameters (..))
-import Hydra.Chain.Direct.Contract.Gen (genForParty)
 import Hydra.Chain.Direct.Fixture (
   epochInfo,
   pparams,
@@ -36,6 +35,7 @@ import Hydra.Contract.Initial qualified as Initial
 import Hydra.Ledger.Cardano (adaOnly, genOneUTxOFor, genVerificationKey)
 import Hydra.Ledger.Cardano.Evaluate (EvaluationReport, maxTxExecutionUnits)
 import Hydra.Party (Party)
+import Test.Hydra.Fixture (genForParty)
 import Test.QuickCheck (
   Property,
   choose,
diff --git a/hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs
new file mode 100644
index 00000000000..028c3d80b61
--- /dev/null
+++ b/hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs
@@ -0,0 +1,373 @@
+module Hydra.Chain.Direct.TxTraceSpec where
+
+import Hydra.Prelude hiding (Any, State, label, show)
+import Test.Hydra.Prelude
+
+import Cardano.Api.UTxO (UTxO)
+import Cardano.Api.UTxO qualified as UTxO
+import Data.List ((\\))
+import Data.Map.Strict qualified as Map
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import Hydra.Cardano.Api (mkTxOutDatumInline)
+import Hydra.Cardano.Api.Pretty (renderTxWithUTxO)
+import Hydra.Chain.Direct.Contract.Mutation (addParticipationTokens)
+import Hydra.Chain.Direct.Fixture qualified as Fixture
+import Hydra.Chain.Direct.ScriptRegistry (ScriptRegistry, genScriptRegistry, registryUTxO)
+import Hydra.Chain.Direct.State (ChainContext (..), close, contest)
+import Hydra.Chain.Direct.Tx (HeadObservation, headIdToCurrencySymbol, mkHeadId, mkHeadOutput, observeHeadTx)
+import Hydra.Chain.Direct.Tx qualified as Tx
+import Hydra.ContestationPeriod qualified as CP
+import Hydra.Contract.HeadState qualified as Head
+import Hydra.Crypto (aggregate, sign)
+import Hydra.Ledger (hashUTxO)
+import Hydra.Ledger.Cardano (Tx, adjustUTxO, genUTxOFor, genVerificationKey)
+import Hydra.Ledger.Cardano.Evaluate (evaluateTx)
+import Hydra.Party (partyToChain)
+import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (..), SnapshotNumber, number)
+import PlutusTx.Builtins (toBuiltin)
+import Test.Hydra.Fixture (genForParty)
+import Test.Hydra.Fixture qualified as Fixture
+import Test.QuickCheck (Property, Smart (..), checkCoverage, cover, elements, forAll, oneof, resize)
+import Test.QuickCheck.Monadic (monadicIO)
+import Test.QuickCheck.StateModel (
+  ActionWithPolarity (..),
+  Actions (..),
+  Any (..),
+  HasVariables (getAllVariables),
+  LookUp,
+  RunModel (..),
+  StateModel (..),
+  Step ((:=)),
+  Var,
+  VarContext,
+  mkVar,
+  runActions,
+ )
+import Text.Pretty.Simple (pShowNoColor)
+import Text.Show (Show (..))
+
+spec :: Spec
+spec = do
+  prop "generates interesting transaction traces" prop_traces
+  prop "all valid transactions" prop_runActions
+
+prop_traces :: Property
+prop_traces =
+  forAll (arbitrary :: Gen (Actions Model)) $ \(Actions_ _ (Smart _ steps)) ->
+    checkCoverage $
+      True
+        & cover 1 (null steps) "empty"
+        & cover 10 (hasFanout steps) "reach fanout"
+        & cover 5 (countContests steps >= 2) "has multiple contests"
+        & cover 5 (containSomeSnapshots steps) "has some snapshots"
+        & cover 5 (closeNonInitial steps) "close with non initial snapshots"
+ where
+  containSomeSnapshots =
+    any $
+      \(_ := ActionWithPolarity{polarAction}) -> case polarAction of
+        ProduceSnapshots snapshots -> not $ null snapshots
+        _ -> False
+
+  hasFanout =
+    any $
+      \(_ := ActionWithPolarity{polarAction}) -> case polarAction of
+        Fanout{} -> True
+        _ -> False
+
+  countContests =
+    length
+      . filter
+        ( \(_ := ActionWithPolarity{polarAction}) -> case polarAction of
+            Contest{} -> True
+            _ -> False
+        )
+
+  closeNonInitial =
+    any $
+      \(_ := ActionWithPolarity{polarAction}) -> case polarAction of
+        Close{snapshotNumber} -> snapshotNumber > 0
+        _ -> False
+
+prop_runActions :: Actions Model -> Property
+prop_runActions actions =
+  monadicIO $
+    void (runActions actions)
+
+-- * Model
+
+data Model = Model
+  { snapshots :: [SnapshotNumber]
+  , headState :: State
+  , utxoV :: Var UTxO
+  -- ^ Last known, spendable UTxO.
+  , alreadyContested :: [Actor]
+  }
+  deriving (Show)
+
+data State
+  = Open
+  | Closed
+  | Final
+  deriving (Show, Eq)
+
+data Actor = Alice | Bob | Carol
+  deriving (Show, Eq)
+
+instance StateModel Model where
+  data Action Model a where
+    ProduceSnapshots :: [SnapshotNumber] -> Action Model ()
+    Close :: {actor :: Actor, snapshotNumber :: SnapshotNumber} -> Action Model UTxO
+    Contest :: {actor :: Actor, snapshotNumber :: SnapshotNumber} -> Action Model UTxO
+    Fanout :: Action Model ()
+    -- \| Helper action to identify the terminal state 'Final' and shorten
+    -- traces using the 'precondition'.
+    Stop :: Action Model ()
+
+  arbitraryAction :: VarContext -> Model -> Gen (Any (Action Model))
+  arbitraryAction _lookup Model{headState, snapshots, alreadyContested} =
+    case headState of
+      Open ->
+        oneof
+          [ -- NOTE: non-continuous snapshot numbers are allowed in this model
+            Some . ProduceSnapshots <$> arbitrary
+          , do
+              actor <- elements allActors
+              snapshotNumber <- elements (0 : snapshots)
+              pure $ Some $ Close{actor, snapshotNumber}
+          ]
+      Closed ->
+        case maybeGenContest of
+          Nothing -> genFanout
+          Just contestAction -> oneof [contestAction, genFanout]
+      Final -> pure $ Some Stop
+   where
+    genFanout = pure $ Some Fanout
+
+    possibleContesters = allActors \\ alreadyContested
+
+    maybeGenContest
+      | null possibleContesters || null snapshots = Nothing
+      | otherwise = Just $ do
+          actor <- elements possibleContesters
+          snapshotNumber <- elements snapshots
+          pure $ Some Contest{actor, snapshotNumber}
+
+  initialState =
+    Model
+      { snapshots = []
+      , headState = Open
+      , utxoV = mkVar (-1)
+      , alreadyContested = []
+      }
+
+  nextState :: Model -> Action Model a -> Var a -> Model
+  nextState m Stop _ = m
+  nextState m t result =
+    case t of
+      ProduceSnapshots snapshots -> m{snapshots = snapshots}
+      Close{snapshotNumber} ->
+        m
+          { headState = Closed
+          , utxoV = result
+          , snapshots = filter (> snapshotNumber) $ snapshots m
+          , alreadyContested = []
+          }
+      Contest{actor, snapshotNumber} ->
+        m
+          { headState = Closed
+          , utxoV = result
+          , snapshots = filter (> snapshotNumber) $ snapshots m
+          , alreadyContested = actor : alreadyContested m
+          }
+      Fanout -> m{headState = Final}
+
+  precondition :: Model -> Action Model a -> Bool
+  precondition Model{headState = Final} Stop =
+    False
+  precondition Model{headState} Contest{snapshotNumber} =
+    headState == Closed && snapshotNumber /= 0
+  precondition _ _ = True
+
+instance HasVariables Model where
+  getAllVariables = mempty
+
+instance HasVariables (Action Model a) where
+  getAllVariables = mempty
+
+deriving instance Eq (Action Model a)
+deriving instance Show (Action Model a)
+
+instance RunModel Model IO where
+  perform :: Model -> Action Model a -> LookUp IO -> IO a
+  perform Model{utxoV, alreadyContested} action lookupVar = do
+    case action of
+      ProduceSnapshots _snapshots -> pure ()
+      Close{actor, snapshotNumber} -> do
+        tx <- newCloseTx actor $ correctlySignedSnapshot snapshotNumber
+        validateTx openHeadUTxO tx
+        observeTxMatching openHeadUTxO tx $ \case
+          Tx.Close{} -> Just ()
+          _ -> Nothing
+        pure $ adjustUTxO tx openHeadUTxO
+      Contest{actor, snapshotNumber} -> do
+        let utxo = lookupVar utxoV
+        tx <- newContestTx utxo actor $ correctlySignedSnapshot snapshotNumber
+        validateTx utxo tx
+        observation@Tx.ContestObservation{contesters} <-
+          observeTxMatching utxo tx $ \case
+            Tx.Contest obs -> Just obs
+            _ -> Nothing
+        let newContesters = actor : alreadyContested
+        unless (length contesters == length newContesters) $
+          failure . toString . unlines $
+            fromString
+              <$> [ "Expected contesters " <> show newContesters <> ", but observed only " <> show contesters
+                  , toString $ pShowNoColor observation
+                  , "Transaction: " <> renderTxWithUTxO utxo tx
+                  ]
+        pure $ adjustUTxO tx utxo
+      Fanout -> pure ()
+      Stop -> pure ()
+
+-- * Fixtures and glue code
+
+-- | List of all model actors corresponding to the fixtures used.
+allActors :: [Actor]
+allActors = [Alice, Bob, Carol]
+
+-- | A "random" UTxO distribution for a given snapshot number. This always
+-- contains one UTxO for alice, bob, and carol.
+snapshotUTxO :: SnapshotNumber -> UTxO
+snapshotUTxO n = (`generateWith` fromIntegral n) . resize 1 $ do
+  aliceUTxO <- genUTxOFor (genVerificationKey `genForParty` Fixture.alice)
+  bobUTxO <- genUTxOFor (genVerificationKey `genForParty` Fixture.bob)
+  carolUTxO <- genUTxOFor (genVerificationKey `genForParty` Fixture.carol)
+  pure $ aliceUTxO <> bobUTxO <> carolUTxO
+
+-- | A model of a correctly signed snapshot. Given a snapshot number a snapshot
+-- signed by all participants (alice, bob and carol) with some UTxO contained is
+-- produced.
+correctlySignedSnapshot :: SnapshotNumber -> ConfirmedSnapshot Tx
+correctlySignedSnapshot = \case
+  0 ->
+    InitialSnapshot
+      { -- -- NOTE: The close validator would not check headId on close with
+        -- initial snapshot, but we need to provide it still.
+        headId = mkHeadId Fixture.testPolicyId
+      , initialUTxO = snapshotUTxO 0
+      }
+  number -> ConfirmedSnapshot{snapshot, signatures}
+   where
+    snapshot =
+      Snapshot
+        { headId = mkHeadId Fixture.testPolicyId
+        , number
+        , utxo = snapshotUTxO number
+        , confirmed = []
+        }
+
+    signatures = aggregate [sign sk snapshot | sk <- [Fixture.aliceSk, Fixture.bobSk, Fixture.carolSk]]
+
+-- | UTxO of the open head on-chain. NOTE: This uses fixtures for headId, parties, and cperiod.
+openHeadUTxO :: UTxO
+openHeadUTxO =
+  UTxO.singleton (headTxIn, openHeadTxOut)
+    <> registryUTxO testScriptRegistry
+ where
+  headTxIn = arbitrary `generateWith` 42
+
+  openHeadTxOut =
+    mkHeadOutput Fixture.testNetworkId Fixture.testPolicyId openHeadDatum
+      & addParticipationTokens [Fixture.alicePVk, Fixture.bobPVk, Fixture.carolPVk]
+
+  openHeadDatum =
+    mkTxOutDatumInline
+      Head.Open
+        { parties = partyToChain <$> [Fixture.alice, Fixture.bob, Fixture.carol]
+        , utxoHash = toBuiltin $ hashUTxO @Tx $ snapshotUTxO 0
+        , contestationPeriod = CP.toChain Fixture.cperiod
+        , headId = headIdToCurrencySymbol $ mkHeadId Fixture.testPolicyId
+        }
+
+-- | Creates a transaction that closes 'openHeadUTxO' with given the snapshot.
+-- NOTE: This uses fixtures for headId, parties (alice, bob, carol),
+-- contestation period and also claims to close at time 0 resulting in a
+-- contestation deadline of 0 + cperiod.
+newCloseTx :: HasCallStack => Actor -> ConfirmedSnapshot Tx -> IO Tx
+newCloseTx actor snapshot =
+  either (failure . show) pure $
+    close
+      (actorChainContext actor)
+      openHeadUTxO
+      (mkHeadId Fixture.testPolicyId)
+      Fixture.testHeadParameters
+      snapshot
+      lowerBound
+      upperBound
+ where
+  lowerBound = 0
+
+  upperBound = (0, posixSecondsToUTCTime 0)
+
+-- | Creates a contest transaction using given utxo and contesting with given
+-- snapshot. NOTE: This uses fixtures for headId, contestation period and also
+-- claims to contest at time 0.
+newContestTx :: HasCallStack => UTxO -> Actor -> ConfirmedSnapshot Tx -> IO Tx
+newContestTx spendableUTxO actor snapshot =
+  either (failure . show) pure $
+    contest
+      (actorChainContext actor)
+      spendableUTxO
+      (mkHeadId Fixture.testPolicyId)
+      Fixture.cperiod
+      snapshot
+      currentTime
+ where
+  currentTime = (0, posixSecondsToUTCTime 0)
+
+-- | Fixture for the chain context of a model 'Actor' on 'testNetworkId'. Uses a generated 'ScriptRegistry'.
+actorChainContext :: Actor -> ChainContext
+actorChainContext actor =
+  ChainContext
+    { networkId = Fixture.testNetworkId
+    , ownVerificationKey =
+        case actor of
+          Alice -> Fixture.alicePVk
+          Bob -> Fixture.bobPVk
+          Carol -> Fixture.carolPVk
+    , ownParty =
+        case actor of
+          Alice -> Fixture.alice
+          Bob -> Fixture.bob
+          Carol -> Fixture.carol
+    , scriptRegistry = testScriptRegistry
+    }
+
+testScriptRegistry :: ScriptRegistry
+testScriptRegistry = genScriptRegistry `generateWith` 42
+
+-- * Helpers
+
+-- | Thin wrapper around 'evaluateTx' that fails with 'failure' if any of the
+-- scripts/redeemers fail to evaluate.
+validateTx :: (HasCallStack, MonadThrow m) => UTxO -> Tx -> m ()
+validateTx utxo tx =
+  case evaluateTx tx utxo of
+    Left err ->
+      failure $ show err
+    Right redeemerReport ->
+      when (any isLeft (Map.elems redeemerReport)) $
+        failure . toString . unlines $
+          fromString
+            <$> [ "Transaction evaluation failed: " <> renderTxWithUTxO utxo tx
+                , "Some redeemers failed: " <> show redeemerReport
+                ]
+
+-- | Expect to observe a transaction matching given predicate. This fails with
+-- 'failure' if the predicate yields 'Nothing'.
+observeTxMatching :: (HasCallStack, MonadThrow m) => UTxO -> Tx -> (HeadObservation -> Maybe a) -> m a
+observeTxMatching utxo tx predicate = do
+  let res = observeHeadTx Fixture.testNetworkId utxo tx
+  case predicate res of
+    Just a -> pure a
+    Nothing -> failure $ "Observation result not matching expectation, got " <> show res
diff --git a/hydra-node/test/Test/Hydra/Fixture.hs b/hydra-node/test/Test/Hydra/Fixture.hs
index 767d00c3356..575cf65ae1d 100644
--- a/hydra-node/test/Test/Hydra/Fixture.hs
+++ b/hydra-node/test/Test/Hydra/Fixture.hs
@@ -3,31 +3,42 @@ module Test.Hydra.Fixture where
 
 import Hydra.Prelude
 
-import Hydra.Cardano.Api (Key (..), SerialiseAsRawBytes (..), SigningKey, VerificationKey, getVerificationKey)
+import Cardano.Crypto.Hash (hashToBytes)
+import Codec.CBOR.Magic (uintegerFromBytes)
+import Hydra.Cardano.Api (Key (..), PaymentKey, SerialiseAsRawBytes (..), SigningKey, VerificationKey, getVerificationKey)
+import Hydra.Chain (HeadParameters (..))
 import Hydra.ContestationPeriod (ContestationPeriod (..))
-import Hydra.Crypto (HydraKey, generateSigningKey)
+import Hydra.Crypto (Hash (..), HydraKey, generateSigningKey)
 import Hydra.Environment (Environment (..))
 import Hydra.HeadId (HeadId (..), HeadSeed (..))
+import Hydra.Ledger.Cardano (genVerificationKey)
 import Hydra.OnChainId (AsType (AsOnChainId), OnChainId)
 import Hydra.Party (Party (..), deriveParty)
 
+-- | Our beloved alice, bob, and carol.
 alice, bob, carol :: Party
 alice = deriveParty aliceSk
 bob = deriveParty bobSk
 carol = deriveParty carolSk
 
+-- | Hydra signing keys for 'alice', 'bob', and 'carol'.
 aliceSk, bobSk, carolSk :: SigningKey HydraKey
 aliceSk = generateSigningKey "alice"
 bobSk = generateSigningKey "bob"
+-- NOTE: Using 'zcarol' as seed results in ordered 'deriveParty' values
 carolSk = generateSigningKey "zcarol"
 
+-- | Hydra verification keys for 'alice', 'bob', and 'carol'.
 aliceVk, bobVk, carolVk :: VerificationKey HydraKey
 aliceVk = getVerificationKey aliceSk
 bobVk = getVerificationKey bobSk
 carolVk = getVerificationKey carolSk
 
-allVKeys :: [VerificationKey HydraKey]
-allVKeys = vkey <$> [alice, bob, carol]
+-- | Cardano payment keys for 'alice', 'bob', and 'carol'.
+alicePVk, bobPVk, carolPVk :: VerificationKey PaymentKey
+alicePVk = genVerificationKey `genForParty` alice
+bobPVk = genVerificationKey `genForParty` bob
+carolPVk = genVerificationKey `genForParty` carol
 
 cperiod :: ContestationPeriod
 cperiod = UnsafeContestationPeriod 42
@@ -49,6 +60,22 @@ deriveOnChainId Party{vkey} =
  where
   bytes = serialiseToRawBytes $ verificationKeyHash vkey
 
+-- | Generate some 'a' given the Party as a seed. NOTE: While this is useful to
+-- generate party-specific values, it DOES depend on the generator used. For
+-- example, `genForParty genVerificationKey` and `genForParty (fst <$>
+-- genKeyPair)` do not yield the same verification keys!
+genForParty :: Gen a -> Party -> a
+genForParty gen Party{vkey} =
+  generateWith gen seed
+ where
+  seed =
+    fromIntegral
+      . uintegerFromBytes
+      . hydraKeyHashToBytes
+      $ verificationKeyHash vkey
+
+  hydraKeyHashToBytes (HydraKeyHash h) = hashToBytes h
+
 -- | An environment fixture for testing.
 testEnvironment :: Environment
 testEnvironment =
@@ -59,3 +86,11 @@ testEnvironment =
     , contestationPeriod = cperiod
     , participants = deriveOnChainId <$> [alice, bob, carol]
     }
+
+-- | Head parameters fixture for testing.
+testHeadParameters :: HeadParameters
+testHeadParameters =
+  HeadParameters
+    { contestationPeriod = cperiod
+    , parties = [alice, bob, carol]
+    }