diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index db7d630ed1e..dd11c82d124 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -281,6 +281,7 @@ test-suite tests Hydra.Chain.Direct.Contract.Close.CloseCurrent Hydra.Chain.Direct.Contract.Close.CloseInitial Hydra.Chain.Direct.Contract.Close.CloseOutdated + Hydra.Chain.Direct.Contract.Close.Healthy Hydra.Chain.Direct.Contract.CollectCom Hydra.Chain.Direct.Contract.Commit Hydra.Chain.Direct.Contract.Contest.ContestCurrent 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 b86f41c6f5e..c1a54ab129d 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseCurrent.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseCurrent.hs @@ -6,13 +6,12 @@ module Hydra.Chain.Direct.Contract.Close.CloseCurrent where import Hydra.Cardano.Api import Hydra.Prelude hiding (label) -import Cardano.Api.UTxO as UTxO import Data.Maybe (fromJust) +import Hydra.Chain.Direct.Contract.Close.Healthy (healthyContestationDeadline, healthyContestationPeriodSeconds, healthyOnChainParties, healthyOpenDatum, healthyOpenHeadTxIn, healthyOpenHeadTxOut, healthySignature, healthySnapshot, somePartyCardanoVerificationKey, healthySplitUTxOInHead, healthyConfirmedClosingSnapshotTx) import Hydra.Chain.Direct.Contract.Gen (genHash, genMintedOrBurnedValue) import Hydra.Chain.Direct.Contract.Mutation ( Mutation (..), SomeMutation (..), - addParticipationTokens, changeMintedTokens, modifyInlineDatum, replaceContestationDeadline, @@ -26,169 +25,40 @@ import Hydra.Chain.Direct.Contract.Mutation ( replaceUtxoToDecommitHash, ) import Hydra.Chain.Direct.Fixture qualified as Fixture -import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO) -import Hydra.Chain.Direct.State (splitUTxO) -import Hydra.Chain.Direct.TimeHandle (PointInTime) -import Hydra.Chain.Direct.Tx (ClosingSnapshot (..), OpenThreadOutput (..), UTxOHash (UTxOHash), closeTx, mkHeadId, mkHeadOutput) -import Hydra.ContestationPeriod (fromChain) import Hydra.Contract.Error (toErrorCode) import Hydra.Contract.HeadError (HeadError (..)) import Hydra.Contract.HeadState qualified as Head import Hydra.Contract.HeadTokens (headPolicyId) import Hydra.Contract.Util (UtilError (MintingOrBurningIsForbidden)) -import Hydra.Crypto (HydraKey, MultiSignature, aggregate, sign, toPlutusSignatures) -import Hydra.Data.ContestationPeriod qualified as OnChain -import Hydra.Data.Party qualified as OnChain +import Hydra.Crypto (MultiSignature, toPlutusSignatures) import Hydra.Ledger (hashUTxO) -import Hydra.Ledger.Cardano (genAddressInEra, genOneUTxOFor, genValue, genVerificationKey) -import Hydra.Ledger.Cardano.Evaluate (genValidityBoundsFromContestationPeriod) -import Hydra.Party (Party, deriveParty, partyToChain) +import Hydra.Ledger.Cardano (genAddressInEra, genValue, genVerificationKey) import Hydra.Plutus.Extras (posixFromUTCTime) import Hydra.Plutus.Orphans () -import Hydra.Snapshot (Snapshot (..), SnapshotNumber, SnapshotVersion) +import Hydra.Snapshot (Snapshot (..)) import Hydra.Snapshot qualified as Snapshot import PlutusLedgerApi.V1.Time (DiffMilliSeconds (..), fromMilliSeconds) import PlutusLedgerApi.V2 (POSIXTime, PubKeyHash (PubKeyHash), toBuiltin) -import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty) import Test.QuickCheck (arbitrarySizedNatural, choose, elements, listOf1, oneof, suchThat) import Test.QuickCheck.Instances () --- | 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 = - (tx, lookupUTxO) - where - tx = - closeTx - scriptRegistry - somePartyCardanoVerificationKey - closingSnapshot - healthyCloseLowerBoundSlot - healthyCloseUpperBoundPointInTime - openThreadOutput - (mkHeadId Fixture.testPolicyId) - healthyCloseSnapshotVersion - - datum = toUTxOContext (mkTxOutDatumInline healthyOpenDatum) - - lookupUTxO = - UTxO.singleton (healthyOpenHeadTxIn, healthyOpenHeadTxOut datum) - <> registryUTxO scriptRegistry - - scriptRegistry = genScriptRegistry `generateWith` 42 - - openThreadOutput = - OpenThreadOutput - { openThreadUTxO = (healthyOpenHeadTxIn, healthyOpenHeadTxOut datum) - , openParties = healthyOnChainParties - , openContestationPeriod = healthyContestationPeriod - } - -healthyCloseSnapshotNumber :: SnapshotNumber -healthyCloseSnapshotNumber = 1 - -healthyCloseSnapshotVersion :: SnapshotVersion -healthyCloseSnapshotVersion = 1 - -healthyCloseUTxO :: UTxO -healthyCloseUTxO = - genOneUTxOFor somePartyCardanoVerificationKey - `generateWith` 42 - -splittedCloseUTxO :: (UTxO, UTxO) -splittedCloseUTxO = splitUTxO healthyCloseUTxO - -splitUTxOInHead :: UTxO -splitUTxOInHead = fst splittedCloseUTxO - -splitUTxOToDecommit :: UTxO -splitUTxOToDecommit = snd splittedCloseUTxO -healthySnapshot :: Snapshot Tx -healthySnapshot = - Snapshot - { headId = mkHeadId Fixture.testPolicyId - , number = healthyCloseSnapshotNumber - , utxo = splitUTxOInHead - , confirmed = [] - , -- XXX even after observing a decrement tx, - -- the snapshot still contains something to decommit. - utxoToDecommit = Just splitUTxOToDecommit - , version = healthyCloseSnapshotVersion - } +healthyCurrentSnapshotNumber :: Snapshot.SnapshotNumber +healthyCurrentSnapshotNumber = 1 -closingSnapshot :: ClosingSnapshot -closingSnapshot = - CloseWithConfirmedSnapshot - { snapshotNumber = number healthySnapshot - , closeUtxoHash = UTxOHash $ hashUTxO @Tx (utxo healthySnapshot) - , closeUtxoToDecommitHash = UTxOHash $ hashUTxO @Tx (fromMaybe mempty $ utxoToDecommit healthySnapshot) - , signatures = healthySignature (number healthySnapshot) - , version = Snapshot.version healthySnapshot - } +healthyCurrentSnapshotVersion :: Snapshot.SnapshotVersion +healthyCurrentSnapshotVersion = 1 -healthyOpenDatum :: Head.State -healthyOpenDatum = - Head.Open - { parties = healthyOnChainParties - , utxoHash = toBuiltin $ hashUTxO @Tx splitUTxOInHead - , snapshotNumber = toInteger healthyCloseSnapshotNumber - , contestationPeriod = healthyContestationPeriod - , headId = toPlutusCurrencySymbol Fixture.testPolicyId - , version = toInteger healthyCloseSnapshotVersion - } - --- 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 -healthyCloseLowerBoundSlot :: SlotNo -healthyCloseUpperBoundPointInTime :: PointInTime -(healthyCloseLowerBoundSlot, healthyCloseUpperBoundPointInTime) = - genValidityBoundsFromContestationPeriod (fromChain healthyContestationPeriod) `generateWith` 42 - -healthyOpenHeadTxIn :: TxIn -healthyOpenHeadTxIn = generateWith arbitrary 42 - -healthyOpenHeadTxOut :: TxOutDatum CtxUTxO -> TxOut CtxUTxO -healthyOpenHeadTxOut headTxOutDatum = - mkHeadOutput Fixture.testNetworkId Fixture.testPolicyId headTxOutDatum - & addParticipationTokens healthyParticipants - -healthyContestationPeriod :: OnChain.ContestationPeriod -healthyContestationPeriod = OnChain.contestationPeriodFromDiffTime $ fromInteger healthyContestationPeriodSeconds - -healthyContestationPeriodSeconds :: Integer -healthyContestationPeriodSeconds = 10 - -healthyParticipants :: [VerificationKey PaymentKey] -healthyParticipants = - genForParty genVerificationKey <$> healthyParties - -somePartyCardanoVerificationKey :: VerificationKey PaymentKey -somePartyCardanoVerificationKey = - elements healthyParticipants `generateWith` 42 - -healthySigningKeys :: [SigningKey HydraKey] -healthySigningKeys = [aliceSk, bobSk, carolSk] - -healthyParties :: [Party] -healthyParties = deriveParty <$> healthySigningKeys - -healthyOnChainParties :: [OnChain.Party] -healthyOnChainParties = partyToChain <$> healthyParties +-- | 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 = healthyConfirmedClosingSnapshotTx healthyCurrentSnapshot -healthySignature :: SnapshotNumber -> MultiSignature (Snapshot Tx) -healthySignature number = - aggregate [sign sk snapshot | sk <- healthySigningKeys] - where - snapshot = healthySnapshot{number} +healthyCurrentSnapshot :: Snapshot Tx +healthyCurrentSnapshot = healthySnapshot healthyCurrentSnapshotNumber healthyCurrentSnapshotVersion -healthyContestationDeadline :: UTCTime -healthyContestationDeadline = - addUTCTime - (fromInteger healthyContestationPeriodSeconds) - (snd healthyCloseUpperBoundPointInTime) +healthyCurrentOpenDatum :: Head.State +healthyCurrentOpenDatum = healthyOpenDatum healthyCurrentSnapshot data CloseMutation = -- | Ensures collectCom does not allow any output address but νHead. @@ -287,10 +157,10 @@ genCloseCurrentMutation (tx, _utxo) = pure $ Changes [ ChangeOutput 0 $ modifyInlineDatum (replaceSnapshotNumber mutatedSnapshotNumber) headTxOut - , ChangeInputHeadDatum healthyOpenDatum{Head.utxoHash = ""} + , ChangeInputHeadDatum healthyCurrentOpenDatum{Head.utxoHash = ""} ] , SomeMutation (pure $ toErrorCode SignatureVerificationFailed) MutateSnapshotNumberButNotSignature <$> do - mutatedSnapshotNumber <- arbitrarySizedNatural `suchThat` (> healthyCloseSnapshotNumber) + mutatedSnapshotNumber <- arbitrarySizedNatural `suchThat` (> healthyCurrentSnapshotNumber) pure $ ChangeOutput 0 $ modifyInlineDatum (replaceSnapshotNumber $ toInteger mutatedSnapshotNumber) headTxOut , -- , -- XXX: Last known open state version is recorded in closed state -- SomeMutation (pure $ toErrorCode LastKnownVersionIsNotMatching) MutateSnapshotVersion <$> do @@ -298,7 +168,7 @@ genCloseCurrentMutation (tx, _utxo) = -- pure $ ChangeOutput 0 $ modifyInlineDatum (replaceSnapshotVersionInClosed $ toInteger mutatedSnapshotVersion) headTxOut SomeMutation (pure $ toErrorCode SignatureVerificationFailed) SnapshotNotSignedByAllParties . ChangeInputHeadDatum <$> do mutatedParties <- arbitrary `suchThat` (/= healthyOnChainParties) - pure $ healthyOpenDatum{Head.parties = mutatedParties} + pure $ healthyCurrentOpenDatum {Head.parties = mutatedParties} , SomeMutation (pure $ toErrorCode ChangedParameters) MutatePartiesInOutput <$> do n <- choose (1, length healthyOnChainParties - 1) fn <- elements [drop n, take n] @@ -318,7 +188,7 @@ genCloseCurrentMutation (tx, _utxo) = let signerAndOthers = somePartyCardanoVerificationKey : otherSigners pure $ ChangeRequiredSigners (verificationKeyHash <$> signerAndOthers) , SomeMutation (pure $ toErrorCode SignatureVerificationFailed) MutateCloseUTxOHash . ChangeOutput 0 <$> do - mutatedUTxOHash <- genHash `suchThat` ((/= toBuiltin (hashUTxO @Tx splitUTxOInHead)) . toBuiltin) + mutatedUTxOHash <- genHash `suchThat` ((/= toBuiltin (hashUTxO @Tx healthySplitUTxOInHead)) . toBuiltin) pure $ modifyInlineDatum (replaceUtxoHash $ toBuiltin mutatedUTxOHash) headTxOut , -- XXX: Correct contestation deadline is set SomeMutation (pure $ toErrorCode IncorrectClosedContestationDeadline) MutateContestationDeadline <$> do @@ -344,7 +214,7 @@ genCloseCurrentMutation (tx, _utxo) = -- This is a bit confusing and not giving much value. Maybe we can remove this. SomeMutation (pure $ toErrorCode SignerIsNotAParticipant) CloseFromDifferentHead <$> do otherHeadId <- headPolicyId <$> arbitrary `suchThat` (/= Fixture.testSeedInput) - let expectedHash = toBuiltin $ hashUTxO @Tx (fromMaybe mempty $ utxoToDecommit healthySnapshot) + let expectedHash = toBuiltin $ hashUTxO @Tx (fromMaybe mempty $ utxoToDecommit healthyCurrentSnapshot) pure $ Changes [ ChangeOutput 0 (replacePolicyIdWith Fixture.testPolicyId otherHeadId headTxOut) @@ -356,7 +226,7 @@ genCloseCurrentMutation (tx, _utxo) = ( Head.Close { signature = toPlutusSignatures $ - healthySignature healthyCloseSnapshotNumber + healthySignature healthyCurrentSnapshot , version = Head.CurrentVersion , utxoToDecommitHash = expectedHash } @@ -388,7 +258,7 @@ genCloseCurrentMutation (tx, _utxo) = headTxOut = fromJust $ txOuts' tx !!? 0 - datum = toUTxOContext (mkTxOutDatumInline healthyOpenDatum) + datum = toUTxOContext (mkTxOutDatumInline healthyCurrentOpenDatum) -- | Generate not acceptable, but interesting deadlines. genMutatedDeadline :: Gen POSIXTime 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 2f799f1878c..59cc2645eeb 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseInitial.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseInitial.hs @@ -8,40 +8,32 @@ import Hydra.Prelude hiding (label) import Cardano.Api.UTxO as UTxO import Data.Maybe (fromJust) -import Hydra.Chain.Direct.Contract.Mutation ( - Mutation (..), - SomeMutation (..), - addParticipationTokens, - modifyInlineDatum, - replaceContestationDeadline, - ) +import Hydra.Chain.Direct.Contract.Close.Healthy (healthyCloseLowerBoundSlot, healthyCloseUpperBoundPointInTime, healthyContestationDeadline, healthyContestationPeriod, healthyOnChainParties, healthyOpenDatum, healthyOpenHeadTxIn, healthyOpenHeadTxOut, healthyUTxO, somePartyCardanoVerificationKey, healthySnapshot) +import Hydra.Chain.Direct.Contract.Mutation (Mutation (..), SomeMutation (..), modifyInlineDatum, replaceContestationDeadline) import Hydra.Chain.Direct.Fixture qualified as Fixture -import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO) -import Hydra.Chain.Direct.TimeHandle (PointInTime) -import Hydra.Chain.Direct.Tx (ClosingSnapshot (..), OpenThreadOutput (..), UTxOHash (UTxOHash), closeTx, mkHeadId, mkHeadOutput) -import Hydra.ContestationPeriod (fromChain) -import Hydra.Contract.Error (toErrorCode) +import Hydra.Chain.Direct.ScriptRegistry (ScriptRegistry, genScriptRegistry, registryUTxO) +import Hydra.Chain.Direct.Tx (ClosingSnapshot (..), OpenThreadOutput (..), UTxOHash (UTxOHash), closeTx, mkHeadId) +import Hydra.Contract.Error (ToErrorCode (..)) import Hydra.Contract.HeadError (HeadError (..)) -import Hydra.Contract.HeadState qualified as Head -import Hydra.Crypto (HydraKey) -import Hydra.Data.ContestationPeriod qualified as OnChain -import Hydra.Data.Party qualified as OnChain import Hydra.Ledger (hashUTxO) -import Hydra.Ledger.Cardano (genOneUTxOFor, genVerificationKey) -import Hydra.Ledger.Cardano.Evaluate (genValidityBoundsFromContestationPeriod) -import Hydra.Party (Party, deriveParty, partyToChain) import Hydra.Plutus.Extras (posixFromUTCTime) import Hydra.Plutus.Orphans () -import Hydra.Snapshot (SnapshotNumber, SnapshotVersion) -import PlutusLedgerApi.V2 (POSIXTime, toBuiltin) -import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty) -import Test.QuickCheck (elements, oneof, suchThat) +import PlutusLedgerApi.V2 (POSIXTime) +import Test.QuickCheck (oneof, suchThat) import Test.QuickCheck.Instances () +import Hydra.Snapshot (Snapshot, SnapshotVersion, SnapshotNumber) +import qualified Hydra.Contract.HeadState as HeadState data CloseInitialMutation = MutateCloseContestationDeadline' deriving stock (Generic, Show, Enum, Bounded) +healthyCloseSnapshotNumber :: SnapshotNumber +healthyCloseSnapshotNumber = 0 + +healthyCloseSnapshotVersion :: SnapshotVersion +healthyCloseSnapshotVersion = 0 + -- | Healthy close transaction for the specific case were we close a head -- with the initial UtxO, that is, no snapshot have been agreed upon and -- signed by the head members yet. @@ -49,6 +41,7 @@ healthyCloseInitialTx :: (Tx, UTxO) healthyCloseInitialTx = (tx, lookupUTxO) where + tx :: Tx tx = closeTx scriptRegistry @@ -60,97 +53,43 @@ healthyCloseInitialTx = (mkHeadId Fixture.testPolicyId) healthyCloseSnapshotVersion - initialDatum = toUTxOContext (mkTxOutDatumInline healthyOpenHeadDatum) + initialDatum :: TxOutDatum CtxUTxO + initialDatum = toUTxOContext (mkTxOutDatumInline healthyCloseInitialOpenDatum) + lookupUTxO :: UTxO' (TxOut CtxUTxO) lookupUTxO = UTxO.singleton (healthyOpenHeadTxIn, healthyOpenHeadTxOut initialDatum) <> registryUTxO scriptRegistry + scriptRegistry :: ScriptRegistry scriptRegistry = genScriptRegistry `generateWith` 42 + openThreadOutput :: OpenThreadOutput openThreadOutput = OpenThreadOutput { openThreadUTxO = (healthyOpenHeadTxIn, healthyOpenHeadTxOut initialDatum) , openParties = healthyOnChainParties , openContestationPeriod = healthyContestationPeriod } + closingSnapshot :: ClosingSnapshot closingSnapshot = CloseWithInitialSnapshot { openUtxoHash = UTxOHash $ hashUTxO @Tx healthyUTxO } -healthyContestationPeriod :: OnChain.ContestationPeriod -healthyContestationPeriod = OnChain.contestationPeriodFromDiffTime $ fromInteger healthyContestationPeriodSeconds - -healthyContestationPeriodSeconds :: Integer -healthyContestationPeriodSeconds = 10 - -healthyParticipants :: [VerificationKey PaymentKey] -healthyParticipants = - genForParty genVerificationKey <$> healthyParties - -somePartyCardanoVerificationKey :: VerificationKey PaymentKey -somePartyCardanoVerificationKey = - elements healthyParticipants `generateWith` 42 +healthyCloseInitialSnapshot :: Snapshot Tx +healthyCloseInitialSnapshot = healthySnapshot healthyCloseSnapshotNumber healthyCloseSnapshotVersion -healthySigningKeys :: [SigningKey HydraKey] -healthySigningKeys = [aliceSk, bobSk, carolSk] - -healthyParties :: [Party] -healthyParties = deriveParty <$> healthySigningKeys - -healthyOnChainParties :: [OnChain.Party] -healthyOnChainParties = partyToChain <$> healthyParties - -healthyContestationDeadline :: UTCTime -healthyContestationDeadline = - addUTCTime - (fromInteger healthyContestationPeriodSeconds) - (snd healthyCloseUpperBoundPointInTime) - -healthyOpenHeadDatum :: Head.State -healthyOpenHeadDatum = - Head.Open - { parties = healthyOnChainParties - , utxoHash = toBuiltin $ hashUTxO @Tx healthyUTxO - , snapshotNumber = toInteger healthyCloseSnapshotNumber - , contestationPeriod = healthyContestationPeriod - , headId = toPlutusCurrencySymbol Fixture.testPolicyId - , version = toInteger healthyCloseSnapshotVersion - } - -healthyCloseSnapshotNumber :: SnapshotNumber -healthyCloseSnapshotNumber = 0 - -healthyCloseSnapshotVersion :: SnapshotVersion -healthyCloseSnapshotVersion = 0 +healthyCloseInitialOpenDatum :: HeadState.State +healthyCloseInitialOpenDatum = healthyOpenDatum healthyCloseInitialSnapshot -healthyUTxO :: UTxO -healthyUTxO = genOneUTxOFor somePartyCardanoVerificationKey `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 -healthyCloseLowerBoundSlot :: SlotNo -healthyCloseUpperBoundPointInTime :: PointInTime -(healthyCloseLowerBoundSlot, healthyCloseUpperBoundPointInTime) = - genValidityBoundsFromContestationPeriod (fromChain healthyContestationPeriod) `generateWith` 42 - -healthyOpenHeadTxIn :: TxIn -healthyOpenHeadTxIn = generateWith arbitrary 42 - -healthyOpenHeadTxOut :: TxOutDatum CtxUTxO -> TxOut CtxUTxO -healthyOpenHeadTxOut headTxOutDatum = - mkHeadOutput Fixture.testNetworkId Fixture.testPolicyId headTxOutDatum - & addParticipationTokens healthyParticipants - --- | Mutations for the specific case of closing with the intial state. --- We should probably validate all the mutation to this initial state but at --- least we keep this regression test as we stumbled upon problems with the following case. --- The nice thing to do would probably to generate either "normal" healthyCloseTx or --- or healthyCloseInitialTx and apply all the mutations to it but we didn't manage to do that --- right away. +--- | Mutations for the specific case of closing with the intial state. +--- We should probably validate all the mutation to this initial state but at +--- least we keep this regression test as we stumbled upon problems with the following case. +--- The nice thing to do would probably to generate either "normal" healthyCloseTx or +--- or healthyCloseInitialTx and apply all the mutations to it but we didn't manage to do that +--- right away. genCloseInitialMutation :: (Tx, UTxO) -> Gen SomeMutation genCloseInitialMutation (tx, _utxo) = SomeMutation (pure $ toErrorCode IncorrectClosedContestationDeadline) MutateCloseContestationDeadline' <$> do 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 ebe5cc8720c..d01338fd801 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseOutdated.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseOutdated.hs @@ -6,13 +6,11 @@ module Hydra.Chain.Direct.Contract.Close.CloseOutdated where import Hydra.Cardano.Api import Hydra.Prelude hiding (label) -import Cardano.Api.UTxO as UTxO import Data.Maybe (fromJust) import Hydra.Chain.Direct.Contract.Gen (genHash, genMintedOrBurnedValue) import Hydra.Chain.Direct.Contract.Mutation ( Mutation (..), SomeMutation (..), - addParticipationTokens, changeMintedTokens, modifyInlineDatum, replaceContestationDeadline, @@ -24,165 +22,55 @@ import Hydra.Chain.Direct.Contract.Mutation ( replaceSnapshotNumber, replaceUtxoHash, ) +import Hydra.Chain.Direct.Contract.Close.Healthy (healthyContestationDeadline, healthyContestationPeriodSeconds, healthyOnChainParties, healthyOpenDatum, healthyOpenHeadTxIn, healthyOpenHeadTxOut, healthySignature, somePartyCardanoVerificationKey, healthySplitUTxOInHead, healthySplitUTxOToDecommit, healthyCloseUTxOHash, healthyConfirmedClosingSnapshot, healthyConfirmedClosingSnapshotTx) import Hydra.Chain.Direct.Fixture qualified as Fixture -import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO) -import Hydra.Chain.Direct.State (splitUTxO) -import Hydra.Chain.Direct.TimeHandle (PointInTime) -import Hydra.Chain.Direct.Tx (ClosingSnapshot (..), OpenThreadOutput (..), UTxOHash (UTxOHash), closeTx, mkHeadId, mkHeadOutput) -import Hydra.ContestationPeriod (fromChain) +import Hydra.Chain.Direct.Tx (ClosingSnapshot (..), UTxOHash (UTxOHash), mkHeadId) import Hydra.Contract.Error (toErrorCode) import Hydra.Contract.HeadError (HeadError (..)) import Hydra.Contract.HeadState qualified as Head import Hydra.Contract.HeadTokens (headPolicyId) import Hydra.Contract.Util (UtilError (MintingOrBurningIsForbidden)) -import Hydra.Crypto (HydraKey, MultiSignature (..), aggregate, sign, toPlutusSignatures) -import Hydra.Data.ContestationPeriod qualified as OnChain -import Hydra.Data.Party qualified as OnChain +import Hydra.Crypto (MultiSignature (..), toPlutusSignatures) import Hydra.Ledger (hashUTxO) -import Hydra.Ledger.Cardano (genAddressInEra, genOneUTxOFor, genValue, genVerificationKey) -import Hydra.Ledger.Cardano.Evaluate (genValidityBoundsFromContestationPeriod) -import Hydra.Party (Party, deriveParty, partyToChain) +import Hydra.Ledger.Cardano (genAddressInEra, genValue, genVerificationKey) import Hydra.Plutus.Extras (posixFromUTCTime) import Hydra.Plutus.Orphans () import Hydra.Snapshot (Snapshot (..), SnapshotNumber, SnapshotVersion) -import Hydra.Snapshot qualified as Snapshot import PlutusLedgerApi.V1.Time (DiffMilliSeconds (..), fromMilliSeconds) -import PlutusLedgerApi.V2 (BuiltinByteString, POSIXTime, PubKeyHash (PubKeyHash), toBuiltin) -import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty) +import PlutusLedgerApi.V2 (POSIXTime, PubKeyHash (PubKeyHash), toBuiltin) import Test.QuickCheck (arbitrarySizedNatural, choose, elements, listOf1, oneof, suchThat) import Test.QuickCheck.Instances () --- | Healthy close transaction for the generic case were we close a head --- after one or more snapshot have been agreed upon between the members. -healthyCloseOutdatedTx :: (Tx, UTxO) -healthyCloseOutdatedTx = - (tx, lookupUTxO) - where - tx = - closeTx - scriptRegistry - somePartyCardanoVerificationKey - closingSnapshot - healthyCloseLowerBoundSlot - healthyCloseUpperBoundPointInTime - openThreadOutput - (mkHeadId Fixture.testPolicyId) - healthyCloseSnapshotVersion - - datum = toUTxOContext (mkTxOutDatumInline healthyOpenDatum) - - lookupUTxO = - UTxO.singleton (healthyOpenHeadTxIn, healthyOpenHeadTxOut datum) - <> registryUTxO scriptRegistry - - scriptRegistry = genScriptRegistry `generateWith` 42 - - openThreadOutput = - OpenThreadOutput - { openThreadUTxO = (healthyOpenHeadTxIn, healthyOpenHeadTxOut datum) - , openParties = healthyOnChainParties - , openContestationPeriod = healthyContestationPeriod - } +healthyOutdatedSnapshotNumber :: SnapshotNumber +healthyOutdatedSnapshotNumber = 1 -healthyCloseSnapshotNumber :: SnapshotNumber -healthyCloseSnapshotNumber = 1 - -healthyCloseSnapshotVersion :: SnapshotVersion -healthyCloseSnapshotVersion = 1 - -healthyCloseUTxO :: UTxO -healthyCloseUTxO = - genOneUTxOFor somePartyCardanoVerificationKey - `generateWith` 42 - -splitUTxOInHead, splitUTxOToDecommit :: UTxO -(splitUTxOInHead, splitUTxOToDecommit) = splitUTxO healthyCloseUTxO +healthyOutdatedSnapshotVersion :: SnapshotVersion +healthyOutdatedSnapshotVersion = 1 --- XXX: Decommit snapshot which we want to mimick so that we test how close --- behaves after decommit. -healthySnapshot :: Snapshot Tx -healthySnapshot = +healthyOutdatedSnapshot :: Snapshot Tx +healthyOutdatedSnapshot = Snapshot { headId = mkHeadId Fixture.testPolicyId - , number = healthyCloseSnapshotNumber - , utxo = splitUTxOInHead + , number = healthyOutdatedSnapshotNumber + , utxo = healthySplitUTxOInHead , confirmed = [] , -- XXX even after observing a decrement tx, -- the snapshot still contains something to decommit. - utxoToDecommit = Just splitUTxOToDecommit - , -- XXX this is the version used to sign the snapshot - -- before observing a decommit - version = healthyCloseSnapshotVersion - 1 + utxoToDecommit = Just healthySplitUTxOToDecommit + , version = healthyOutdatedSnapshotVersion } -closingSnapshot :: ClosingSnapshot -closingSnapshot = - CloseWithConfirmedSnapshot - { snapshotNumber = number healthySnapshot - , closeUtxoHash = UTxOHash $ hashUTxO @Tx (utxo healthySnapshot) - , closeUtxoToDecommitHash = UTxOHash $ hashUTxO @Tx (fromMaybe mempty $ utxoToDecommit healthySnapshot) - , signatures = healthySignature (number healthySnapshot) healthySnapshot - , version = Snapshot.version healthySnapshot - } - -healthyOpenDatum :: Head.State -healthyOpenDatum = - Head.Open - { parties = healthyOnChainParties - , utxoHash = toBuiltin $ hashUTxO @Tx splitUTxOInHead - , snapshotNumber = toInteger healthyCloseSnapshotNumber - , contestationPeriod = healthyContestationPeriod - , headId = toPlutusCurrencySymbol Fixture.testPolicyId - , version = toInteger healthyCloseSnapshotVersion - } +healthyOutdatedOpenDatum :: Head.State +healthyOutdatedOpenDatum = healthyOpenDatum healthyOutdatedSnapshot --- 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 -healthyCloseLowerBoundSlot :: SlotNo -healthyCloseUpperBoundPointInTime :: PointInTime -(healthyCloseLowerBoundSlot, healthyCloseUpperBoundPointInTime) = - genValidityBoundsFromContestationPeriod (fromChain healthyContestationPeriod) `generateWith` 42 +healthyOutdatedConfirmedClosingSnapshot :: ClosingSnapshot +healthyOutdatedConfirmedClosingSnapshot = healthyConfirmedClosingSnapshot healthyOutdatedSnapshot -healthyOpenHeadTxIn :: TxIn -healthyOpenHeadTxIn = generateWith arbitrary 42 - -healthyOpenHeadTxOut :: TxOutDatum CtxUTxO -> TxOut CtxUTxO -healthyOpenHeadTxOut headTxOutDatum = - mkHeadOutput Fixture.testNetworkId Fixture.testPolicyId headTxOutDatum - & addParticipationTokens healthyParticipants - -healthyContestationPeriod :: OnChain.ContestationPeriod -healthyContestationPeriod = OnChain.contestationPeriodFromDiffTime $ fromInteger healthyContestationPeriodSeconds - -healthyContestationPeriodSeconds :: Integer -healthyContestationPeriodSeconds = 10 - -healthyParticipants :: [VerificationKey PaymentKey] -healthyParticipants = - genForParty genVerificationKey <$> healthyParties - -somePartyCardanoVerificationKey :: VerificationKey PaymentKey -somePartyCardanoVerificationKey = - elements healthyParticipants `generateWith` 42 - -healthySigningKeys :: [SigningKey HydraKey] -healthySigningKeys = [aliceSk, bobSk, carolSk] - -healthyParties :: [Party] -healthyParties = deriveParty <$> healthySigningKeys - -healthyOnChainParties :: [OnChain.Party] -healthyOnChainParties = partyToChain <$> healthyParties - -healthySignature :: SnapshotNumber -> Snapshot Tx -> MultiSignature (Snapshot Tx) -healthySignature number snapshot = aggregate [sign sk snapshot{number} | sk <- healthySigningKeys] +healthyCloseOutdatedTx :: (Tx, UTxO) +healthyCloseOutdatedTx = healthyConfirmedClosingSnapshotTx healthyOutdatedSnapshot -healthyContestationDeadline :: UTCTime -healthyContestationDeadline = - addUTCTime - (fromInteger healthyContestationPeriodSeconds) - (snd healthyCloseUpperBoundPointInTime) data CloseMutation = -- | Ensures collectCom does not allow any output address but νHead. @@ -290,10 +178,10 @@ genCloseOutdatedMutation (tx, _utxo) = pure $ Changes [ ChangeOutput 0 $ modifyInlineDatum (replaceSnapshotNumber mutatedSnapshotNumber) headTxOut - , ChangeInputHeadDatum healthyOpenDatum{Head.utxoHash = ""} + , ChangeInputHeadDatum healthyOutdatedOpenDatum{Head.utxoHash = ""} ] , SomeMutation (pure $ toErrorCode SignatureVerificationFailed) MutateSnapshotNumberButNotSignature <$> do - mutatedSnapshotNumber <- arbitrarySizedNatural `suchThat` (> healthyCloseSnapshotNumber) + mutatedSnapshotNumber <- arbitrarySizedNatural `suchThat` (> healthyOutdatedSnapshotNumber) pure $ ChangeOutput 0 $ modifyInlineDatum (replaceSnapshotNumber $ toInteger mutatedSnapshotNumber) headTxOut , -- , -- XXX: Last known open state version is recorded in closed state -- SomeMutation (pure $ toErrorCode LastKnownVersionIsNotMatching) MutateSnapshotVersion <$> do @@ -301,7 +189,7 @@ genCloseOutdatedMutation (tx, _utxo) = -- pure $ ChangeOutput 0 $ modifyInlineDatum (replaceSnapshotVersionInClosed $ toInteger mutatedSnapshotVersion) headTxOut SomeMutation (pure $ toErrorCode SignatureVerificationFailed) SnapshotNotSignedByAllParties . ChangeInputHeadDatum <$> do mutatedParties <- arbitrary `suchThat` (/= healthyOnChainParties) - pure $ healthyOpenDatum{Head.parties = mutatedParties} + pure $ healthyOutdatedOpenDatum{Head.parties = mutatedParties} , SomeMutation (pure $ toErrorCode ChangedParameters) MutatePartiesInOutput <$> do n <- choose (1, length healthyOnChainParties - 1) fn <- elements [drop n, take n] @@ -347,7 +235,7 @@ genCloseOutdatedMutation (tx, _utxo) = -- This is a bit confusing and not giving much value. Maybe we can remove this. SomeMutation (pure $ toErrorCode SignerIsNotAParticipant) CloseFromDifferentHead <$> do otherHeadId <- headPolicyId <$> arbitrary `suchThat` (/= Fixture.testSeedInput) - let expectedHash = toBuiltin $ hashUTxO @Tx (fromMaybe mempty $ utxoToDecommit healthySnapshot) + let expectedHash = toBuiltin $ hashUTxO @Tx (fromMaybe mempty $ utxoToDecommit healthyOutdatedSnapshot) pure $ Changes [ ChangeOutput 0 (replacePolicyIdWith Fixture.testPolicyId otherHeadId headTxOut) @@ -359,7 +247,7 @@ genCloseOutdatedMutation (tx, _utxo) = ( Head.Close { signature = toPlutusSignatures $ - healthySignature healthyCloseSnapshotNumber healthySnapshot + healthySignature healthyOutdatedSnapshot , version = Head.CurrentVersion , utxoToDecommitHash = expectedHash } @@ -378,21 +266,21 @@ genCloseOutdatedMutation (tx, _utxo) = newValue <- genValue pure $ ChangeOutput 0 (headTxOut{txOutValue = newValue}) , SomeMutation (pure $ toErrorCode SignatureVerificationFailed) MutateCloseUTxOToDecommitHash . ChangeHeadRedeemer <$> do - let UTxOHash expectedHash = closeUtxoToDecommitHash closingSnapshot + let UTxOHash expectedHash = closeUtxoToDecommitHash healthyOutdatedConfirmedClosingSnapshot -- XXX: Close redeemer contains the hash of a decommit utxo. If we -- change it should cause invalid signature error. - pure $ Head.Close (toPlutusSignatures $ signatures closingSnapshot) Head.OutdatedVersion (toBuiltin $ expectedHash <> "0") + pure $ Head.Close (toPlutusSignatures $ signatures healthyOutdatedConfirmedClosingSnapshot) Head.OutdatedVersion (toBuiltin $ expectedHash <> "0") , SomeMutation (pure $ toErrorCode SignatureVerificationFailed) MutateCloseSignatures . ChangeHeadRedeemer <$> do - let UTxOHash expectedHash = closeUtxoToDecommitHash closingSnapshot + let UTxOHash expectedHash = closeUtxoToDecommitHash healthyOutdatedConfirmedClosingSnapshot sigs <- toPlutusSignatures <$> (arbitrary :: Gen (MultiSignature (Snapshot Tx))) -- XXX: Close redeemer contains the signatures. If we -- change them should cause invalid signature error. pure $ Head.Close sigs Head.OutdatedVersion (toBuiltin expectedHash) , SomeMutation (pure $ toErrorCode SignatureVerificationFailed) MutateCloseVersion . ChangeHeadRedeemer <$> do - let UTxOHash expectedHash = closeUtxoToDecommitHash closingSnapshot + let UTxOHash expectedHash = closeUtxoToDecommitHash healthyOutdatedConfirmedClosingSnapshot -- XXX: Close redeemer contains the appropriate version. If we -- change it then it should cause invalid signature error. - pure $ Head.Close (toPlutusSignatures $ signatures closingSnapshot) Head.CurrentVersion (toBuiltin expectedHash) + pure $ Head.Close (toPlutusSignatures $ signatures healthyOutdatedConfirmedClosingSnapshot) Head.CurrentVersion (toBuiltin expectedHash) ] where genOversizedTransactionValidity = do @@ -405,7 +293,7 @@ genCloseOutdatedMutation (tx, _utxo) = headTxOut = fromJust $ txOuts' tx !!? 0 - datum = toUTxOContext (mkTxOutDatumInline healthyOpenDatum) + datum = toUTxOContext (mkTxOutDatumInline healthyOutdatedOpenDatum) -- | Generate not acceptable, but interesting deadlines. genMutatedDeadline :: Gen POSIXTime @@ -420,7 +308,3 @@ genMutatedDeadline = do valuesAroundDeadline = arbitrary `suchThat` (/= 0) <&> (+ deadline) deadline = posixFromUTCTime healthyContestationDeadline - -healthyCloseUTxOHash :: BuiltinByteString -healthyCloseUTxOHash = - toBuiltin $ hashUTxO @Tx splitUTxOInHead diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Close/Healthy.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Close/Healthy.hs new file mode 100644 index 00000000000..a9720b9cdbe --- /dev/null +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Close/Healthy.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Hydra.Chain.Direct.Contract.Close.Healthy where + +import Hydra.Cardano.Api +import Hydra.Prelude hiding (label) + +import Hydra.Chain.Direct.Contract.Mutation ( + addParticipationTokens, + ) +import Hydra.Chain.Direct.Fixture qualified as Fixture +import Hydra.Chain.Direct.State (splitUTxO) +import Hydra.Chain.Direct.TimeHandle (PointInTime) +import Hydra.Chain.Direct.Tx (mkHeadId, mkHeadOutput, ClosingSnapshot (..), UTxOHash (..), OpenThreadOutput (..), closeTx) +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 +import Hydra.Ledger (hashUTxO) +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 as Snapshot (Snapshot (..), SnapshotNumber, SnapshotVersion) +import PlutusLedgerApi.V2 (toBuiltin, BuiltinByteString) +import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty) +import Test.QuickCheck (elements) +import Test.QuickCheck.Instances () +import qualified Cardano.Api.UTxO as UTxO +import Hydra.Chain.Direct.ScriptRegistry (registryUTxO, genScriptRegistry, ScriptRegistry) + +healthySeed :: Int +healthySeed = 42 + +healthyUTxO :: UTxO +healthyUTxO = genOneUTxOFor somePartyCardanoVerificationKey `generateWith` healthySeed + +healthySplitUTxOInHead :: UTxO +healthySplitUTxOToDecommit :: UTxO +(healthySplitUTxOInHead, healthySplitUTxOToDecommit) = splitUTxO healthyUTxO + +-- 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 +healthyCloseLowerBoundSlot :: SlotNo +healthyCloseUpperBoundPointInTime :: PointInTime +(healthyCloseLowerBoundSlot, healthyCloseUpperBoundPointInTime) = + genValidityBoundsFromContestationPeriod (fromChain healthyContestationPeriod) `generateWith` healthySeed + +healthyOpenHeadTxIn :: TxIn +healthyOpenHeadTxIn = generateWith arbitrary healthySeed + +healthyOpenHeadTxOut :: TxOutDatum CtxUTxO -> TxOut CtxUTxO +healthyOpenHeadTxOut headTxOutDatum = + mkHeadOutput Fixture.testNetworkId Fixture.testPolicyId headTxOutDatum + & addParticipationTokens healthyParticipants + +healthyContestationPeriodSeconds :: Integer +healthyContestationPeriodSeconds = 10 + +healthyContestationPeriod :: OnChain.ContestationPeriod +healthyContestationPeriod = OnChain.contestationPeriodFromDiffTime $ fromInteger healthyContestationPeriodSeconds + +healthyContestationDeadline :: UTCTime +healthyContestationDeadline = + addUTCTime + (fromInteger healthyContestationPeriodSeconds) + (snd healthyCloseUpperBoundPointInTime) + +healthyCloseUTxOHash :: BuiltinByteString +healthyCloseUTxOHash = + toBuiltin $ hashUTxO @Tx healthySplitUTxOInHead + +healthyParticipants :: [VerificationKey PaymentKey] +healthyParticipants = + genForParty genVerificationKey <$> healthyParties + +somePartyCardanoVerificationKey :: VerificationKey PaymentKey +somePartyCardanoVerificationKey = + elements healthyParticipants `generateWith` healthySeed + +healthySigningKeys :: [SigningKey HydraKey] +healthySigningKeys = [aliceSk, bobSk, carolSk] + +healthyParties :: [Party] +healthyParties = deriveParty <$> healthySigningKeys + +healthyOnChainParties :: [OnChain.Party] +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 + , number + , utxo = healthySplitUTxOInHead + , confirmed = [] + , -- XXX even after observing a decrement tx, + -- the snapshot still contains something to decommit. + utxoToDecommit = Just healthySplitUTxOToDecommit + , version + } + +healthyOpenDatum :: Snapshot Tx -> Head.State +healthyOpenDatum Snapshot{version, number} = + Head.Open + { parties = healthyOnChainParties + , utxoHash = toBuiltin $ hashUTxO @Tx healthySplitUTxOInHead + , snapshotNumber = toInteger number + , contestationPeriod = healthyContestationPeriod + , headId = toPlutusCurrencySymbol Fixture.testPolicyId + , version = toInteger version + } + +healthyConfirmedClosingSnapshot :: Snapshot Tx -> ClosingSnapshot +healthyConfirmedClosingSnapshot snapshot = + CloseWithConfirmedSnapshot + { snapshotNumber = number snapshot + , closeUtxoHash = UTxOHash $ hashUTxO @Tx $ utxo snapshot + , closeUtxoToDecommitHash = UTxOHash $ hashUTxO @Tx $ fromMaybe mempty $ utxoToDecommit snapshot + , signatures = healthySignature snapshot + , version = Snapshot.version snapshot + } + +healthyConfirmedClosingSnapshotTx :: Snapshot Tx -> (Tx, UTxO) +healthyConfirmedClosingSnapshotTx snapshot@Snapshot{version} = + (tx, lookupUTxO) + where + tx :: Tx + tx = + closeTx + scriptRegistry + somePartyCardanoVerificationKey + (healthyConfirmedClosingSnapshot snapshot) + healthyCloseLowerBoundSlot + healthyCloseUpperBoundPointInTime + openThreadOutput + (mkHeadId Fixture.testPolicyId) + version + + datum :: TxOutDatum CtxUTxO + datum = toUTxOContext $ mkTxOutDatumInline $ healthyOpenDatum snapshot + + lookupUTxO :: UTxO' (TxOut CtxUTxO) + lookupUTxO = + UTxO.singleton (healthyOpenHeadTxIn, healthyOpenHeadTxOut datum) + <> registryUTxO scriptRegistry + + scriptRegistry :: ScriptRegistry + scriptRegistry = genScriptRegistry `generateWith` healthySeed + + openThreadOutput :: OpenThreadOutput + openThreadOutput = + OpenThreadOutput + { openThreadUTxO = (healthyOpenHeadTxIn, healthyOpenHeadTxOut datum) + , openParties = healthyOnChainParties + , openContestationPeriod = healthyContestationPeriod + } diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index 1a9aa35b27e..4a9e4cd03ff 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -39,7 +39,7 @@ import Data.Text qualified as T import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Hydra.Cardano.Api.Pretty (renderTx, renderTxWithUTxO) import Hydra.Chain (CommitBlueprintTx (..), HeadParameters (..)) -import Hydra.Chain.Direct.Contract.Close.CloseCurrent (healthyOpenHeadTxOut) +import Hydra.Chain.Direct.Contract.Close.Healthy (healthyOpenHeadTxOut) import Hydra.Chain.Direct.Contract.Commit (commitSigningKey, healthyInitialTxIn, healthyInitialTxOut) import Hydra.Chain.Direct.Fixture ( epochInfo, diff --git a/hydra-plutus/src/Hydra/Contract/Commit.hs b/hydra-plutus/src/Hydra/Contract/Commit.hs index 01982d871c5..f0908534bc8 100644 --- a/hydra-plutus/src/Hydra/Contract/Commit.hs +++ b/hydra-plutus/src/Hydra/Contract/Commit.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-specialize #-} -{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-} {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:conservative-optimisation #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-} -- Plutus core version to compile to. In babbage era, that is Cardano protocol -- version 7 and 8, only plutus-core version 1.0.0 is available. {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 #-}