diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseCurrent.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseCurrent.hs index 0f4e4b096e9..73cb104d542 100644 --- 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 index 2eca65bf4f2..84af4e24759 100644 --- 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 index a606bebfca7..feee11875be 100644 --- 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 index e11d37d04bc..b5d1c49b737 100644 --- 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 - }