{-# LANGUAGE DuplicateRecordFields #-}

-- | Mutation-based script validator tests for the init transaction where a
-- 'healthyInitTx' gets mutated by an arbitrary 'InitMutation'.
module Hydra.Chain.Direct.Contract.Init where

import Hydra.Cardano.Api
import Hydra.Prelude

import Cardano.Api.UTxO qualified as UTxO
import Data.Maybe (fromJust)
import Hydra.Chain (HeadParameters (..))
import Hydra.Chain.Direct.Contract.Gen (genForParty)
import Hydra.Chain.Direct.Contract.Mutation (
  Mutation (..),
  SomeMutation (..),
  addPTWithQuantity,
  changeMintedValueQuantityFrom,
  modifyInlineDatum,
  replaceHeadId,
 )
import Hydra.Chain.Direct.Fixture (testNetworkId, testPolicyId, testSeedInput)
import Hydra.Chain.Direct.Tx (initTx)
import Hydra.Contract.Error (toErrorCode)
import Hydra.Contract.HeadState (State (..))
import Hydra.Contract.HeadTokensError (HeadTokensError (..))
import Hydra.Ledger.Cardano (genOneUTxOFor, genValue)
import Hydra.OnChainId (OnChainId, genOnChainId)
import Hydra.Party (Party)
import PlutusLedgerApi.Test.Examples qualified as Plutus
import Test.QuickCheck (choose, elements, oneof, suchThat, vectorOf)
import Prelude qualified

--
-- InitTx
--

healthyInitTx :: (Tx, UTxO)
healthyInitTx :: (Tx, UTxO)
healthyInitTx =
  (Tx
tx, UTxO
healthyLookupUTxO)
 where
  tx :: Tx
tx =
    NetworkId -> TxIn -> [OnChainId] -> HeadParameters -> Tx
initTx
      NetworkId
testNetworkId
      TxIn
healthySeedInput
      [OnChainId]
healthyParticipants
      HeadParameters
healthyHeadParameters

healthyHeadParameters :: HeadParameters
healthyHeadParameters :: HeadParameters
healthyHeadParameters =
  (Gen HeadParameters -> Int -> HeadParameters)
-> Int -> Gen HeadParameters -> HeadParameters
forall a b c. (a -> b -> c) -> b -> a -> c
flip Gen HeadParameters -> Int -> HeadParameters
forall a. Gen a -> Int -> a
generateWith Int
42 (Gen HeadParameters -> HeadParameters)
-> Gen HeadParameters -> HeadParameters
forall a b. (a -> b) -> a -> b
$
    ContestationPeriod -> [Party] -> HeadParameters
HeadParameters
      (ContestationPeriod -> [Party] -> HeadParameters)
-> Gen ContestationPeriod -> Gen ([Party] -> HeadParameters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ContestationPeriod
forall a. Arbitrary a => Gen a
arbitrary
      Gen ([Party] -> HeadParameters)
-> Gen [Party] -> Gen HeadParameters
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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]
healthyParties) Gen Party
forall a. Arbitrary a => Gen a
arbitrary

healthySeedInput :: TxIn
healthySeedInput :: TxIn
healthySeedInput =
  (TxIn, TxOut CtxUTxO Era) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, TxOut CtxUTxO Era) -> TxIn)
-> ([(TxIn, TxOut CtxUTxO Era)] -> (TxIn, TxOut CtxUTxO Era))
-> [(TxIn, TxOut CtxUTxO Era)]
-> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxIn, TxOut CtxUTxO Era)] -> (TxIn, TxOut CtxUTxO Era)
forall a. HasCallStack => [a] -> a
Prelude.head ([(TxIn, TxOut CtxUTxO Era)] -> TxIn)
-> [(TxIn, TxOut CtxUTxO Era)] -> TxIn
forall a b. (a -> b) -> a -> b
$ UTxO -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.pairs UTxO
healthyLookupUTxO

healthyParties :: [Party]
healthyParties :: [Party]
healthyParties =
  Gen [Party] -> Int -> [Party]
forall a. Gen a -> Int -> a
generateWith (Int -> Gen Party -> Gen [Party]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
3 Gen Party
forall a. Arbitrary a => Gen a
arbitrary) Int
42

healthyParticipants :: [OnChainId]
healthyParticipants :: [OnChainId]
healthyParticipants =
  Gen OnChainId -> Party -> OnChainId
forall a. Gen a -> Party -> a
genForParty Gen OnChainId
genOnChainId (Party -> OnChainId) -> [Party] -> [OnChainId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Party]
healthyParties

healthyLookupUTxO :: UTxO
healthyLookupUTxO :: UTxO
healthyLookupUTxO =
  -- REVIEW: Was this checked by the ledger?
  Gen UTxO -> Int -> UTxO
forall a. Gen a -> Int -> a
generateWith (VerificationKey PaymentKey -> Gen UTxO
genOneUTxOFor (VerificationKey PaymentKey -> Gen UTxO)
-> Gen (VerificationKey PaymentKey) -> Gen UTxO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen (VerificationKey PaymentKey)
forall a. Arbitrary a => Gen a
arbitrary) Int
42

data InitMutation
  = -- | Mint more than one ST and PTs.
    MintTooManyTokens
  | MutateAddAnotherPT
  | MutateDropInitialOutput
  | MutateDropSeedInput
  | MutateInitialOutputValue
  | MutateHeadIdInDatum
  | MutateHeadIdInInitialDatum
  | MutateSeedInDatum
  deriving stock ((forall x. InitMutation -> Rep InitMutation x)
-> (forall x. Rep InitMutation x -> InitMutation)
-> Generic InitMutation
forall x. Rep InitMutation x -> InitMutation
forall x. InitMutation -> Rep InitMutation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InitMutation -> Rep InitMutation x
from :: forall x. InitMutation -> Rep InitMutation x
$cto :: forall x. Rep InitMutation x -> InitMutation
to :: forall x. Rep InitMutation x -> InitMutation
Generic, Int -> InitMutation -> ShowS
[InitMutation] -> ShowS
InitMutation -> String
(Int -> InitMutation -> ShowS)
-> (InitMutation -> String)
-> ([InitMutation] -> ShowS)
-> Show InitMutation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitMutation -> ShowS
showsPrec :: Int -> InitMutation -> ShowS
$cshow :: InitMutation -> String
show :: InitMutation -> String
$cshowList :: [InitMutation] -> ShowS
showList :: [InitMutation] -> ShowS
Show, Int -> InitMutation
InitMutation -> Int
InitMutation -> [InitMutation]
InitMutation -> InitMutation
InitMutation -> InitMutation -> [InitMutation]
InitMutation -> InitMutation -> InitMutation -> [InitMutation]
(InitMutation -> InitMutation)
-> (InitMutation -> InitMutation)
-> (Int -> InitMutation)
-> (InitMutation -> Int)
-> (InitMutation -> [InitMutation])
-> (InitMutation -> InitMutation -> [InitMutation])
-> (InitMutation -> InitMutation -> [InitMutation])
-> (InitMutation -> InitMutation -> InitMutation -> [InitMutation])
-> Enum InitMutation
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 :: InitMutation -> InitMutation
succ :: InitMutation -> InitMutation
$cpred :: InitMutation -> InitMutation
pred :: InitMutation -> InitMutation
$ctoEnum :: Int -> InitMutation
toEnum :: Int -> InitMutation
$cfromEnum :: InitMutation -> Int
fromEnum :: InitMutation -> Int
$cenumFrom :: InitMutation -> [InitMutation]
enumFrom :: InitMutation -> [InitMutation]
$cenumFromThen :: InitMutation -> InitMutation -> [InitMutation]
enumFromThen :: InitMutation -> InitMutation -> [InitMutation]
$cenumFromTo :: InitMutation -> InitMutation -> [InitMutation]
enumFromTo :: InitMutation -> InitMutation -> [InitMutation]
$cenumFromThenTo :: InitMutation -> InitMutation -> InitMutation -> [InitMutation]
enumFromThenTo :: InitMutation -> InitMutation -> InitMutation -> [InitMutation]
Enum, InitMutation
InitMutation -> InitMutation -> Bounded InitMutation
forall a. a -> a -> Bounded a
$cminBound :: InitMutation
minBound :: InitMutation
$cmaxBound :: InitMutation
maxBound :: InitMutation
Bounded)

data ObserveInitMutation
  = MutateSomePT
  deriving stock ((forall x. ObserveInitMutation -> Rep ObserveInitMutation x)
-> (forall x. Rep ObserveInitMutation x -> ObserveInitMutation)
-> Generic ObserveInitMutation
forall x. Rep ObserveInitMutation x -> ObserveInitMutation
forall x. ObserveInitMutation -> Rep ObserveInitMutation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObserveInitMutation -> Rep ObserveInitMutation x
from :: forall x. ObserveInitMutation -> Rep ObserveInitMutation x
$cto :: forall x. Rep ObserveInitMutation x -> ObserveInitMutation
to :: forall x. Rep ObserveInitMutation x -> ObserveInitMutation
Generic, Int -> ObserveInitMutation -> ShowS
[ObserveInitMutation] -> ShowS
ObserveInitMutation -> String
(Int -> ObserveInitMutation -> ShowS)
-> (ObserveInitMutation -> String)
-> ([ObserveInitMutation] -> ShowS)
-> Show ObserveInitMutation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObserveInitMutation -> ShowS
showsPrec :: Int -> ObserveInitMutation -> ShowS
$cshow :: ObserveInitMutation -> String
show :: ObserveInitMutation -> String
$cshowList :: [ObserveInitMutation] -> ShowS
showList :: [ObserveInitMutation] -> ShowS
Show, Int -> ObserveInitMutation
ObserveInitMutation -> Int
ObserveInitMutation -> [ObserveInitMutation]
ObserveInitMutation -> ObserveInitMutation
ObserveInitMutation -> ObserveInitMutation -> [ObserveInitMutation]
ObserveInitMutation
-> ObserveInitMutation
-> ObserveInitMutation
-> [ObserveInitMutation]
(ObserveInitMutation -> ObserveInitMutation)
-> (ObserveInitMutation -> ObserveInitMutation)
-> (Int -> ObserveInitMutation)
-> (ObserveInitMutation -> Int)
-> (ObserveInitMutation -> [ObserveInitMutation])
-> (ObserveInitMutation
    -> ObserveInitMutation -> [ObserveInitMutation])
-> (ObserveInitMutation
    -> ObserveInitMutation -> [ObserveInitMutation])
-> (ObserveInitMutation
    -> ObserveInitMutation
    -> ObserveInitMutation
    -> [ObserveInitMutation])
-> Enum ObserveInitMutation
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 :: ObserveInitMutation -> ObserveInitMutation
succ :: ObserveInitMutation -> ObserveInitMutation
$cpred :: ObserveInitMutation -> ObserveInitMutation
pred :: ObserveInitMutation -> ObserveInitMutation
$ctoEnum :: Int -> ObserveInitMutation
toEnum :: Int -> ObserveInitMutation
$cfromEnum :: ObserveInitMutation -> Int
fromEnum :: ObserveInitMutation -> Int
$cenumFrom :: ObserveInitMutation -> [ObserveInitMutation]
enumFrom :: ObserveInitMutation -> [ObserveInitMutation]
$cenumFromThen :: ObserveInitMutation -> ObserveInitMutation -> [ObserveInitMutation]
enumFromThen :: ObserveInitMutation -> ObserveInitMutation -> [ObserveInitMutation]
$cenumFromTo :: ObserveInitMutation -> ObserveInitMutation -> [ObserveInitMutation]
enumFromTo :: ObserveInitMutation -> ObserveInitMutation -> [ObserveInitMutation]
$cenumFromThenTo :: ObserveInitMutation
-> ObserveInitMutation
-> ObserveInitMutation
-> [ObserveInitMutation]
enumFromThenTo :: ObserveInitMutation
-> ObserveInitMutation
-> ObserveInitMutation
-> [ObserveInitMutation]
Enum, ObserveInitMutation
ObserveInitMutation
-> ObserveInitMutation -> Bounded ObserveInitMutation
forall a. a -> a -> Bounded a
$cminBound :: ObserveInitMutation
minBound :: ObserveInitMutation
$cmaxBound :: ObserveInitMutation
maxBound :: ObserveInitMutation
Bounded)

genInitMutation :: (Tx, UTxO) -> Gen SomeMutation
genInitMutation :: (Tx, UTxO) -> Gen SomeMutation
genInitMutation (Tx
tx, UTxO
_utxo) =
  [Gen SomeMutation] -> Gen SomeMutation
forall a. [Gen a] -> Gen a
oneof
    [ Maybe Text -> InitMutation -> 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
$ HeadTokensError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadTokensError
WrongNumberOfTokensMinted) InitMutation
MintTooManyTokens (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tx -> Integer -> Gen Mutation
changeMintedValueQuantityFrom Tx
tx Integer
1
    , Maybe Text -> InitMutation -> 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
$ HeadTokensError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadTokensError
WrongNumberOfTokensMinted) InitMutation
MutateAddAnotherPT (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tx -> Quantity -> Gen Mutation
addPTWithQuantity Tx
tx Quantity
1
    , Maybe Text -> InitMutation -> 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
$ HeadTokensError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadTokensError
NoPT) InitMutation
MutateInitialOutputValue (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        let outs :: [TxOut CtxTx Era]
outs = Tx -> [TxOut CtxTx Era]
forall era. Tx era -> [TxOut CtxTx era]
txOuts' Tx
tx
        (Int
ix :: Int, TxOut CtxTx Era
out) <- [(Int, TxOut CtxTx Era)] -> Gen (Int, TxOut CtxTx Era)
forall a. [a] -> Gen a
elements (Int -> [(Int, TxOut CtxTx Era)] -> [(Int, TxOut CtxTx Era)]
forall a. Int -> [a] -> [a]
drop Int
1 ([(Int, TxOut CtxTx Era)] -> [(Int, TxOut CtxTx Era)])
-> [(Int, TxOut CtxTx Era)] -> [(Int, TxOut CtxTx Era)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [TxOut CtxTx Era] -> [(Int, TxOut CtxTx Era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [TxOut CtxTx Era]
outs)
        Value
value' <- Gen Value
genValue Gen Value -> (Value -> Bool) -> Gen Value
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= TxOut CtxTx Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxTx Era
out)
        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 Era -> Mutation
ChangeOutput (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix) ((Value -> Value) -> TxOut CtxTx Era -> TxOut CtxTx Era
forall era ctx.
(IsMaryEraOnwards era, IsShelleyBasedEra era) =>
(Value -> Value) -> TxOut ctx era -> TxOut ctx era
modifyTxOutValue (Value -> Value -> Value
forall a b. a -> b -> a
const Value
value') TxOut CtxTx Era
out)
    , Maybe Text -> InitMutation -> 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
$ HeadTokensError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadTokensError
WrongNumberOfInitialOutputs) InitMutation
MutateDropInitialOutput (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        Int
ix <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, [TxOut CtxTx Era] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxOut CtxTx Era]
forall era. Tx era -> [TxOut CtxTx era]
txOuts' Tx
tx) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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
$ Word -> Mutation
RemoveOutput (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix)
    , Maybe Text -> InitMutation -> 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
$ HeadTokensError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadTokensError
SeedNotSpent) InitMutation
MutateDropSeedInput (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
$ TxIn -> Mutation
RemoveInput TxIn
healthySeedInput
    , Maybe Text -> InitMutation -> 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
$ HeadTokensError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadTokensError
WrongDatum) InitMutation
MutateHeadIdInDatum (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        CurrencySymbol
mutatedHeadId <- Gen CurrencySymbol
forall a. Arbitrary a => Gen a
arbitrary Gen CurrencySymbol
-> (CurrencySymbol -> Bool) -> Gen CurrencySymbol
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (CurrencySymbol -> CurrencySymbol -> Bool
forall a. Eq a => a -> a -> Bool
/= PolicyId -> CurrencySymbol
toPlutusCurrencySymbol PolicyId
testPolicyId)
        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 Era -> Mutation
ChangeOutput Word
0 (TxOut CtxTx Era -> Mutation) -> TxOut CtxTx Era -> Mutation
forall a b. (a -> b) -> a -> b
$ (State -> State) -> TxOut CtxTx Era -> TxOut CtxTx Era
forall a.
(FromScriptData a, ToScriptData a) =>
(a -> a) -> TxOut CtxTx Era -> TxOut CtxTx Era
modifyInlineDatum (CurrencySymbol -> State -> State
replaceHeadId CurrencySymbol
mutatedHeadId) TxOut CtxTx Era
headTxOut
    , Maybe Text -> InitMutation -> 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
$ HeadTokensError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadTokensError
WrongInitialDatum) InitMutation
MutateHeadIdInInitialDatum (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        let outs :: [TxOut CtxTx Era]
outs = Tx -> [TxOut CtxTx Era]
forall era. Tx era -> [TxOut CtxTx era]
txOuts' Tx
tx
        (Word
ix, TxOut CtxTx Era
out) <- [(Word, TxOut CtxTx Era)] -> Gen (Word, TxOut CtxTx Era)
forall a. [a] -> Gen a
elements (Int -> [(Word, TxOut CtxTx Era)] -> [(Word, TxOut CtxTx Era)]
forall a. Int -> [a] -> [a]
drop Int
1 ([(Word, TxOut CtxTx Era)] -> [(Word, TxOut CtxTx Era)])
-> [(Word, TxOut CtxTx Era)] -> [(Word, TxOut CtxTx Era)]
forall a b. (a -> b) -> a -> b
$ [Word] -> [TxOut CtxTx Era] -> [(Word, TxOut CtxTx Era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0 ..] [TxOut CtxTx Era]
outs)
        [Mutation] -> Gen Mutation
forall a. [a] -> Gen a
elements
          [ Word -> TxOut CtxTx Era -> Mutation
forall {ctx0}. Word -> TxOut ctx0 Era -> Mutation
changeInitialOutputToFakeId Word
ix TxOut CtxTx Era
out
          , Word -> TxOut CtxTx Era -> Mutation
forall {ctx0}. Word -> TxOut ctx0 Era -> Mutation
removeInitialOutputDatum Word
ix TxOut CtxTx Era
out
          , Word -> TxOut CtxTx Era -> Mutation
forall {ctx0}. Word -> TxOut ctx0 Era -> Mutation
changeInitialOutputToNotAHeadId Word
ix TxOut CtxTx Era
out
          ]
    , Maybe Text -> InitMutation -> 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
$ HeadTokensError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode HeadTokensError
WrongDatum) InitMutation
MutateSeedInDatum (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        TxOutRef
mutatedSeed <- TxIn -> TxOutRef
toPlutusTxOutRef (TxIn -> TxOutRef) -> Gen TxIn -> Gen TxOutRef
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
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 Era -> Mutation
ChangeOutput Word
0 (TxOut CtxTx Era -> Mutation) -> TxOut CtxTx Era -> Mutation
forall a b. (a -> b) -> a -> b
$
            ((State -> State) -> TxOut CtxTx Era -> TxOut CtxTx Era)
-> TxOut CtxTx Era -> (State -> State) -> TxOut CtxTx Era
forall a b c. (a -> b -> c) -> b -> a -> c
flip (State -> State) -> TxOut CtxTx Era -> TxOut CtxTx Era
forall a.
(FromScriptData a, ToScriptData a) =>
(a -> a) -> TxOut CtxTx Era -> TxOut CtxTx Era
modifyInlineDatum TxOut CtxTx Era
headTxOut ((State -> State) -> TxOut CtxTx Era)
-> (State -> State) -> TxOut CtxTx Era
forall a b. (a -> b) -> a -> b
$ \case
              Initial{ContestationPeriod
contestationPeriod :: ContestationPeriod
$sel:contestationPeriod:Initial :: State -> ContestationPeriod
contestationPeriod, [Party]
parties :: [Party]
$sel:parties:Initial :: State -> [Party]
parties, CurrencySymbol
headId :: CurrencySymbol
$sel:headId:Initial :: State -> CurrencySymbol
headId} ->
                Initial{ContestationPeriod
contestationPeriod :: ContestationPeriod
$sel:contestationPeriod:Initial :: ContestationPeriod
contestationPeriod, [Party]
parties :: [Party]
$sel:parties:Initial :: [Party]
parties, CurrencySymbol
headId :: CurrencySymbol
$sel:headId:Initial :: CurrencySymbol
headId, $sel:seed:Initial :: TxOutRef
seed = TxOutRef
mutatedSeed}
              State
s -> State
s
    ]
 where
  headTxOut :: TxOut CtxTx Era
headTxOut = Maybe (TxOut CtxTx Era) -> TxOut CtxTx Era
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (TxOut CtxTx Era) -> TxOut CtxTx Era)
-> Maybe (TxOut CtxTx Era) -> TxOut CtxTx Era
forall a b. (a -> b) -> a -> b
$ Tx -> [TxOut CtxTx Era]
forall era. Tx era -> [TxOut CtxTx era]
txOuts' Tx
tx [TxOut CtxTx Era] -> Int -> Maybe (TxOut CtxTx Era)
forall a. [a] -> Int -> Maybe a
!!? Int
0
  alwaysSucceedsV2 :: PlutusScript
alwaysSucceedsV2 = ShortByteString -> PlutusScript
PlutusScriptSerialised (ShortByteString -> PlutusScript)
-> ShortByteString -> PlutusScript
forall a b. (a -> b) -> a -> b
$ Natural -> ShortByteString
Plutus.alwaysSucceedingNAryFunction Natural
2
  fakePolicyId :: PolicyId
fakePolicyId = Script PlutusScriptV2 -> PolicyId
forall lang. Script lang -> PolicyId
scriptPolicyId (Script PlutusScriptV2 -> PolicyId)
-> Script PlutusScriptV2 -> PolicyId
forall a b. (a -> b) -> a -> b
$ PlutusScript -> Script PlutusScriptV2
PlutusScript PlutusScript
alwaysSucceedsV2

  changeInitialOutputToFakeId :: Word -> TxOut ctx0 Era -> Mutation
changeInitialOutputToFakeId Word
ix TxOut ctx0 Era
out =
    Word -> TxOut CtxTx Era -> Mutation
ChangeOutput Word
ix (TxOut CtxTx Era -> Mutation) -> TxOut CtxTx Era -> Mutation
forall a b. (a -> b) -> a -> b
$
      (TxOutDatum ctx0 Era -> TxOutDatum CtxTx Era)
-> TxOut ctx0 Era -> TxOut CtxTx Era
forall ctx0 era ctx1.
(TxOutDatum ctx0 era -> TxOutDatum ctx1 era)
-> TxOut ctx0 era -> TxOut ctx1 era
modifyTxOutDatum
        ( TxOutDatum CtxTx Era -> TxOutDatum ctx0 Era -> TxOutDatum CtxTx Era
forall a b. a -> b -> a
const (TxOutDatum CtxTx Era
 -> TxOutDatum ctx0 Era -> TxOutDatum CtxTx Era)
-> TxOutDatum CtxTx Era
-> TxOutDatum ctx0 Era
-> TxOutDatum CtxTx Era
forall a b. (a -> b) -> a -> b
$
            HashableScriptData -> TxOutDatum CtxTx Era
forall ctx. HashableScriptData -> TxOutDatum ctx
TxOutDatumInline (HashableScriptData -> TxOutDatum CtxTx Era)
-> HashableScriptData -> TxOutDatum CtxTx Era
forall a b. (a -> b) -> a -> b
$
              CurrencySymbol -> HashableScriptData
forall a. ToScriptData a => a -> HashableScriptData
toScriptData (CurrencySymbol -> HashableScriptData)
-> CurrencySymbol -> HashableScriptData
forall a b. (a -> b) -> a -> b
$
                PolicyId -> CurrencySymbol
toPlutusCurrencySymbol PolicyId
fakePolicyId
        )
        TxOut ctx0 Era
out

  removeInitialOutputDatum :: Word -> TxOut ctx0 Era -> Mutation
removeInitialOutputDatum Word
ix TxOut ctx0 Era
out =
    Word -> TxOut CtxTx Era -> Mutation
ChangeOutput Word
ix (TxOut CtxTx Era -> Mutation) -> TxOut CtxTx Era -> Mutation
forall a b. (a -> b) -> a -> b
$ (TxOutDatum ctx0 Era -> TxOutDatum CtxTx Era)
-> TxOut ctx0 Era -> TxOut CtxTx Era
forall ctx0 era ctx1.
(TxOutDatum ctx0 era -> TxOutDatum ctx1 era)
-> TxOut ctx0 era -> TxOut ctx1 era
modifyTxOutDatum (TxOutDatum CtxTx Era -> TxOutDatum ctx0 Era -> TxOutDatum CtxTx Era
forall a b. a -> b -> a
const TxOutDatum CtxTx Era
forall ctx. TxOutDatum ctx
TxOutDatumNone) TxOut ctx0 Era
out

  changeInitialOutputToNotAHeadId :: Word -> TxOut ctx0 Era -> Mutation
changeInitialOutputToNotAHeadId Word
ix TxOut ctx0 Era
out =
    Word -> TxOut CtxTx Era -> Mutation
ChangeOutput Word
ix (TxOut CtxTx Era -> Mutation) -> TxOut CtxTx Era -> Mutation
forall a b. (a -> b) -> a -> b
$ (TxOutDatum ctx0 Era -> TxOutDatum CtxTx Era)
-> TxOut ctx0 Era -> TxOut CtxTx Era
forall ctx0 era ctx1.
(TxOutDatum ctx0 era -> TxOutDatum ctx1 era)
-> TxOut ctx0 era -> TxOut ctx1 era
modifyTxOutDatum (TxOutDatum CtxTx Era -> TxOutDatum ctx0 Era -> TxOutDatum CtxTx Era
forall a b. a -> b -> a
const (TxOutDatum CtxTx Era
 -> TxOutDatum ctx0 Era -> TxOutDatum CtxTx Era)
-> TxOutDatum CtxTx Era
-> TxOutDatum ctx0 Era
-> TxOutDatum CtxTx Era
forall a b. (a -> b) -> a -> b
$ HashableScriptData -> TxOutDatum CtxTx Era
forall ctx. HashableScriptData -> TxOutDatum ctx
TxOutDatumInline (HashableScriptData -> TxOutDatum CtxTx Era)
-> HashableScriptData -> TxOutDatum CtxTx Era
forall a b. (a -> b) -> a -> b
$ Integer -> HashableScriptData
forall a. ToScriptData a => a -> HashableScriptData
toScriptData (Integer
42 :: Integer)) TxOut ctx0 Era
out