import Hydra.Chain.Direct.Contract.Mutation (Mutation (..), SomeMutation (..), addParticipationTokens, changeHeadOutputDatum, genHash, replacePolicyIdWith)
import Hydra.Chain.Direct.Fixture (genForParty, testNetworkId)
import qualified Hydra.Chain.Direct.Fixture as Fixture
+
import Hydra.Chain.Direct.TimeHandle (PointInTime)
import Hydra.Chain.Direct.Tx (ClosingSnapshot (..), OpenThreadOutput (..), UTxOHash (UTxOHash), closeTx, mkHeadId, mkHeadOutput)
import Hydra.ContestationPeriod (fromChain)
import qualified Hydra.Contract.HeadState as Head
somePartyCardanoVerificationKey
+
healthyCloseLowerBoundSlot
+
healthyCloseUpperBoundPointInTime
(mkHeadId Fixture.testPolicyId)
-
-- here we need to pass in contestation period when generating start/end tx validity slots/time
-
-- since if tx validity bound difference is bigger than contestation period our close validator
-
(startSlot, pointInTime) =
-
genValidityBoundsFromContestationPeriod (fromChain healthyContestationPeriod) `generateWith` 42
lookupUTxO = UTxO.singleton (healthyOpenHeadTxIn, healthyOpenHeadTxOut)
headDatum = fromPlutusData $ toData healthyCloseDatum
, openContestationPeriod = healthyContestationPeriod
+
-- 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
headTxOutDatum = toUTxOContext (mkTxOutDatum healthyCloseDatum)
-- FIXME: This is not a healthy value anyhow related to the 'healthyCloseTx' above
-
healthySlotNo = arbitrary `generateWith` 42
+
brokenSlotNo = arbitrary `generateWith` 42
healthyClosingSnapshot :: ClosingSnapshot
healthyContestationDeadline =
(fromInteger healthyContestationPeriodSeconds)
-
(slotNoToUTCTime healthySlotNo)
+
(snd healthyCloseUpperBoundPointInTime)
healthyClosedUTxOHash :: BuiltinByteString
= MutateSignatureButNotSnapshotNumber
-
| MutateSnapshotNumberButNotSignature
+
| -- | Change the resulting snapshot number, this should make the signature
+
MutateSnapshotNumberButNotSignature
| MutateSnapshotToIllFormedValue
[ SomeMutation Nothing MutateSignatureButNotSnapshotNumber . ChangeHeadRedeemer <$> do
Head.Close . toPlutusSignatures <$> (arbitrary :: Gen (MultiSignature (Snapshot Tx)))
-
, SomeMutation Nothing MutateSnapshotNumberButNotSignature . ChangeInputHeadDatum <$> do
-
-- FIXME: This is failing for the wrong reason, we would expect "invalid snapshot signature" here
+
, SomeMutation (Just "invalid snapshot signature") MutateSnapshotNumberButNotSignature <$> do
mutatedSnapshotNumber <- arbitrarySizedNatural `suchThat` (\n -> n /= healthySnapshotNumber && n > 0)
-
{ snapshotNumber = toInteger mutatedSnapshotNumber
-
, utxoHash = Head.utxoHash healthyCloseDatum
-
, parties = Head.parties healthyCloseDatum
-
, contestationDeadline = posixFromUTCTime healthyContestationDeadline
-
, headId = Head.headId healthyCloseDatum
+
{ snapshotNumber = toInteger mutatedSnapshotNumber
+
, utxoHash = Head.utxoHash healthyCloseDatum
+
, parties = Head.parties healthyCloseDatum
+
, contestationDeadline = posixFromUTCTime healthyContestationDeadline
+
, headId = Head.headId healthyCloseDatum
+
pure $ ChangeOutput 0 $ changeHeadOutputDatum (const newClosedState) headTxOut
, SomeMutation Nothing MutateSnapshotToIllFormedValue <$> do
mutatedSnapshotNumber <- arbitrary `suchThat` (< 0)
, SomeMutation Nothing MutateCloseContestationDeadlineWithZero . ChangeOutput 0 <$> mutateClosedContestationDeadline 0
, SomeMutation Nothing MutateValidityInterval . ChangeValidityInterval <$> do
-
ub <- arbitrary `suchThat` (/= TxValidityUpperBound healthySlotNo)
+
ub <- arbitrary `suchThat` (/= TxValidityUpperBound brokenSlotNo)
, -- try to change a tx so that lower bound is higher than the upper bound
SomeMutation Nothing MutateValidityInterval . ChangeValidityInterval <$> do
-
let closingTime = slotNoToUTCTime healthySlotNo
+
let closingTime = slotNoToUTCTime brokenSlotNo
in posixFromUTCTime $ addUTCTime (fromInteger contestationPeriod) closingTime
, headId = toPlutusCurrencySymbol Fixture.testPolicyId
