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

module Hydra.Chain.Direct.Contract.FanOut where

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

import Cardano.Api.UTxO as UTxO
import Hydra.Chain.Direct.Contract.Mutation (Mutation (..), SomeMutation (..), changeMintedTokens)
import Hydra.Chain.Direct.Fixture (slotLength, systemStart, testNetworkId, testPolicyId, testSeedInput)
import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO)
import Hydra.Chain.Direct.Tx (fanoutTx, mkHeadOutput)
import Hydra.Contract.Error (toErrorCode)
import Hydra.Contract.HeadError (HeadError (..))
import Hydra.Contract.HeadState qualified as Head
import Hydra.Contract.HeadTokens (mkHeadTokenScript)
import Hydra.Data.ContestationPeriod qualified as OnChain
import Hydra.Ledger (IsTx (hashUTxO))
import Hydra.Ledger.Cardano (
  adaOnly,
  genOutput,
  genUTxOWithSimplifiedAddresses,
  genValue,
 )
import Hydra.Ledger.Cardano.Time (slotNoFromUTCTime, slotNoToUTCTime)
import Hydra.Party (Party, partyToChain, vkey)
import Hydra.Plutus.Extras (posixFromUTCTime)
import Hydra.Plutus.Orphans ()
import PlutusTx.Builtins (toBuiltin)
import Test.QuickCheck (choose, elements, oneof, suchThat)
import Test.QuickCheck.Instances ()

healthyFanoutTx :: (Tx, UTxO)
healthyFanoutTx :: (Tx, UTxO' (TxOut CtxUTxO Era))
healthyFanoutTx =
  (Tx
tx, UTxO' (TxOut CtxUTxO Era)
lookupUTxO)
 where
  lookupUTxO :: UTxO' (TxOut CtxUTxO Era)
lookupUTxO =
    (TxIn, TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall out. (TxIn, out) -> UTxO' out
UTxO.singleton (TxIn
headInput, TxOut CtxUTxO Era
headOutput)
      UTxO' (TxOut CtxUTxO Era)
-> UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall a. Semigroup a => a -> a -> a
<> ScriptRegistry -> UTxO' (TxOut CtxUTxO Era)
registryUTxO ScriptRegistry
scriptRegistry

  tx :: Tx
tx =
    ScriptRegistry
-> UTxO' (TxOut CtxUTxO Era)
-> (TxIn, TxOut CtxUTxO Era)
-> SlotNo
-> PlutusScript
-> Tx
fanoutTx
      ScriptRegistry
scriptRegistry
      UTxO' (TxOut CtxUTxO Era)
healthyFanoutUTxO
      (TxIn
headInput, TxOut CtxUTxO Era
headOutput)
      SlotNo
healthySlotNo
      PlutusScript
headTokenScript

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

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

  headTokenScript :: PlutusScript
headTokenScript = TxIn -> PlutusScript
mkHeadTokenScript TxIn
testSeedInput

  headOutput' :: TxOut CtxUTxO Era
headOutput' = NetworkId -> PolicyId -> TxOutDatum CtxUTxO -> TxOut CtxUTxO Era
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
healthyFanoutDatum)

  headOutput :: TxOut CtxUTxO Era
headOutput = (Value -> Value) -> TxOut CtxUTxO Era -> TxOut CtxUTxO Era
forall era ctx.
(IsMaryEraOnwards era, IsShelleyBasedEra era) =>
(Value -> Value) -> TxOut ctx era -> TxOut ctx era
modifyTxOutValue (Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
participationTokens) TxOut CtxUTxO Era
headOutput'

  participationTokens :: Value
participationTokens =
    [(AssetId, Quantity)] -> Value
valueFromList ([(AssetId, Quantity)] -> Value) -> [(AssetId, Quantity)] -> Value
forall a b. (a -> b) -> a -> b
$
      (Party -> (AssetId, Quantity)) -> [Party] -> [(AssetId, Quantity)]
forall a b. (a -> b) -> [a] -> [b]
map
        ( \Party
party ->
            (PolicyId -> AssetName -> AssetId
AssetId PolicyId
testPolicyId (ByteString -> AssetName
AssetName (ByteString -> AssetName)
-> (Party -> ByteString) -> Party -> AssetName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash HydraKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes (Hash HydraKey -> ByteString)
-> (Party -> Hash HydraKey) -> Party -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey HydraKey -> Hash HydraKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey HydraKey -> Hash HydraKey)
-> (Party -> VerificationKey HydraKey) -> Party -> Hash HydraKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Party -> VerificationKey HydraKey
vkey (Party -> AssetName) -> Party -> AssetName
forall a b. (a -> b) -> a -> b
$ Party
party), Quantity
1)
        )
        [Party]
healthyParties

healthyFanoutUTxO :: UTxO
healthyFanoutUTxO :: UTxO' (TxOut CtxUTxO Era)
healthyFanoutUTxO =
  -- FIXME: fanoutTx would result in 0 outputs and MutateChangeOutputValue below fail
  TxOut CtxUTxO Era -> TxOut CtxUTxO Era
adaOnly (TxOut CtxUTxO Era -> TxOut CtxUTxO Era)
-> UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (UTxO' (TxOut CtxUTxO Era)) -> Int -> UTxO' (TxOut CtxUTxO Era)
forall a. Gen a -> Int -> a
generateWith (Gen (UTxO' (TxOut CtxUTxO Era))
genUTxOWithSimplifiedAddresses Gen (UTxO' (TxOut CtxUTxO Era))
-> (UTxO' (TxOut CtxUTxO Era) -> Bool)
-> Gen (UTxO' (TxOut CtxUTxO Era))
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Bool -> Bool
not (Bool -> Bool)
-> (UTxO' (TxOut CtxUTxO Era) -> Bool)
-> UTxO' (TxOut CtxUTxO Era)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO' (TxOut CtxUTxO Era) -> Bool
forall a. UTxO' a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)) Int
42

healthySlotNo :: SlotNo
healthySlotNo :: SlotNo
healthySlotNo = Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary Gen SlotNo -> Int -> SlotNo
forall a. Gen a -> Int -> a
`generateWith` Int
42

healthyContestationDeadline :: UTCTime
healthyContestationDeadline :: UTCTime
healthyContestationDeadline =
  SystemStart -> SlotLength -> SlotNo -> UTCTime
slotNoToUTCTime SystemStart
systemStart SlotLength
slotLength (SlotNo -> UTCTime) -> SlotNo -> UTCTime
forall a b. (a -> b) -> a -> b
$ SlotNo
healthySlotNo SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
- SlotNo
1

healthyFanoutDatum :: Head.State
healthyFanoutDatum :: State
healthyFanoutDatum =
  Head.Closed
    { $sel:snapshotNumber:Initial :: SnapshotNumber
snapshotNumber = SnapshotNumber
1
    , $sel:utxoHash:Initial :: Hash
utxoHash = ByteString -> Hash
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (ByteString -> Hash) -> ByteString -> Hash
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @Tx UTxO' (TxOut CtxUTxO Era)
UTxOType Tx
healthyFanoutUTxO
    , $sel:parties:Initial :: [Party]
parties =
        Party -> Party
partyToChain (Party -> Party) -> [Party] -> [Party]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Party]
healthyParties
    , $sel:contestationDeadline:Initial :: POSIXTime
contestationDeadline = UTCTime -> POSIXTime
posixFromUTCTime UTCTime
healthyContestationDeadline
    , $sel:contestationPeriod:Initial :: ContestationPeriod
contestationPeriod = ContestationPeriod
healthyContestationPeriod
    , $sel:headId:Initial :: CurrencySymbol
headId = PolicyId -> CurrencySymbol
toPlutusCurrencySymbol PolicyId
testPolicyId
    , $sel:contesters:Initial :: [PubKeyHash]
contesters = []
    }
 where
  healthyContestationPeriodSeconds :: SnapshotNumber
healthyContestationPeriodSeconds = SnapshotNumber
10

  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

healthyParties :: [Party]
healthyParties :: [Party]
healthyParties =
  [ Gen Party -> Int -> Party
forall a. Gen a -> Int -> a
generateWith Gen Party
forall a. Arbitrary a => Gen a
arbitrary Int
i | Int
i <- [Int
1 .. Int
3]
  ]

data FanoutMutation
  = MutateAddUnexpectedOutput
  | MutateChangeOutputValue
  | MutateValidityBeforeDeadline
  | -- | Meant to test that the minting policy is burning all PTs and ST present in tx
    MutateThreadTokenQuantity
  deriving stock ((forall x. FanoutMutation -> Rep FanoutMutation x)
-> (forall x. Rep FanoutMutation x -> FanoutMutation)
-> Generic FanoutMutation
forall x. Rep FanoutMutation x -> FanoutMutation
forall x. FanoutMutation -> Rep FanoutMutation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FanoutMutation -> Rep FanoutMutation x
from :: forall x. FanoutMutation -> Rep FanoutMutation x
$cto :: forall x. Rep FanoutMutation x -> FanoutMutation
to :: forall x. Rep FanoutMutation x -> FanoutMutation
Generic, Int -> FanoutMutation -> ShowS
[FanoutMutation] -> ShowS
FanoutMutation -> String
(Int -> FanoutMutation -> ShowS)
-> (FanoutMutation -> String)
-> ([FanoutMutation] -> ShowS)
-> Show FanoutMutation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FanoutMutation -> ShowS
showsPrec :: Int -> FanoutMutation -> ShowS
$cshow :: FanoutMutation -> String
show :: FanoutMutation -> String
$cshowList :: [FanoutMutation] -> ShowS
showList :: [FanoutMutation] -> ShowS
Show, Int -> FanoutMutation
FanoutMutation -> Int
FanoutMutation -> [FanoutMutation]
FanoutMutation -> FanoutMutation
FanoutMutation -> FanoutMutation -> [FanoutMutation]
FanoutMutation
-> FanoutMutation -> FanoutMutation -> [FanoutMutation]
(FanoutMutation -> FanoutMutation)
-> (FanoutMutation -> FanoutMutation)
-> (Int -> FanoutMutation)
-> (FanoutMutation -> Int)
-> (FanoutMutation -> [FanoutMutation])
-> (FanoutMutation -> FanoutMutation -> [FanoutMutation])
-> (FanoutMutation -> FanoutMutation -> [FanoutMutation])
-> (FanoutMutation
    -> FanoutMutation -> FanoutMutation -> [FanoutMutation])
-> Enum FanoutMutation
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 :: FanoutMutation -> FanoutMutation
succ :: FanoutMutation -> FanoutMutation
$cpred :: FanoutMutation -> FanoutMutation
pred :: FanoutMutation -> FanoutMutation
$ctoEnum :: Int -> FanoutMutation
toEnum :: Int -> FanoutMutation
$cfromEnum :: FanoutMutation -> Int
fromEnum :: FanoutMutation -> Int
$cenumFrom :: FanoutMutation -> [FanoutMutation]
enumFrom :: FanoutMutation -> [FanoutMutation]
$cenumFromThen :: FanoutMutation -> FanoutMutation -> [FanoutMutation]
enumFromThen :: FanoutMutation -> FanoutMutation -> [FanoutMutation]
$cenumFromTo :: FanoutMutation -> FanoutMutation -> [FanoutMutation]
enumFromTo :: FanoutMutation -> FanoutMutation -> [FanoutMutation]
$cenumFromThenTo :: FanoutMutation
-> FanoutMutation -> FanoutMutation -> [FanoutMutation]
enumFromThenTo :: FanoutMutation
-> FanoutMutation -> FanoutMutation -> [FanoutMutation]
Enum, FanoutMutation
FanoutMutation -> FanoutMutation -> Bounded FanoutMutation
forall a. a -> a -> Bounded a
$cminBound :: FanoutMutation
minBound :: FanoutMutation
$cmaxBound :: FanoutMutation
maxBound :: FanoutMutation
Bounded)

genFanoutMutation :: (Tx, UTxO) -> Gen SomeMutation
genFanoutMutation :: (Tx, UTxO' (TxOut CtxUTxO Era)) -> Gen SomeMutation
genFanoutMutation (Tx
tx, UTxO' (TxOut CtxUTxO Era)
_utxo) =
  [Gen SomeMutation] -> Gen SomeMutation
forall a. [Gen a] -> Gen a
oneof
    [ Maybe Text -> FanoutMutation -> 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
FannedOutUtxoHashNotEqualToClosedUtxoHash) FanoutMutation
MutateAddUnexpectedOutput (Mutation -> SomeMutation)
-> (TxOut CtxTx -> Mutation) -> TxOut CtxTx -> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxTx -> Mutation
PrependOutput (TxOut CtxTx -> SomeMutation)
-> Gen (TxOut CtxTx) -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        Gen (VerificationKey PaymentKey)
forall a. Arbitrary a => Gen a
arbitrary Gen (VerificationKey PaymentKey)
-> (VerificationKey PaymentKey -> Gen (TxOut CtxTx))
-> Gen (TxOut CtxTx)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VerificationKey PaymentKey -> Gen (TxOut CtxTx)
forall ctx. VerificationKey PaymentKey -> Gen (TxOut ctx)
genOutput
    , Maybe Text -> FanoutMutation -> 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
FannedOutUtxoHashNotEqualToClosedUtxoHash) FanoutMutation
MutateChangeOutputValue (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        let outs :: [TxOut CtxTx]
outs = Tx -> [TxOut CtxTx]
forall era. Tx era -> [TxOut CtxTx era]
txOuts' Tx
tx
        -- NOTE: Assumes the fanout transaction has non-empty outputs, which
        -- might not be always the case when testing unbalanced txs and we need
        -- to ensure it by at least one utxo is in healthyFanoutUTxO
        (Int
ix, TxOut CtxTx
out) <- [(Int, TxOut CtxTx)] -> Gen (Int, TxOut CtxTx)
forall a. [a] -> Gen a
elements ([Int] -> [TxOut CtxTx] -> [(Int, TxOut CtxTx)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 .. [TxOut CtxTx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut CtxTx]
outs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] [TxOut CtxTx]
outs)
        Value
value' <- Gen Value
genValue Gen Value -> (Value -> Bool) -> Gen Value
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= TxOut CtxTx -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxTx
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 -> Mutation
ChangeOutput (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix) ((Value -> Value) -> TxOut CtxTx -> TxOut CtxTx
forall era ctx.
(IsMaryEraOnwards era, IsShelleyBasedEra era) =>
(Value -> Value) -> TxOut ctx era -> TxOut ctx era
modifyTxOutValue (Value -> Value -> Value
forall a b. a -> b -> a
const Value
value') TxOut CtxTx
out)
    , Maybe Text -> FanoutMutation -> 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
LowerBoundBeforeContestationDeadline) FanoutMutation
MutateValidityBeforeDeadline (Mutation -> SomeMutation)
-> ((TxValidityLowerBound, TxValidityUpperBound) -> Mutation)
-> (TxValidityLowerBound, TxValidityUpperBound)
-> SomeMutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxValidityLowerBound, TxValidityUpperBound) -> Mutation
ChangeValidityInterval ((TxValidityLowerBound, TxValidityUpperBound) -> SomeMutation)
-> Gen (TxValidityLowerBound, TxValidityUpperBound)
-> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        SlotNo
lb <- SlotNo -> Gen SlotNo
genSlotBefore (SlotNo -> Gen SlotNo) -> SlotNo -> Gen SlotNo
forall a b. (a -> b) -> a -> b
$ SystemStart -> SlotLength -> UTCTime -> SlotNo
slotNoFromUTCTime SystemStart
systemStart SlotLength
slotLength UTCTime
healthyContestationDeadline
        (TxValidityLowerBound, TxValidityUpperBound)
-> Gen (TxValidityLowerBound, TxValidityUpperBound)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo -> TxValidityLowerBound
TxValidityLowerBound SlotNo
lb, TxValidityUpperBound
TxValidityNoUpperBound)
    , Maybe Text -> FanoutMutation -> 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
BurntTokenNumberMismatch) FanoutMutation
MutateThreadTokenQuantity (Mutation -> SomeMutation) -> Gen Mutation -> Gen SomeMutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        (AssetId
token, Quantity
_) <- [(AssetId, Quantity)] -> Gen (AssetId, Quantity)
forall a. [a] -> Gen a
elements [(AssetId, Quantity)]
burntTokens
        Tx -> Value -> Gen Mutation
changeMintedTokens Tx
tx ([(AssetId, Quantity)] -> Value
valueFromList [(AssetId
token, Quantity
1)])
    ]
 where
  burntTokens :: [(AssetId, Quantity)]
burntTokens =
    case TxBodyContent ViewTx -> TxMintValue ViewTx
forall buidl. TxBodyContent buidl -> TxMintValue buidl
txMintValue (TxBodyContent ViewTx -> TxMintValue ViewTx)
-> TxBodyContent ViewTx -> TxMintValue ViewTx
forall a b. (a -> b) -> a -> b
$ TxBody -> TxBodyContent ViewTx
txBodyContent (TxBody -> TxBodyContent ViewTx) -> TxBody -> TxBodyContent ViewTx
forall a b. (a -> b) -> a -> b
$ Tx -> TxBody
txBody Tx
tx of
      TxMintValue ViewTx
TxMintValueNone -> Text -> [(AssetId, Quantity)]
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected minted value"
      TxMintValue Value
v BuildTxWith ViewTx (Map PolicyId (ScriptWitness WitCtxMint))
_ -> Value -> [(AssetId, Quantity)]
valueToList Value
v

  genSlotBefore :: SlotNo -> Gen SlotNo
genSlotBefore (SlotNo Word64
slot) = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
slot)