{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Hydra.Chain.Direct.Contract.Contest where
import Hydra.Cardano.Api
import Hydra.Prelude hiding (label)
import Data.Maybe (fromJust)
import Cardano.Api.UTxO as UTxO
import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue)
import Hydra.Chain.Direct.Contract.Mutation (
Mutation (..),
SomeMutation (..),
addParticipationTokens,
changeMintedTokens,
modifyInlineDatum,
replaceContestationDeadline,
replaceContestationPeriod,
replaceContesters,
replaceHeadId,
replaceParties,
replacePolicyIdWith,
replaceSnapshotNumber,
replaceUtxoHash,
)
import Hydra.Chain.Direct.Fixture (slotLength, systemStart, testNetworkId, testPolicyId)
import Hydra.Chain.Direct.Fixture qualified as Fixture
import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO)
import Hydra.Chain.Direct.Tx (ClosedThreadOutput (..), contestTx, mkHeadId, mkHeadOutput)
import Hydra.ContestationPeriod (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 (partyFromVerificationKeyBytes)
import Hydra.Data.Party qualified as OnChain
import Hydra.Ledger (hashUTxO)
import Hydra.Ledger.Cardano (genAddressInEra, genOneUTxOFor, genValue, genVerificationKey)
import Hydra.Ledger.Cardano.Time (slotNoToUTCTime)
import Hydra.Party (Party, deriveParty, partyToChain)
import Hydra.Plutus.Extras (posixFromUTCTime)
import Hydra.Plutus.Orphans ()
import Hydra.Snapshot (Snapshot (..), SnapshotNumber)
import PlutusLedgerApi.V2 (BuiltinByteString, toBuiltin)
import PlutusLedgerApi.V2 qualified as Plutus
import Test.Hydra.Fixture (aliceSk, bobSk, carolSk)
import Test.QuickCheck (arbitrarySizedNatural, elements, listOf, listOf1, oneof, suchThat, vectorOf)
import Test.QuickCheck.Gen (choose)
import Test.QuickCheck.Instances ()
healthyContestTx :: (Tx, UTxO)
healthyContestTx :: (Tx, UTxO)
healthyContestTx =
(Tx
tx, UTxO
lookupUTxO)
where
lookupUTxO :: UTxO
lookupUTxO =
(TxIn, TxOut CtxUTxO Era) -> UTxO
forall out. (TxIn, out) -> UTxO' out
UTxO.singleton (TxIn
healthyClosedHeadTxIn, TxOut CtxUTxO Era
healthyClosedHeadTxOut)
UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> ScriptRegistry -> UTxO
registryUTxO ScriptRegistry
scriptRegistry
tx :: Tx
tx =
ScriptRegistry
-> VerificationKey PaymentKey
-> Snapshot Tx
-> MultiSignature (Snapshot Tx)
-> PointInTime
-> ClosedThreadOutput
-> HeadId
-> ContestationPeriod
-> Tx
contestTx
ScriptRegistry
scriptRegistry
VerificationKey PaymentKey
healthyContesterVerificationKey
Snapshot Tx
healthyContestSnapshot
(SnapshotNumber -> MultiSignature (Snapshot Tx)
healthySignature SnapshotNumber
healthyContestSnapshotNumber)
(SlotNo
healthySlotNo, SystemStart -> SlotLength -> SlotNo -> UTCTime
slotNoToUTCTime SystemStart
systemStart SlotLength
slotLength SlotNo
healthySlotNo)
ClosedThreadOutput
closedThreadOutput
(PolicyId -> HeadId
mkHeadId PolicyId
testPolicyId)
ContestationPeriod
healthyContestationPeriod
scriptRegistry :: ScriptRegistry
scriptRegistry = Gen ScriptRegistry
genScriptRegistry Gen ScriptRegistry -> Int -> ScriptRegistry
forall a. Gen a -> Int -> a
`generateWith` Int
42
closedThreadOutput :: ClosedThreadOutput
closedThreadOutput =
ClosedThreadOutput
{ $sel:closedThreadUTxO:ClosedThreadOutput :: (TxIn, TxOut CtxUTxO Era)
closedThreadUTxO = (TxIn
healthyClosedHeadTxIn, TxOut CtxUTxO Era
healthyClosedHeadTxOut)
, $sel:closedParties:ClosedThreadOutput :: [Party]
closedParties =
[Party]
healthyOnChainParties
, $sel:closedContestationDeadline:ClosedThreadOutput :: POSIXTime
closedContestationDeadline = UTCTime -> POSIXTime
posixFromUTCTime UTCTime
healthyContestationDeadline
, $sel:closedContesters:ClosedThreadOutput :: [PubKeyHash]
closedContesters = []
}
healthyClosedHeadTxIn :: TxIn
healthyClosedHeadTxIn :: TxIn
healthyClosedHeadTxIn = Gen TxIn -> Int -> TxIn
forall a. Gen a -> Int -> a
generateWith Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary Int
42
healthyClosedHeadTxOut :: TxOut CtxUTxO
healthyClosedHeadTxOut :: TxOut CtxUTxO Era
healthyClosedHeadTxOut =
NetworkId -> PolicyId -> TxOutDatum CtxUTxO -> TxOut CtxUTxO Era
forall ctx. NetworkId -> PolicyId -> TxOutDatum ctx -> TxOut ctx
mkHeadOutput NetworkId
testNetworkId PolicyId
testPolicyId TxOutDatum CtxUTxO
headTxOutDatum
TxOut CtxUTxO Era
-> (TxOut CtxUTxO Era -> TxOut CtxUTxO Era) -> TxOut CtxUTxO Era
forall a b. a -> (a -> b) -> b
& [VerificationKey PaymentKey]
-> TxOut CtxUTxO Era -> TxOut CtxUTxO Era
addParticipationTokens [VerificationKey PaymentKey]
healthyParticipants
where
headTxOutDatum :: TxOutDatum CtxUTxO
headTxOutDatum = TxOutDatum CtxTx Era -> TxOutDatum CtxUTxO
forall era. TxOutDatum CtxTx era -> TxOutDatum CtxUTxO era
forall {k} (f :: * -> k -> *) (era :: k).
ToUTxOContext f =>
f CtxTx era -> f CtxUTxO era
toUTxOContext (State -> TxOutDatum CtxTx Era
forall era a ctx.
(ToScriptData a, IsBabbageEraOnwards era) =>
a -> TxOutDatum ctx era
mkTxOutDatumInline State
healthyClosedState)
healthyContestSnapshot :: Snapshot Tx
healthyContestSnapshot :: Snapshot Tx
healthyContestSnapshot =
Snapshot
{ $sel:headId:Snapshot :: HeadId
headId = PolicyId -> HeadId
mkHeadId PolicyId
testPolicyId
, $sel:number:Snapshot :: SnapshotNumber
number = SnapshotNumber
healthyContestSnapshotNumber
, $sel:utxo:Snapshot :: UTxOType Tx
utxo = UTxO
UTxOType Tx
healthyContestUTxO
, $sel:confirmed:Snapshot :: [TxIdType Tx]
confirmed = []
}
healthyContestSnapshotNumber :: SnapshotNumber
healthyContestSnapshotNumber :: SnapshotNumber
healthyContestSnapshotNumber = SnapshotNumber
4
healthyContestUTxO :: UTxO
healthyContestUTxO :: UTxO
healthyContestUTxO =
(VerificationKey PaymentKey -> Gen UTxO
genOneUTxOFor VerificationKey PaymentKey
healthyContesterVerificationKey Gen UTxO -> (UTxO -> Bool) -> Gen UTxO
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (UTxO -> UTxO -> Bool
forall a. Eq a => a -> a -> Bool
/= UTxO
healthyClosedUTxO))
Gen UTxO -> Int -> UTxO
forall a. Gen a -> Int -> a
`generateWith` Int
42
healthyContestUTxOHash :: BuiltinByteString
healthyContestUTxOHash :: BuiltinByteString
healthyContestUTxOHash =
ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @Tx UTxO
UTxOType Tx
healthyContestUTxO
healthyClosedState :: Head.State
healthyClosedState :: State
healthyClosedState =
Head.Closed
{ $sel:snapshotNumber:Initial :: SnapshotNumber
snapshotNumber = SnapshotNumber -> SnapshotNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral SnapshotNumber
healthyClosedSnapshotNumber
, $sel:utxoHash:Initial :: BuiltinByteString
utxoHash = BuiltinByteString
healthyClosedUTxOHash
, $sel:parties:Initial :: [Party]
parties = [Party]
healthyOnChainParties
, $sel:contestationDeadline:Initial :: POSIXTime
contestationDeadline = UTCTime -> POSIXTime
posixFromUTCTime UTCTime
healthyContestationDeadline
, $sel:contestationPeriod:Initial :: ContestationPeriod
contestationPeriod = ContestationPeriod
healthyOnChainContestationPeriod
, $sel:headId:Initial :: CurrencySymbol
headId = PolicyId -> CurrencySymbol
toPlutusCurrencySymbol PolicyId
testPolicyId
, $sel:contesters:Initial :: [PubKeyHash]
contesters = []
}
healthySlotNo :: SlotNo
healthySlotNo :: SlotNo
healthySlotNo = Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary Gen SlotNo -> Int -> SlotNo
forall a. Gen a -> Int -> a
`generateWith` Int
42
healthyContestationDeadline :: UTCTime
healthyContestationDeadline :: UTCTime
healthyContestationDeadline =
NominalDiffTime -> UTCTime -> UTCTime
addUTCTime
(SnapshotNumber -> NominalDiffTime
forall a. Num a => SnapshotNumber -> a
fromInteger SnapshotNumber
healthyContestationPeriodSeconds)
(SystemStart -> SlotLength -> SlotNo -> UTCTime
slotNoToUTCTime SystemStart
systemStart SlotLength
slotLength SlotNo
healthySlotNo)
healthyOnChainContestationPeriod :: OnChain.ContestationPeriod
healthyOnChainContestationPeriod :: ContestationPeriod
healthyOnChainContestationPeriod = NominalDiffTime -> ContestationPeriod
OnChain.contestationPeriodFromDiffTime (NominalDiffTime -> ContestationPeriod)
-> NominalDiffTime -> ContestationPeriod
forall a b. (a -> b) -> a -> b
$ SnapshotNumber -> NominalDiffTime
forall a. Num a => SnapshotNumber -> a
fromInteger SnapshotNumber
healthyContestationPeriodSeconds
healthyContestationPeriod :: ContestationPeriod
healthyContestationPeriod :: ContestationPeriod
healthyContestationPeriod = ContestationPeriod -> ContestationPeriod
fromChain ContestationPeriod
healthyOnChainContestationPeriod
healthyContestationPeriodSeconds :: Integer
healthyContestationPeriodSeconds :: SnapshotNumber
healthyContestationPeriodSeconds = SnapshotNumber
10
healthyClosedSnapshotNumber :: SnapshotNumber
healthyClosedSnapshotNumber :: SnapshotNumber
healthyClosedSnapshotNumber = SnapshotNumber
3
healthyClosedUTxOHash :: BuiltinByteString
healthyClosedUTxOHash :: BuiltinByteString
healthyClosedUTxOHash =
ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @Tx UTxO
UTxOType Tx
healthyClosedUTxO
healthyClosedUTxO :: UTxO
healthyClosedUTxO :: UTxO
healthyClosedUTxO =
VerificationKey PaymentKey -> Gen UTxO
genOneUTxOFor VerificationKey PaymentKey
healthyContesterVerificationKey Gen UTxO -> Int -> UTxO
forall a. Gen a -> Int -> a
`generateWith` Int
42
healthyParticipants :: [VerificationKey PaymentKey]
healthyParticipants :: [VerificationKey PaymentKey]
healthyParticipants =
Gen (VerificationKey PaymentKey)
-> Party -> VerificationKey PaymentKey
forall a. Gen a -> Party -> a
genForParty Gen (VerificationKey PaymentKey)
genVerificationKey (Party -> VerificationKey PaymentKey)
-> [Party] -> [VerificationKey PaymentKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Party]
healthyParties
healthyContesterVerificationKey :: VerificationKey PaymentKey
healthyContesterVerificationKey :: VerificationKey PaymentKey
healthyContesterVerificationKey =
[VerificationKey PaymentKey] -> Gen (VerificationKey PaymentKey)
forall a. [a] -> Gen a
elements [VerificationKey PaymentKey]
healthyParticipants Gen (VerificationKey PaymentKey)
-> Int -> VerificationKey PaymentKey
forall a. Gen a -> Int -> a
`generateWith` Int
42
healthySigningKeys :: [SigningKey HydraKey]
healthySigningKeys :: [SigningKey HydraKey]
healthySigningKeys = [SigningKey HydraKey
aliceSk, SigningKey HydraKey
bobSk, SigningKey HydraKey
carolSk]
healthyParties :: [Party]
healthyParties :: [Party]
healthyParties = SigningKey HydraKey -> Party
deriveParty (SigningKey HydraKey -> Party) -> [SigningKey HydraKey] -> [Party]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigningKey HydraKey]
healthySigningKeys
healthyOnChainParties :: [OnChain.Party]
healthyOnChainParties :: [Party]
healthyOnChainParties = Party -> Party
partyToChain (Party -> Party) -> [Party] -> [Party]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Party]
healthyParties
healthySignature :: SnapshotNumber -> MultiSignature (Snapshot Tx)
healthySignature :: SnapshotNumber -> MultiSignature (Snapshot Tx)
healthySignature SnapshotNumber
number =
[Signature (Snapshot Tx)] -> MultiSignature (Snapshot Tx)
forall {k} (a :: k). [Signature a] -> MultiSignature a
aggregate [SigningKey HydraKey -> Snapshot Tx -> Signature (Snapshot Tx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
sk Snapshot Tx
snapshot | SigningKey HydraKey
sk <- [SigningKey HydraKey]
healthySigningKeys]
where
snapshot :: Snapshot Tx
snapshot = Snapshot Tx
healthyContestSnapshot{number}
data ContestMutation
=
NotContinueContract
|
MutateSignatureButNotSnapshotNumber
|
MutateSnapshotNumberButNotSignature
|
MutateToNonNewerSnapshot
|
MutateRequiredSigner
|
MutateNoRequiredSigner
|
MutateMultipleRequiredSigner
|
MutateContestUTxOHash
|
SnapshotNotSignedByAllParties
|
MutateValidityPastDeadline
|
ContestFromDifferentHead
|
MutateTokenMintingOrBurning
|
MutateInputContesters
|
MutateContesters
|
MutateValueInOutput
|
NotUpdateDeadlineAlthoughItShould
|
PushDeadlineAlthoughItShouldNot
|
MutateOutputContestationPeriod
|
MutatePartiesInOutput
|
MutateHeadIdInOutput
deriving stock ((forall x. ContestMutation -> Rep ContestMutation x)
-> (forall x. Rep ContestMutation x -> ContestMutation)
-> Generic ContestMutation
forall x. Rep ContestMutation x -> ContestMutation
forall x. ContestMutation -> Rep ContestMutation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContestMutation -> Rep ContestMutation x
from :: forall x. ContestMutation -> Rep ContestMutation x
$cto :: forall x. Rep ContestMutation x -> ContestMutation
to :: forall x. Rep ContestMutation x -> ContestMutation
Generic, Int -> ContestMutation -> ShowS
[ContestMutation] -> ShowS
ContestMutation -> String
(Int -> ContestMutation -> ShowS)
-> (ContestMutation -> String)
-> ([ContestMutation] -> ShowS)
-> Show ContestMutation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContestMutation -> ShowS
showsPrec :: Int -> ContestMutation -> ShowS
$cshow :: ContestMutation -> String
show :: ContestMutation -> String
$cshowList :: [ContestMutation] -> ShowS
showList :: [ContestMutation] -> ShowS
Show, Int -> ContestMutation
ContestMutation -> Int
ContestMutation -> [ContestMutation]
ContestMutation -> ContestMutation
ContestMutation -> ContestMutation -> [ContestMutation]
ContestMutation
-> ContestMutation -> ContestMutation -> [ContestMutation]
(ContestMutation -> ContestMutation)
-> (ContestMutation -> ContestMutation)
-> (Int -> ContestMutation)
-> (ContestMutation -> Int)
-> (ContestMutation -> [ContestMutation])
-> (ContestMutation -> ContestMutation -> [ContestMutation])
-> (ContestMutation -> ContestMutation -> [ContestMutation])
-> (ContestMutation
-> ContestMutation -> ContestMutation -> [ContestMutation])
-> Enum ContestMutation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ContestMutation -> ContestMutation
succ :: ContestMutation -> ContestMutation
$cpred :: ContestMutation -> ContestMutation
pred :: ContestMutation -> ContestMutation
$ctoEnum :: Int -> ContestMutation
toEnum :: Int -> ContestMutation
$cfromEnum :: ContestMutation -> Int
fromEnum :: ContestMutation -> Int
$cenumFrom :: ContestMutation -> [ContestMutation]
enumFrom :: ContestMutation -> [ContestMutation]
$cenumFromThen :: ContestMutation -> ContestMutation -> [ContestMutation]
enumFromThen :: ContestMutation -> ContestMutation -> [ContestMutation]
$cenumFromTo :: ContestMutation -> ContestMutation -> [ContestMutation]
enumFromTo :: ContestMutation -> ContestMutation -> [ContestMutation]
$cenumFromThenTo :: ContestMutation
-> ContestMutation -> ContestMutation -> [ContestMutation]
enumFromThenTo :: ContestMutation
-> ContestMutation -> ContestMutation -> [ContestMutation]
Enum, ContestMutation
ContestMutation -> ContestMutation -> Bounded ContestMutation
forall a. a -> a -> Bounded a
$cminBound :: ContestMutation
minBound :: ContestMutation
$cmaxBound :: ContestMutation
maxBound :: ContestMutation
Bounded)
genContestMutation :: (Tx, UTxO) -> Gen SomeMutation
genContestMutation :: (Tx, UTxO) -> Gen SomeMutation
genContestMutation (Tx
tx, UTxO
_utxo) =
[Gen SomeMutation] -> Gen SomeMutation
forall a. [Gen a] -> Gen a
oneof
[ Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
NotPayingToHead) ContestMutation
NotContinueContract (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
AddressInEra
mutatedAddress <- NetworkId -> Gen AddressInEra
genAddressInEra NetworkId
testNetworkId
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$ Word -> TxOut CtxTx -> Mutation
ChangeOutput Word
0 ((AddressInEra -> AddressInEra) -> TxOut CtxTx -> TxOut CtxTx
forall era ctx.
(AddressInEra era -> AddressInEra era)
-> TxOut ctx era -> TxOut ctx era
modifyTxOutAddress (AddressInEra -> AddressInEra -> AddressInEra
forall a b. a -> b -> a
const AddressInEra
mutatedAddress) TxOut CtxTx
headTxOut)
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
SignatureVerificationFailed) ContestMutation
MutateSignatureButNotSnapshotNumber (Mutation -> SomeMutation)
-> (Input -> Mutation) -> Input -> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Mutation
ChangeHeadRedeemer (Input -> SomeMutation) -> Gen Input -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
MultiSignature (Snapshot Tx)
mutatedSignature <- Gen (MultiSignature (Snapshot Tx))
forall a. Arbitrary a => Gen a
arbitrary :: Gen (MultiSignature (Snapshot Tx))
Input -> Gen Input
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Gen Input) -> Input -> Gen Input
forall a b. (a -> b) -> a -> b
$
Head.Contest
{ $sel:signature:CollectCom :: [BuiltinByteString]
signature = MultiSignature (Snapshot Tx) -> [BuiltinByteString]
forall {k} (a :: k). MultiSignature a -> [BuiltinByteString]
toPlutusSignatures MultiSignature (Snapshot Tx)
mutatedSignature
}
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
SignatureVerificationFailed) ContestMutation
MutateSnapshotNumberButNotSignature (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
SnapshotNumber
mutatedSnapshotNumber <- Gen SnapshotNumber
forall a. Integral a => Gen a
arbitrarySizedNatural Gen SnapshotNumber
-> (SnapshotNumber -> Bool) -> Gen SnapshotNumber
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (SnapshotNumber -> SnapshotNumber -> Bool
forall a. Ord a => a -> a -> Bool
> SnapshotNumber
healthyContestSnapshotNumber)
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$ Word -> TxOut CtxTx -> Mutation
ChangeOutput Word
0 (TxOut CtxTx -> Mutation) -> TxOut CtxTx -> Mutation
forall a b. (a -> b) -> a -> b
$ (State -> State) -> TxOut CtxTx -> TxOut CtxTx
forall a.
(FromScriptData a, ToScriptData a) =>
(a -> a) -> TxOut CtxTx -> TxOut CtxTx
modifyInlineDatum (SnapshotNumber -> State -> State
replaceSnapshotNumber (SnapshotNumber -> State -> State)
-> SnapshotNumber -> State -> State
forall a b. (a -> b) -> a -> b
$ SnapshotNumber -> SnapshotNumber
forall a. Integral a => a -> SnapshotNumber
toInteger SnapshotNumber
mutatedSnapshotNumber) TxOut CtxTx
headTxOut
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
TooOldSnapshot) ContestMutation
MutateToNonNewerSnapshot (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
SnapshotNumber
mutatedSnapshotNumber <- (SnapshotNumber, SnapshotNumber) -> Gen SnapshotNumber
forall a. Random a => (a, a) -> Gen a
choose (SnapshotNumber -> SnapshotNumber
forall a. Integral a => a -> SnapshotNumber
toInteger SnapshotNumber
healthyContestSnapshotNumber, SnapshotNumber -> SnapshotNumber
forall a. Integral a => a -> SnapshotNumber
toInteger SnapshotNumber
healthyContestSnapshotNumber SnapshotNumber -> SnapshotNumber -> SnapshotNumber
forall a. Num a => a -> a -> a
+ SnapshotNumber
1)
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$
[Mutation] -> Mutation
Changes
[ State -> Mutation
ChangeInputHeadDatum (State -> Mutation) -> State -> Mutation
forall a b. (a -> b) -> a -> b
$
State
healthyClosedState State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& SnapshotNumber -> State -> State
replaceSnapshotNumber SnapshotNumber
mutatedSnapshotNumber
, Input -> Mutation
ChangeHeadRedeemer (Input -> Mutation) -> Input -> Mutation
forall a b. (a -> b) -> a -> b
$
Head.Contest
{ $sel:signature:CollectCom :: [BuiltinByteString]
signature =
MultiSignature (Snapshot Tx) -> [BuiltinByteString]
forall {k} (a :: k). MultiSignature a -> [BuiltinByteString]
toPlutusSignatures (MultiSignature (Snapshot Tx) -> [BuiltinByteString])
-> MultiSignature (Snapshot Tx) -> [BuiltinByteString]
forall a b. (a -> b) -> a -> b
$
SnapshotNumber -> MultiSignature (Snapshot Tx)
healthySignature (SnapshotNumber -> SnapshotNumber
forall a. Num a => SnapshotNumber -> a
fromInteger SnapshotNumber
mutatedSnapshotNumber)
}
]
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
SignerIsNotAParticipant) ContestMutation
MutateRequiredSigner (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Hash PaymentKey
newSigner <- VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey PaymentKey -> Hash PaymentKey)
-> Gen (VerificationKey PaymentKey) -> Gen (Hash PaymentKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VerificationKey PaymentKey)
genVerificationKey Gen (VerificationKey PaymentKey)
-> (VerificationKey PaymentKey -> Bool)
-> Gen (VerificationKey PaymentKey)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (VerificationKey PaymentKey -> VerificationKey PaymentKey -> Bool
forall a. Eq a => a -> a -> Bool
/= VerificationKey PaymentKey
healthyContesterVerificationKey)
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$ [Hash PaymentKey] -> Mutation
ChangeRequiredSigners [Hash PaymentKey
newSigner]
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
NoSigners) ContestMutation
MutateNoRequiredSigner (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$ [Hash PaymentKey] -> Mutation
ChangeRequiredSigners []
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
TooManySigners) ContestMutation
MutateMultipleRequiredSigner (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
[VerificationKey PaymentKey]
otherSigners <- Gen (VerificationKey PaymentKey)
-> Gen [VerificationKey PaymentKey]
forall a. Gen a -> Gen [a]
listOf1 (Gen (VerificationKey PaymentKey)
genVerificationKey Gen (VerificationKey PaymentKey)
-> (VerificationKey PaymentKey -> Bool)
-> Gen (VerificationKey PaymentKey)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (VerificationKey PaymentKey -> VerificationKey PaymentKey -> Bool
forall a. Eq a => a -> a -> Bool
/= VerificationKey PaymentKey
healthyContesterVerificationKey))
let signerAndOthers :: [VerificationKey PaymentKey]
signerAndOthers = VerificationKey PaymentKey
healthyContesterVerificationKey VerificationKey PaymentKey
-> [VerificationKey PaymentKey] -> [VerificationKey PaymentKey]
forall a. a -> [a] -> [a]
: [VerificationKey PaymentKey]
otherSigners
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$ [Hash PaymentKey] -> Mutation
ChangeRequiredSigners (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey PaymentKey -> Hash PaymentKey)
-> [VerificationKey PaymentKey] -> [Hash PaymentKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VerificationKey PaymentKey]
signerAndOthers)
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
SignatureVerificationFailed) ContestMutation
MutateContestUTxOHash (Mutation -> SomeMutation)
-> (TxOut CtxTx -> Mutation) -> TxOut CtxTx -> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> TxOut CtxTx -> Mutation
ChangeOutput Word
0 (TxOut CtxTx -> SomeMutation)
-> Gen (TxOut CtxTx) -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
ByteString
mutatedUTxOHash <- Gen ByteString
genHash Gen ByteString -> (ByteString -> Bool) -> Gen ByteString
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` ((BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= BuiltinByteString
healthyContestUTxOHash) (BuiltinByteString -> Bool)
-> (ByteString -> BuiltinByteString) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin)
TxOut CtxTx -> Gen (TxOut CtxTx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut CtxTx -> Gen (TxOut CtxTx))
-> TxOut CtxTx -> Gen (TxOut CtxTx)
forall a b. (a -> b) -> a -> b
$
(State -> State) -> TxOut CtxTx -> TxOut CtxTx
forall a.
(FromScriptData a, ToScriptData a) =>
(a -> a) -> TxOut CtxTx -> TxOut CtxTx
modifyInlineDatum
(BuiltinByteString -> State -> State
replaceUtxoHash (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin ByteString
mutatedUTxOHash))
TxOut CtxTx
headTxOut
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
SignatureVerificationFailed) ContestMutation
SnapshotNotSignedByAllParties (Mutation -> SomeMutation)
-> (State -> Mutation) -> State -> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Mutation
ChangeInputHeadDatum (State -> SomeMutation) -> Gen State -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
[Party]
mutatedParties <- Gen [Party]
forall a. Arbitrary a => Gen a
arbitrary Gen [Party] -> ([Party] -> Bool) -> Gen [Party]
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` ([Party] -> [Party] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Party]
healthyOnChainParties)
State -> Gen State
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State -> Gen State) -> State -> Gen State
forall a b. (a -> b) -> a -> b
$
State
healthyClosedState State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& [Party] -> State -> State
replaceParties [Party]
mutatedParties
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
UpperBoundBeyondContestationDeadline) ContestMutation
MutateValidityPastDeadline (Mutation -> SomeMutation)
-> ((TxValidityLowerBound, TxValidityUpperBound) -> Mutation)
-> (TxValidityLowerBound, TxValidityUpperBound)
-> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxValidityLowerBound, TxValidityUpperBound) -> Mutation
ChangeValidityInterval ((TxValidityLowerBound, TxValidityUpperBound) -> SomeMutation)
-> Gen (TxValidityLowerBound, TxValidityUpperBound)
-> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
TxValidityLowerBound
lb <- Gen TxValidityLowerBound
forall a. Arbitrary a => Gen a
arbitrary
TxValidityUpperBound
ub <- SlotNo -> TxValidityUpperBound
TxValidityUpperBound (SlotNo -> TxValidityUpperBound)
-> Gen SlotNo -> Gen TxValidityUpperBound
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary Gen SlotNo -> (SlotNo -> Bool) -> Gen SlotNo
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` SlotNo -> Bool
slotOverContestationDeadline
(TxValidityLowerBound, TxValidityUpperBound)
-> Gen (TxValidityLowerBound, TxValidityUpperBound)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxValidityLowerBound
lb, TxValidityUpperBound
ub)
,
Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
SignerIsNotAParticipant) ContestMutation
ContestFromDifferentHead (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
PolicyId
otherHeadId <- TxIn -> PolicyId
headPolicyId (TxIn -> PolicyId) -> Gen TxIn -> Gen PolicyId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary Gen TxIn -> (TxIn -> Bool) -> Gen TxIn
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (TxIn -> TxIn -> Bool
forall a. Eq a => a -> a -> Bool
/= TxIn
healthyClosedHeadTxIn)
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$
[Mutation] -> Mutation
Changes
[ Word -> TxOut CtxTx -> Mutation
ChangeOutput Word
0 (PolicyId -> PolicyId -> TxOut CtxTx -> TxOut CtxTx
forall a. PolicyId -> PolicyId -> TxOut a -> TxOut a
replacePolicyIdWith PolicyId
testPolicyId PolicyId
otherHeadId TxOut CtxTx
headTxOut)
, TxIn -> TxOut CtxUTxO Era -> Maybe HashableScriptData -> Mutation
ChangeInput
TxIn
healthyClosedHeadTxIn
(PolicyId -> PolicyId -> TxOut CtxUTxO Era -> TxOut CtxUTxO Era
forall a. PolicyId -> PolicyId -> TxOut a -> TxOut a
replacePolicyIdWith PolicyId
testPolicyId PolicyId
otherHeadId TxOut CtxUTxO Era
healthyClosedHeadTxOut)
( HashableScriptData -> Maybe HashableScriptData
forall a. a -> Maybe a
Just (HashableScriptData -> Maybe HashableScriptData)
-> HashableScriptData -> Maybe HashableScriptData
forall a b. (a -> b) -> a -> b
$
Input -> HashableScriptData
forall a. ToScriptData a => a -> HashableScriptData
toScriptData
( Head.Contest
{ $sel:signature:CollectCom :: [BuiltinByteString]
signature =
MultiSignature (Snapshot Tx) -> [BuiltinByteString]
forall {k} (a :: k). MultiSignature a -> [BuiltinByteString]
toPlutusSignatures (MultiSignature (Snapshot Tx) -> [BuiltinByteString])
-> MultiSignature (Snapshot Tx) -> [BuiltinByteString]
forall a b. (a -> b) -> a -> b
$
SnapshotNumber -> MultiSignature (Snapshot Tx)
healthySignature SnapshotNumber
healthyContestSnapshotNumber
}
)
)
]
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ UtilError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode UtilError
MintingOrBurningIsForbidden) ContestMutation
MutateTokenMintingOrBurning
(Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tx -> Value -> Gen Mutation
changeMintedTokens Tx
tx (Value -> Gen Mutation) -> Gen Value -> Gen Mutation
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen Value
genMintedOrBurnedValue)
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
SignerAlreadyContested) ContestMutation
MutateInputContesters (Mutation -> SomeMutation)
-> (State -> Mutation) -> State -> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Mutation
ChangeInputHeadDatum (State -> SomeMutation) -> Gen State -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
let contester :: PubKeyHash
contester = Hash PaymentKey -> PubKeyHash
toPlutusKeyHash (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
healthyContesterVerificationKey)
contesterAndSomeOthers :: Gen [PubKeyHash]
contesterAndSomeOthers = do
[PubKeyHash]
contesters <- Gen PubKeyHash -> Gen [PubKeyHash]
forall a. Gen a -> Gen [a]
listOf (Gen PubKeyHash -> Gen [PubKeyHash])
-> Gen PubKeyHash -> Gen [PubKeyHash]
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> PubKeyHash
Plutus.PubKeyHash (BuiltinByteString -> PubKeyHash)
-> (ByteString -> BuiltinByteString) -> ByteString -> PubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (ByteString -> PubKeyHash) -> Gen ByteString -> Gen PubKeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
genHash
[PubKeyHash] -> Gen [PubKeyHash]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PubKeyHash
contester PubKeyHash -> [PubKeyHash] -> [PubKeyHash]
forall a. a -> [a] -> [a]
: [PubKeyHash]
contesters)
[PubKeyHash]
mutatedContesters <-
[Gen [PubKeyHash]] -> Gen [PubKeyHash]
forall a. [Gen a] -> Gen a
oneof
[ [PubKeyHash] -> Gen [PubKeyHash]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [PubKeyHash
contester]
, Gen [PubKeyHash]
contesterAndSomeOthers
]
State -> Gen State
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State -> Gen State) -> State -> Gen State
forall a b. (a -> b) -> a -> b
$
State
healthyClosedState State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& [PubKeyHash] -> State -> State
replaceContesters [PubKeyHash]
mutatedContesters
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
ContesterNotIncluded) ContestMutation
MutateContesters (Mutation -> SomeMutation)
-> (TxOut CtxTx -> Mutation) -> TxOut CtxTx -> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> TxOut CtxTx -> Mutation
ChangeOutput Word
0 (TxOut CtxTx -> SomeMutation)
-> Gen (TxOut CtxTx) -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
[ByteString]
hashes <- Gen ByteString -> Gen [ByteString]
forall a. Gen a -> Gen [a]
listOf Gen ByteString
genHash
let mutatedContesters :: [PubKeyHash]
mutatedContesters = BuiltinByteString -> PubKeyHash
Plutus.PubKeyHash (BuiltinByteString -> PubKeyHash)
-> (ByteString -> BuiltinByteString) -> ByteString -> PubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (ByteString -> PubKeyHash) -> [ByteString] -> [PubKeyHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
hashes
TxOut CtxTx -> Gen (TxOut CtxTx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut CtxTx -> Gen (TxOut CtxTx))
-> TxOut CtxTx -> Gen (TxOut CtxTx)
forall a b. (a -> b) -> a -> b
$ (State -> State) -> TxOut CtxTx -> TxOut CtxTx
forall a.
(FromScriptData a, ToScriptData a) =>
(a -> a) -> TxOut CtxTx -> TxOut CtxTx
modifyInlineDatum ([PubKeyHash] -> State -> State
replaceContesters [PubKeyHash]
mutatedContesters) TxOut CtxTx
headTxOut
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
HeadValueIsNotPreserved) ContestMutation
MutateValueInOutput (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Value
newValue <- Gen Value
genValue
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$ Word -> TxOut CtxTx -> Mutation
ChangeOutput Word
0 (TxOut CtxTx
headTxOut{txOutValue = newValue})
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
MustPushDeadline) ContestMutation
NotUpdateDeadlineAlthoughItShould (Mutation -> SomeMutation)
-> (TxOut CtxTx -> Mutation) -> TxOut CtxTx -> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> TxOut CtxTx -> Mutation
ChangeOutput Word
0 (TxOut CtxTx -> SomeMutation)
-> Gen (TxOut CtxTx) -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
let deadline :: POSIXTime
deadline = UTCTime -> POSIXTime
posixFromUTCTime UTCTime
healthyContestationDeadline
TxOut CtxTx -> Gen (TxOut CtxTx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut CtxTx -> Gen (TxOut CtxTx))
-> TxOut CtxTx -> Gen (TxOut CtxTx)
forall a b. (a -> b) -> a -> b
$ TxOut CtxTx
headTxOut TxOut CtxTx -> (TxOut CtxTx -> TxOut CtxTx) -> TxOut CtxTx
forall a b. a -> (a -> b) -> b
& (State -> State) -> TxOut CtxTx -> TxOut CtxTx
forall a.
(FromScriptData a, ToScriptData a) =>
(a -> a) -> TxOut CtxTx -> TxOut CtxTx
modifyInlineDatum (POSIXTime -> State -> State
replaceContestationDeadline POSIXTime
deadline)
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
MustNotPushDeadline) ContestMutation
PushDeadlineAlthoughItShouldNot (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
[PubKeyHash]
alreadyContested <- Int -> Gen PubKeyHash -> Gen [PubKeyHash]
forall a. Int -> Gen a -> Gen [a]
vectorOf ([Party] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Party]
healthyParties Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Gen PubKeyHash -> Gen [PubKeyHash])
-> Gen PubKeyHash -> Gen [PubKeyHash]
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> PubKeyHash
Plutus.PubKeyHash (BuiltinByteString -> PubKeyHash)
-> (ByteString -> BuiltinByteString) -> ByteString -> PubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (ByteString -> PubKeyHash) -> Gen ByteString -> Gen PubKeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
genHash
let contester :: PubKeyHash
contester = Hash PaymentKey -> PubKeyHash
toPlutusKeyHash (Hash PaymentKey -> PubKeyHash) -> Hash PaymentKey -> PubKeyHash
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
healthyContesterVerificationKey
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$
[Mutation] -> Mutation
Changes
[ Word -> TxOut CtxTx -> Mutation
ChangeOutput Word
0 (TxOut CtxTx
headTxOut TxOut CtxTx -> (TxOut CtxTx -> TxOut CtxTx) -> TxOut CtxTx
forall a b. a -> (a -> b) -> b
& (State -> State) -> TxOut CtxTx -> TxOut CtxTx
forall a.
(FromScriptData a, ToScriptData a) =>
(a -> a) -> TxOut CtxTx -> TxOut CtxTx
modifyInlineDatum ([PubKeyHash] -> State -> State
replaceContesters (PubKeyHash
contester PubKeyHash -> [PubKeyHash] -> [PubKeyHash]
forall a. a -> [a] -> [a]
: [PubKeyHash]
alreadyContested)))
, State -> Mutation
ChangeInputHeadDatum (State
healthyClosedState State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& [PubKeyHash] -> State -> State
replaceContesters [PubKeyHash]
alreadyContested)
]
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
ChangedParameters) ContestMutation
MutateOutputContestationPeriod (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
ContestationPeriod
randomCP <- Gen ContestationPeriod
forall a. Arbitrary a => Gen a
arbitrary Gen ContestationPeriod
-> (ContestationPeriod -> Bool) -> Gen ContestationPeriod
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (ContestationPeriod -> ContestationPeriod -> Bool
forall a. Eq a => a -> a -> Bool
/= ContestationPeriod
healthyOnChainContestationPeriod)
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$ Word -> TxOut CtxTx -> Mutation
ChangeOutput Word
0 (TxOut CtxTx
headTxOut TxOut CtxTx -> (TxOut CtxTx -> TxOut CtxTx) -> TxOut CtxTx
forall a b. a -> (a -> b) -> b
& (State -> State) -> TxOut CtxTx -> TxOut CtxTx
forall a.
(FromScriptData a, ToScriptData a) =>
(a -> a) -> TxOut CtxTx -> TxOut CtxTx
modifyInlineDatum (ContestationPeriod -> State -> State
replaceContestationPeriod ContestationPeriod
randomCP))
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
ChangedParameters) ContestMutation
MutatePartiesInOutput (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
[Party]
mutatedParties <-
Int -> Gen Party -> Gen [Party]
forall a. Int -> Gen a -> Gen [a]
vectorOf
([Party] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Party]
healthyOnChainParties)
( ByteString -> Party
partyFromVerificationKeyBytes (ByteString -> Party) -> Gen ByteString -> Gen Party
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
genHash
)
Gen [Party] -> ([Party] -> Bool) -> Gen [Party]
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` ([Party] -> [Party] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Party]
healthyOnChainParties)
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$ Word -> TxOut CtxTx -> Mutation
ChangeOutput Word
0 (TxOut CtxTx -> Mutation) -> TxOut CtxTx -> Mutation
forall a b. (a -> b) -> a -> b
$ (State -> State) -> TxOut CtxTx -> TxOut CtxTx
forall a.
(FromScriptData a, ToScriptData a) =>
(a -> a) -> TxOut CtxTx -> TxOut CtxTx
modifyInlineDatum ([Party] -> State -> State
replaceParties [Party]
mutatedParties) TxOut CtxTx
headTxOut
, Maybe Text -> ContestMutation -> Mutation -> SomeMutation
forall lbl.
(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) =>
Maybe Text -> lbl -> Mutation -> SomeMutation
SomeMutation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeadError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadError
ChangedParameters) ContestMutation
MutateHeadIdInOutput (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
CurrencySymbol
otherHeadId <- PolicyId -> CurrencySymbol
toPlutusCurrencySymbol (PolicyId -> CurrencySymbol)
-> (TxIn -> PolicyId) -> TxIn -> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> PolicyId
headPolicyId (TxIn -> CurrencySymbol) -> Gen TxIn -> Gen CurrencySymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary Gen TxIn -> (TxIn -> Bool) -> Gen TxIn
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (TxIn -> TxIn -> Bool
forall a. Eq a => a -> a -> Bool
/= TxIn
Fixture.testSeedInput)
Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$ Word -> TxOut CtxTx -> Mutation
ChangeOutput Word
0 (TxOut CtxTx -> Mutation) -> TxOut CtxTx -> Mutation
forall a b. (a -> b) -> a -> b
$ (State -> State) -> TxOut CtxTx -> TxOut CtxTx
forall a.
(FromScriptData a, ToScriptData a) =>
(a -> a) -> TxOut CtxTx -> TxOut CtxTx
modifyInlineDatum (CurrencySymbol -> State -> State
replaceHeadId CurrencySymbol
otherHeadId) TxOut CtxTx
headTxOut
]
where
headTxOut :: TxOut CtxTx
headTxOut = Maybe (TxOut CtxTx) -> TxOut CtxTx
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (TxOut CtxTx) -> TxOut CtxTx)
-> Maybe (TxOut CtxTx) -> TxOut CtxTx
forall a b. (a -> b) -> a -> b
$ Tx -> [TxOut CtxTx]
forall era. Tx era -> [TxOut CtxTx era]
txOuts' Tx
tx [TxOut CtxTx] -> Int -> Maybe (TxOut CtxTx)
forall a. [a] -> Int -> Maybe a
!!? Int
0
slotOverContestationDeadline :: SlotNo -> Bool
slotOverContestationDeadline SlotNo
slotNo =
SystemStart -> SlotLength -> SlotNo -> UTCTime
slotNoToUTCTime SystemStart
systemStart SlotLength
slotLength SlotNo
slotNo UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
healthyContestationDeadline