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

module Hydra.Chain.Direct.Contract.Close where

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

import Cardano.Api.UTxO as UTxO
import Data.Maybe (fromJust)
import Hydra.Chain.Direct.Contract.Gen (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 qualified as Fixture
import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO)
import Hydra.Chain.Direct.TimeHandle (PointInTime)
import Hydra.Chain.Direct.Tx (ClosingSnapshot (..), OpenThreadOutput (..), UTxOHash (UTxOHash), closeTx, mkHeadId, mkHeadOutput)
import Hydra.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 qualified as OnChain
import Hydra.Ledger (hashUTxO)
import Hydra.Ledger.Cardano (genAddressInEra, genOneUTxOFor, genValue, genVerificationKey)
import Hydra.Ledger.Cardano.Evaluate (genValidityBoundsFromContestationPeriod)
import Hydra.Party (Party, deriveParty, partyToChain)
import Hydra.Plutus.Extras (posixFromUTCTime)
import Hydra.Plutus.Orphans ()
import Hydra.Snapshot (Snapshot (..), SnapshotNumber)
import PlutusLedgerApi.V1.Time (DiffMilliSeconds (..), fromMilliSeconds)
import PlutusLedgerApi.V2 (BuiltinByteString, POSIXTime, PubKeyHash (PubKeyHash), toBuiltin)
import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty)
import Test.QuickCheck (arbitrarySizedNatural, choose, elements, listOf1, oneof, suchThat)
import Test.QuickCheck.Instances ()

-- | Healthy close transaction for the generic case were we close a head
--   after one or more snapshot have been agreed upon between the members.
healthyCloseTx :: (Tx, UTxO)
healthyCloseTx :: (Tx, UTxO)
healthyCloseTx =
  (Tx
tx, UTxO
lookupUTxO)
 where
  tx :: Tx
tx =
    ScriptRegistry
-> VerificationKey PaymentKey
-> ClosingSnapshot
-> SlotNo
-> PointInTime
-> OpenThreadOutput
-> HeadId
-> Tx
closeTx
      ScriptRegistry
scriptRegistry
      VerificationKey PaymentKey
somePartyCardanoVerificationKey
      ClosingSnapshot
closingSnapshot
      SlotNo
healthyCloseLowerBoundSlot
      PointInTime
healthyCloseUpperBoundPointInTime
      OpenThreadOutput
openThreadOutput
      (PolicyId -> HeadId
mkHeadId PolicyId
Fixture.testPolicyId)

  lookupUTxO :: UTxO
lookupUTxO =
    (TxIn, TxOut CtxUTxO Era) -> UTxO
forall out. (TxIn, out) -> UTxO' out
UTxO.singleton (TxIn
healthyOpenHeadTxIn, TxOut CtxUTxO Era
healthyOpenHeadTxOut)
      UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> ScriptRegistry -> UTxO
registryUTxO ScriptRegistry
scriptRegistry

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

  openThreadOutput :: OpenThreadOutput
openThreadOutput =
    OpenThreadOutput
      { $sel:openThreadUTxO:OpenThreadOutput :: (TxIn, TxOut CtxUTxO Era)
openThreadUTxO = (TxIn
healthyOpenHeadTxIn, TxOut CtxUTxO Era
healthyOpenHeadTxOut)
      , $sel:openParties:OpenThreadOutput :: [Party]
openParties = [Party]
healthyOnChainParties
      , $sel:openContestationPeriod:OpenThreadOutput :: ContestationPeriod
openContestationPeriod = ContestationPeriod
healthyContestationPeriod
      }

  closingSnapshot :: ClosingSnapshot
  closingSnapshot :: ClosingSnapshot
closingSnapshot =
    CloseWithConfirmedSnapshot
      { $sel:snapshotNumber:CloseWithInitialSnapshot :: SnapshotNumber
snapshotNumber = SnapshotNumber
healthyCloseSnapshotNumber
      , $sel:closeUtxoHash:CloseWithInitialSnapshot :: UTxOHash
closeUtxoHash = ByteString -> UTxOHash
UTxOHash (ByteString -> UTxOHash) -> ByteString -> UTxOHash
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @Tx UTxO
UTxOType Tx
healthyCloseUTxO
      , $sel:signatures:CloseWithInitialSnapshot :: MultiSignature (Snapshot Tx)
signatures = SnapshotNumber -> MultiSignature (Snapshot Tx)
healthySignature SnapshotNumber
healthyCloseSnapshotNumber
      }

-- | Healthy close transaction for the specific case were we close a head
--   with the initial UtxO, that is, no snapshot have been agreed upon and
--   signed by the head members yet.
healthyCloseInitialTx :: (Tx, UTxO)
healthyCloseInitialTx :: (Tx, UTxO)
healthyCloseInitialTx =
  (Tx
tx, UTxO
lookupUTxO)
 where
  tx :: Tx
tx =
    ScriptRegistry
-> VerificationKey PaymentKey
-> ClosingSnapshot
-> SlotNo
-> PointInTime
-> OpenThreadOutput
-> HeadId
-> Tx
closeTx
      ScriptRegistry
scriptRegistry
      VerificationKey PaymentKey
somePartyCardanoVerificationKey
      ClosingSnapshot
closingSnapshot
      SlotNo
healthyCloseLowerBoundSlot
      PointInTime
healthyCloseUpperBoundPointInTime
      OpenThreadOutput
openThreadOutput
      (PolicyId -> HeadId
mkHeadId PolicyId
Fixture.testPolicyId)

  lookupUTxO :: UTxO
lookupUTxO =
    (TxIn, TxOut CtxUTxO Era) -> UTxO
forall out. (TxIn, out) -> UTxO' out
UTxO.singleton (TxIn
healthyOpenHeadTxIn, TxOut CtxUTxO Era
healthyOpenHeadTxOut)
      UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> ScriptRegistry -> UTxO
registryUTxO ScriptRegistry
scriptRegistry

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

  openThreadOutput :: OpenThreadOutput
openThreadOutput =
    OpenThreadOutput
      { $sel:openThreadUTxO:OpenThreadOutput :: (TxIn, TxOut CtxUTxO Era)
openThreadUTxO = (TxIn
healthyOpenHeadTxIn, TxOut CtxUTxO Era
healthyOpenHeadTxOut)
      , $sel:openParties:OpenThreadOutput :: [Party]
openParties = [Party]
healthyOnChainParties
      , $sel:openContestationPeriod:OpenThreadOutput :: ContestationPeriod
openContestationPeriod = ContestationPeriod
healthyContestationPeriod
      }
  closingSnapshot :: ClosingSnapshot
  closingSnapshot :: ClosingSnapshot
closingSnapshot =
    CloseWithInitialSnapshot
      { $sel:openUtxoHash:CloseWithInitialSnapshot :: UTxOHash
openUtxoHash = ByteString -> UTxOHash
UTxOHash (ByteString -> UTxOHash) -> ByteString -> UTxOHash
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @Tx UTxO
UTxOType Tx
healthyUTxO
      }

-- NOTE: We need to use the contestation period when generating start/end tx
-- validity slots/time since if tx validity bound difference is bigger than
-- contestation period our close validator will fail
healthyCloseLowerBoundSlot :: SlotNo
healthyCloseUpperBoundPointInTime :: PointInTime
(SlotNo
healthyCloseLowerBoundSlot, PointInTime
healthyCloseUpperBoundPointInTime) =
  ContestationPeriod -> Gen (SlotNo, PointInTime)
genValidityBoundsFromContestationPeriod (ContestationPeriod -> ContestationPeriod
fromChain ContestationPeriod
healthyContestationPeriod) Gen (SlotNo, PointInTime) -> Int -> (SlotNo, PointInTime)
forall a. Gen a -> Int -> a
`generateWith` Int
42

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

healthyOpenHeadTxOut :: TxOut CtxUTxO
healthyOpenHeadTxOut :: TxOut CtxUTxO Era
healthyOpenHeadTxOut =
  NetworkId -> PolicyId -> TxOutDatum CtxUTxO -> TxOut CtxUTxO Era
forall ctx. NetworkId -> PolicyId -> TxOutDatum ctx -> TxOut ctx
mkHeadOutput NetworkId
Fixture.testNetworkId PolicyId
Fixture.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
healthyOpenHeadDatum)

healthySnapshot :: Snapshot Tx
healthySnapshot :: Snapshot Tx
healthySnapshot =
  Snapshot
    { $sel:headId:Snapshot :: HeadId
headId = PolicyId -> HeadId
mkHeadId PolicyId
Fixture.testPolicyId
    , $sel:number:Snapshot :: SnapshotNumber
number = SnapshotNumber
healthyCloseSnapshotNumber
    , $sel:utxo:Snapshot :: UTxOType Tx
utxo = UTxO
UTxOType Tx
healthyCloseUTxO
    , $sel:confirmed:Snapshot :: [TxIdType Tx]
confirmed = []
    }

healthyCloseUTxO :: UTxO
healthyCloseUTxO :: UTxO
healthyCloseUTxO =
  (VerificationKey PaymentKey -> Gen UTxO
genOneUTxOFor VerificationKey PaymentKey
somePartyCardanoVerificationKey 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
healthyUTxO))
    Gen UTxO -> Int -> UTxO
forall a. Gen a -> Int -> a
`generateWith` Int
42

healthyCloseSnapshotNumber :: SnapshotNumber
healthyCloseSnapshotNumber :: SnapshotNumber
healthyCloseSnapshotNumber = SnapshotNumber
1

healthyOpenHeadDatum :: Head.State
healthyOpenHeadDatum :: State
healthyOpenHeadDatum =
  Head.Open
    { $sel:parties:Initial :: [Party]
parties = [Party]
healthyOnChainParties
    , $sel:utxoHash:Initial :: BuiltinByteString
utxoHash = 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
healthyUTxO
    , $sel:contestationPeriod:Initial :: ContestationPeriod
contestationPeriod = ContestationPeriod
healthyContestationPeriod
    , $sel:headId:Initial :: CurrencySymbol
headId = PolicyId -> CurrencySymbol
toPlutusCurrencySymbol PolicyId
Fixture.testPolicyId
    }

healthyContestationPeriod :: OnChain.ContestationPeriod
healthyContestationPeriod :: ContestationPeriod
healthyContestationPeriod = 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

healthyContestationPeriodSeconds :: Integer
healthyContestationPeriodSeconds :: SnapshotNumber
healthyContestationPeriodSeconds = SnapshotNumber
10

healthyUTxO :: UTxO
healthyUTxO :: UTxO
healthyUTxO = VerificationKey PaymentKey -> Gen UTxO
genOneUTxOFor VerificationKey PaymentKey
somePartyCardanoVerificationKey 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

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

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
healthySnapshot{number}

healthyContestationDeadline :: UTCTime
healthyContestationDeadline :: UTCTime
healthyContestationDeadline =
  NominalDiffTime -> UTCTime -> UTCTime
addUTCTime
    (SnapshotNumber -> NominalDiffTime
forall a. Num a => SnapshotNumber -> a
fromInteger SnapshotNumber
healthyContestationPeriodSeconds)
    (PointInTime -> UTCTime
forall a b. (a, b) -> b
snd PointInTime
healthyCloseUpperBoundPointInTime)

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
somePartyCardanoVerificationKey Gen UTxO -> Int -> UTxO
forall a. Gen a -> Int -> a
`generateWith` Int
42

data CloseMutation
  = -- | Ensures collectCom does not allow any output address but νHead.
    NotContinueContract
  | -- | Ensures the snapshot signature is multisigned by all valid Head
    -- participants.
    --
    -- Invalidates the tx by changing the redeemer signature
    -- but not the snapshot number in output head datum.
    MutateSignatureButNotSnapshotNumber
  | -- | Ensures the snapshot number is consistent with the signature.
    --
    -- Invalidates the tx by changing the snapshot number
    -- in resulting head output but not the redeemer signature.
    MutateSnapshotNumberButNotSignature
  | -- | Check that snapshot numbers <= 0 need to close the head with the
    -- initial UTxO hash.
    MutateSnapshotNumberToLessThanEqualZero
  | -- | Ensures the close snapshot is multisigned by all Head participants by
    -- changing the parties in the input head datum. If they do not align the
    -- multisignature will not be valid anymore.
    SnapshotNotSignedByAllParties
  | -- | Ensures close is authenticated by a one of the Head members by changing
    --  the signer used on the tx to not be one of PTs.
    MutateRequiredSigner
  | -- | Ensures close is authenticated by a one of the Head members by changing
    --  the signer used on the tx to be empty.
    MutateNoRequiredSigner
  | -- | Ensures close is authenticated by a one of the Head members by changing
    --  the signer used on the tx to have multiple signers (including the signer
    -- to not fail for SignerIsNotAParticipant).
    MutateMultipleRequiredSigner
  | -- | Invalidates the tx by changing the utxo hash in resulting head output.
    --
    -- Ensures the output state is consistent with the redeemer.
    MutateCloseUTxOHash
  | -- | Ensures parties do not change between head input datum and head output
    --  datum.
    MutatePartiesInOutput
  | -- | Ensures headId do not change between head input datum and head output
    -- datum.
    MutateHeadIdInOutput
  | -- | Invalidates the tx by changing the lower bound to be non finite.
    MutateInfiniteLowerBound
  | -- | Invalidates the tx by changing the upper bound to be non finite.
    MutateInfiniteUpperBound
  | -- | Invalidates the tx by changing the contestation deadline to not satisfy
    -- `contestationDeadline = upperBound + contestationPeriod`.
    MutateContestationDeadline
  | -- | Invalidates the tx by changing the lower and upper bound to be not
    -- bounded as per spec `upperBound - lowerBound <= contestationPeriod`.
    --
    -- This also changes the resulting `head output` contestation deadline to be
    -- valid, so it satisfy `contestationDeadline = upperBound +
    -- contestationPeriod`.
    MutateValidityInterval
  | -- | Ensure the Head cannot be closed with correct authentication from a
    -- different Head. We simulate this by changing the head policy id of the ST
    -- and PTs to be of a different head - a real attack would be to add inputs
    -- with those tokens on top of spending the head output, a bit like a double
    -- satisfaction attack. Note that the token name stays the same and
    -- consistent with the signer. This will cause authentication failure
    -- because the signer's PT, although with a consistent name, is not from the
    -- right head (has a different policy id than in the datum).
    CloseFromDifferentHead
  | -- | Minting or burning of tokens should not be possible in close.
    MutateTokenMintingOrBurning
  | -- | Invalidates the tx by changing the contesters to be non empty.
    MutateContesters
  | -- | Invalidates the tx by changing output values arbitrarily to be different
    -- (not preserved) from the head.
    --
    -- Ensures values are preserved between head input and output.
    MutateValueInOutput
  | -- | Invalidate the tx by changing the contestation period.
    MutateContestationPeriod
  deriving stock ((forall x. CloseMutation -> Rep CloseMutation x)
-> (forall x. Rep CloseMutation x -> CloseMutation)
-> Generic CloseMutation
forall x. Rep CloseMutation x -> CloseMutation
forall x. CloseMutation -> Rep CloseMutation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CloseMutation -> Rep CloseMutation x
from :: forall x. CloseMutation -> Rep CloseMutation x
$cto :: forall x. Rep CloseMutation x -> CloseMutation
to :: forall x. Rep CloseMutation x -> CloseMutation
Generic, Int -> CloseMutation -> ShowS
[CloseMutation] -> ShowS
CloseMutation -> String
(Int -> CloseMutation -> ShowS)
-> (CloseMutation -> String)
-> ([CloseMutation] -> ShowS)
-> Show CloseMutation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloseMutation -> ShowS
showsPrec :: Int -> CloseMutation -> ShowS
$cshow :: CloseMutation -> String
show :: CloseMutation -> String
$cshowList :: [CloseMutation] -> ShowS
showList :: [CloseMutation] -> ShowS
Show, Int -> CloseMutation
CloseMutation -> Int
CloseMutation -> [CloseMutation]
CloseMutation -> CloseMutation
CloseMutation -> CloseMutation -> [CloseMutation]
CloseMutation -> CloseMutation -> CloseMutation -> [CloseMutation]
(CloseMutation -> CloseMutation)
-> (CloseMutation -> CloseMutation)
-> (Int -> CloseMutation)
-> (CloseMutation -> Int)
-> (CloseMutation -> [CloseMutation])
-> (CloseMutation -> CloseMutation -> [CloseMutation])
-> (CloseMutation -> CloseMutation -> [CloseMutation])
-> (CloseMutation
    -> CloseMutation -> CloseMutation -> [CloseMutation])
-> Enum CloseMutation
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 :: CloseMutation -> CloseMutation
succ :: CloseMutation -> CloseMutation
$cpred :: CloseMutation -> CloseMutation
pred :: CloseMutation -> CloseMutation
$ctoEnum :: Int -> CloseMutation
toEnum :: Int -> CloseMutation
$cfromEnum :: CloseMutation -> Int
fromEnum :: CloseMutation -> Int
$cenumFrom :: CloseMutation -> [CloseMutation]
enumFrom :: CloseMutation -> [CloseMutation]
$cenumFromThen :: CloseMutation -> CloseMutation -> [CloseMutation]
enumFromThen :: CloseMutation -> CloseMutation -> [CloseMutation]
$cenumFromTo :: CloseMutation -> CloseMutation -> [CloseMutation]
enumFromTo :: CloseMutation -> CloseMutation -> [CloseMutation]
$cenumFromThenTo :: CloseMutation -> CloseMutation -> CloseMutation -> [CloseMutation]
enumFromThenTo :: CloseMutation -> CloseMutation -> CloseMutation -> [CloseMutation]
Enum, CloseMutation
CloseMutation -> CloseMutation -> Bounded CloseMutation
forall a. a -> a -> Bounded a
$cminBound :: CloseMutation
minBound :: CloseMutation
$cmaxBound :: CloseMutation
maxBound :: CloseMutation
Bounded)

genCloseMutation :: (Tx, UTxO) -> Gen SomeMutation
genCloseMutation :: (Tx, UTxO) -> Gen SomeMutation
genCloseMutation (Tx
tx, UTxO
_utxo) =
  [Gen SomeMutation] -> Gen SomeMutation
forall a. [Gen a] -> Gen a
oneof
    [ Maybe Text -> CloseMutation -> 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) CloseMutation
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
Fixture.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 -> CloseMutation -> 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) CloseMutation
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
        [BuiltinByteString] -> Input
Head.Close ([BuiltinByteString] -> Input)
-> (MultiSignature (Snapshot Tx) -> [BuiltinByteString])
-> MultiSignature (Snapshot Tx)
-> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiSignature (Snapshot Tx) -> [BuiltinByteString]
forall {k} (a :: k). MultiSignature a -> [BuiltinByteString]
toPlutusSignatures (MultiSignature (Snapshot Tx) -> Input)
-> Gen (MultiSignature (Snapshot Tx)) -> Gen Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen (MultiSignature (Snapshot Tx))
forall a. Arbitrary a => Gen a
arbitrary :: Gen (MultiSignature (Snapshot Tx)))
    , Maybe Text -> CloseMutation -> 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
ClosedWithNonInitialHash) CloseMutation
MutateSnapshotNumberToLessThanEqualZero (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. Arbitrary a => Gen a
arbitrary 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
0)
        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
mutatedSnapshotNumber) TxOut CtxTx
headTxOut
    , Maybe Text -> CloseMutation -> 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) CloseMutation
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
healthyCloseSnapshotNumber)
        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 -> CloseMutation -> 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) CloseMutation
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
$
          Head.Open
            { $sel:parties:Initial :: [Party]
parties = [Party]
mutatedParties
            , $sel:utxoHash:Initial :: BuiltinByteString
utxoHash = BuiltinByteString
""
            , $sel:contestationPeriod:Initial :: ContestationPeriod
contestationPeriod = ContestationPeriod
healthyContestationPeriod
            , $sel:headId:Initial :: CurrencySymbol
headId = PolicyId -> CurrencySymbol
toPlutusCurrencySymbol PolicyId
Fixture.testPolicyId
            }
    , Maybe Text -> CloseMutation -> 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) CloseMutation
MutatePartiesInOutput (Mutation -> SomeMutation) -> Gen Mutation -> 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)
        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 -> CloseMutation -> 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) CloseMutation
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
    , Maybe Text -> CloseMutation -> 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) CloseMutation
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
somePartyCardanoVerificationKey)
        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 -> CloseMutation -> 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) CloseMutation
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 -> CloseMutation -> 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) CloseMutation
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
somePartyCardanoVerificationKey))
        let signerAndOthers :: [VerificationKey PaymentKey]
signerAndOthers = VerificationKey PaymentKey
somePartyCardanoVerificationKey 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 -> CloseMutation -> 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) CloseMutation
MutateCloseUTxOHash (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
healthyClosedUTxOHash) (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 (BuiltinByteString -> State -> State)
-> BuiltinByteString -> State -> State
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin ByteString
mutatedUTxOHash) TxOut CtxTx
headTxOut
    , Maybe Text -> CloseMutation -> 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
IncorrectClosedContestationDeadline) CloseMutation
MutateContestationDeadline (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        POSIXTime
mutatedDeadline <- Gen POSIXTime
genMutatedDeadline
        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 (POSIXTime -> State -> State
replaceContestationDeadline POSIXTime
mutatedDeadline) TxOut CtxTx
headTxOut
    , Maybe Text -> CloseMutation -> 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) CloseMutation
MutateContestationPeriod (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        ContestationPeriod
mutatedPeriod <- Gen ContestationPeriod
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
$ 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 (ContestationPeriod -> State -> State
replaceContestationPeriod ContestationPeriod
mutatedPeriod) TxOut CtxTx
headTxOut
    , Maybe Text -> CloseMutation -> 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
InfiniteLowerBound) CloseMutation
MutateInfiniteLowerBound (Mutation -> SomeMutation)
-> (TxValidityLowerBound -> Mutation)
-> TxValidityLowerBound
-> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxValidityLowerBound -> Mutation
ChangeValidityLowerBound (TxValidityLowerBound -> SomeMutation)
-> Gen TxValidityLowerBound -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        TxValidityLowerBound -> Gen TxValidityLowerBound
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxValidityLowerBound
TxValidityNoLowerBound
    , Maybe Text -> CloseMutation -> 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
InfiniteUpperBound) CloseMutation
MutateInfiniteUpperBound (Mutation -> SomeMutation)
-> (TxValidityUpperBound -> Mutation)
-> TxValidityUpperBound
-> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxValidityUpperBound -> Mutation
ChangeValidityUpperBound (TxValidityUpperBound -> SomeMutation)
-> Gen TxValidityUpperBound -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        TxValidityUpperBound -> Gen TxValidityUpperBound
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxValidityUpperBound
TxValidityNoUpperBound
    , Maybe Text -> CloseMutation -> 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
HasBoundedValidityCheckFailed) CloseMutation
MutateValidityInterval (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        (SlotNo
lowerSlotNo, SlotNo
upperSlotNo, POSIXTime
adjustedContestationDeadline) <- Gen (SlotNo, SlotNo, POSIXTime)
genOversizedTransactionValidity
        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
            [ (TxValidityLowerBound, TxValidityUpperBound) -> Mutation
ChangeValidityInterval (SlotNo -> TxValidityLowerBound
TxValidityLowerBound SlotNo
lowerSlotNo, SlotNo -> TxValidityUpperBound
TxValidityUpperBound SlotNo
upperSlotNo)
            , 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 (POSIXTime -> State -> State
replaceContestationDeadline POSIXTime
adjustedContestationDeadline) TxOut CtxTx
headTxOut
            ]
    , -- XXX: This is a bit confusing and not giving much value. Maybe we can remove this.
      -- This also seems to be covered by MutateRequiredSigner
      Maybe Text -> CloseMutation -> 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) CloseMutation
CloseFromDifferentHead (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
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
$
          [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
Fixture.testPolicyId PolicyId
otherHeadId TxOut CtxTx
headTxOut)
            , TxIn -> TxOut CtxUTxO Era -> Maybe HashableScriptData -> Mutation
ChangeInput
                TxIn
healthyOpenHeadTxIn
                (PolicyId -> PolicyId -> TxOut CtxUTxO Era -> TxOut CtxUTxO Era
forall a. PolicyId -> PolicyId -> TxOut a -> TxOut a
replacePolicyIdWith PolicyId
Fixture.testPolicyId PolicyId
otherHeadId TxOut CtxUTxO Era
healthyOpenHeadTxOut)
                ( 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.Close
                          { $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
healthyCloseSnapshotNumber
                          }
                      )
                )
            ]
    , Maybe Text -> CloseMutation -> 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) CloseMutation
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 -> CloseMutation -> 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
ContestersNonEmpty) CloseMutation
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
        [PubKeyHash]
mutatedContesters <- Gen PubKeyHash -> Gen [PubKeyHash]
forall a. Gen a -> Gen [a]
listOf1 (Gen PubKeyHash -> Gen [PubKeyHash])
-> Gen PubKeyHash -> Gen [PubKeyHash]
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> PubKeyHash
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
        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 ([PubKeyHash] -> State -> State
replaceContesters [PubKeyHash]
mutatedContesters)
    , Maybe Text -> CloseMutation -> 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) CloseMutation
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})
    ]
 where
  genOversizedTransactionValidity :: Gen (SlotNo, SlotNo, POSIXTime)
genOversizedTransactionValidity = do
    -- Implicit hypotheses: the slot length is and has always been 1 seconds so we can add slot with seconds
    Word64
lowerValidityBound <- Gen Word64
forall a. Arbitrary a => Gen a
arbitrary :: Gen Word64
    Word64
upperValidityBound <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
lowerValidityBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ SnapshotNumber -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral SnapshotNumber
healthyContestationPeriodSeconds, Word64
forall a. Bounded a => a
maxBound)
    let adjustedContestationDeadline :: POSIXTime
adjustedContestationDeadline =
          DiffMilliSeconds -> POSIXTime
fromMilliSeconds (DiffMilliSeconds -> POSIXTime)
-> (SnapshotNumber -> DiffMilliSeconds)
-> SnapshotNumber
-> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapshotNumber -> DiffMilliSeconds
DiffMilliSeconds (SnapshotNumber -> POSIXTime) -> SnapshotNumber -> POSIXTime
forall a b. (a -> b) -> a -> b
$ (SnapshotNumber
healthyContestationPeriodSeconds SnapshotNumber -> SnapshotNumber -> SnapshotNumber
forall a. Num a => a -> a -> a
+ Word64 -> SnapshotNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
upperValidityBound) SnapshotNumber -> SnapshotNumber -> SnapshotNumber
forall a. Num a => a -> a -> a
* SnapshotNumber
1000
    (SlotNo, SlotNo, POSIXTime) -> Gen (SlotNo, SlotNo, POSIXTime)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> SlotNo
SlotNo Word64
lowerValidityBound, Word64 -> SlotNo
SlotNo Word64
upperValidityBound, POSIXTime
adjustedContestationDeadline)

  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

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

-- | Mutations for the specific case of closing with the intial state.
-- We should probably validate all the mutation to this initial state but at
-- least we keep this regression test as we stumbled upon problems with the following case.
-- The nice thing to do would probably to generate either "normal" healthyCloseTx or
-- or healthyCloseInitialTx and apply all the mutations to it but we didn't manage to do that
-- right away.
genCloseInitialMutation :: (Tx, UTxO) -> Gen SomeMutation
genCloseInitialMutation :: (Tx, UTxO) -> Gen SomeMutation
genCloseInitialMutation (Tx
tx, UTxO
_utxo) =
  Maybe Text -> CloseInitialMutation -> 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
IncorrectClosedContestationDeadline) CloseInitialMutation
MutateCloseContestationDeadline' (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    POSIXTime
mutatedDeadline <- Gen POSIXTime
genMutatedDeadline
    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 (POSIXTime -> State -> State
replaceContestationDeadline POSIXTime
mutatedDeadline) 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

-- | Generate not acceptable, but interesting deadlines.
genMutatedDeadline :: Gen POSIXTime
genMutatedDeadline :: Gen POSIXTime
genMutatedDeadline = do
  [Gen POSIXTime] -> Gen POSIXTime
forall a. [Gen a] -> Gen a
oneof
    [ Gen POSIXTime
valuesAroundZero
    , Gen POSIXTime
valuesAroundDeadline
    ]
 where
  valuesAroundZero :: Gen POSIXTime
valuesAroundZero = Gen POSIXTime
forall a. Arbitrary a => Gen a
arbitrary Gen POSIXTime -> (POSIXTime -> Bool) -> Gen POSIXTime
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
/= POSIXTime
deadline)

  valuesAroundDeadline :: Gen POSIXTime
valuesAroundDeadline = Gen POSIXTime
forall a. Arbitrary a => Gen a
arbitrary Gen POSIXTime -> (POSIXTime -> Bool) -> Gen POSIXTime
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
/= POSIXTime
0) Gen POSIXTime -> (POSIXTime -> POSIXTime) -> Gen POSIXTime
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
deadline)

  deadline :: POSIXTime
deadline = UTCTime -> POSIXTime
posixFromUTCTime UTCTime
healthyContestationDeadline