Untangle some healthyXXX functions

cardano-scaling · Jul 16, 2024 · 023e08e · 023e08e
1 parent 5d32b95
commit 023e08e
Show file tree

Hide file tree

Showing 4 changed files with 74 additions and 81 deletions.
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseCurrent.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseCurrent.hs
@@ -6,17 +6,19 @@ module Hydra.Chain.Direct.Contract.Close.CloseCurrent where
 import Hydra.Cardano.Api
 import Hydra.Prelude hiding (label)
 
+import Cardano.Api.UTxO qualified as UTxO
 import Data.Maybe (fromJust)
 import Hydra.Chain.Direct.Contract.Close.Healthy (
-  healthyConfirmedClosingTx,
+  healthyCloseLowerBoundSlot,
+  healthyCloseUpperBoundPointInTime,
+  healthyConfirmedSnapshot,
   healthyContestationDeadline,
+  healthyContestationPeriod,
   healthyContestationPeriodSeconds,
   healthyOnChainParties,
-  healthyOpenDatum,
   healthyOpenHeadTxIn,
   healthyOpenHeadTxOut,
   healthySignature,
-  healthySnapshot,
   healthySplitUTxOInHead,
   healthySplitUTxOToDecommit,
   somePartyCardanoVerificationKey,
@@ -39,6 +41,8 @@ import Hydra.Chain.Direct.Contract.Mutation (
   replaceUTxOHash,
  )
 import Hydra.Chain.Direct.Fixture qualified as Fixture
+import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO)
+import Hydra.Chain.Direct.Tx (OpenThreadOutput (..), closeTx, mkHeadId)
 import Hydra.Contract.Error (toErrorCode)
 import Hydra.Contract.HeadError (HeadError (..))
 import Hydra.Contract.HeadState qualified as Head
@@ -65,13 +69,56 @@ healthyCurrentSnapshotVersion = 1
 -- | Healthy close transaction for the generic case were we close a head
 --  after one or more snapshot have been agreed upon between the members.
 healthyCloseCurrentTx :: (Tx, UTxO)
-healthyCloseCurrentTx = healthyConfirmedClosingTx healthyCurrentSnapshot
+healthyCloseCurrentTx =
+  (tx, lookupUTxO)
+ where
+  tx =
+    closeTx
+      scriptRegistry
+      somePartyCardanoVerificationKey
+      (mkHeadId Fixture.testPolicyId)
+      healthyCurrentSnapshotVersion
+      (healthyConfirmedSnapshot healthyCurrentSnapshot)
+      healthyCloseLowerBoundSlot
+      healthyCloseUpperBoundPointInTime
+      openThreadOutput
+
+  datum = toUTxOContext $ mkTxOutDatumInline healthyCurrentOpenDatum
+
+  lookupUTxO =
+    UTxO.singleton (healthyOpenHeadTxIn, healthyOpenHeadTxOut datum)
+      <> registryUTxO scriptRegistry
+
+  scriptRegistry = genScriptRegistry `generateWith` 42
+
+  openThreadOutput =
+    OpenThreadOutput
+      { openThreadUTxO = (healthyOpenHeadTxIn, healthyOpenHeadTxOut datum)
+      , openParties = healthyOnChainParties
+      , openContestationPeriod = healthyContestationPeriod
+      }
 
 healthyCurrentSnapshot :: Snapshot Tx
-healthyCurrentSnapshot = healthySnapshot healthyCurrentSnapshotNumber healthyCurrentSnapshotVersion
+healthyCurrentSnapshot =
+  Snapshot
+    { headId = mkHeadId Fixture.testPolicyId
+    , version = healthyCurrentSnapshotVersion
+    , number = healthyCurrentSnapshotNumber
+    , confirmed = []
+    , utxo = healthySplitUTxOInHead
+    , utxoToDecommit = Just healthySplitUTxOToDecommit
+    }
 
 healthyCurrentOpenDatum :: Head.State
-healthyCurrentOpenDatum = healthyOpenDatum healthyCurrentSnapshot
+healthyCurrentOpenDatum =
+  Head.Open
+    Head.OpenDatum
+      { parties = healthyOnChainParties
+      , utxoHash = toBuiltin $ hashUTxO @Tx healthySplitUTxOInHead
+      , contestationPeriod = healthyContestationPeriod
+      , headId = toPlutusCurrencySymbol Fixture.testPolicyId
+      , version = toInteger healthyCurrentSnapshotVersion
+      }
 
 data CloseMutation
   = -- | Ensures collectCom does not allow any output address but νHead.

diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseInitial.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseInitial.hs
@@ -8,10 +8,20 @@ import Hydra.Prelude hiding (label)
 
 import Cardano.Api.UTxO as UTxO
 import Data.Maybe (fromJust)
-import Hydra.Chain.Direct.Contract.Close.Healthy (healthyCloseLowerBoundSlot, healthyCloseUpperBoundPointInTime, healthyContestationDeadline, healthyContestationPeriod, healthyOnChainParties, healthyOpenHeadTxIn, healthyOpenHeadTxOut, healthySnapshot, healthyUTxO, scriptRegistry, somePartyCardanoVerificationKey)
+import Hydra.Chain.Direct.Contract.Close.Healthy (
+  healthyCloseLowerBoundSlot,
+  healthyCloseUpperBoundPointInTime,
+  healthyContestationDeadline,
+  healthyContestationPeriod,
+  healthyOnChainParties,
+  healthyOpenHeadTxIn,
+  healthyOpenHeadTxOut,
+  healthyUTxO,
+  somePartyCardanoVerificationKey,
+ )
 import Hydra.Chain.Direct.Contract.Mutation (Mutation (..), SomeMutation (..), modifyInlineDatum, replaceContestationDeadline)
 import Hydra.Chain.Direct.Fixture qualified as Fixture
-import Hydra.Chain.Direct.ScriptRegistry (registryUTxO)
+import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO)
 import Hydra.Chain.Direct.Tx (OpenThreadOutput (..), closeTx, mkHeadId)
 import Hydra.Contract.Error (ToErrorCode (..))
 import Hydra.Contract.HeadError (HeadError (..))
@@ -20,7 +30,7 @@ import Hydra.Contract.HeadState qualified as HeadState
 import Hydra.Ledger (hashUTxO)
 import Hydra.Plutus.Extras (posixFromUTCTime)
 import Hydra.Plutus.Orphans ()
-import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot, SnapshotNumber, SnapshotVersion, utxo, utxoToDecommit)
+import Hydra.Snapshot (ConfirmedSnapshot (..), SnapshotNumber, SnapshotVersion)
 import PlutusLedgerApi.V2 (POSIXTime, toBuiltin)
 import Test.QuickCheck (oneof, suchThat)
 import Test.QuickCheck.Instances ()
@@ -62,6 +72,8 @@ healthyCloseInitialTx =
     UTxO.singleton (healthyOpenHeadTxIn, healthyOpenHeadTxOut initialDatum)
       <> registryUTxO scriptRegistry
 
+  scriptRegistry = genScriptRegistry `generateWith` 42
+
   openThreadOutput :: OpenThreadOutput
   openThreadOutput =
     OpenThreadOutput
@@ -74,9 +86,6 @@ healthyCloseInitialTx =
 
   closingSnapshot = InitialSnapshot{headId, initialUTxO = healthyUTxO}
 
-healthyInitialSnapshot :: Snapshot Tx
-healthyInitialSnapshot = (healthySnapshot healthyCloseSnapshotNumber healthyCloseSnapshotVersion){utxo = healthyUTxO, utxoToDecommit = mempty}
-
 healthyInitialOpenDatum :: HeadState.State
 healthyInitialOpenDatum =
   Head.Open

diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseOutdated.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseOutdated.hs
@@ -22,7 +22,6 @@ import Hydra.Chain.Direct.Contract.Close.Healthy (
   healthySignature,
   healthySplitUTxOInHead,
   healthySplitUTxOToDecommit,
-  scriptRegistry,
   somePartyCardanoVerificationKey,
  )
 import Hydra.Chain.Direct.Contract.Gen (genHash, genMintedOrBurnedValue)
@@ -42,7 +41,7 @@ import Hydra.Chain.Direct.Contract.Mutation (
   replaceUTxOHash,
  )
 import Hydra.Chain.Direct.Fixture qualified as Fixture
-import Hydra.Chain.Direct.ScriptRegistry (registryUTxO)
+import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO)
 import Hydra.Chain.Direct.Tx (
   OpenThreadOutput (..),
   closeTx,
@@ -121,6 +120,8 @@ healthyCloseOutdatedTx =
     UTxO.singleton (healthyOpenHeadTxIn, healthyOpenHeadTxOut datum)
       <> registryUTxO scriptRegistry
 
+  scriptRegistry = genScriptRegistry `generateWith` 42
+
   datum :: TxOutDatum CtxUTxO
   datum = toUTxOContext (mkTxOutDatumInline healthyOutdatedOpenDatum)
 

diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Close/Healthy.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Close/Healthy.hs
@@ -6,17 +6,12 @@ module Hydra.Chain.Direct.Contract.Close.Healthy where
 import Hydra.Cardano.Api
 import Hydra.Prelude hiding (label)
 
-import Cardano.Api.UTxO qualified as UTxO
-import Hydra.Chain.Direct.Contract.Mutation (
-  addParticipationTokens,
- )
+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 (splitUTxO)
 import Hydra.Chain.Direct.TimeHandle (PointInTime)
-import Hydra.Chain.Direct.Tx (OpenThreadOutput (..), closeTx, mkHeadId, mkHeadOutput)
+import Hydra.Chain.Direct.Tx (mkHeadOutput)
 import Hydra.ContestationPeriod (fromChain)
-import Hydra.Contract.HeadState qualified as Head
 import Hydra.Crypto (HydraKey, MultiSignature, aggregate, sign)
 import Hydra.Data.ContestationPeriod qualified as OnChain
 import Hydra.Data.Party qualified as OnChain
@@ -25,8 +20,7 @@ import Hydra.Ledger.Cardano (genOneUTxOFor, genVerificationKey)
 import Hydra.Ledger.Cardano.Evaluate (genValidityBoundsFromContestationPeriod)
 import Hydra.Party (Party, deriveParty, partyToChain)
 import Hydra.Plutus.Orphans ()
-import Hydra.Snapshot (ConfirmedSnapshot (..))
-import Hydra.Snapshot as Snapshot (Snapshot (..), SnapshotNumber, SnapshotVersion)
+import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot)
 import PlutusLedgerApi.V2 (BuiltinByteString, toBuiltin)
 import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty)
 import Test.QuickCheck (elements)
@@ -42,9 +36,6 @@ healthySplitUTxOInHead :: UTxO
 healthySplitUTxOToDecommit :: UTxO
 (healthySplitUTxOInHead, healthySplitUTxOToDecommit) = splitUTxO healthyUTxO
 
-scriptRegistry :: ScriptRegistry
-scriptRegistry = genScriptRegistry `generateWith` 42
-
 -- NOTE: We need to use the contestation period when generating start/end tx
 -- validity slots/time since if tx validity bound difference is bigger than
 -- contestation period our close validator will fail
@@ -97,64 +88,9 @@ healthyOnChainParties = partyToChain <$> healthyParties
 healthySignature :: Snapshot Tx -> MultiSignature (Snapshot Tx)
 healthySignature snapshot = aggregate [sign sk snapshot | sk <- healthySigningKeys]
 
-healthySnapshot :: SnapshotNumber -> SnapshotVersion -> Snapshot Tx
-healthySnapshot number version =
-  Snapshot
-    { headId = mkHeadId Fixture.testPolicyId
-    , version
-    , number
-    , confirmed = []
-    , utxo = healthySplitUTxOInHead
-    , utxoToDecommit = Just healthySplitUTxOToDecommit
-    }
-
--- FIXME: check all usages of this
-healthyOpenDatum :: Snapshot Tx -> Head.State
-healthyOpenDatum Snapshot{version} =
-  Head.Open
-    Head.OpenDatum
-      { parties = healthyOnChainParties
-      , utxoHash = toBuiltin $ hashUTxO @Tx healthySplitUTxOInHead
-      , contestationPeriod = healthyContestationPeriod
-      , headId = toPlutusCurrencySymbol Fixture.testPolicyId
-      , version = toInteger version
-      }
-
 healthyConfirmedSnapshot :: Snapshot Tx -> ConfirmedSnapshot Tx
 healthyConfirmedSnapshot snapshot =
   ConfirmedSnapshot
     { snapshot
     , signatures = healthySignature snapshot
     }
-
-healthyConfirmedClosingTx :: Snapshot Tx -> (Tx, UTxO)
-healthyConfirmedClosingTx snapshot@Snapshot{version} =
-  (tx, lookupUTxO)
- where
-  tx :: Tx
-  tx =
-    closeTx
-      scriptRegistry
-      somePartyCardanoVerificationKey
-      (mkHeadId Fixture.testPolicyId)
-      version
-      (healthyConfirmedSnapshot snapshot)
-      healthyCloseLowerBoundSlot
-      healthyCloseUpperBoundPointInTime
-      openThreadOutput
-
-  datum :: TxOutDatum CtxUTxO
-  datum = toUTxOContext $ mkTxOutDatumInline $ healthyOpenDatum snapshot
-
-  lookupUTxO :: UTxO' (TxOut CtxUTxO)
-  lookupUTxO =
-    UTxO.singleton (healthyOpenHeadTxIn, healthyOpenHeadTxOut datum)
-      <> registryUTxO scriptRegistry
-
-  openThreadOutput :: OpenThreadOutput
-  openThreadOutput =
-    OpenThreadOutput
-      { openThreadUTxO = (healthyOpenHeadTxIn, healthyOpenHeadTxOut datum)
-      , openParties = healthyOnChainParties
-      , openContestationPeriod = healthyContestationPeriod
-      }