{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Hydra.Chain.Direct.Contract.CollectCom where

import Hydra.Cardano.Api
import Hydra.Prelude hiding (label)

import Cardano.Api.UTxO qualified as UTxO
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Maybe (fromJust)
import Hydra.Chain (HeadParameters (..))
import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue)
import Hydra.Chain.Direct.Contract.Mutation (
  Mutation (..),
  SomeMutation (..),
  changeMintedTokens,
  modifyInlineDatum,
  replaceParties,
 )
import Hydra.Chain.Direct.Fixture (
  testNetworkId,
  testPolicyId,
  testSeedInput,
 )
import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO)
import Hydra.Chain.Direct.Tx (
  collectComTx,
  hydraHeadV1AssetName,
  mkCommitDatum,
  mkHeadId,
  mkHeadOutput,
  mkInitialOutput,
  onChainIdToAssetName,
  verificationKeyToOnChainId,
 )
import Hydra.ContestationPeriod (ContestationPeriod)
import Hydra.ContestationPeriod qualified as ContestationPeriod
import Hydra.Contract.Commit qualified as Commit
import Hydra.Contract.CommitError (CommitError (STIsMissingInTheOutput))
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.Initial qualified as Initial
import Hydra.Contract.InitialError (InitialError (ExpectedSingleCommitOutput))
import Hydra.Contract.Util (UtilError (MintingOrBurningIsForbidden))
import Hydra.Data.Party qualified as OnChain
import Hydra.Ledger.Cardano (genAddressInEra, genUTxOAdaOnlyOfSize, genVerificationKey)
import Hydra.OnChainId (OnChainId)
import Hydra.Party (Party, partyToChain)
import Hydra.Plutus.Orphans ()
import PlutusTx.Builtins (toBuiltin)
import Test.QuickCheck (choose, elements, oneof, suchThat)
import Test.QuickCheck.Instances ()

--
-- CollectComTx
--

healthyCollectComTx :: (Tx, UTxO)
healthyCollectComTx :: (Tx, UTxO)
healthyCollectComTx =
  (Tx
tx, UTxO
lookupUTxO)
 where
  commitOutputs :: Map TxIn (TxOut CtxUTxO)
commitOutputs = HealthyCommit -> TxOut CtxUTxO
txOut (HealthyCommit -> TxOut CtxUTxO)
-> Map TxIn HealthyCommit -> Map TxIn (TxOut CtxUTxO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxIn HealthyCommit
healthyCommits
  committedUTxO :: UTxO
committedUTxO = (HealthyCommit -> UTxO) -> [HealthyCommit] -> UTxO
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap HealthyCommit -> UTxO
committed ([HealthyCommit] -> UTxO) -> [HealthyCommit] -> UTxO
forall a b. (a -> b) -> a -> b
$ Map TxIn HealthyCommit -> [HealthyCommit]
forall k a. Map k a -> [a]
Map.elems Map TxIn HealthyCommit
healthyCommits

  lookupUTxO :: UTxO
lookupUTxO =
    (TxIn, TxOut CtxUTxO) -> UTxO
forall out. (TxIn, out) -> UTxO' out
UTxO.singleton (TxIn
healthyHeadTxIn, TxOut CtxUTxO
healthyHeadTxOut)
      UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> Map TxIn (TxOut CtxUTxO) -> UTxO
forall out. Map TxIn out -> UTxO' out
UTxO Map TxIn (TxOut CtxUTxO)
commitOutputs
      UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> ScriptRegistry -> UTxO
registryUTxO ScriptRegistry
scriptRegistry

  tx :: Tx
tx =
    NetworkId
-> ScriptRegistry
-> VerificationKey PaymentKey
-> HeadId
-> HeadParameters
-> (TxIn, TxOut CtxUTxO)
-> Map TxIn (TxOut CtxUTxO)
-> UTxO
-> Tx
collectComTx
      NetworkId
testNetworkId
      ScriptRegistry
scriptRegistry
      VerificationKey PaymentKey
somePartyCardanoVerificationKey
      (PolicyId -> HeadId
mkHeadId PolicyId
testPolicyId)
      HeadParameters
parameters
      (TxIn
healthyHeadTxIn, TxOut CtxUTxO
healthyHeadTxOut)
      Map TxIn (TxOut CtxUTxO)
commitOutputs
      UTxO
committedUTxO

  scriptRegistry :: ScriptRegistry
scriptRegistry = Gen ScriptRegistry
genScriptRegistry Gen ScriptRegistry -> Int -> ScriptRegistry
forall a. Gen a -> Int -> a
`generateWith` Int
42

  somePartyCardanoVerificationKey :: VerificationKey PaymentKey
somePartyCardanoVerificationKey = [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

  parameters :: HeadParameters
parameters =
    HeadParameters
      { $sel:parties:HeadParameters :: [Party]
parties = [Party]
healthyParties
      , $sel:contestationPeriod:HeadParameters :: ContestationPeriod
contestationPeriod = ContestationPeriod
healthyContestationPeriod
      }

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

healthyCommits :: Map TxIn HealthyCommit
healthyCommits :: Map TxIn HealthyCommit
healthyCommits =
  [(TxIn, HealthyCommit)] -> Map TxIn HealthyCommit
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(TxIn, HealthyCommit)] -> Map TxIn HealthyCommit)
-> (Gen [(TxIn, HealthyCommit)] -> [(TxIn, HealthyCommit)])
-> Gen [(TxIn, HealthyCommit)]
-> Map TxIn HealthyCommit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen [(TxIn, HealthyCommit)] -> Int -> [(TxIn, HealthyCommit)])
-> Int -> Gen [(TxIn, HealthyCommit)] -> [(TxIn, HealthyCommit)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Gen [(TxIn, HealthyCommit)] -> Int -> [(TxIn, HealthyCommit)]
forall a. Gen a -> Int -> a
generateWith Int
42
    (Gen [(TxIn, HealthyCommit)] -> Map TxIn HealthyCommit)
-> Gen [(TxIn, HealthyCommit)] -> Map TxIn HealthyCommit
forall a b. (a -> b) -> a -> b
$ ((VerificationKey PaymentKey, Party) -> Gen (TxIn, HealthyCommit))
-> [(VerificationKey PaymentKey, Party)]
-> Gen [(TxIn, HealthyCommit)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (VerificationKey PaymentKey, Party) -> Gen (TxIn, HealthyCommit)
createHealthyCommit
    ([(VerificationKey PaymentKey, Party)]
 -> Gen [(TxIn, HealthyCommit)])
-> [(VerificationKey PaymentKey, Party)]
-> Gen [(TxIn, HealthyCommit)]
forall a b. (a -> b) -> a -> b
$ [VerificationKey PaymentKey]
-> [Party] -> [(VerificationKey PaymentKey, Party)]
forall a b. [a] -> [b] -> [(a, b)]
zip [VerificationKey PaymentKey]
healthyParticipants [Party]
healthyParties
 where
  createHealthyCommit :: (VerificationKey PaymentKey, Party) -> Gen (TxIn, HealthyCommit)
createHealthyCommit (VerificationKey PaymentKey
vk, Party
party) = do
    UTxO
utxo <- Int -> Gen UTxO
genUTxOAdaOnlyOfSize (Int -> Gen UTxO) -> Gen Int -> Gen UTxO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
5)
    (TxIn, HealthyCommit) -> Gen (TxIn, HealthyCommit)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TxIn, HealthyCommit) -> Gen (TxIn, HealthyCommit))
-> (TxIn, HealthyCommit) -> Gen (TxIn, HealthyCommit)
forall a b. (a -> b) -> a -> b
$ OnChainId -> Party -> UTxO -> (TxIn, HealthyCommit)
healthyCommitOutput (VerificationKey PaymentKey -> OnChainId
verificationKeyToOnChainId VerificationKey PaymentKey
vk) Party
party UTxO
utxo

healthyContestationPeriod :: ContestationPeriod
healthyContestationPeriod :: ContestationPeriod
healthyContestationPeriod =
  Gen ContestationPeriod
forall a. Arbitrary a => Gen a
arbitrary Gen ContestationPeriod -> Int -> ContestationPeriod
forall a. Gen a -> Int -> a
`generateWith` Int
42

healthyHeadTxIn :: TxIn
healthyHeadTxIn :: TxIn
healthyHeadTxIn =
  Gen TxIn -> Int -> TxIn
forall a. Gen a -> Int -> a
generateWith Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary Int
42

healthyHeadTxOut :: TxOut CtxUTxO
healthyHeadTxOut :: TxOut CtxUTxO
healthyHeadTxOut =
  NetworkId -> PolicyId -> TxOutDatum CtxUTxO -> TxOut CtxUTxO
forall ctx. NetworkId -> PolicyId -> TxOutDatum ctx -> TxOut ctx
mkHeadOutput
    NetworkId
testNetworkId
    PolicyId
testPolicyId
    (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 (TxOutDatum CtxTx Era -> TxOutDatum CtxUTxO)
-> TxOutDatum CtxTx Era -> TxOutDatum CtxUTxO
forall a b. (a -> b) -> a -> b
$ State -> TxOutDatum CtxTx Era
forall era a ctx.
(ToScriptData a, IsBabbageEraOnwards era) =>
a -> TxOutDatum ctx era
mkTxOutDatumInline State
healthyCollectComInitialDatum)

healthyCollectComInitialDatum :: Head.State
healthyCollectComInitialDatum :: State
healthyCollectComInitialDatum =
  Head.Initial
    { $sel:contestationPeriod:Initial :: ContestationPeriod
contestationPeriod = ContestationPeriod -> ContestationPeriod
ContestationPeriod.toChain ContestationPeriod
healthyContestationPeriod
    , $sel:parties:Initial :: [Party]
parties = [Party]
healthyOnChainParties
    , $sel:headId:Initial :: CurrencySymbol
headId = PolicyId -> CurrencySymbol
toPlutusCurrencySymbol PolicyId
testPolicyId
    , $sel:seed:Initial :: TxOutRef
seed = TxIn -> TxOutRef
toPlutusTxOutRef TxIn
testSeedInput
    }

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

healthyParties :: [Party]
healthyParties :: [Party]
healthyParties = (Gen [Party] -> Int -> [Party]) -> Int -> Gen [Party] -> [Party]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Gen [Party] -> Int -> [Party]
forall a. Gen a -> Int -> a
generateWith Int
42 (Gen [Party] -> [Party]) -> Gen [Party] -> [Party]
forall a b. (a -> b) -> a -> b
$ do
  Party
alice <- Gen Party
forall a. Arbitrary a => Gen a
arbitrary
  Party
bob <- Gen Party
forall a. Arbitrary a => Gen a
arbitrary
  Party
carol <- Gen Party
forall a. Arbitrary a => Gen a
arbitrary
  [Party] -> Gen [Party]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Party
alice, Party
bob, Party
carol]

data HealthyCommit = HealthyCommit
  { HealthyCommit -> OnChainId
participant :: OnChainId
  , HealthyCommit -> TxOut CtxUTxO
txOut :: TxOut CtxUTxO
  , HealthyCommit -> UTxO
committed :: UTxO
  }
  deriving stock (Int -> HealthyCommit -> ShowS
[HealthyCommit] -> ShowS
HealthyCommit -> String
(Int -> HealthyCommit -> ShowS)
-> (HealthyCommit -> String)
-> ([HealthyCommit] -> ShowS)
-> Show HealthyCommit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HealthyCommit -> ShowS
showsPrec :: Int -> HealthyCommit -> ShowS
$cshow :: HealthyCommit -> String
show :: HealthyCommit -> String
$cshowList :: [HealthyCommit] -> ShowS
showList :: [HealthyCommit] -> ShowS
Show)

healthyCommitOutput ::
  OnChainId ->
  Party ->
  UTxO ->
  (TxIn, HealthyCommit)
healthyCommitOutput :: OnChainId -> Party -> UTxO -> (TxIn, HealthyCommit)
healthyCommitOutput OnChainId
participant Party
party UTxO
committed =
  ( TxIn
txIn
  , HealthyCommit
      { OnChainId
$sel:participant:HealthyCommit :: OnChainId
participant :: OnChainId
participant
      , $sel:txOut:HealthyCommit :: TxOut CtxUTxO
txOut = TxOut CtxTx Era -> TxOut CtxUTxO
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
toCtxUTxOTxOut (AddressInEra
-> Value
-> TxOutDatum CtxTx Era
-> ReferenceScript
-> TxOut CtxTx Era
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut AddressInEra
commitAddress Value
commitValue (Datum -> TxOutDatum CtxTx Era
forall era a ctx.
(ToScriptData a, IsBabbageEraOnwards era) =>
a -> TxOutDatum ctx era
mkTxOutDatumInline Datum
commitDatum) ReferenceScript
ReferenceScriptNone)
      , UTxO
$sel:committed:HealthyCommit :: UTxO
committed :: UTxO
committed
      }
  )
 where
  txIn :: TxIn
txIn = Gen TxIn
genTxIn Gen TxIn -> Party -> TxIn
forall a. Gen a -> Party -> a
`genForParty` Party
party

  commitScript :: PlutusScript lang
commitScript =
    SerialisedScript -> PlutusScript lang
forall lang. SerialisedScript -> PlutusScript lang
fromPlutusScript SerialisedScript
Commit.validatorScript
  commitAddress :: AddressInEra
commitAddress =
    forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress @PlutusScriptV2 NetworkId
testNetworkId PlutusScript PlutusScriptV2
forall {lang}. PlutusScript lang
commitScript
  commitValue :: Value
commitValue =
    (TxOut CtxUTxO -> Value) -> UTxO -> Value
forall m a. Monoid m => (a -> m) -> UTxO' a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut CtxUTxO -> Value
forall ctx. TxOut ctx -> Value
txOutValue UTxO
committed
      Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [(AssetId, Quantity)] -> Value
valueFromList
        [ (PolicyId -> AssetName -> AssetId
AssetId PolicyId
testPolicyId (OnChainId -> AssetName
onChainIdToAssetName OnChainId
participant), Quantity
1)
        ]
  commitDatum :: Datum
commitDatum =
    Party -> UTxO -> CurrencySymbol -> Datum
mkCommitDatum Party
party UTxO
committed (PolicyId -> CurrencySymbol
toPlutusCurrencySymbol (PolicyId -> CurrencySymbol) -> PolicyId -> CurrencySymbol
forall a b. (a -> b) -> a -> b
$ TxIn -> PolicyId
headPolicyId TxIn
healthyHeadTxIn)

data CollectComMutation
  = -- | Ensures collectCom does not allow any output address but νHead.
    NotContinueContract
  | -- | Needs to prevent that not all value is collected into the head output.
    ExtractSomeValue
  | MutateOpenUTxOHash
  | -- | Ensures collectCom cannot collect from an initial UTxO.
    MutateCommitToInitial
  | -- | Every party should have commited and been taken into account for the
    -- collectCom transaction to be valid. Here we increase the number of
    -- parties in input and output but keep the commits unchanged. This
    -- simulates the situation where one participant would not have commited
    -- already or whose commit would have been ignored by the collectCom
    -- transaction.
    MutateNumberOfParties
  | MutateHeadId
  | MutateRequiredSigner
  | -- | Minting or burning of tokens should not be possible in collectCom.
    MutateTokenMintingOrBurning
  | -- | νCommit validator checks the ST is in the output
    RemoveSTFromOutput
  deriving stock ((forall x. CollectComMutation -> Rep CollectComMutation x)
-> (forall x. Rep CollectComMutation x -> CollectComMutation)
-> Generic CollectComMutation
forall x. Rep CollectComMutation x -> CollectComMutation
forall x. CollectComMutation -> Rep CollectComMutation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CollectComMutation -> Rep CollectComMutation x
from :: forall x. CollectComMutation -> Rep CollectComMutation x
$cto :: forall x. Rep CollectComMutation x -> CollectComMutation
to :: forall x. Rep CollectComMutation x -> CollectComMutation
Generic, Int -> CollectComMutation -> ShowS
[CollectComMutation] -> ShowS
CollectComMutation -> String
(Int -> CollectComMutation -> ShowS)
-> (CollectComMutation -> String)
-> ([CollectComMutation] -> ShowS)
-> Show CollectComMutation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CollectComMutation -> ShowS
showsPrec :: Int -> CollectComMutation -> ShowS
$cshow :: CollectComMutation -> String
show :: CollectComMutation -> String
$cshowList :: [CollectComMutation] -> ShowS
showList :: [CollectComMutation] -> ShowS
Show, Int -> CollectComMutation
CollectComMutation -> Int
CollectComMutation -> [CollectComMutation]
CollectComMutation -> CollectComMutation
CollectComMutation -> CollectComMutation -> [CollectComMutation]
CollectComMutation
-> CollectComMutation -> CollectComMutation -> [CollectComMutation]
(CollectComMutation -> CollectComMutation)
-> (CollectComMutation -> CollectComMutation)
-> (Int -> CollectComMutation)
-> (CollectComMutation -> Int)
-> (CollectComMutation -> [CollectComMutation])
-> (CollectComMutation
    -> CollectComMutation -> [CollectComMutation])
-> (CollectComMutation
    -> CollectComMutation -> [CollectComMutation])
-> (CollectComMutation
    -> CollectComMutation
    -> CollectComMutation
    -> [CollectComMutation])
-> Enum CollectComMutation
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 :: CollectComMutation -> CollectComMutation
succ :: CollectComMutation -> CollectComMutation
$cpred :: CollectComMutation -> CollectComMutation
pred :: CollectComMutation -> CollectComMutation
$ctoEnum :: Int -> CollectComMutation
toEnum :: Int -> CollectComMutation
$cfromEnum :: CollectComMutation -> Int
fromEnum :: CollectComMutation -> Int
$cenumFrom :: CollectComMutation -> [CollectComMutation]
enumFrom :: CollectComMutation -> [CollectComMutation]
$cenumFromThen :: CollectComMutation -> CollectComMutation -> [CollectComMutation]
enumFromThen :: CollectComMutation -> CollectComMutation -> [CollectComMutation]
$cenumFromTo :: CollectComMutation -> CollectComMutation -> [CollectComMutation]
enumFromTo :: CollectComMutation -> CollectComMutation -> [CollectComMutation]
$cenumFromThenTo :: CollectComMutation
-> CollectComMutation -> CollectComMutation -> [CollectComMutation]
enumFromThenTo :: CollectComMutation
-> CollectComMutation -> CollectComMutation -> [CollectComMutation]
Enum, CollectComMutation
CollectComMutation
-> CollectComMutation -> Bounded CollectComMutation
forall a. a -> a -> Bounded a
$cminBound :: CollectComMutation
minBound :: CollectComMutation
$cmaxBound :: CollectComMutation
maxBound :: CollectComMutation
Bounded)

genCollectComMutation :: (Tx, UTxO) -> Gen SomeMutation
genCollectComMutation :: (Tx, UTxO) -> Gen SomeMutation
genCollectComMutation (Tx
tx, UTxO
_utxo) =
  [Gen SomeMutation] -> Gen SomeMutation
forall a. [Gen a] -> Gen a
oneof
    [ Maybe Text -> CollectComMutation -> 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) CollectComMutation
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 Era -> Mutation
ChangeOutput Word
0 ((AddressInEra -> AddressInEra)
-> TxOut CtxTx Era -> TxOut CtxTx Era
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 Era
headTxOut)
    , Maybe Text -> CollectComMutation -> 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
NotAllValueCollected) CollectComMutation
ExtractSomeValue (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        -- Remove a random asset and quantity from headOutput
        Value
removedValue <- do
          let allAssets :: [(AssetId, Quantity)]
allAssets = Value -> [(AssetId, Quantity)]
valueToList (Value -> [(AssetId, Quantity)]) -> Value -> [(AssetId, Quantity)]
forall a b. (a -> b) -> a -> b
$ TxOut CtxTx Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxTx Era
headTxOut
              nonPTs :: [(AssetId, Quantity)]
nonPTs = (((AssetId, Quantity) -> Bool)
 -> [(AssetId, Quantity)] -> [(AssetId, Quantity)])
-> [(AssetId, Quantity)]
-> ((AssetId, Quantity) -> Bool)
-> [(AssetId, Quantity)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((AssetId, Quantity) -> Bool)
-> [(AssetId, Quantity)] -> [(AssetId, Quantity)]
forall a. (a -> Bool) -> [a] -> [a]
filter [(AssetId, Quantity)]
allAssets (((AssetId, Quantity) -> Bool) -> [(AssetId, Quantity)])
-> ((AssetId, Quantity) -> Bool) -> [(AssetId, Quantity)]
forall a b. (a -> b) -> a -> b
$ \case
                (AssetId PolicyId
pid AssetName
_, Quantity
_) -> PolicyId
pid PolicyId -> PolicyId -> Bool
forall a. Eq a => a -> a -> Bool
/= PolicyId
testPolicyId
                (AssetId, Quantity)
_ -> Bool
True
          (AssetId
assetId, Quantity Integer
n) <- [(AssetId, Quantity)] -> Gen (AssetId, Quantity)
forall a. [a] -> Gen a
elements [(AssetId, Quantity)]
nonPTs
          Quantity
q <- Integer -> Quantity
Quantity (Integer -> Quantity) -> Gen Integer -> Gen Quantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
n)
          Value -> Gen Value
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Gen Value) -> Value -> Gen Value
forall a b. (a -> b) -> a -> b
$ [(AssetId, Quantity)] -> Value
valueFromList [(AssetId
assetId, Quantity
q)]
        -- Add another output which would extract the 'removedValue'. The ledger
        -- would check for this, and this is needed because the way we implement
        -- collectCom checks.
        TxOut CtxTx Era
extractionTxOut <- do
          AddressInEra
someAddress <- NetworkId -> Gen AddressInEra
genAddressInEra NetworkId
testNetworkId
          TxOut CtxTx Era -> Gen (TxOut CtxTx Era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut CtxTx Era -> Gen (TxOut CtxTx Era))
-> TxOut CtxTx Era -> Gen (TxOut CtxTx Era)
forall a b. (a -> b) -> a -> b
$ AddressInEra
-> Value
-> TxOutDatum CtxTx Era
-> ReferenceScript
-> TxOut CtxTx Era
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut AddressInEra
someAddress Value
removedValue TxOutDatum CtxTx Era
forall ctx. TxOutDatum ctx
TxOutDatumNone ReferenceScript
ReferenceScriptNone
        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 Era -> Mutation
ChangeOutput Word
0 (TxOut CtxTx Era -> Mutation) -> TxOut CtxTx Era -> Mutation
forall a b. (a -> b) -> a -> b
$ (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
v -> Value
v Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
negateValue Value
removedValue) TxOut CtxTx Era
headTxOut
            , TxOut CtxTx Era -> Mutation
AppendOutput TxOut CtxTx Era
extractionTxOut
            ]
    , Maybe Text -> CollectComMutation -> 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
IncorrectUtxoHash) CollectComMutation
MutateOpenUTxOHash (Mutation -> SomeMutation)
-> (TxOut CtxTx Era -> Mutation) -> TxOut CtxTx Era -> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> TxOut CtxTx Era -> Mutation
ChangeOutput Word
0 (TxOut CtxTx Era -> SomeMutation)
-> Gen (TxOut CtxTx Era) -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxOut CtxTx Era)
mutateUTxOHash
    , Maybe Text -> CollectComMutation -> 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
MissingCommits) CollectComMutation
MutateNumberOfParties (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        [Party]
moreParties <- (Party -> [Party] -> [Party]
forall a. a -> [a] -> [a]
: [Party]
healthyOnChainParties) (Party -> [Party]) -> Gen Party -> Gen [Party]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Party
forall a. Arbitrary a => Gen a
arbitrary
        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
$ [Party] -> State -> State
replaceParties [Party]
moreParties State
healthyCollectComInitialDatum
            , Word -> TxOut CtxTx Era -> Mutation
ChangeOutput Word
0 (TxOut CtxTx Era -> Mutation) -> TxOut CtxTx Era -> Mutation
forall a b. (a -> b) -> a -> b
$ [Party] -> TxOut CtxTx Era -> TxOut CtxTx Era
mutatedPartiesHeadTxOut [Party]
moreParties TxOut CtxTx Era
headTxOut
            ]
    , Maybe Text -> CollectComMutation -> 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
STNotSpent) CollectComMutation
MutateHeadId (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        -- XXX: This mutation is unrealistic. It would only change the headId in
        -- the value, but not in the datum. This is not allowed by the protocol
        -- prior to this transaction.
        TxOut CtxUTxO
illedHeadResolvedInput <-
          NetworkId -> PolicyId -> TxOutDatum CtxUTxO -> TxOut CtxUTxO
forall ctx. NetworkId -> PolicyId -> TxOutDatum ctx -> TxOut ctx
mkHeadOutput NetworkId
testNetworkId
            (PolicyId -> TxOutDatum CtxUTxO -> TxOut CtxUTxO)
-> Gen PolicyId -> Gen (TxOutDatum CtxUTxO -> TxOut CtxUTxO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxIn -> PolicyId) -> Gen TxIn -> Gen PolicyId
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxIn -> PolicyId
headPolicyId (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))
            Gen (TxOutDatum CtxUTxO -> TxOut CtxUTxO)
-> Gen (TxOutDatum CtxUTxO) -> Gen (TxOut CtxUTxO)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxOutDatum CtxUTxO -> Gen (TxOutDatum CtxUTxO)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 (TxOutDatum CtxTx Era -> TxOutDatum CtxUTxO)
-> TxOutDatum CtxTx Era -> TxOutDatum CtxUTxO
forall a b. (a -> b) -> a -> b
$ State -> TxOutDatum CtxTx Era
forall era a ctx.
(ToScriptData a, IsBabbageEraOnwards era) =>
a -> TxOutDatum ctx era
mkTxOutDatumInline State
healthyCollectComInitialDatum)
        Mutation -> Gen Mutation
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutation -> Gen Mutation) -> Mutation -> Gen Mutation
forall a b. (a -> b) -> a -> b
$ TxIn -> TxOut CtxUTxO -> Maybe HashableScriptData -> Mutation
ChangeInput TxIn
healthyHeadTxIn TxOut CtxUTxO
illedHeadResolvedInput (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 Input
Head.CollectCom)
    , Maybe Text -> CollectComMutation -> 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) CollectComMutation
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
        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 -> CollectComMutation -> 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
$ InitialError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode InitialError
ExpectedSingleCommitOutput) CollectComMutation
MutateCommitToInitial (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        -- By changing a commit output to an initial, we simulate a situation
        -- where we do pretend to have collected every commit, but we just
        -- changed one back to be an initial. This should be caught by the
        -- initial validator.
        (TxIn
txIn, HealthyCommit{OnChainId
$sel:participant:HealthyCommit :: HealthyCommit -> OnChainId
participant :: OnChainId
participant}) <- [(TxIn, HealthyCommit)] -> Gen (TxIn, HealthyCommit)
forall a. [a] -> Gen a
elements ([(TxIn, HealthyCommit)] -> Gen (TxIn, HealthyCommit))
-> [(TxIn, HealthyCommit)] -> Gen (TxIn, HealthyCommit)
forall a b. (a -> b) -> a -> b
$ Map TxIn HealthyCommit -> [(TxIn, HealthyCommit)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn HealthyCommit
healthyCommits
        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
            [ TxIn -> TxOut CtxUTxO -> Maybe HashableScriptData -> Mutation
ChangeInput
                TxIn
txIn
                (TxOut CtxTx Era -> TxOut CtxUTxO
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
forall {k} (f :: * -> k -> *) (era :: k).
ToUTxOContext f =>
f CtxTx era -> f CtxUTxO era
toUTxOContext (TxOut CtxTx Era -> TxOut CtxUTxO)
-> TxOut CtxTx Era -> TxOut CtxUTxO
forall a b. (a -> b) -> a -> b
$ NetworkId -> TxIn -> OnChainId -> TxOut CtxTx Era
mkInitialOutput NetworkId
testNetworkId TxIn
testSeedInput OnChainId
participant)
                (HashableScriptData -> Maybe HashableScriptData
forall a. a -> Maybe a
Just (HashableScriptData -> Maybe HashableScriptData)
-> (InitialRedeemer -> HashableScriptData)
-> InitialRedeemer
-> Maybe HashableScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redeemer -> HashableScriptData
forall a. ToScriptData a => a -> HashableScriptData
toScriptData (Redeemer -> HashableScriptData)
-> (InitialRedeemer -> Redeemer)
-> InitialRedeemer
-> HashableScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitialRedeemer -> Redeemer
Initial.redeemer (InitialRedeemer -> Maybe HashableScriptData)
-> InitialRedeemer -> Maybe HashableScriptData
forall a b. (a -> b) -> a -> b
$ [TxOutRef] -> InitialRedeemer
Initial.ViaCommit [TxIn -> TxOutRef
toPlutusTxOutRef TxIn
txIn])
            , PlutusScript PlutusScriptV2 -> Mutation
AddScript (PlutusScript PlutusScriptV2 -> Mutation)
-> PlutusScript PlutusScriptV2 -> Mutation
forall a b. (a -> b) -> a -> b
$ SerialisedScript -> PlutusScript PlutusScriptV2
forall lang. SerialisedScript -> PlutusScript lang
fromPlutusScript SerialisedScript
Initial.validatorScript
            ]
    , Maybe Text -> CollectComMutation -> 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) CollectComMutation
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 -> CollectComMutation -> 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
$ CommitError -> Text
forall a. ToErrorCode a => a -> Text
toErrorCode CommitError
STIsMissingInTheOutput) CollectComMutation
RemoveSTFromOutput (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        let out :: TxOut CtxTx Era
out = [TxOut CtxTx Era] -> TxOut CtxTx Era
forall a. HasCallStack => [a] -> a
List.head ([TxOut CtxTx Era] -> TxOut CtxTx Era)
-> [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
        let stAssetId :: AssetId
stAssetId = PolicyId -> AssetName -> AssetId
AssetId (TxIn -> PolicyId
headPolicyId TxIn
testSeedInput) AssetName
hydraHeadV1AssetName
        let newValue :: Value
newValue = (AssetId -> Bool) -> Value -> Value
filterValue (AssetId -> AssetId -> Bool
forall a. Eq a => a -> a -> Bool
/= AssetId
stAssetId) (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 Word
0 (TxOut CtxTx Era
headTxOut{txOutValue = newValue})
    ]
 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

  mutatedPartiesHeadTxOut :: [Party] -> TxOut CtxTx Era -> TxOut CtxTx Era
mutatedPartiesHeadTxOut [Party]
parties =
    (State -> State) -> TxOut CtxTx Era -> TxOut CtxTx Era
forall a.
(FromScriptData a, ToScriptData a) =>
(a -> a) -> TxOut CtxTx Era -> TxOut CtxTx Era
modifyInlineDatum ((State -> State) -> TxOut CtxTx Era -> TxOut CtxTx Era)
-> (State -> State) -> TxOut CtxTx Era -> TxOut CtxTx Era
forall a b. (a -> b) -> a -> b
$ \case
      Head.Open{Hash
utxoHash :: Hash
$sel:utxoHash:Initial :: State -> Hash
utxoHash, ContestationPeriod
$sel:contestationPeriod:Initial :: State -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod, CurrencySymbol
$sel:headId:Initial :: State -> CurrencySymbol
headId :: CurrencySymbol
headId} ->
        Head.Open{$sel:parties:Initial :: [Party]
Head.parties = [Party]
parties, ContestationPeriod
$sel:contestationPeriod:Initial :: ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod, Hash
utxoHash :: Hash
$sel:utxoHash:Initial :: Hash
utxoHash, CurrencySymbol
$sel:headId:Initial :: CurrencySymbol
headId :: CurrencySymbol
headId}
      State
st -> Text -> State
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> State) -> Text -> State
forall a b. (a -> b) -> a -> b
$ Text
"Unexpected state " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> State -> Text
forall b a. (Show a, IsString b) => a -> b
show State
st

  mutateUTxOHash :: Gen (TxOut CtxTx Era)
mutateUTxOHash = do
    ByteString
mutatedUTxOHash <- Gen ByteString
genHash
    TxOut CtxTx Era -> Gen (TxOut CtxTx Era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut CtxTx Era -> Gen (TxOut CtxTx Era))
-> TxOut CtxTx Era -> Gen (TxOut CtxTx Era)
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 (ByteString -> State -> State
forall {a}. ToBuiltin a Hash => a -> State -> State
mutateState ByteString
mutatedUTxOHash) TxOut CtxTx Era
headTxOut

  mutateState :: a -> State -> State
mutateState a
mutatedUTxOHash = \case
    Head.Open{[Party]
$sel:parties:Initial :: State -> [Party]
parties :: [Party]
parties, ContestationPeriod
$sel:contestationPeriod:Initial :: State -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod, CurrencySymbol
$sel:headId:Initial :: State -> CurrencySymbol
headId :: CurrencySymbol
headId} ->
      Head.Open{[Party]
$sel:parties:Initial :: [Party]
parties :: [Party]
parties, ContestationPeriod
$sel:contestationPeriod:Initial :: ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod, $sel:utxoHash:Initial :: Hash
Head.utxoHash = a -> Hash
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin a
mutatedUTxOHash, CurrencySymbol
$sel:headId:Initial :: CurrencySymbol
headId :: CurrencySymbol
headId}
    State
st -> State
st