From ef81ded4ed9583234d86c11bf1a9eb7e16de2d3b Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Wed, 8 Feb 2023 16:38:31 +0100 Subject: [PATCH 01/24] Add contestationPeriod to Closed head state - Introduce a mutation - Introduce a validator check for pushing the deadline --- hydra-node/src/Hydra/Chain/Direct/State.hs | 2 +- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 4 +++- .../test/Hydra/Chain/Direct/Contract/Contest.hs | 12 ++++++++++++ hydra-plutus/src/Hydra/Contract/Head.hs | 15 ++++++++++----- hydra-plutus/src/Hydra/Contract/HeadState.hs | 1 + 5 files changed, 27 insertions(+), 7 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct/State.hs b/hydra-node/src/Hydra/Chain/Direct/State.hs index 549edaa7c43..a77383bb5a5 100644 --- a/hydra-node/src/Hydra/Chain/Direct/State.hs +++ b/hydra-node/src/Hydra/Chain/Direct/State.hs @@ -433,7 +433,7 @@ contest :: PointInTime -> Tx contest ctx st confirmedSnapshot pointInTime = do - contestTx ownVerificationKey sn sigs pointInTime closedThreadOutput headId + contestTx ownVerificationKey sn sigs pointInTime closedThreadOutput headId (contestationPeriod ctx) where (sn, sigs) = case confirmedSnapshot of diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index 73188f3e2d6..002c6ecd5d0 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -391,8 +391,9 @@ contestTx :: -- | Everything needed to spend the Head state-machine output. ClosedThreadOutput -> HeadId -> + ContestationPeriod -> Tx -contestTx vk Snapshot{number, utxo} sig (slotNo, _) ClosedThreadOutput{closedThreadUTxO = (headInput, headOutputBefore, ScriptDatumForTxIn -> headDatumBefore), closedParties, closedContestationDeadline, closedContesters} headId = +contestTx vk Snapshot{number, utxo} sig (slotNo, _) ClosedThreadOutput{closedThreadUTxO = (headInput, headOutputBefore, ScriptDatumForTxIn -> headDatumBefore), closedParties, closedContestationDeadline, closedContesters} headId contestationPeriod = unsafeBuildTransaction $ emptyTxBody & addInputs [(headInput, headWitness)] @@ -421,6 +422,7 @@ contestTx vk Snapshot{number, utxo} sig (slotNo, _) ClosedThreadOutput{closedThr , utxoHash , parties = closedParties , contestationDeadline = closedContestationDeadline + , contestationPeriod = toChain contestationPeriod , headId = headIdToCurrencySymbol headId , contesters = contester : closedContesters } diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index c864b61e9e6..7ff63e32be4 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -10,6 +10,7 @@ import Hydra.Prelude hiding (label) import Data.Maybe (fromJust) import Cardano.Api.UTxO as UTxO +import Hydra.Chain.Direct.Contract.Close (genMutatedDeadline) import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue) import Hydra.Chain.Direct.Contract.Mutation ( Mutation (..), @@ -17,6 +18,7 @@ import Hydra.Chain.Direct.Contract.Mutation ( addParticipationTokens, changeHeadOutputDatum, changeMintedTokens, + replaceContestationDeadline, replaceContesters, replaceParties, replacePolicyIdWith, @@ -181,6 +183,9 @@ data ContestMutation MutateContesters | -- | See spec: 5.5. rule 6 -> value is preserved MutateValueInOutput + | -- | Should change the 'ContestationDeadline' in the 'Closed' datum for contest tx such that + -- deadline is pushed in an unexpected way + MutateContestationDeadlineInTheClosedState deriving (Generic, Show, Enum, Bounded) genContestMutation :: (Tx, UTxO) -> Gen SomeMutation @@ -256,6 +261,13 @@ genContestMutation , SomeMutation (Just "head value is not preserved") MutateValueInOutput <$> do newValue <- genValue pure $ ChangeOutput 0 (headTxOut{txOutValue = newValue}) + , SomeMutation (Just "must push deadline") MutateContestationDeadlineInTheClosedState . ChangeOutput 0 <$> do + -- let deadline = + -- case healthyClosedState of + -- Head.Closed{contestationDeadline} -> contestationDeadline + -- _ -> error "not in a closed state" + -- mutatedDeadline <- genMutatedDeadline `suchThat` (> deadline) + pure headTxOut -- changeHeadOutputDatum (replaceContestationDeadline deadline) headTxOut ] where headTxOut = fromJust $ txOuts' tx !!? 0 diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs index 1fc51b4e7b3..dcb1586a10b 100644 --- a/hydra-plutus/src/Hydra/Contract/Head.hs +++ b/hydra-plutus/src/Hydra/Contract/Head.hs @@ -81,8 +81,8 @@ headValidator oldState input ctx = checkAbort ctx headId parties (Open{parties, utxoHash = initialUtxoHash, contestationPeriod, headId}, Close{signature}) -> checkClose ctx parties initialUtxoHash signature contestationPeriod headId - (Closed{parties, snapshotNumber = closedSnapshotNumber, contestationDeadline, headId, contesters}, Contest{signature}) -> - checkContest ctx contestationDeadline parties closedSnapshotNumber signature contesters headId + (Closed{parties, snapshotNumber = closedSnapshotNumber, contestationDeadline, contestationPeriod, headId, contesters}, Contest{signature}) -> + checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotNumber signature contesters headId (Closed{utxoHash, contestationDeadline}, Fanout{numberOfFanoutOutputs}) -> checkFanout utxoHash contestationDeadline numberOfFanoutOutputs ctx _ -> @@ -364,6 +364,7 @@ checkClose ctx parties initialUtxoHash sig cperiod headPolicyId = checkContest :: ScriptContext -> POSIXTime -> + ContestationPeriod -> [Party] -> -- | Snapshot number of the closed state. SnapshotNumber -> @@ -373,7 +374,7 @@ checkContest :: -- | Head id CurrencySymbol -> Bool -checkContest ctx contestationDeadline parties closedSnapshotNumber sig contesters headId = +checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotNumber sig contesters headId = mustNotMintOrBurn txInfo && mustBeNewer && mustBeMultiSigned @@ -384,6 +385,7 @@ checkContest ctx contestationDeadline parties closedSnapshotNumber sig contester && hasST headId val && mustNotChangeParameters && mustPreserveValue + && mustPushDeadline where mustPreserveValue = traceIfFalse "head value is not preserved" $ @@ -409,14 +411,17 @@ checkContest ctx contestationDeadline parties closedSnapshotNumber sig contester mustNotChangeParameters = traceIfFalse "changed parameters" $ parties' == parties - && contestationDeadline' == contestationDeadline && headId' == headId + mustPushDeadline = + traceIfFalse "must push deadline" $ + contestationDeadlineFromDatum == addContestationPeriod contestationDeadline contestationPeriod + mustUpdateContesters = traceIfFalse "contester not included" $ contesters' == (contester : contesters) - (contestSnapshotNumber, contestUtxoHash, parties', contestationDeadline', headId', contesters') = + (contestSnapshotNumber, contestUtxoHash, parties', contestationDeadlineFromDatum, headId', contesters') = -- XXX: fromBuiltinData is super big (and also expensive?) case fromBuiltinData @DatumType $ getDatum (headOutputDatum ctx) of Just diff --git a/hydra-plutus/src/Hydra/Contract/HeadState.hs b/hydra-plutus/src/Hydra/Contract/HeadState.hs index 721f4237608..4d6eae8beb8 100644 --- a/hydra-plutus/src/Hydra/Contract/HeadState.hs +++ b/hydra-plutus/src/Hydra/Contract/HeadState.hs @@ -37,6 +37,7 @@ data State , snapshotNumber :: SnapshotNumber , utxoHash :: Hash , contestationDeadline :: POSIXTime + , contestationPeriod :: ContestationPeriod , headId :: CurrencySymbol , contesters :: [PubKeyHash] } From 30a007c8e7e575f8a77e68f05b2dcadd8644d363 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 8 Feb 2023 12:56:18 -0300 Subject: [PATCH 02/24] Add mutation spec check we push contestation deadline on output --- hydra-node/src/Hydra/Chain/Direct/State.hs | 4 ++-- .../Hydra/Chain/Direct/Contract/Contest.hs | 19 ++++++++++++------- .../Hydra/Chain/Direct/Contract/Mutation.hs | 18 ++++++++++++------ 3 files changed, 26 insertions(+), 15 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct/State.hs b/hydra-node/src/Hydra/Chain/Direct/State.hs index a77383bb5a5..f18aea477e9 100644 --- a/hydra-node/src/Hydra/Chain/Direct/State.hs +++ b/hydra-node/src/Hydra/Chain/Direct/State.hs @@ -433,14 +433,14 @@ contest :: PointInTime -> Tx contest ctx st confirmedSnapshot pointInTime = do - contestTx ownVerificationKey sn sigs pointInTime closedThreadOutput headId (contestationPeriod ctx) + contestTx ownVerificationKey sn sigs pointInTime closedThreadOutput headId contestationPeriod where (sn, sigs) = case confirmedSnapshot of ConfirmedSnapshot{signatures} -> (getSnapshot confirmedSnapshot, signatures) _ -> (getSnapshot confirmedSnapshot, mempty) - ChainContext{ownVerificationKey} = ctx + ChainContext{contestationPeriod, ownVerificationKey} = ctx ClosedState { closedThreadOutput diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 7ff63e32be4..1d2f41f0b02 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -10,7 +10,6 @@ import Hydra.Prelude hiding (label) import Data.Maybe (fromJust) import Cardano.Api.UTxO as UTxO -import Hydra.Chain.Direct.Contract.Close (genMutatedDeadline) import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue) import Hydra.Chain.Direct.Contract.Mutation ( Mutation (..), @@ -27,10 +26,12 @@ import Hydra.Chain.Direct.Contract.Mutation ( ) import Hydra.Chain.Direct.Fixture (testNetworkId, testPolicyId) import Hydra.Chain.Direct.Tx (ClosedThreadOutput (..), contestTx, mkHeadId, mkHeadOutput) +import Hydra.ContestationPeriod (ContestationPeriod, fromChain) import qualified Hydra.Contract.HeadState as Head import Hydra.Contract.HeadTokens (headPolicyId) import Hydra.Crypto (HydraKey, MultiSignature, aggregate, sign, toPlutusSignatures) import Hydra.Data.ContestationPeriod (posixFromUTCTime) +import qualified Hydra.Data.ContestationPeriod as OnChain import qualified Hydra.Data.Party as OnChain import Hydra.Ledger (hashUTxO) import Hydra.Ledger.Cardano (genOneUTxOFor, genValue, genVerificationKey) @@ -61,6 +62,7 @@ healthyContestTx = (healthySlotNo, slotNoToUTCTime healthySlotNo) closedThreadOutput (mkHeadId testPolicyId) + healthyContestationPeriod headDatum = fromPlutusData $ toData healthyClosedState @@ -112,6 +114,7 @@ healthyClosedState = , utxoHash = healthyClosedUTxOHash , parties = healthyOnChainParties , contestationDeadline = posixFromUTCTime healthyContestationDeadline + , contestationPeriod = fromInteger healthyContestationPeriodSeconds , headId = toPlutusCurrencySymbol testPolicyId , contesters = [] } @@ -125,6 +128,9 @@ healthyContestationDeadline = (fromInteger healthyContestationPeriodSeconds) (slotNoToUTCTime healthySlotNo) +healthyContestationPeriod :: ContestationPeriod +healthyContestationPeriod = fromChain $ OnChain.contestationPeriodFromDiffTime $ fromInteger healthyContestationPeriodSeconds + healthyContestationPeriodSeconds :: Integer healthyContestationPeriodSeconds = 10 @@ -262,12 +268,11 @@ genContestMutation newValue <- genValue pure $ ChangeOutput 0 (headTxOut{txOutValue = newValue}) , SomeMutation (Just "must push deadline") MutateContestationDeadlineInTheClosedState . ChangeOutput 0 <$> do - -- let deadline = - -- case healthyClosedState of - -- Head.Closed{contestationDeadline} -> contestationDeadline - -- _ -> error "not in a closed state" - -- mutatedDeadline <- genMutatedDeadline `suchThat` (> deadline) - pure headTxOut -- changeHeadOutputDatum (replaceContestationDeadline deadline) headTxOut + let deadline = + case healthyClosedState of + Head.Closed{contestationDeadline} -> contestationDeadline + _ -> error "not in a closed state" + pure $ changeHeadOutputDatum (replaceContestationDeadline deadline) headTxOut ] where headTxOut = fromJust $ txOuts' tx !!? 0 diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs index 022ccb0734b..492ff81ec51 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs @@ -644,12 +644,13 @@ replacePolicyIdWith originalPolicyId otherPolicyId output = replaceSnapshotNumber :: Head.SnapshotNumber -> Head.State -> Head.State replaceSnapshotNumber snapshotNumber = \case - Head.Closed{parties, utxoHash, contestationDeadline, headId, contesters} -> + Head.Closed{parties, utxoHash, contestationDeadline, headId, contesters, contestationPeriod} -> Head.Closed { Head.parties = parties , Head.snapshotNumber = snapshotNumber , Head.utxoHash = utxoHash , Head.contestationDeadline = contestationDeadline + , Head.contestationPeriod = contestationPeriod , Head.headId = headId , Head.contesters = contesters } @@ -670,12 +671,13 @@ replaceParties parties = \case , Head.utxoHash = utxoHash , Head.headId = headId } - Head.Closed{snapshotNumber, utxoHash, contestationDeadline, headId, contesters} -> + Head.Closed{snapshotNumber, utxoHash, contestationDeadline, headId, contesters, contestationPeriod} -> Head.Closed { Head.parties = parties , Head.snapshotNumber = snapshotNumber , Head.utxoHash = utxoHash , Head.contestationDeadline = contestationDeadline + , Head.contestationPeriod = contestationPeriod , Head.headId = headId , Head.contesters = contesters } @@ -690,12 +692,13 @@ replaceUtxoHash utxoHash = \case , Head.utxoHash = utxoHash , Head.headId = headId } - Head.Closed{parties, snapshotNumber, contestationDeadline, headId, contesters} -> + Head.Closed{parties, snapshotNumber, contestationDeadline, headId, contesters, contestationPeriod} -> Head.Closed { Head.parties = parties , Head.snapshotNumber = snapshotNumber , Head.utxoHash = utxoHash , Head.contestationDeadline = contestationDeadline + , Head.contestationPeriod = contestationPeriod , Head.headId = headId , Head.contesters = contesters } @@ -703,12 +706,13 @@ replaceUtxoHash utxoHash = \case replaceContestationDeadline :: POSIXTime -> Head.State -> Head.State replaceContestationDeadline contestationDeadline = \case - Head.Closed{snapshotNumber, utxoHash, parties, headId, contesters} -> + Head.Closed{snapshotNumber, utxoHash, parties, headId, contesters, contestationPeriod} -> Head.Closed { snapshotNumber , utxoHash , parties , contestationDeadline + , contestationPeriod , headId , contesters } @@ -729,12 +733,13 @@ replaceHeadId headId = \case , Head.utxoHash = utxoHash , Head.headId = headId } - Head.Closed{snapshotNumber, utxoHash, contestationDeadline, parties, contesters} -> + Head.Closed{snapshotNumber, utxoHash, contestationDeadline, parties, contesters, contestationPeriod} -> Head.Closed { Head.parties = parties , Head.snapshotNumber = snapshotNumber , Head.utxoHash = utxoHash , Head.contestationDeadline = contestationDeadline + , Head.contestationPeriod = contestationPeriod , Head.headId = headId , Head.contesters = contesters } @@ -742,12 +747,13 @@ replaceHeadId headId = \case replaceContesters :: [Plutus.PubKeyHash] -> Head.State -> Head.State replaceContesters contesters = \case - Head.Closed{snapshotNumber, utxoHash, contestationDeadline, parties, headId} -> + Head.Closed{snapshotNumber, utxoHash, contestationDeadline, parties, headId, contestationPeriod} -> Head.Closed { Head.parties = parties , Head.snapshotNumber = snapshotNumber , Head.utxoHash = utxoHash , Head.contestationDeadline = contestationDeadline + , Head.contestationPeriod = contestationPeriod , Head.headId = headId , Head.contesters = contesters } From e50062fa0a8c2e3c5597ccd484a60713bea240f9 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 8 Feb 2023 12:56:48 -0300 Subject: [PATCH 03/24] Push deadline using contestation period during contest tx building --- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index 002c6ecd5d0..c5efd991614 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -355,6 +355,7 @@ closeTx vk closing startSlotNo (endSlotNo, utcTime) openThreadOutput headId = , utxoHash = toBuiltin utxoHashBytes , parties = openParties , contestationDeadline + , contestationPeriod = openContestationPeriod , headId = headIdToCurrencySymbol headId , contesters = [] } @@ -415,14 +416,18 @@ contestTx vk Snapshot{number, utxo} sig (slotNo, _) ClosedThreadOutput{closedThr contester = toPlutusKeyHash (verificationKeyHash vk) + onChainConstestationPeriod = toChain contestationPeriod + + pushedContestationDeadline = addContestationPeriod closedContestationDeadline onChainConstestationPeriod + headDatumAfter = mkTxOutDatum Head.Closed { snapshotNumber = toInteger number , utxoHash , parties = closedParties - , contestationDeadline = closedContestationDeadline - , contestationPeriod = toChain contestationPeriod + , contestationDeadline = pushedContestationDeadline + , contestationPeriod = onChainConstestationPeriod , headId = headIdToCurrencySymbol headId , contesters = contester : closedContesters } From 3b4351e3137de80d7551841ff2dc2a1a607832ac Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 8 Feb 2023 13:02:04 -0300 Subject: [PATCH 04/24] Add healthy contestation period to fanout and contest mutations --- hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs | 7 +++++-- hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs | 8 ++++++++ 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 1d2f41f0b02..cd534b530e3 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -114,7 +114,7 @@ healthyClosedState = , utxoHash = healthyClosedUTxOHash , parties = healthyOnChainParties , contestationDeadline = posixFromUTCTime healthyContestationDeadline - , contestationPeriod = fromInteger healthyContestationPeriodSeconds + , contestationPeriod = healthyOnChainContestationPeriod , headId = toPlutusCurrencySymbol testPolicyId , contesters = [] } @@ -128,8 +128,11 @@ healthyContestationDeadline = (fromInteger healthyContestationPeriodSeconds) (slotNoToUTCTime healthySlotNo) +healthyOnChainContestationPeriod :: OnChain.ContestationPeriod +healthyOnChainContestationPeriod = OnChain.contestationPeriodFromDiffTime $ fromInteger healthyContestationPeriodSeconds + healthyContestationPeriod :: ContestationPeriod -healthyContestationPeriod = fromChain $ OnChain.contestationPeriodFromDiffTime $ fromInteger healthyContestationPeriodSeconds +healthyContestationPeriod = fromChain healthyOnChainContestationPeriod healthyContestationPeriodSeconds :: Integer healthyContestationPeriodSeconds = 10 diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs index 4e80663f985..6e5f9cdd5e1 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs @@ -15,6 +15,7 @@ import Hydra.Chain.Direct.Tx (fanoutTx, mkHeadOutput) import qualified Hydra.Contract.HeadState as Head import Hydra.Contract.HeadTokens (mkHeadTokenScript) import Hydra.Data.ContestationPeriod (posixFromUTCTime) +import qualified Hydra.Data.ContestationPeriod as OnChain import Hydra.Ledger (IsTx (hashUTxO)) import Hydra.Ledger.Cardano ( adaOnly, @@ -74,6 +75,12 @@ healthyContestationDeadline :: UTCTime healthyContestationDeadline = slotNoToUTCTime $ healthySlotNo - 1 +healthyContestationPeriod :: OnChain.ContestationPeriod +healthyContestationPeriod = OnChain.contestationPeriodFromDiffTime $ fromInteger healthyContestationPeriodSeconds + +healthyContestationPeriodSeconds :: Integer +healthyContestationPeriodSeconds = 10 + healthyFanoutDatum :: Head.State healthyFanoutDatum = Head.Closed @@ -81,6 +88,7 @@ healthyFanoutDatum = , utxoHash = toBuiltin $ hashUTxO @Tx healthyFanoutUTxO , parties = partyToChain <$> arbitrary `generateWith` 42 , contestationDeadline = posixFromUTCTime healthyContestationDeadline + , contestationPeriod = healthyContestationPeriod , headId = toPlutusCurrencySymbol testPolicyId , contesters = [] } From 5cda2c4bb14f3907f1492d2e870ff03401e29b5b Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 8 Feb 2023 13:11:05 -0300 Subject: [PATCH 05/24] Add minor comment to explain the mutation on contestationd deadline --- hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index cd534b530e3..c206d668be0 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -273,6 +273,7 @@ genContestMutation , SomeMutation (Just "must push deadline") MutateContestationDeadlineInTheClosedState . ChangeOutput 0 <$> do let deadline = case healthyClosedState of + -- We are replacing the contestationDeadline using the previous without pushing it Head.Closed{contestationDeadline} -> contestationDeadline _ -> error "not in a closed state" pure $ changeHeadOutputDatum (replaceContestationDeadline deadline) headTxOut From db9fc9af24c23e53b0c390704f9967c6ad762941 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 8 Feb 2023 13:26:50 -0300 Subject: [PATCH 06/24] Add mutation spec check we push contestation deadline on input datum --- .../test/Hydra/Chain/Direct/Contract/Contest.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index c206d668be0..34ff1b592e2 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -192,9 +192,12 @@ data ContestMutation MutateContesters | -- | See spec: 5.5. rule 6 -> value is preserved MutateValueInOutput - | -- | Should change the 'ContestationDeadline' in the 'Closed' datum for contest tx such that - -- deadline is pushed in an unexpected way - MutateContestationDeadlineInTheClosedState + | -- | Should change the 'ContestationDeadline' in the 'Closed' output datum for contest tx such that + -- deadline is not pushed away + MutateContestationDeadlineOnOutputClosedState + | -- | Should change the 'ContestationDeadline' in the 'Closed' input datum for contest tx such that + -- deadline is not pushed away + MutateContestationDeadlineOnInputClosedState deriving (Generic, Show, Enum, Bounded) genContestMutation :: (Tx, UTxO) -> Gen SomeMutation @@ -270,13 +273,18 @@ genContestMutation , SomeMutation (Just "head value is not preserved") MutateValueInOutput <$> do newValue <- genValue pure $ ChangeOutput 0 (headTxOut{txOutValue = newValue}) - , SomeMutation (Just "must push deadline") MutateContestationDeadlineInTheClosedState . ChangeOutput 0 <$> do + , SomeMutation (Just "must push deadline") MutateContestationDeadlineOnOutputClosedState . ChangeOutput 0 <$> do let deadline = case healthyClosedState of -- We are replacing the contestationDeadline using the previous without pushing it Head.Closed{contestationDeadline} -> contestationDeadline _ -> error "not in a closed state" pure $ changeHeadOutputDatum (replaceContestationDeadline deadline) headTxOut + , SomeMutation (Just "must push deadline") MutateContestationDeadlineOnInputClosedState . ChangeInputHeadDatum <$> do + let deadline = posixFromUTCTime healthyContestationDeadline + positive <- arbitrary + let mutatedDeadline = deadline + positive + pure $ healthyClosedState & replaceContestationDeadline mutatedDeadline ] where headTxOut = fromJust $ txOuts' tx !!? 0 From 05632ba0a1d108e2a0bf72bf2b9282bbf3bf00b7 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 8 Feb 2023 13:31:50 -0300 Subject: [PATCH 07/24] Add mutation spec check we push contestation period on input datum --- .../test/Hydra/Chain/Direct/Contract/Contest.hs | 12 ++++++++++-- .../test/Hydra/Chain/Direct/Contract/Mutation.hs | 15 +++++++++++++++ 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 34ff1b592e2..2a2e7f1f45e 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -18,6 +18,7 @@ import Hydra.Chain.Direct.Contract.Mutation ( changeHeadOutputDatum, changeMintedTokens, replaceContestationDeadline, + replaceContestationPeriod, replaceContesters, replaceParties, replacePolicyIdWith, @@ -198,6 +199,9 @@ data ContestMutation | -- | Should change the 'ContestationDeadline' in the 'Closed' input datum for contest tx such that -- deadline is not pushed away MutateContestationDeadlineOnInputClosedState + | -- | Should change the 'ContestationPeriod' in the 'Closed' input datum for contest tx such that + -- deadline is not pushed away + MutateContestationPeriodOnInputClosedState deriving (Generic, Show, Enum, Bounded) genContestMutation :: (Tx, UTxO) -> Gen SomeMutation @@ -282,9 +286,13 @@ genContestMutation pure $ changeHeadOutputDatum (replaceContestationDeadline deadline) headTxOut , SomeMutation (Just "must push deadline") MutateContestationDeadlineOnInputClosedState . ChangeInputHeadDatum <$> do let deadline = posixFromUTCTime healthyContestationDeadline - positive <- arbitrary - let mutatedDeadline = deadline + positive + randomPosixTime <- arbitrary + let mutatedDeadline = deadline + randomPosixTime pure $ healthyClosedState & replaceContestationDeadline mutatedDeadline + , SomeMutation (Just "must push deadline") MutateContestationPeriodOnInputClosedState . ChangeInputHeadDatum <$> do + randomContestationPeriod <- arbitrary + let mutatedContestationPeriod = healthyOnChainContestationPeriod + randomContestationPeriod + pure $ healthyClosedState & replaceContestationPeriod mutatedContestationPeriod ] where headTxOut = fromJust $ txOuts' tx !!? 0 diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs index 492ff81ec51..906822669ab 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs @@ -146,6 +146,7 @@ import qualified Hydra.Chain.Direct.Fixture as Fixture import Hydra.Chain.Direct.Tx (assetNameFromVerificationKey) import qualified Hydra.Contract.Head as Head import qualified Hydra.Contract.HeadState as Head +import Hydra.Data.ContestationPeriod import qualified Hydra.Data.Party as Data (Party) import Hydra.Ledger.Cardano (genKeyPair, genOutput, genVerificationKey, renderTxWithUTxO) import Hydra.Ledger.Cardano.Evaluate (evaluateTx) @@ -718,6 +719,20 @@ replaceContestationDeadline contestationDeadline = \case } otherState -> otherState +replaceContestationPeriod :: ContestationPeriod -> Head.State -> Head.State +replaceContestationPeriod contestationPeriod = \case + Head.Closed{snapshotNumber, utxoHash, parties, headId, contesters, contestationDeadline} -> + Head.Closed + { snapshotNumber + , utxoHash + , parties + , contestationDeadline + , contestationPeriod + , headId + , contesters + } + otherState -> otherState + replaceHeadId :: CurrencySymbol -> Head.State -> Head.State replaceHeadId headId = \case Head.Initial{contestationPeriod, parties} -> From cc6cfa0204941d2339e03a340655f0b060b414a0 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Wed, 8 Feb 2023 17:33:30 +0100 Subject: [PATCH 08/24] Update changelog --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7cc70f9e267..9f21bc3b0b0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -31,7 +31,8 @@ changes. + The v_head output must now be the first output of the transaction so that we can make the validator code simpler. + Introduce check in head validator to allow contest only once per party. + Check that value is preserved in v_head - + Introduce a function `(===!)` for strict equality check between serialized `Value`. + + Introduce a function `(===)` for strict equality check between serialized `Value`. + + Push contestation deadline on contest. - **BREAKING** Change the way tx validity and contestation deadline is constructed for close transactions: + There is a new hydra-node flag `--contestation-period` expressed in seconds From a23785dcd4aba58dd7a8e6a4277a7447366f9b5c Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 8 Feb 2023 16:57:56 -0300 Subject: [PATCH 09/24] Do not push contestation deadline if the signer is the last one missing to contest --- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 7 +++- .../Hydra/Chain/Direct/Contract/Contest.hs | 41 ++++++++----------- hydra-plutus/src/Hydra/Contract/Head.hs | 5 ++- 3 files changed, 24 insertions(+), 29 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index c5efd991614..3286cb63756 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -418,7 +418,10 @@ contestTx vk Snapshot{number, utxo} sig (slotNo, _) ClosedThreadOutput{closedThr onChainConstestationPeriod = toChain contestationPeriod - pushedContestationDeadline = addContestationPeriod closedContestationDeadline onChainConstestationPeriod + newContestationDeadline = + if length (contester : closedContesters) == length closedParties + then closedContestationDeadline + else addContestationPeriod closedContestationDeadline onChainConstestationPeriod headDatumAfter = mkTxOutDatum @@ -426,7 +429,7 @@ contestTx vk Snapshot{number, utxo} sig (slotNo, _) ClosedThreadOutput{closedThr { snapshotNumber = toInteger number , utxoHash , parties = closedParties - , contestationDeadline = pushedContestationDeadline + , contestationDeadline = newContestationDeadline , contestationPeriod = onChainConstestationPeriod , headId = headIdToCurrencySymbol headId , contesters = contester : closedContesters diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 2a2e7f1f45e..d711bb7eb35 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -18,7 +18,6 @@ import Hydra.Chain.Direct.Contract.Mutation ( changeHeadOutputDatum, changeMintedTokens, replaceContestationDeadline, - replaceContestationPeriod, replaceContesters, replaceParties, replacePolicyIdWith, @@ -193,15 +192,19 @@ data ContestMutation MutateContesters | -- | See spec: 5.5. rule 6 -> value is preserved MutateValueInOutput - | -- | Should change the 'ContestationDeadline' in the 'Closed' output datum for contest tx such that - -- deadline is not pushed away - MutateContestationDeadlineOnOutputClosedState - | -- | Should change the 'ContestationDeadline' in the 'Closed' input datum for contest tx such that - -- deadline is not pushed away - MutateContestationDeadlineOnInputClosedState - | -- | Should change the 'ContestationPeriod' in the 'Closed' input datum for contest tx such that - -- deadline is not pushed away - MutateContestationPeriodOnInputClosedState + | -- | Change the 'ContestationDeadline' in the 'Closed' output datum such that deadline is pushed away + MutatePushedContestationDeadlineOnOutputClosedState + -- TODO + -- | -- | Change the 'ContestationDeadline' in the 'Closed' output datum such that deadline is NOT pushed away + -- MutateNotPushedContestationDeadlineOnOutputClosedState + -- | -- | Change the 'ContestationDeadline' in the 'Closed' input datum such that deadline is pushed away + -- MutatePushedContestationDeadlineOnInputClosedState + -- | -- | Change the 'ContestationDeadline' in the 'Closed' input datum such that deadline is NOT pushed away + -- MutateNotPushedContestationDeadlineOnInputClosedState + -- | -- | Change the 'ContestationPeriod' in the 'Closed' input datum such that deadline is pushed away + -- MutatePushedContestationPeriodOnInputClosedState + -- | -- | Change the 'ContestationPeriod' in the 'Closed' input datum such that deadline is NOT pushed away + -- MutateNotPushedContestationPeriodOnInputClosedState deriving (Generic, Show, Enum, Bounded) genContestMutation :: (Tx, UTxO) -> Gen SomeMutation @@ -277,22 +280,10 @@ genContestMutation , SomeMutation (Just "head value is not preserved") MutateValueInOutput <$> do newValue <- genValue pure $ ChangeOutput 0 (headTxOut{txOutValue = newValue}) - , SomeMutation (Just "must push deadline") MutateContestationDeadlineOnOutputClosedState . ChangeOutput 0 <$> do - let deadline = - case healthyClosedState of - -- We are replacing the contestationDeadline using the previous without pushing it - Head.Closed{contestationDeadline} -> contestationDeadline - _ -> error "not in a closed state" - pure $ changeHeadOutputDatum (replaceContestationDeadline deadline) headTxOut - , SomeMutation (Just "must push deadline") MutateContestationDeadlineOnInputClosedState . ChangeInputHeadDatum <$> do + , SomeMutation (Just "must push deadline") MutatePushedContestationDeadlineOnOutputClosedState . ChangeOutput 0 <$> do let deadline = posixFromUTCTime healthyContestationDeadline - randomPosixTime <- arbitrary - let mutatedDeadline = deadline + randomPosixTime - pure $ healthyClosedState & replaceContestationDeadline mutatedDeadline - , SomeMutation (Just "must push deadline") MutateContestationPeriodOnInputClosedState . ChangeInputHeadDatum <$> do - randomContestationPeriod <- arbitrary - let mutatedContestationPeriod = healthyOnChainContestationPeriod + randomContestationPeriod - pure $ healthyClosedState & replaceContestationPeriod mutatedContestationPeriod + -- Here we are replacing the contestationDeadline using the previous without pushing it + pure $ headTxOut & changeHeadOutputDatum (replaceContestationDeadline deadline) ] where headTxOut = fromJust $ txOuts' tx !!? 0 diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs index dcb1586a10b..4d6d2e07fbd 100644 --- a/hydra-plutus/src/Hydra/Contract/Head.hs +++ b/hydra-plutus/src/Hydra/Contract/Head.hs @@ -414,8 +414,9 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN && headId' == headId mustPushDeadline = - traceIfFalse "must push deadline" $ - contestationDeadlineFromDatum == addContestationPeriod contestationDeadline contestationPeriod + if length contesters' == length parties' + then traceIfFalse "must not push deadline" $ contestationDeadlineFromDatum == contestationDeadline + else traceIfFalse "must push deadline" $ contestationDeadlineFromDatum == addContestationPeriod contestationDeadline contestationPeriod mustUpdateContesters = traceIfFalse "contester not included" $ From 5f302ffcb032d8b2bad29e4d53b5608356a96d2c Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 8 Feb 2023 17:29:23 -0300 Subject: [PATCH 10/24] Add mutation spec to check deadline is not pushed away --- .../Hydra/Chain/Direct/Contract/Contest.hs | 31 ++++++++++++------- 1 file changed, 19 insertions(+), 12 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index d711bb7eb35..5adefc7a842 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -42,7 +42,7 @@ import Plutus.Orphans () import Plutus.V2.Ledger.Api (BuiltinByteString, toBuiltin, toData) import qualified Plutus.V2.Ledger.Api as Plutus import Test.Hydra.Fixture (aliceSk, bobSk, carolSk) -import Test.QuickCheck (elements, listOf, oneof, suchThat) +import Test.QuickCheck (elements, listOf, oneof, suchThat, vectorOf) import Test.QuickCheck.Gen (choose) import Test.QuickCheck.Instances () @@ -194,17 +194,9 @@ data ContestMutation MutateValueInOutput | -- | Change the 'ContestationDeadline' in the 'Closed' output datum such that deadline is pushed away MutatePushedContestationDeadlineOnOutputClosedState - -- TODO - -- | -- | Change the 'ContestationDeadline' in the 'Closed' output datum such that deadline is NOT pushed away - -- MutateNotPushedContestationDeadlineOnOutputClosedState - -- | -- | Change the 'ContestationDeadline' in the 'Closed' input datum such that deadline is pushed away - -- MutatePushedContestationDeadlineOnInputClosedState - -- | -- | Change the 'ContestationDeadline' in the 'Closed' input datum such that deadline is NOT pushed away - -- MutateNotPushedContestationDeadlineOnInputClosedState - -- | -- | Change the 'ContestationPeriod' in the 'Closed' input datum such that deadline is pushed away - -- MutatePushedContestationPeriodOnInputClosedState - -- | -- | Change the 'ContestationPeriod' in the 'Closed' input datum such that deadline is NOT pushed away - -- MutateNotPushedContestationPeriodOnInputClosedState + | -- | Change the 'ContestationDeadline' in the 'Closed' output datum such that deadline is NOT pushed away + -- and contesters must change on input and output so they are complete + MutateNotPushedContestationDeadlineOnOutputClosedState deriving (Generic, Show, Enum, Bounded) genContestMutation :: (Tx, UTxO) -> Gen SomeMutation @@ -284,6 +276,21 @@ genContestMutation let deadline = posixFromUTCTime healthyContestationDeadline -- Here we are replacing the contestationDeadline using the previous without pushing it pure $ headTxOut & changeHeadOutputDatum (replaceContestationDeadline deadline) + , SomeMutation (Just "must not push deadline") MutateNotPushedContestationDeadlineOnOutputClosedState <$> do + randomContesters <- vectorOf (length healthyParties - 1) $ Plutus.PubKeyHash . toBuiltin <$> genHash + randomPosixTime <- arbitrary + let contester = toPlutusKeyHash (verificationKeyHash somePartyCardanoVerificationKey) + mutatedContesters = contester : randomContesters + deadline = posixFromUTCTime healthyContestationDeadline + mutatedDeadline = deadline + randomPosixTime + pure $ + Changes + [ ChangeInputHeadDatum $ + healthyClosedState & replaceContesters randomContesters + , ChangeOutput 0 $ + headTxOut & changeHeadOutputDatum (replaceContesters mutatedContesters) + & changeHeadOutputDatum (replaceContestationDeadline mutatedDeadline) + ] ] where headTxOut = fromJust $ txOuts' tx !!? 0 From 9df8280f07063c3b4345e0cc0f4bd286968c875b Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 8 Feb 2023 17:30:27 -0300 Subject: [PATCH 11/24] minor comments --- hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 5adefc7a842..c48b789ec89 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -278,10 +278,13 @@ genContestMutation pure $ headTxOut & changeHeadOutputDatum (replaceContestationDeadline deadline) , SomeMutation (Just "must not push deadline") MutateNotPushedContestationDeadlineOnOutputClosedState <$> do randomContesters <- vectorOf (length healthyParties - 1) $ Plutus.PubKeyHash . toBuiltin <$> genHash + -- Here we are replacing the contesters so they are almost complete in output randomPosixTime <- arbitrary let contester = toPlutusKeyHash (verificationKeyHash somePartyCardanoVerificationKey) + -- Here we are replacing the contesters so they are complete in output mutatedContesters = contester : randomContesters deadline = posixFromUTCTime healthyContestationDeadline + -- Here we are replacing the contestationDeadline using the previous and pushing it mutatedDeadline = deadline + randomPosixTime pure $ Changes From 4f883c4c01d33723e73051947c1075c952ff6017 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 8 Feb 2023 20:36:33 -0300 Subject: [PATCH 12/24] Remove spec as it was not working as expected --- .../Hydra/Chain/Direct/Contract/Contest.hs | 23 +------------------ 1 file changed, 1 insertion(+), 22 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index c48b789ec89..695590441d6 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -42,7 +42,7 @@ import Plutus.Orphans () import Plutus.V2.Ledger.Api (BuiltinByteString, toBuiltin, toData) import qualified Plutus.V2.Ledger.Api as Plutus import Test.Hydra.Fixture (aliceSk, bobSk, carolSk) -import Test.QuickCheck (elements, listOf, oneof, suchThat, vectorOf) +import Test.QuickCheck (elements, listOf, oneof, suchThat) import Test.QuickCheck.Gen (choose) import Test.QuickCheck.Instances () @@ -194,9 +194,6 @@ data ContestMutation MutateValueInOutput | -- | Change the 'ContestationDeadline' in the 'Closed' output datum such that deadline is pushed away MutatePushedContestationDeadlineOnOutputClosedState - | -- | Change the 'ContestationDeadline' in the 'Closed' output datum such that deadline is NOT pushed away - -- and contesters must change on input and output so they are complete - MutateNotPushedContestationDeadlineOnOutputClosedState deriving (Generic, Show, Enum, Bounded) genContestMutation :: (Tx, UTxO) -> Gen SomeMutation @@ -276,24 +273,6 @@ genContestMutation let deadline = posixFromUTCTime healthyContestationDeadline -- Here we are replacing the contestationDeadline using the previous without pushing it pure $ headTxOut & changeHeadOutputDatum (replaceContestationDeadline deadline) - , SomeMutation (Just "must not push deadline") MutateNotPushedContestationDeadlineOnOutputClosedState <$> do - randomContesters <- vectorOf (length healthyParties - 1) $ Plutus.PubKeyHash . toBuiltin <$> genHash - -- Here we are replacing the contesters so they are almost complete in output - randomPosixTime <- arbitrary - let contester = toPlutusKeyHash (verificationKeyHash somePartyCardanoVerificationKey) - -- Here we are replacing the contesters so they are complete in output - mutatedContesters = contester : randomContesters - deadline = posixFromUTCTime healthyContestationDeadline - -- Here we are replacing the contestationDeadline using the previous and pushing it - mutatedDeadline = deadline + randomPosixTime - pure $ - Changes - [ ChangeInputHeadDatum $ - healthyClosedState & replaceContesters randomContesters - , ChangeOutput 0 $ - headTxOut & changeHeadOutputDatum (replaceContesters mutatedContesters) - & changeHeadOutputDatum (replaceContestationDeadline mutatedDeadline) - ] ] where headTxOut = fromJust $ txOuts' tx !!? 0 From 949ed7a2ee28efee4f8c82a1907b883d89ffa343 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Thu, 9 Feb 2023 11:03:22 +0100 Subject: [PATCH 13/24] Add a mutation to exercise the path where deadline shoult NOT get pushed --- .../Hydra/Chain/Direct/Contract/Contest.hs | 26 +++++++++++++++++-- hydra-plutus/src/Hydra/Contract/Head.hs | 13 +++++++--- 2 files changed, 33 insertions(+), 6 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 695590441d6..00219063144 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -10,6 +10,8 @@ import Hydra.Prelude hiding (label) import Data.Maybe (fromJust) import Cardano.Api.UTxO as UTxO +import qualified Data.List as List +import qualified Data.List.NonEmpty as NE import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue) import Hydra.Chain.Direct.Contract.Mutation ( Mutation (..), @@ -36,13 +38,13 @@ import qualified Hydra.Data.Party as OnChain import Hydra.Ledger (hashUTxO) import Hydra.Ledger.Cardano (genOneUTxOFor, genValue, genVerificationKey) import Hydra.Ledger.Cardano.Evaluate (slotNoToUTCTime) -import Hydra.Party (Party, deriveParty, partyToChain) +import Hydra.Party (Party, deriveParty, partyToChain, vkey) import Hydra.Snapshot (Snapshot (..), SnapshotNumber) import Plutus.Orphans () import Plutus.V2.Ledger.Api (BuiltinByteString, toBuiltin, toData) import qualified Plutus.V2.Ledger.Api as Plutus import Test.Hydra.Fixture (aliceSk, bobSk, carolSk) -import Test.QuickCheck (elements, listOf, oneof, suchThat) +import Test.QuickCheck (elements, listOf, oneof, suchThat, vectorOf) import Test.QuickCheck.Gen (choose) import Test.QuickCheck.Instances () @@ -273,6 +275,26 @@ genContestMutation let deadline = posixFromUTCTime healthyContestationDeadline -- Here we are replacing the contestationDeadline using the previous without pushing it pure $ headTxOut & changeHeadOutputDatum (replaceContestationDeadline deadline) + , SomeMutation (Just "must not push deadline") MutatePushedContestationDeadlineOnOutputClosedState <$> do + let deadline = posixFromUTCTime healthyContestationDeadline + let partiesVKeys = genForParty genVerificationKey <$> healthyParties + let contesters = toPlutusKeyHash . verificationKeyHash <$> partiesVKeys + -- Here we are replacing : + -- - contestationDeadline using the previous without pushing it + -- - alter the contesters in input so that everybody contested + -- - alter the contesters in output so that there is one party left to contest + pure $ + Changes + [ ChangeOutput + 0 + ( headTxOut & do + void $ changeHeadOutputDatum (replaceContestationDeadline deadline) + changeHeadOutputDatum (replaceContesters contesters) + ) + , ChangeInputHeadDatum + -- use tail here to remove one contestant + (healthyClosedState & replaceContesters (List.tail contesters)) + ] ] where headTxOut = fromJust $ txOuts' tx !!? 0 diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs index 4d6d2e07fbd..90a36143ede 100644 --- a/hydra-plutus/src/Hydra/Contract/Head.hs +++ b/hydra-plutus/src/Hydra/Contract/Head.hs @@ -414,13 +414,17 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN && headId' == headId mustPushDeadline = - if length contesters' == length parties' - then traceIfFalse "must not push deadline" $ contestationDeadlineFromDatum == contestationDeadline - else traceIfFalse "must push deadline" $ contestationDeadlineFromDatum == addContestationPeriod contestationDeadline contestationPeriod + if length allContesters == length parties' + then + traceIfFalse "must not push deadline" $ + contestationDeadlineFromDatum == contestationDeadline + else + traceIfFalse "must push deadline" $ + contestationDeadlineFromDatum == addContestationPeriod contestationDeadline contestationPeriod mustUpdateContesters = traceIfFalse "contester not included" $ - contesters' == (contester : contesters) + contesters' == allContesters (contestSnapshotNumber, contestUtxoHash, parties', contestationDeadlineFromDatum, headId', contesters') = -- XXX: fromBuiltinData is super big (and also expensive?) @@ -438,6 +442,7 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN ScriptContext{scriptContextTxInfo = txInfo} = ctx + allContesters = contester : contesters contester = case txInfoSignatories txInfo of [signer] -> signer From 6307f46b0af306cc47fe7a3a09e674e70c176ece Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Thu, 9 Feb 2023 11:26:06 +0100 Subject: [PATCH 14/24] Fix compilation errors --- hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 00219063144..5dc5f7cdc28 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -11,7 +11,6 @@ import Data.Maybe (fromJust) import Cardano.Api.UTxO as UTxO import qualified Data.List as List -import qualified Data.List.NonEmpty as NE import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue) import Hydra.Chain.Direct.Contract.Mutation ( Mutation (..), @@ -38,13 +37,13 @@ import qualified Hydra.Data.Party as OnChain import Hydra.Ledger (hashUTxO) import Hydra.Ledger.Cardano (genOneUTxOFor, genValue, genVerificationKey) import Hydra.Ledger.Cardano.Evaluate (slotNoToUTCTime) -import Hydra.Party (Party, deriveParty, partyToChain, vkey) +import Hydra.Party (Party, deriveParty, partyToChain) import Hydra.Snapshot (Snapshot (..), SnapshotNumber) import Plutus.Orphans () import Plutus.V2.Ledger.Api (BuiltinByteString, toBuiltin, toData) import qualified Plutus.V2.Ledger.Api as Plutus import Test.Hydra.Fixture (aliceSk, bobSk, carolSk) -import Test.QuickCheck (elements, listOf, oneof, suchThat, vectorOf) +import Test.QuickCheck (elements, listOf, oneof, suchThat) import Test.QuickCheck.Gen (choose) import Test.QuickCheck.Instances () From b27d189fce01d1d5b770aaf601ae8f7227b191d5 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Thu, 9 Feb 2023 12:51:29 +0100 Subject: [PATCH 15/24] Reduce the number of fanout outputs to 39 --- hydra-node/test/Hydra/Chain/Direct/StateSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs index 773e89eec54..3bce12346bd 100644 --- a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs @@ -398,7 +398,7 @@ forAllFanout action = in action utxo tx & label ("Fanout size: " <> prettyLength (countAssets $ txOuts' tx)) where - maxSupported = 45 + maxSupported = 39 countAssets = getSum . foldMap (Sum . valueSize . txOutValue) From b217d042842d6c50ce909d74cdd822099830c780 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Thu, 9 Feb 2023 14:18:45 +0100 Subject: [PATCH 16/24] Do not change the deadline in the mutation --- .../test/Hydra/Chain/Direct/Contract/Contest.hs | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 5dc5f7cdc28..9228356ae5a 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -272,24 +272,17 @@ genContestMutation pure $ ChangeOutput 0 (headTxOut{txOutValue = newValue}) , SomeMutation (Just "must push deadline") MutatePushedContestationDeadlineOnOutputClosedState . ChangeOutput 0 <$> do let deadline = posixFromUTCTime healthyContestationDeadline - -- Here we are replacing the contestationDeadline using the previous without pushing it + -- Here we are replacing the contestationDeadline using the previous so we are not _pushing it_ further pure $ headTxOut & changeHeadOutputDatum (replaceContestationDeadline deadline) , SomeMutation (Just "must not push deadline") MutatePushedContestationDeadlineOnOutputClosedState <$> do - let deadline = posixFromUTCTime healthyContestationDeadline let partiesVKeys = genForParty genVerificationKey <$> healthyParties let contesters = toPlutusKeyHash . verificationKeyHash <$> partiesVKeys - -- Here we are replacing : - -- - contestationDeadline using the previous without pushing it - -- - alter the contesters in input so that everybody contested - -- - alter the contesters in output so that there is one party left to contest + -- Here we are : + -- - altering the contesters in input so that everybody contested + -- - altering the contesters in output so that there is one party left to contest pure $ Changes - [ ChangeOutput - 0 - ( headTxOut & do - void $ changeHeadOutputDatum (replaceContestationDeadline deadline) - changeHeadOutputDatum (replaceContesters contesters) - ) + [ ChangeOutput 0 (headTxOut & changeHeadOutputDatum (replaceContesters contesters)) , ChangeInputHeadDatum -- use tail here to remove one contestant (healthyClosedState & replaceContesters (List.tail contesters)) From e7a3ba32d9ab15465f836c498e8d7816e6ae6b6e Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Fri, 10 Feb 2023 17:34:15 +0100 Subject: [PATCH 17/24] Rename and generate a healthy state mutation --- .../Hydra/Chain/Direct/Contract/Contest.hs | 42 ++++++++++--------- hydra-plutus/src/Hydra/Contract/Head.hs | 5 +-- 2 files changed, 24 insertions(+), 23 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 9228356ae5a..0e3b9797577 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -10,7 +10,6 @@ import Hydra.Prelude hiding (label) import Data.Maybe (fromJust) import Cardano.Api.UTxO as UTxO -import qualified Data.List as List import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue) import Hydra.Chain.Direct.Contract.Mutation ( Mutation (..), @@ -43,7 +42,7 @@ import Plutus.Orphans () import Plutus.V2.Ledger.Api (BuiltinByteString, toBuiltin, toData) import qualified Plutus.V2.Ledger.Api as Plutus import Test.Hydra.Fixture (aliceSk, bobSk, carolSk) -import Test.QuickCheck (elements, listOf, oneof, suchThat) +import Test.QuickCheck (elements, listOf, oneof, suchThat, vectorOf) import Test.QuickCheck.Gen (choose) import Test.QuickCheck.Instances () @@ -57,7 +56,7 @@ healthyContestTx = where tx = contestTx - somePartyCardanoVerificationKey + healthyContesterVerificationKey healthyContestSnapshot (healthySignature healthyContestSnapshotNumber) (healthySlotNo, slotNoToUTCTime healthySlotNo) @@ -101,7 +100,7 @@ healthyContestSnapshotNumber = 4 healthyContestUTxO :: UTxO healthyContestUTxO = - (genOneUTxOFor somePartyCardanoVerificationKey `suchThat` (/= healthyClosedUTxO)) + (genOneUTxOFor healthyContesterVerificationKey `suchThat` (/= healthyClosedUTxO)) `generateWith` 42 healthyContestUTxOHash :: BuiltinByteString @@ -147,10 +146,10 @@ healthyClosedUTxOHash = healthyClosedUTxO :: UTxO healthyClosedUTxO = - genOneUTxOFor somePartyCardanoVerificationKey `generateWith` 42 + genOneUTxOFor healthyContesterVerificationKey `generateWith` 42 -somePartyCardanoVerificationKey :: VerificationKey PaymentKey -somePartyCardanoVerificationKey = flip generateWith 42 $ do +healthyContesterVerificationKey :: VerificationKey PaymentKey +healthyContesterVerificationKey = flip generateWith 42 $ do genForParty genVerificationKey <$> elements healthyParties healthySigningKeys :: [SigningKey HydraKey] @@ -194,7 +193,11 @@ data ContestMutation | -- | See spec: 5.5. rule 6 -> value is preserved MutateValueInOutput | -- | Change the 'ContestationDeadline' in the 'Closed' output datum such that deadline is pushed away - MutatePushedContestationDeadlineOnOutputClosedState + NotUpdateDeadlineAlthoughItShould + | -- | Changes the deadline although this is the last contest. Instead of + -- creating another healthy case this mutation also changes the starting + -- state so that everyone else already contested. + PushDeadlineAlthoughItShouldNot deriving (Generic, Show, Enum, Bounded) genContestMutation :: (Tx, UTxO) -> Gen SomeMutation @@ -252,7 +255,7 @@ genContestMutation , SomeMutation (Just "minting or burning is forbidden") MutateTokenMintingOrBurning <$> (changeMintedTokens tx =<< genMintedOrBurnedValue) , SomeMutation (Just "signer already contested") MutateInputContesters . ChangeInputHeadDatum <$> do - let contester = toPlutusKeyHash (verificationKeyHash somePartyCardanoVerificationKey) + let contester = toPlutusKeyHash (verificationKeyHash healthyContesterVerificationKey) contesterAndSomeOthers = do contesters <- listOf $ Plutus.PubKeyHash . toBuiltin <$> genHash pure (contester : contesters) @@ -270,23 +273,22 @@ genContestMutation , SomeMutation (Just "head value is not preserved") MutateValueInOutput <$> do newValue <- genValue pure $ ChangeOutput 0 (headTxOut{txOutValue = newValue}) - , SomeMutation (Just "must push deadline") MutatePushedContestationDeadlineOnOutputClosedState . ChangeOutput 0 <$> do + , SomeMutation (Just "must push deadline") NotUpdateDeadlineAlthoughItShould . ChangeOutput 0 <$> do let deadline = posixFromUTCTime healthyContestationDeadline -- Here we are replacing the contestationDeadline using the previous so we are not _pushing it_ further pure $ headTxOut & changeHeadOutputDatum (replaceContestationDeadline deadline) - , SomeMutation (Just "must not push deadline") MutatePushedContestationDeadlineOnOutputClosedState <$> do - let partiesVKeys = genForParty genVerificationKey <$> healthyParties - let contesters = toPlutusKeyHash . verificationKeyHash <$> partiesVKeys + , SomeMutation (Just "must not push deadline") PushDeadlineAlthoughItShouldNot <$> do + alreadyContested <- fmap (toPlutusKeyHash . verificationKeyHash) <$> vectorOf (length healthyParties - 1) genVerificationKey + let contester = toPlutusKeyHash $ verificationKeyHash healthyContesterVerificationKey + let mutateToHealthyCase = + [ ChangeOutput 0 (headTxOut & changeHeadOutputDatum (replaceContesters (contester : alreadyContested))) + , ChangeInputHeadDatum (healthyClosedState & replaceContesters alreadyContested) + ] + -- let deadline = posixFromUTCTime healthyContestationDeadline -- Here we are : -- - altering the contesters in input so that everybody contested -- - altering the contesters in output so that there is one party left to contest - pure $ - Changes - [ ChangeOutput 0 (headTxOut & changeHeadOutputDatum (replaceContesters contesters)) - , ChangeInputHeadDatum - -- use tail here to remove one contestant - (healthyClosedState & replaceContesters (List.tail contesters)) - ] + pure $ Changes (mutateToHealthyCase <> []) ] where headTxOut = fromJust $ txOuts' tx !!? 0 diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs index 90a36143ede..cfe2e935cad 100644 --- a/hydra-plutus/src/Hydra/Contract/Head.hs +++ b/hydra-plutus/src/Hydra/Contract/Head.hs @@ -414,7 +414,7 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN && headId' == headId mustPushDeadline = - if length allContesters == length parties' + if length contesters' == length parties' then traceIfFalse "must not push deadline" $ contestationDeadlineFromDatum == contestationDeadline @@ -424,7 +424,7 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN mustUpdateContesters = traceIfFalse "contester not included" $ - contesters' == allContesters + contesters' == contester : contesters (contestSnapshotNumber, contestUtxoHash, parties', contestationDeadlineFromDatum, headId', contesters') = -- XXX: fromBuiltinData is super big (and also expensive?) @@ -442,7 +442,6 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN ScriptContext{scriptContextTxInfo = txInfo} = ctx - allContesters = contester : contesters contester = case txInfoSignatories txInfo of [signer] -> signer From 06a1b51ace96bd15b8f821324993b563839bb0e1 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Fri, 10 Feb 2023 18:04:37 +0100 Subject: [PATCH 18/24] Finalize and document related mutation --- .../Hydra/Chain/Direct/Contract/Contest.hs | 25 +++++++++---------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 0e3b9797577..51032aacfe0 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -50,6 +50,8 @@ import Test.QuickCheck.Instances () -- ContestTx -- +-- | Healthy contest tx where the contester is the first one to contest and +-- correctly pushing out the deadline by the contestation period. healthyContestTx :: (Tx, UTxO) healthyContestTx = (tx, lookupUTxO) @@ -194,9 +196,10 @@ data ContestMutation MutateValueInOutput | -- | Change the 'ContestationDeadline' in the 'Closed' output datum such that deadline is pushed away NotUpdateDeadlineAlthoughItShould - | -- | Changes the deadline although this is the last contest. Instead of - -- creating another healthy case this mutation also changes the starting - -- state so that everyone else already contested. + | -- | Pushes the deadline although this is the last contest. Instead of + -- creating another healthy case and mutate that one, this mutation just + -- changes the starting situation so that everyone else already contested. + -- Remember the 'healthyContestTx' is already pushing out the deadline. PushDeadlineAlthoughItShouldNot deriving (Generic, Show, Enum, Bounded) @@ -278,17 +281,13 @@ genContestMutation -- Here we are replacing the contestationDeadline using the previous so we are not _pushing it_ further pure $ headTxOut & changeHeadOutputDatum (replaceContestationDeadline deadline) , SomeMutation (Just "must not push deadline") PushDeadlineAlthoughItShouldNot <$> do - alreadyContested <- fmap (toPlutusKeyHash . verificationKeyHash) <$> vectorOf (length healthyParties - 1) genVerificationKey + alreadyContested <- vectorOf (length healthyParties - 1) $ Plutus.PubKeyHash . toBuiltin <$> genHash let contester = toPlutusKeyHash $ verificationKeyHash healthyContesterVerificationKey - let mutateToHealthyCase = - [ ChangeOutput 0 (headTxOut & changeHeadOutputDatum (replaceContesters (contester : alreadyContested))) - , ChangeInputHeadDatum (healthyClosedState & replaceContesters alreadyContested) - ] - -- let deadline = posixFromUTCTime healthyContestationDeadline - -- Here we are : - -- - altering the contesters in input so that everybody contested - -- - altering the contesters in output so that there is one party left to contest - pure $ Changes (mutateToHealthyCase <> []) + pure $ + Changes + [ ChangeOutput 0 (headTxOut & changeHeadOutputDatum (replaceContesters (contester : alreadyContested))) + , ChangeInputHeadDatum (healthyClosedState & replaceContesters alreadyContested) + ] ] where headTxOut = fromJust $ txOuts' tx !!? 0 From a5dc824b754c12098e51d8440360bf7db02af93b Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Fri, 10 Feb 2023 15:19:39 -0300 Subject: [PATCH 19/24] Minor rename over contestation deadline in output datum --- hydra-plutus/src/Hydra/Contract/Head.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs index cfe2e935cad..acf7a10e7d0 100644 --- a/hydra-plutus/src/Hydra/Contract/Head.hs +++ b/hydra-plutus/src/Hydra/Contract/Head.hs @@ -417,16 +417,16 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN if length contesters' == length parties' then traceIfFalse "must not push deadline" $ - contestationDeadlineFromDatum == contestationDeadline + contestationDeadline' == contestationDeadline else traceIfFalse "must push deadline" $ - contestationDeadlineFromDatum == addContestationPeriod contestationDeadline contestationPeriod + contestationDeadline' == addContestationPeriod contestationDeadline contestationPeriod mustUpdateContesters = traceIfFalse "contester not included" $ contesters' == contester : contesters - (contestSnapshotNumber, contestUtxoHash, parties', contestationDeadlineFromDatum, headId', contesters') = + (contestSnapshotNumber, contestUtxoHash, parties', contestationDeadline', headId', contesters') = -- XXX: fromBuiltinData is super big (and also expensive?) case fromBuiltinData @DatumType $ getDatum (headOutputDatum ctx) of Just From 36b6479f3b843ad856b9d81465b9b863a08c75be Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Fri, 10 Feb 2023 15:29:15 -0300 Subject: [PATCH 20/24] Add mutation spec to check that the contestation period does not changed in outout. We must prevent a contester to reduce the period for future contesters. --- hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 51032aacfe0..93945e3f302 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -18,6 +18,7 @@ import Hydra.Chain.Direct.Contract.Mutation ( changeHeadOutputDatum, changeMintedTokens, replaceContestationDeadline, + replaceContestationPeriod, replaceContesters, replaceParties, replacePolicyIdWith, @@ -201,6 +202,8 @@ data ContestMutation -- changes the starting situation so that everyone else already contested. -- Remember the 'healthyContestTx' is already pushing out the deadline. PushDeadlineAlthoughItShouldNot + | -- | Change the contestation period to test parameters not changed in output. + MutateOutputContestationPeriod deriving (Generic, Show, Enum, Bounded) genContestMutation :: (Tx, UTxO) -> Gen SomeMutation @@ -288,6 +291,9 @@ genContestMutation [ ChangeOutput 0 (headTxOut & changeHeadOutputDatum (replaceContesters (contester : alreadyContested))) , ChangeInputHeadDatum (healthyClosedState & replaceContesters alreadyContested) ] + , SomeMutation (Just "changed parameters") MutateOutputContestationPeriod <$> do + randomCP <- arbitrary + pure $ ChangeOutput 0 (headTxOut & changeHeadOutputDatum (replaceContestationPeriod randomCP)) ] where headTxOut = fromJust $ txOuts' tx !!? 0 From 2e48bb432135f083a02c8a964f7aee7fdc34d332 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Fri, 10 Feb 2023 15:54:12 -0300 Subject: [PATCH 21/24] Update head validator to check that the contestation period does not changed in outout. --- hydra-plutus/src/Hydra/Contract/Head.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs index acf7a10e7d0..c3f4132e135 100644 --- a/hydra-plutus/src/Hydra/Contract/Head.hs +++ b/hydra-plutus/src/Hydra/Contract/Head.hs @@ -344,6 +344,8 @@ checkClose ctx parties initialUtxoHash sig cperiod headPolicyId = -- | The contest validator must verify that: -- +-- * The transaction does not mint or burn tokens. +-- -- * The contest snapshot number is strictly greater than the closed snapshot number. -- -- * The contest snapshot is correctly signed. @@ -354,9 +356,11 @@ checkClose ctx parties initialUtxoHash sig cperiod headPolicyId = -- -- * The transaction is performed before the deadline. -- +-- * Add signer to list of contesters. +-- -- * State token (ST) is present in the output -- --- * Add signer to list of contesters. +-- * Push deadline if signer is not the last one to contest. -- -- * No other parameters have changed. -- @@ -383,9 +387,9 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN && mustBeWithinContestationPeriod && mustUpdateContesters && hasST headId val + && mustPushDeadline && mustNotChangeParameters && mustPreserveValue - && mustPushDeadline where mustPreserveValue = traceIfFalse "head value is not preserved" $ @@ -412,6 +416,7 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN traceIfFalse "changed parameters" $ parties' == parties && headId' == headId + && contestationPeriod' == contestationPeriod mustPushDeadline = if length contesters' == length parties' @@ -426,7 +431,7 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN traceIfFalse "contester not included" $ contesters' == contester : contesters - (contestSnapshotNumber, contestUtxoHash, parties', contestationDeadline', headId', contesters') = + (contestSnapshotNumber, contestUtxoHash, parties', contestationDeadline', contestationPeriod', headId', contesters') = -- XXX: fromBuiltinData is super big (and also expensive?) case fromBuiltinData @DatumType $ getDatum (headOutputDatum ctx) of Just @@ -435,9 +440,10 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN , utxoHash , parties = p , contestationDeadline = dl + , contestationPeriod = cp , headId = hid , contesters = cs - } -> (snapshotNumber, utxoHash, p, dl, hid, cs) + } -> (snapshotNumber, utxoHash, p, dl, cp, hid, cs) _ -> traceError "wrong state in output datum" ScriptContext{scriptContextTxInfo = txInfo} = ctx From b6ee2a7234b661298e12f8c5592bb1f58ca7006d Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Fri, 10 Feb 2023 15:57:19 -0300 Subject: [PATCH 22/24] Move functions to from module level to local scope in where block --- hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs index 6e5f9cdd5e1..e57ce93b89f 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs @@ -75,12 +75,6 @@ healthyContestationDeadline :: UTCTime healthyContestationDeadline = slotNoToUTCTime $ healthySlotNo - 1 -healthyContestationPeriod :: OnChain.ContestationPeriod -healthyContestationPeriod = OnChain.contestationPeriodFromDiffTime $ fromInteger healthyContestationPeriodSeconds - -healthyContestationPeriodSeconds :: Integer -healthyContestationPeriodSeconds = 10 - healthyFanoutDatum :: Head.State healthyFanoutDatum = Head.Closed @@ -92,6 +86,10 @@ healthyFanoutDatum = , headId = toPlutusCurrencySymbol testPolicyId , contesters = [] } + where + healthyContestationPeriodSeconds = 10 + + healthyContestationPeriod = OnChain.contestationPeriodFromDiffTime $ fromInteger healthyContestationPeriodSeconds data FanoutMutation = MutateAddUnexpectedOutput From b09742d932d142a8111f80b2bb252217796e48c4 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Mon, 13 Feb 2023 10:25:07 +0100 Subject: [PATCH 23/24] Reduce fanout outputs by one --- hydra-node/test/Hydra/Chain/Direct/StateSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs index 3bce12346bd..bc7cd38c14f 100644 --- a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs @@ -398,7 +398,7 @@ forAllFanout action = in action utxo tx & label ("Fanout size: " <> prettyLength (countAssets $ txOuts' tx)) where - maxSupported = 39 + maxSupported = 38 countAssets = getSum . foldMap (Sum . valueSize . txOutValue) From baabff9f3c61775ffd092c8fdb4be7fdbf44c6c8 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Mon, 13 Feb 2023 13:17:49 +0100 Subject: [PATCH 24/24] Exclude healthyContestationPeriod --- hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index 93945e3f302..478ed5218ea 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -292,7 +292,7 @@ genContestMutation , ChangeInputHeadDatum (healthyClosedState & replaceContesters alreadyContested) ] , SomeMutation (Just "changed parameters") MutateOutputContestationPeriod <$> do - randomCP <- arbitrary + randomCP <- arbitrary `suchThat` (/= healthyOnChainContestationPeriod) pure $ ChangeOutput 0 (headTxOut & changeHeadOutputDatum (replaceContestationPeriod randomCP)) ] where