{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE NumericUnderscores  #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}

-- | Generators for constructing blockchains and transactions for use in property-based testing.
module Cardano.Node.Emulator.Generators(
    -- * Mockchain
    Mockchain(..),
    genMockchain,
    genMockchain',
    emptyChain,
    GeneratorModel(..),
    generatorModel,
    -- * Transactions
    genValidTransaction,
    genValidTransactionBody,
    genValidTransaction',
    genValidTransactionSpending,
    genValidTransactionSpending',
    genInitialTransaction,
    makeTx,
    -- * Assertions
    assertValid,
    -- * Time
    genInterval,
    genSlotRange,
    genTimeRange,
    genSlot,
    genPOSIXTime,
    genSlotConfig,
    -- * Etc.
    failOnCardanoError,
    genPolicyId,
    genAssetId,
    Gen.genAssetName,
    genSingleton,
    genValue,
    genValueNonNegative,
    genSizedByteString,
    genSeed,
    genPassphrase,
    splitVal,
    validateMockchain,
    signAll,
    CW.knownAddresses,
    CW.knownPaymentPublicKeys,
    CW.knownPaymentPrivateKeys,
    CW.knownPaymentKeys,
    knownXPrvs,
    alwaysSucceedPolicy,
    alwaysSucceedPolicyId,
    someTokenValue,
    Tx.emptyTxBodyContent
    ) where

import Cardano.Api qualified as C
import Cardano.Api.Shelley qualified as C
import Cardano.Crypto.Wallet qualified as Crypto
import Cardano.Node.Emulator.Internal.Node.Params (Params (pSlotConfig), testnet)
import Cardano.Node.Emulator.Internal.Node.TimeSlot (SlotConfig)
import Cardano.Node.Emulator.Internal.Node.TimeSlot qualified as TimeSlot
import Cardano.Node.Emulator.Internal.Node.Validation (validateCardanoTx)
import Control.Monad (guard, replicateM)
import Data.Bifunctor (Bifunctor (first))
import Data.ByteString qualified as BS
import Data.Default (Default (def), def)
import Data.Foldable (fold, foldl')
import Data.Functor (($>))
import Data.List (sort)
import Data.List qualified as List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe, isNothing)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.String (fromString)
import GHC.Stack (HasCallStack)
import Gen.Cardano.Api.Typed qualified as Gen
import Hedgehog (Gen, MonadGen, MonadTest, Range)
import Hedgehog qualified as H
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import Ledger (CardanoTx (CardanoEmulatorEraTx), Interval, MintingPolicy (getMintingPolicy),
               POSIXTime (POSIXTime, getPOSIXTime), POSIXTimeRange, Passphrase (Passphrase),
               PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey, Slot (Slot), SlotRange, TxOut,
               ValidationErrorInPhase, ValidationPhase (Phase1, Phase2), ValidationResult (FailPhase1, FailPhase2),
               addCardanoTxSignature, createGenesisTransaction, minLovelaceTxOutEstimated, pubKeyAddress, txOutValue)
import Ledger.CardanoWallet qualified as CW
import Ledger.Tx qualified as Tx
import Ledger.Tx.CardanoAPI (ToCardanoError, fromCardanoPlutusScript)
import Ledger.Tx.CardanoAPI qualified as C hiding (makeTransactionBody)
import Ledger.Value.CardanoAPI qualified as Value
import Numeric.Natural (Natural)
import Plutus.V1.Ledger.Api qualified as V1
import Plutus.V1.Ledger.Interval qualified as Interval
import Plutus.V1.Ledger.Scripts qualified as Script
import PlutusTx (toData)

-- | Attach signatures of all known private keys to a transaction.
signAll :: CardanoTx -> CardanoTx
signAll :: CardanoTx -> CardanoTx
signAll CardanoTx
tx = (CardanoTx -> PrivateKey -> CardanoTx)
-> CardanoTx -> [PrivateKey] -> CardanoTx
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((PrivateKey -> CardanoTx -> CardanoTx)
-> CardanoTx -> PrivateKey -> CardanoTx
forall a b c. (a -> b -> c) -> b -> a -> c
flip PrivateKey -> CardanoTx -> CardanoTx
addCardanoTxSignature) CardanoTx
tx
           ([PrivateKey] -> CardanoTx) -> [PrivateKey] -> CardanoTx
forall a b. (a -> b) -> a -> b
$ (PaymentPrivateKey -> PrivateKey)
-> [PaymentPrivateKey] -> [PrivateKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PaymentPrivateKey -> PrivateKey
unPaymentPrivateKey [PaymentPrivateKey]
CW.knownPaymentPrivateKeys

-- | The parameters for the generators in this module.
data GeneratorModel = GeneratorModel {
    GeneratorModel -> Map PaymentPubKey Lovelace
gmInitialBalance      :: !(Map PaymentPubKey C.Lovelace),
    -- ^ Value created at the beginning of the blockchain.
    GeneratorModel -> Set PaymentPubKey
gmPubKeys             :: !(Set PaymentPubKey),
    -- ^ Public keys that are to be used for generating transactions.
    GeneratorModel -> Maybe Natural
gmMaxCollateralInputs :: !(Maybe Natural)
    } deriving Int -> GeneratorModel -> ShowS
[GeneratorModel] -> ShowS
GeneratorModel -> String
(Int -> GeneratorModel -> ShowS)
-> (GeneratorModel -> String)
-> ([GeneratorModel] -> ShowS)
-> Show GeneratorModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeneratorModel] -> ShowS
$cshowList :: [GeneratorModel] -> ShowS
show :: GeneratorModel -> String
$cshow :: GeneratorModel -> String
showsPrec :: Int -> GeneratorModel -> ShowS
$cshowsPrec :: Int -> GeneratorModel -> ShowS
Show

-- | A generator model with some sensible defaults.
generatorModel :: GeneratorModel
generatorModel :: GeneratorModel
generatorModel =
    let vl :: Lovelace
vl = Integer -> Lovelace
C.Lovelace (Integer -> Lovelace) -> Integer -> Lovelace
forall a b. (a -> b) -> a -> b
$ Integer
1_000_000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100
        pubKeys :: [PaymentPubKey]
pubKeys = [PaymentPubKey]
CW.knownPaymentPublicKeys

    in
    GeneratorModel :: Map PaymentPubKey Lovelace
-> Set PaymentPubKey -> Maybe Natural -> GeneratorModel
GeneratorModel
    { gmInitialBalance :: Map PaymentPubKey Lovelace
gmInitialBalance = [(PaymentPubKey, Lovelace)] -> Map PaymentPubKey Lovelace
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PaymentPubKey, Lovelace)] -> Map PaymentPubKey Lovelace)
-> [(PaymentPubKey, Lovelace)] -> Map PaymentPubKey Lovelace
forall a b. (a -> b) -> a -> b
$ [PaymentPubKey] -> [Lovelace] -> [(PaymentPubKey, Lovelace)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PaymentPubKey]
pubKeys (Lovelace -> [Lovelace]
forall a. a -> [a]
repeat Lovelace
vl)
    , gmPubKeys :: Set PaymentPubKey
gmPubKeys        = [PaymentPubKey] -> Set PaymentPubKey
forall a. Ord a => [a] -> Set a
Set.fromList [PaymentPubKey]
pubKeys
    , gmMaxCollateralInputs :: Maybe Natural
gmMaxCollateralInputs = ProtocolParameters -> Maybe Natural
C.protocolParamMaxCollateralInputs ProtocolParameters
forall a. Default a => a
def
    }

-- | Blockchain for testing the emulator implementation and traces.
--
--   To avoid having to rely on functions from the implementation of
--   plutus-ledger (in particular, 'Ledger.Tx.unspentOutputs') we note the
--   unspent outputs of the chain when it is first created.
data Mockchain = Mockchain {
    Mockchain -> [CardanoTx]
mockchainInitialTxPool :: [CardanoTx],
    Mockchain -> Map TxIn TxOut
mockchainUtxo          :: Map C.TxIn TxOut,
    Mockchain -> Params
mockchainParams        :: Params
    } deriving Int -> Mockchain -> ShowS
[Mockchain] -> ShowS
Mockchain -> String
(Int -> Mockchain -> ShowS)
-> (Mockchain -> String)
-> ([Mockchain] -> ShowS)
-> Show Mockchain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mockchain] -> ShowS
$cshowList :: [Mockchain] -> ShowS
show :: Mockchain -> String
$cshow :: Mockchain -> String
showsPrec :: Int -> Mockchain -> ShowS
$cshowsPrec :: Int -> Mockchain -> ShowS
Show

-- | The empty mockchain.
emptyChain :: Mockchain
emptyChain :: Mockchain
emptyChain = [CardanoTx] -> Map TxIn TxOut -> Params -> Mockchain
Mockchain [] Map TxIn TxOut
forall k a. Map k a
Map.empty Params
forall a. Default a => a
def

-- | Generate a mockchain.
--
--   TODO: Generate more than 1 txn
genMockchain' ::
       GeneratorModel
    -> Gen Mockchain
genMockchain' :: GeneratorModel -> Gen Mockchain
genMockchain' GeneratorModel
gm = do
    SlotConfig
slotCfg <- GenT Identity SlotConfig
forall (m :: * -> *). MonadGen m => m SlotConfig
genSlotConfig
    (CardanoTx
txn, [TxOut]
ot) <- GeneratorModel -> Gen (CardanoTx, [TxOut])
genInitialTransaction GeneratorModel
gm
    let params :: Params
params = Params
forall a. Default a => a
def { pSlotConfig :: SlotConfig
pSlotConfig = SlotConfig
slotCfg }
        -- There is a problem that txId of emulator tx and tx of cardano tx are different.
        -- We convert the emulator tx to cardano tx here to get the correct transaction id
        -- because later we anyway will use the converted cardano tx so the utxo should match it.
        tid :: TxId
tid = CardanoTx -> TxId
Tx.getCardanoTxId CardanoTx
txn
    Mockchain -> Gen Mockchain
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mockchain :: [CardanoTx] -> Map TxIn TxOut -> Params -> Mockchain
Mockchain {
        mockchainInitialTxPool :: [CardanoTx]
mockchainInitialTxPool = [CardanoTx
txn],
        mockchainUtxo :: Map TxIn TxOut
mockchainUtxo = [(TxIn, TxOut)] -> Map TxIn TxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, TxOut)] -> Map TxIn TxOut)
-> [(TxIn, TxOut)] -> Map TxIn TxOut
forall a b. (a -> b) -> a -> b
$ (Word -> TxIn) -> (Word, TxOut) -> (TxIn, TxOut)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (TxId -> TxIx -> TxIn
C.TxIn TxId
tid (TxIx -> TxIn) -> (Word -> TxIx) -> Word -> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> TxIx
C.TxIx) ((Word, TxOut) -> (TxIn, TxOut))
-> [(Word, TxOut)] -> [(TxIn, TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word] -> [TxOut] -> [(Word, TxOut)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0..] [TxOut]
ot,
        mockchainParams :: Params
mockchainParams = Params
params
        }

-- | Generate a mockchain using the default 'GeneratorModel'.
--
genMockchain :: Gen Mockchain
genMockchain :: Gen Mockchain
genMockchain = GeneratorModel -> Gen Mockchain
genMockchain' GeneratorModel
generatorModel

-- | A transaction with no inputs that mints some value (to be used at the
--   beginning of a blockchain).
genInitialTransaction ::
       GeneratorModel
    -> Gen (CardanoTx, [TxOut])
genInitialTransaction :: GeneratorModel -> Gen (CardanoTx, [TxOut])
genInitialTransaction GeneratorModel{Maybe Natural
Map PaymentPubKey Lovelace
Set PaymentPubKey
gmMaxCollateralInputs :: Maybe Natural
gmPubKeys :: Set PaymentPubKey
gmInitialBalance :: Map PaymentPubKey Lovelace
gmMaxCollateralInputs :: GeneratorModel -> Maybe Natural
gmPubKeys :: GeneratorModel -> Set PaymentPubKey
gmInitialBalance :: GeneratorModel -> Map PaymentPubKey Lovelace
..} = do
    let pkAddr :: PaymentPubKey -> AddressInEra BabbageEra
pkAddr PaymentPubKey
pk = (ToCardanoError -> AddressInEra BabbageEra)
-> (AddressInEra BabbageEra -> AddressInEra BabbageEra)
-> Either ToCardanoError (AddressInEra BabbageEra)
-> AddressInEra BabbageEra
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> AddressInEra BabbageEra
forall a. HasCallStack => String -> a
error (String -> AddressInEra BabbageEra)
-> (ToCardanoError -> String)
-> ToCardanoError
-> AddressInEra BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> String
forall a. Show a => a -> String
show) AddressInEra BabbageEra -> AddressInEra BabbageEra
forall a. a -> a
id (Either ToCardanoError (AddressInEra BabbageEra)
 -> AddressInEra BabbageEra)
-> Either ToCardanoError (AddressInEra BabbageEra)
-> AddressInEra BabbageEra
forall a b. (a -> b) -> a -> b
$ NetworkId
-> Address -> Either ToCardanoError (AddressInEra BabbageEra)
C.toCardanoAddressInEra NetworkId
testnet (Address -> Either ToCardanoError (AddressInEra BabbageEra))
-> Address -> Either ToCardanoError (AddressInEra BabbageEra)
forall a b. (a -> b) -> a -> b
$ PaymentPubKey -> Maybe StakingCredential -> Address
pubKeyAddress PaymentPubKey
pk Maybe StakingCredential
forall a. Maybe a
Nothing
        initialDist :: Map (AddressInEra BabbageEra) Value
initialDist = (PaymentPubKey -> AddressInEra BabbageEra)
-> Map PaymentPubKey Value -> Map (AddressInEra BabbageEra) Value
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys PaymentPubKey -> AddressInEra BabbageEra
pkAddr (Map PaymentPubKey Value -> Map (AddressInEra BabbageEra) Value)
-> Map PaymentPubKey Value -> Map (AddressInEra BabbageEra) Value
forall a b. (a -> b) -> a -> b
$ (Lovelace -> Value)
-> Map PaymentPubKey Lovelace -> Map PaymentPubKey Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Lovelace -> Value
Value.lovelaceToValue Map PaymentPubKey Lovelace
gmInitialBalance
    let tx :: CardanoTx
tx@(CardanoEmulatorEraTx (C.Tx (C.TxBody TxBodyContent ViewTx BabbageEra
txBodyContent) [KeyWitness BabbageEra]
_)) = Map (AddressInEra BabbageEra) Value -> CardanoTx
createGenesisTransaction Map (AddressInEra BabbageEra) Value
initialDist
        txOuts :: [TxOut]
txOuts = TxOut CtxTx BabbageEra -> TxOut
Tx.TxOut (TxOut CtxTx BabbageEra -> TxOut)
-> [TxOut CtxTx BabbageEra] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBodyContent ViewTx BabbageEra -> [TxOut CtxTx BabbageEra]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
C.txOuts TxBodyContent ViewTx BabbageEra
txBodyContent
    (CardanoTx, [TxOut]) -> Gen (CardanoTx, [TxOut])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CardanoTx
tx, [TxOut]
txOuts)

-- | Generate a valid transaction, using the unspent outputs provided.
--   Fails if the there are no unspent outputs, or if the total value
--   of the unspent outputs is smaller than the minimum fee.
genValidTransaction
    :: Mockchain
    -> Gen CardanoTx
genValidTransaction :: Mockchain -> Gen CardanoTx
genValidTransaction = GeneratorModel -> Mockchain -> Gen CardanoTx
genValidTransaction' GeneratorModel
generatorModel

genValidTransactionBody
    :: Mockchain
    -> Gen (C.TxBodyContent C.BuildTx C.BabbageEra)
genValidTransactionBody :: Mockchain -> Gen (TxBodyContent BuildTx BabbageEra)
genValidTransactionBody = GeneratorModel
-> Mockchain -> Gen (TxBodyContent BuildTx BabbageEra)
genValidTransactionBody' GeneratorModel
generatorModel

-- | Generate a valid transaction, using the unspent outputs provided.
--   Fails if the there are no unspent outputs, or if the total value
--   of the unspent outputs is smaller than the estimated fee.
genValidTransaction'
    :: GeneratorModel
    -> Mockchain
    -> Gen CardanoTx
genValidTransaction' :: GeneratorModel -> Mockchain -> Gen CardanoTx
genValidTransaction' GeneratorModel
g Mockchain
chain = GeneratorModel
-> Mockchain -> Gen (TxBodyContent BuildTx BabbageEra)
genValidTransactionBody' GeneratorModel
g Mockchain
chain Gen (TxBodyContent BuildTx BabbageEra)
-> (TxBodyContent BuildTx BabbageEra -> Gen CardanoTx)
-> Gen CardanoTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxBodyContent BuildTx BabbageEra -> Gen CardanoTx
forall (m :: * -> *).
MonadFail m =>
TxBodyContent BuildTx BabbageEra -> m CardanoTx
makeTx

genValidTransactionSpending
    :: [C.TxIn]
    -> C.Value
    -> Gen CardanoTx
genValidTransactionSpending :: [TxIn] -> Value -> Gen CardanoTx
genValidTransactionSpending = GeneratorModel -> [TxIn] -> Value -> Gen CardanoTx
genValidTransactionSpending' GeneratorModel
generatorModel

genValidTransactionSpending'
    :: GeneratorModel
    -> [C.TxIn]
    -> C.Value
    -> Gen CardanoTx
genValidTransactionSpending' :: GeneratorModel -> [TxIn] -> Value -> Gen CardanoTx
genValidTransactionSpending' GeneratorModel
g [TxIn]
ins Value
totalVal =
    GeneratorModel
-> [TxIn] -> Value -> Gen (TxBodyContent BuildTx BabbageEra)
genValidTransactionBodySpending' GeneratorModel
g [TxIn]
ins Value
totalVal Gen (TxBodyContent BuildTx BabbageEra)
-> (TxBodyContent BuildTx BabbageEra -> Gen CardanoTx)
-> Gen CardanoTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxBodyContent BuildTx BabbageEra -> Gen CardanoTx
forall (m :: * -> *).
MonadFail m =>
TxBodyContent BuildTx BabbageEra -> m CardanoTx
makeTx


makeTx
    :: MonadFail m
    => C.TxBodyContent C.BuildTx C.BabbageEra
    -> m CardanoTx
makeTx :: TxBodyContent BuildTx BabbageEra -> m CardanoTx
makeTx TxBodyContent BuildTx BabbageEra
bodyContent = do
    TxBody BabbageEra
txBody <- (TxBodyError -> m (TxBody BabbageEra))
-> (TxBody BabbageEra -> m (TxBody BabbageEra))
-> Either TxBodyError (TxBody BabbageEra)
-> m (TxBody BabbageEra)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m (TxBody BabbageEra)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (TxBody BabbageEra))
-> (TxBodyError -> String) -> TxBodyError -> m (TxBody BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"makeTx: Can't create TxBody: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (TxBodyError -> String) -> TxBodyError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBodyError -> String
forall a. Show a => a -> String
show) TxBody BabbageEra -> m (TxBody BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TxBodyError (TxBody BabbageEra) -> m (TxBody BabbageEra))
-> Either TxBodyError (TxBody BabbageEra) -> m (TxBody BabbageEra)
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx BabbageEra
-> Either TxBodyError (TxBody BabbageEra)
forall era.
IsCardanoEra era =>
TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
C.makeTransactionBody TxBodyContent BuildTx BabbageEra
bodyContent
    CardanoTx -> m CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CardanoTx -> m CardanoTx) -> CardanoTx -> m CardanoTx
forall a b. (a -> b) -> a -> b
$ CardanoTx -> CardanoTx
signAll (CardanoTx -> CardanoTx) -> CardanoTx -> CardanoTx
forall a b. (a -> b) -> a -> b
$ Tx BabbageEra -> CardanoTx
CardanoEmulatorEraTx (Tx BabbageEra -> CardanoTx) -> Tx BabbageEra -> CardanoTx
forall a b. (a -> b) -> a -> b
$ TxBody BabbageEra -> [KeyWitness BabbageEra] -> Tx BabbageEra
forall era. TxBody era -> [KeyWitness era] -> Tx era
C.Tx TxBody BabbageEra
txBody []

-- | Generate a valid transaction, using the unspent outputs provided.
--   Fails if the there are no unspent outputs, or if the total value
--   of the unspent outputs is smaller than the estimated fee.
genValidTransactionBody'
    :: GeneratorModel
    -> Mockchain
    -> Gen (C.TxBodyContent C.BuildTx C.BabbageEra)
genValidTransactionBody' :: GeneratorModel
-> Mockchain -> Gen (TxBodyContent BuildTx BabbageEra)
genValidTransactionBody' GeneratorModel
g (Mockchain [CardanoTx]
_ Map TxIn TxOut
ops Params
_) = do
    -- Take a random number of UTXO from the input
    Int
nUtxo <- if Map TxIn TxOut -> Bool
forall k a. Map k a -> Bool
Map.null Map TxIn TxOut
ops
                then GenT Identity Int
forall (m :: * -> *) a. MonadGen m => m a
Gen.discard
                else Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 (Map TxIn TxOut -> Int
forall k a. Map k a -> Int
Map.size Map TxIn TxOut
ops))
    let ins :: [TxIn]
ins = (TxIn, TxOut) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, TxOut) -> TxIn) -> [(TxIn, TxOut)] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxIn, TxOut)]
inUTXO
        inUTXO :: [(TxIn, TxOut)]
inUTXO = Int -> [(TxIn, TxOut)] -> [(TxIn, TxOut)]
forall a. Int -> [a] -> [a]
take Int
nUtxo ([(TxIn, TxOut)] -> [(TxIn, TxOut)])
-> [(TxIn, TxOut)] -> [(TxIn, TxOut)]
forall a b. (a -> b) -> a -> b
$ Map TxIn TxOut -> [(TxIn, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn TxOut
ops
        totalVal :: Value
totalVal = ((TxIn, TxOut) -> Value) -> [(TxIn, TxOut)] -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TxOut -> Value
txOutValue (TxOut -> Value)
-> ((TxIn, TxOut) -> TxOut) -> (TxIn, TxOut) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, TxOut) -> TxOut
forall a b. (a, b) -> b
snd) [(TxIn, TxOut)]
inUTXO
    GeneratorModel
-> [TxIn] -> Value -> Gen (TxBodyContent BuildTx BabbageEra)
genValidTransactionBodySpending' GeneratorModel
g [TxIn]
ins Value
totalVal

genValidTransactionBodySpending'
    :: GeneratorModel
    -> [C.TxIn]
    -> C.Value
    -> Gen (C.TxBodyContent C.BuildTx C.BabbageEra)
genValidTransactionBodySpending' :: GeneratorModel
-> [TxIn] -> Value -> Gen (TxBodyContent BuildTx BabbageEra)
genValidTransactionBodySpending' GeneratorModel
g [TxIn]
ins Value
totalVal = do
    Integer
mintAmount <- Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> GenT Identity Int -> GenT Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
forall a. Bounded a => a
maxBound)
    AssetName
mintTokenName <- Gen AssetName
Gen.genAssetName
    let mintValue :: Maybe Value
mintValue = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
mintAmount Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) Maybe () -> Value -> Maybe Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AssetName -> Integer -> Value
someTokenValue AssetName
mintTokenName Integer
mintAmount
        fee' :: Lovelace
fee' = Integer -> Lovelace
C.Lovelace Integer
300000
        numOut :: Int
numOut = Set PaymentPubKey -> Int
forall a. Set a -> Int
Set.size (GeneratorModel -> Set PaymentPubKey
gmPubKeys GeneratorModel
g) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        totalValAda :: Lovelace
totalValAda = Value -> Lovelace
C.selectLovelace Value
totalVal
        totalValTokens :: Maybe Value
totalValTokens = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Value -> Bool
Value.isZero (Value -> Value
Value.noAdaValue Value
totalVal)) Maybe () -> Value -> Maybe Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Value -> Value
Value.noAdaValue Value
totalVal
        canPayTheFees :: Bool
canPayTheFees = Lovelace
fee' Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
< Lovelace
totalValAda
    Bool -> GenT Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
canPayTheFees
    -- We only split the Ada part of the input value
    [Lovelace]
splitOutVals <- Int -> Lovelace -> GenT Identity [Lovelace]
forall (m :: * -> *) n.
(MonadGen m, Integral n) =>
Int -> n -> m [n]
splitVal Int
numOut (Lovelace
totalValAda Lovelace -> Lovelace -> Lovelace
forall a. Num a => a -> a -> a
- Lovelace
fee')
    let outVals :: [Value]
outVals = case Maybe Value
totalValTokens Maybe Value -> Maybe Value -> Maybe Value
forall a. Semigroup a => a -> a -> a
<> Maybe Value
mintValue of
            Maybe Value
Nothing -> Lovelace -> Value
Value.lovelaceToValue (Lovelace -> Value) -> [Lovelace] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Lovelace]
splitOutVals
            Just Value
mv -> do
                -- If there is a minted value, we look for a value in the
                -- splitted values which can be associated with it.
                let outValForMint :: Lovelace
outValForMint =
                        Lovelace -> Maybe Lovelace -> Lovelace
forall a. a -> Maybe a -> a
fromMaybe Lovelace
forall a. Monoid a => a
mempty (Maybe Lovelace -> Lovelace) -> Maybe Lovelace -> Lovelace
forall a b. (a -> b) -> a -> b
$ (Lovelace -> Bool) -> [Lovelace] -> Maybe Lovelace
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
>= Lovelace
Ledger.minLovelaceTxOutEstimated)
                                         ([Lovelace] -> Maybe Lovelace) -> [Lovelace] -> Maybe Lovelace
forall a b. (a -> b) -> a -> b
$ [Lovelace] -> [Lovelace]
forall a. Ord a => [a] -> [a]
List.sort [Lovelace]
splitOutVals
                Lovelace -> Value
Value.lovelaceToValue Lovelace
outValForMint
                    Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
mv Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: (Lovelace -> Value) -> [Lovelace] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Lovelace -> Value
Value.lovelaceToValue (Lovelace -> [Lovelace] -> [Lovelace]
forall a. Eq a => a -> [a] -> [a]
List.delete Lovelace
outValForMint [Lovelace]
splitOutVals)
    [PaymentPubKey]
pubKeys <- [PaymentPubKey] -> GenT Identity [PaymentPubKey]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.shuffle ([PaymentPubKey] -> GenT Identity [PaymentPubKey])
-> [PaymentPubKey] -> GenT Identity [PaymentPubKey]
forall a b. (a -> b) -> a -> b
$ Set PaymentPubKey -> [PaymentPubKey]
forall a. Set a -> [a]
Set.toList (Set PaymentPubKey -> [PaymentPubKey])
-> Set PaymentPubKey -> [PaymentPubKey]
forall a b. (a -> b) -> a -> b
$ GeneratorModel -> Set PaymentPubKey
gmPubKeys GeneratorModel
g
    let txOutputs :: [TxOut]
txOutputs = (ToCardanoError -> [TxOut])
-> ([TxOut] -> [TxOut]) -> Either ToCardanoError [TxOut] -> [TxOut]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> [TxOut]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> [TxOut])
-> (ToCardanoError -> String) -> ToCardanoError -> [TxOut]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Cannot create outputs: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (ToCardanoError -> String) -> ToCardanoError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> String
forall a. Show a => a -> String
show) [TxOut] -> [TxOut]
forall a. a -> a
id
                    (Either ToCardanoError [TxOut] -> [TxOut])
-> Either ToCardanoError [TxOut] -> [TxOut]
forall a b. (a -> b) -> a -> b
$ ((Value, PaymentPubKey) -> Either ToCardanoError TxOut)
-> [(Value, PaymentPubKey)] -> Either ToCardanoError [TxOut]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Value
v, PaymentPubKey
ppk) -> Value
-> PaymentPubKey
-> Maybe StakingCredential
-> Either ToCardanoError TxOut
pubKeyTxOut Value
v PaymentPubKey
ppk Maybe StakingCredential
forall a. Maybe a
Nothing)
                    ([(Value, PaymentPubKey)] -> Either ToCardanoError [TxOut])
-> [(Value, PaymentPubKey)] -> Either ToCardanoError [TxOut]
forall a b. (a -> b) -> a -> b
$ [Value] -> [PaymentPubKey] -> [(Value, PaymentPubKey)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Value]
outVals [PaymentPubKey]
pubKeys
    ScriptWitness WitCtxMint BabbageEra
mintWitness <- Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
-> GenT Identity (ScriptWitness WitCtxMint BabbageEra)
forall (m :: * -> *) a.
MonadFail m =>
Either ToCardanoError a -> m a
failOnCardanoError (Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
 -> GenT Identity (ScriptWitness WitCtxMint BabbageEra))
-> Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
-> GenT Identity (ScriptWitness WitCtxMint BabbageEra)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra PlutusScriptV2 BabbageEra
-> PlutusScriptVersion PlutusScriptV2
-> PlutusScriptOrReferenceInput PlutusScriptV2
-> ScriptDatum WitCtxMint
-> ScriptRedeemer
-> ExecutionUnits
-> ScriptWitness WitCtxMint BabbageEra
forall lang era witctx.
ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> ScriptRedeemer
-> ExecutionUnits
-> ScriptWitness witctx era
C.PlutusScriptWitness ScriptLanguageInEra PlutusScriptV2 BabbageEra
C.PlutusScriptV2InBabbage PlutusScriptVersion PlutusScriptV2
C.PlutusScriptV2
                           (PlutusScriptOrReferenceInput PlutusScriptV2
 -> ScriptDatum WitCtxMint
 -> ScriptRedeemer
 -> ExecutionUnits
 -> ScriptWitness WitCtxMint BabbageEra)
-> Either
     ToCardanoError (PlutusScriptOrReferenceInput PlutusScriptV2)
-> Either
     ToCardanoError
     (ScriptDatum WitCtxMint
      -> ScriptRedeemer
      -> ExecutionUnits
      -> ScriptWitness WitCtxMint BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PlutusScript PlutusScriptV2
-> PlutusScriptOrReferenceInput PlutusScriptV2
forall lang. PlutusScript lang -> PlutusScriptOrReferenceInput lang
C.PScript (PlutusScript PlutusScriptV2
 -> PlutusScriptOrReferenceInput PlutusScriptV2)
-> Either ToCardanoError (PlutusScript PlutusScriptV2)
-> Either
     ToCardanoError (PlutusScriptOrReferenceInput PlutusScriptV2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (PlutusScript PlutusScriptV2)
-> Script -> Either ToCardanoError (PlutusScript PlutusScriptV2)
forall plutusScript.
SerialiseAsRawBytes plutusScript =>
AsType plutusScript -> Script -> Either ToCardanoError plutusScript
C.toCardanoPlutusScript
                                                  (AsType PlutusScriptV2 -> AsType (PlutusScript PlutusScriptV2)
forall lang. AsType lang -> AsType (PlutusScript lang)
C.AsPlutusScript AsType PlutusScriptV2
C.AsPlutusScriptV2)
                                                  (MintingPolicy -> Script
getMintingPolicy MintingPolicy
alwaysSucceedPolicy))
                           Either
  ToCardanoError
  (ScriptDatum WitCtxMint
   -> ScriptRedeemer
   -> ExecutionUnits
   -> ScriptWitness WitCtxMint BabbageEra)
-> Either ToCardanoError (ScriptDatum WitCtxMint)
-> Either
     ToCardanoError
     (ScriptRedeemer
      -> ExecutionUnits -> ScriptWitness WitCtxMint BabbageEra)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ScriptDatum WitCtxMint
-> Either ToCardanoError (ScriptDatum WitCtxMint)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatum WitCtxMint
C.NoScriptDatumForMint
                           Either
  ToCardanoError
  (ScriptRedeemer
   -> ExecutionUnits -> ScriptWitness WitCtxMint BabbageEra)
-> Either ToCardanoError ScriptRedeemer
-> Either
     ToCardanoError
     (ExecutionUnits -> ScriptWitness WitCtxMint BabbageEra)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ScriptRedeemer -> Either ToCardanoError ScriptRedeemer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Data -> ScriptRedeemer
C.fromPlutusData (Data -> ScriptRedeemer) -> Data -> ScriptRedeemer
forall a b. (a -> b) -> a -> b
$ Redeemer -> Data
forall a. ToData a => a -> Data
toData Redeemer
Script.unitRedeemer)
                           Either
  ToCardanoError
  (ExecutionUnits -> ScriptWitness WitCtxMint BabbageEra)
-> Either ToCardanoError ExecutionUnits
-> Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExecutionUnits -> Either ToCardanoError ExecutionUnits
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExecutionUnits
C.zeroExecutionUnits
    let txMintValue :: TxMintValue BuildTx BabbageEra
txMintValue = MultiAssetSupportedInEra BabbageEra
-> Value
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
-> TxMintValue BuildTx BabbageEra
forall era build.
MultiAssetSupportedInEra era
-> Value
-> BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue build era
C.TxMintValue MultiAssetSupportedInEra BabbageEra
C.MultiAssetInBabbageEra (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
forall a. Monoid a => a
mempty Maybe Value
mintValue)
                          (Map PolicyId (ScriptWitness WitCtxMint BabbageEra)
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
forall a. a -> BuildTxWith BuildTx a
C.BuildTxWith (PolicyId
-> ScriptWitness WitCtxMint BabbageEra
-> Map PolicyId (ScriptWitness WitCtxMint BabbageEra)
forall k a. k -> a -> Map k a
Map.singleton PolicyId
alwaysSucceedPolicyId ScriptWitness WitCtxMint BabbageEra
mintWitness))
        txIns :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
txIns = (TxIn
 -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> [TxIn]
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
forall a b. (a -> b) -> [a] -> [b]
map (, Witness WitCtxTxIn BabbageEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)
forall a. a -> BuildTxWith BuildTx a
C.BuildTxWith (Witness WitCtxTxIn BabbageEra
 -> BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
-> Witness WitCtxTxIn BabbageEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn BabbageEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
C.KeyWitness KeyWitnessInCtx WitCtxTxIn
C.KeyWitnessForSpending) [TxIn]
ins
    TxInsCollateral BabbageEra
txInsCollateral <- GenT Identity (TxInsCollateral BabbageEra)
-> (Natural -> GenT Identity (TxInsCollateral BabbageEra))
-> Maybe Natural
-> GenT Identity (TxInsCollateral BabbageEra)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (String -> GenT Identity (TxInsCollateral BabbageEra)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot gen collateral")
        (TxInsCollateral BabbageEra
-> GenT Identity (TxInsCollateral BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxInsCollateral BabbageEra
 -> GenT Identity (TxInsCollateral BabbageEra))
-> (Natural -> TxInsCollateral BabbageEra)
-> Natural
-> GenT Identity (TxInsCollateral BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollateralSupportedInEra BabbageEra
-> [TxIn] -> TxInsCollateral BabbageEra
forall era.
CollateralSupportedInEra era -> [TxIn] -> TxInsCollateral era
C.TxInsCollateral CollateralSupportedInEra BabbageEra
C.CollateralInBabbageEra ([TxIn] -> TxInsCollateral BabbageEra)
-> (Natural -> [TxIn]) -> Natural -> TxInsCollateral BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [TxIn] -> [TxIn]) -> [TxIn] -> Int -> [TxIn]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [TxIn] -> [TxIn]
forall a. Int -> [a] -> [a]
take [TxIn]
ins (Int -> [TxIn]) -> (Natural -> Int) -> Natural -> [TxIn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
        (GeneratorModel -> Maybe Natural
gmMaxCollateralInputs GeneratorModel
g)
    TxBodyContent BuildTx BabbageEra
-> Gen (TxBodyContent BuildTx BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBodyContent BuildTx BabbageEra
 -> Gen (TxBodyContent BuildTx BabbageEra))
-> TxBodyContent BuildTx BabbageEra
-> Gen (TxBodyContent BuildTx BabbageEra)
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx BabbageEra
Tx.emptyTxBodyContent
           { [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
txIns :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
txIns :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
C.txIns
           , TxInsCollateral BabbageEra
txInsCollateral :: TxInsCollateral BabbageEra
txInsCollateral :: TxInsCollateral BabbageEra
C.txInsCollateral
           , TxMintValue BuildTx BabbageEra
txMintValue :: TxMintValue BuildTx BabbageEra
txMintValue :: TxMintValue BuildTx BabbageEra
C.txMintValue
           , txFee :: TxFee BabbageEra
C.txFee = Lovelace -> TxFee BabbageEra
C.toCardanoFee Lovelace
fee'
           , txOuts :: [TxOut CtxTx BabbageEra]
C.txOuts = TxOut -> TxOut CtxTx BabbageEra
Tx.getTxOut (TxOut -> TxOut CtxTx BabbageEra)
-> [TxOut] -> [TxOut CtxTx BabbageEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut]
txOutputs
           }

-- | Create a transaction output locked by a public payment key and optionnaly a public stake key.
pubKeyTxOut :: C.Value -> PaymentPubKey -> Maybe V1.StakingCredential -> Either ToCardanoError TxOut
pubKeyTxOut :: Value
-> PaymentPubKey
-> Maybe StakingCredential
-> Either ToCardanoError TxOut
pubKeyTxOut Value
v PaymentPubKey
pk Maybe StakingCredential
sk = do
  AddressInEra BabbageEra
aie <- NetworkId
-> Address -> Either ToCardanoError (AddressInEra BabbageEra)
C.toCardanoAddressInEra NetworkId
testnet (Address -> Either ToCardanoError (AddressInEra BabbageEra))
-> Address -> Either ToCardanoError (AddressInEra BabbageEra)
forall a b. (a -> b) -> a -> b
$ PaymentPubKey -> Maybe StakingCredential -> Address
pubKeyAddress PaymentPubKey
pk Maybe StakingCredential
sk
  TxOut -> Either ToCardanoError TxOut
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut -> Either ToCardanoError TxOut)
-> TxOut -> Either ToCardanoError TxOut
forall a b. (a -> b) -> a -> b
$ TxOut CtxTx BabbageEra -> TxOut
Tx.TxOut (TxOut CtxTx BabbageEra -> TxOut)
-> TxOut CtxTx BabbageEra -> TxOut
forall a b. (a -> b) -> a -> b
$ AddressInEra BabbageEra
-> TxOutValue BabbageEra
-> TxOutDatum CtxTx BabbageEra
-> ReferenceScript BabbageEra
-> TxOut CtxTx BabbageEra
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
C.TxOut AddressInEra BabbageEra
aie (Value -> TxOutValue BabbageEra
C.toCardanoTxOutValue Value
v) TxOutDatum CtxTx BabbageEra
forall ctx era. TxOutDatum ctx era
C.TxOutDatumNone ReferenceScript BabbageEra
forall era. ReferenceScript era
C.ReferenceScriptNone

-- | Validate a transaction in a mockchain.
validateMockchain :: Mockchain -> CardanoTx -> Maybe Ledger.ValidationErrorInPhase
validateMockchain :: Mockchain -> CardanoTx -> Maybe ValidationErrorInPhase
validateMockchain (Mockchain [CardanoTx]
_ Map TxIn TxOut
utxo Params
params) CardanoTx
tx = Maybe ValidationErrorInPhase
result where
    cUtxoIndex :: UTxO BabbageEra
cUtxoIndex = Map TxIn (TxOut CtxUTxO BabbageEra) -> UTxO BabbageEra
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
C.UTxO (Map TxIn (TxOut CtxUTxO BabbageEra) -> UTxO BabbageEra)
-> Map TxIn (TxOut CtxUTxO BabbageEra) -> UTxO BabbageEra
forall a b. (a -> b) -> a -> b
$ TxOut -> TxOut CtxUTxO BabbageEra
Tx.toCtxUTxOTxOut (TxOut -> TxOut CtxUTxO BabbageEra)
-> Map TxIn TxOut -> Map TxIn (TxOut CtxUTxO BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxIn TxOut
utxo
    result :: Maybe ValidationErrorInPhase
result = case Params -> Slot -> UTxO BabbageEra -> CardanoTx -> ValidationResult
validateCardanoTx Params
params Slot
1 UTxO BabbageEra
cUtxoIndex CardanoTx
tx of
        FailPhase1 CardanoTx
_ ValidationError
err   -> ValidationErrorInPhase -> Maybe ValidationErrorInPhase
forall a. a -> Maybe a
Just (ValidationPhase
Phase1, ValidationError
err)
        FailPhase2 OnChainTx
_ ValidationError
err Value
_ -> ValidationErrorInPhase -> Maybe ValidationErrorInPhase
forall a. a -> Maybe a
Just (ValidationPhase
Phase2, ValidationError
err)
        ValidationResult
_                  -> Maybe ValidationErrorInPhase
forall a. Maybe a
Nothing

-- | Generate an 'Interval where the lower bound if less or equal than the
-- upper bound.
genInterval :: (MonadFail m, Ord a)
            => m a
            -> m (Interval a)
genInterval :: m a -> m (Interval a)
genInterval m a
gen = do
    [a
b, a
e] <- [a] -> [a]
forall a. Ord a => [a] -> [a]
sort ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 m a
gen
    Interval a -> m (Interval a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval a -> m (Interval a)) -> Interval a -> m (Interval a)
forall a b. (a -> b) -> a -> b
$ a -> a -> Interval a
forall a. a -> a -> Interval a
Interval.interval a
b a
e

-- | Generate a 'SlotRange' where the lower bound if less or equal than the
-- upper bound.
genSlotRange :: (MonadFail m, Hedgehog.MonadGen m) => m SlotRange
genSlotRange :: m SlotRange
genSlotRange = m Slot -> m SlotRange
forall (m :: * -> *) a.
(MonadFail m, Ord a) =>
m a -> m (Interval a)
genInterval m Slot
forall (m :: * -> *). MonadGen m => m Slot
genSlot

-- | Generate a 'POSIXTimeRange' where the lower bound if less or equal than the
-- upper bound.
genTimeRange :: (MonadFail m, Hedgehog.MonadGen m) => SlotConfig -> m POSIXTimeRange
genTimeRange :: SlotConfig -> m POSIXTimeRange
genTimeRange SlotConfig
sc = m POSIXTime -> m POSIXTimeRange
forall (m :: * -> *) a.
(MonadFail m, Ord a) =>
m a -> m (Interval a)
genInterval (m POSIXTime -> m POSIXTimeRange)
-> m POSIXTime -> m POSIXTimeRange
forall a b. (a -> b) -> a -> b
$ SlotConfig -> m POSIXTime
forall (m :: * -> *). MonadGen m => SlotConfig -> m POSIXTime
genPOSIXTime SlotConfig
sc

-- | Generate a 'Slot' where the lowest slot number is 0.
genSlot :: (Hedgehog.MonadGen m) => m Slot
genSlot :: m Slot
genSlot = Integer -> Slot
Slot (Integer -> Slot) -> m Integer -> m Slot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Integer -> m Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 Integer
10000)

-- | Generate a 'POSIXTime' where the lowest value is 'scSlotZeroTime' given a
-- 'SlotConfig'.
genPOSIXTime :: (Hedgehog.MonadGen m) => SlotConfig -> m POSIXTime
genPOSIXTime :: SlotConfig -> m POSIXTime
genPOSIXTime SlotConfig
sc = do
    let beginTime :: Integer
beginTime = POSIXTime -> Integer
getPOSIXTime (POSIXTime -> Integer) -> POSIXTime -> Integer
forall a b. (a -> b) -> a -> b
$ SlotConfig -> POSIXTime
TimeSlot.scSlotZeroTime SlotConfig
sc
    Integer -> POSIXTime
POSIXTime (Integer -> POSIXTime) -> m Integer -> m POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Integer -> m Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> Range a
Range.linear Integer
beginTime (Integer
beginTime Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
10000000))

-- | Generate a 'SlotConfig' where the slot length goes from 1 to 100000
-- ms and the time of Slot 0 is the default 'scSlotZeroTime'.
genSlotConfig :: Hedgehog.MonadGen m => m SlotConfig
genSlotConfig :: m SlotConfig
genSlotConfig = do
    Integer
sl <- Range Integer -> m Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> Range a
Range.linear Integer
1 Integer
1000000)
    SlotConfig -> m SlotConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (SlotConfig -> m SlotConfig) -> SlotConfig -> m SlotConfig
forall a b. (a -> b) -> a -> b
$ SlotConfig
forall a. Default a => a
def { scSlotLength :: Integer
TimeSlot.scSlotLength = Integer
sl }

-- | Generate a 'ByteString s' of up to @s@ bytes.
genSizedByteString :: forall m. MonadGen m => Int -> m BS.ByteString
genSizedByteString :: Int -> m ByteString
genSizedByteString Int
s =
    let range :: Range Int
range = Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
s
    in Range Int -> m ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes Range Int
range

-- Copied from Gen.Cardano.Api.Typed, because it's not exported.
genPolicyId :: Gen C.PolicyId
genPolicyId :: Gen PolicyId
genPolicyId =
  [(Int, Gen PolicyId)] -> Gen PolicyId
forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
Gen.frequency
      -- mostly from a small number of choices, so we get plenty of repetition
    [ (Int
9, [PolicyId] -> Gen PolicyId
forall (m :: * -> *) a. MonadGen m => [a] -> m a
Gen.element [ String -> PolicyId
forall a. IsString a => String -> a
fromString (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
55 Char
'0') | Char
x <- [Char
'a'..Char
'c'] ])

       -- and some from the full range of the type
    , (Int
1, ScriptHash -> PolicyId
C.PolicyId (ScriptHash -> PolicyId)
-> GenT Identity ScriptHash -> Gen PolicyId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity ScriptHash
Gen.genScriptHash)
    ]

-- Copied from Gen.Cardano.Api.Typed, because it's not exported.
genAssetId :: Gen C.AssetId
genAssetId :: Gen AssetId
genAssetId = [Gen AssetId] -> Gen AssetId
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ PolicyId -> AssetName -> AssetId
C.AssetId (PolicyId -> AssetName -> AssetId)
-> Gen PolicyId -> GenT Identity (AssetName -> AssetId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PolicyId
genPolicyId GenT Identity (AssetName -> AssetId)
-> Gen AssetName -> Gen AssetId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen AssetName
Gen.genAssetName
    , AssetId -> Gen AssetId
forall (m :: * -> *) a. Monad m => a -> m a
return AssetId
C.AdaAssetId
    ]

genSingleton :: Range Integer -> Gen C.Value
genSingleton :: Range Integer -> Gen Value
genSingleton Range Integer
range = AssetId -> Integer -> Value
Value.assetIdValue (AssetId -> Integer -> Value)
-> Gen AssetId -> GenT Identity (Integer -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AssetId
genAssetId GenT Identity (Integer -> Value)
-> GenT Identity Integer -> Gen Value
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Integer -> GenT Identity Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral Range Integer
range

genValue' :: Range Integer -> Gen C.Value
genValue' :: Range Integer -> Gen Value
genValue' Range Integer
valueRange = do
    let
        -- generate values with no more than 5 elements to avoid the tests
        -- taking too long (due to the map-as-list-of-kv-pairs implementation)
        maxCurrencies :: Int
maxCurrencies = Int
5

    Int
numValues <- Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
maxCurrencies)
    [Value] -> Value
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Value] -> Value) -> GenT Identity [Value] -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen Value) -> [Int] -> GenT Identity [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Gen Value -> Int -> Gen Value
forall a b. a -> b -> a
const (Gen Value -> Int -> Gen Value) -> Gen Value -> Int -> Gen Value
forall a b. (a -> b) -> a -> b
$ Range Integer -> Gen Value
genSingleton Range Integer
valueRange) [Int
0 .. Int
numValues]

-- | Generate a 'Value' with a value range of @minBound .. maxBound@.
genValue :: Gen C.Value
genValue :: Gen Value
genValue = Range Integer -> Gen Value
genValue' (Range Integer -> Gen Value) -> Range Integer -> Gen Value
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Range Int -> Range Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bounded Int, Integral Int) => Range Int
forall a. (Bounded a, Integral a) => Range a
Range.linearBounded @Int

-- | Generate a 'Value' with a value range of @0 .. maxBound@.
genValueNonNegative :: Gen C.Value
genValueNonNegative :: Gen Value
genValueNonNegative = Range Integer -> Gen Value
genValue' (Range Integer -> Gen Value) -> Range Integer -> Gen Value
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Range Int -> Range Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear @Int Int
0 Int
forall a. Bounded a => a
maxBound

-- | Assert that a transaction is valid in a chain.
assertValid :: (MonadTest m, HasCallStack)
    => CardanoTx
    -> Mockchain
    -> m ()
assertValid :: CardanoTx -> Mockchain -> m ()
assertValid CardanoTx
tx Mockchain
mc = let res :: Maybe ValidationErrorInPhase
res = Mockchain -> CardanoTx -> Maybe ValidationErrorInPhase
validateMockchain Mockchain
mc CardanoTx
tx in do
    Maybe ValidationErrorInPhase -> m ()
forall (m :: * -> *) a.
(MonadTest m, Show a, HasCallStack) =>
a -> m ()
H.annotateShow Maybe ValidationErrorInPhase
res
    Bool -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
H.assert (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe ValidationErrorInPhase -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ValidationErrorInPhase
res

{- | Split a value into max. n positive-valued parts such that the sum of the
     parts equals the original value. Each part should contain the required
     minimum amount of Ada.

     I noticed how for values of `mx` > 1000 the resulting lists are much smaller than
     one would expect. I think this may be caused by the way we select the next value
     for the split. It looks like the available funds get exhausted quite fast, which
     makes the function return before generating anything close to `mx` values.
-}
splitVal :: (MonadGen m, Integral n) => Int -> n -> m [n]
splitVal :: Int -> n -> m [n]
splitVal Int
_  n
0     = [n] -> m [n]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
splitVal Int
mx n
init' = Int -> n -> [n] -> m [n]
go Int
0 n
0 [] where
    go :: Int -> n -> [n] -> m [n]
go Int
i n
c [n]
l =
        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int
forall a. Enum a => a -> a
pred Int
mx Bool -> Bool -> Bool
|| n
init' n -> n -> n
forall a. Num a => a -> a -> a
- n
c n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
2 n -> n -> n
forall a. Num a => a -> a -> a
* n
minAda
        then [n] -> m [n]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([n] -> m [n]) -> [n] -> m [n]
forall a b. (a -> b) -> a -> b
$ (n
init' n -> n -> n
forall a. Num a => a -> a -> a
- n
c) n -> [n] -> [n]
forall a. a -> [a] -> [a]
: [n]
l
        else do
            n
v <- Range n -> m n
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (n -> n -> Range n
forall a. Integral a => a -> a -> Range a
Range.linear n
minAda (n -> Range n) -> n -> Range n
forall a b. (a -> b) -> a -> b
$ n
init' n -> n -> n
forall a. Num a => a -> a -> a
- n
c n -> n -> n
forall a. Num a => a -> a -> a
- n
minAda)
            if n
v n -> n -> n
forall a. Num a => a -> a -> a
+ n
c n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
init'
            then [n] -> m [n]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([n] -> m [n]) -> [n] -> m [n]
forall a b. (a -> b) -> a -> b
$ n
v n -> [n] -> [n]
forall a. a -> [a] -> [a]
: [n]
l
            else Int -> n -> [n] -> m [n]
go (Int -> Int
forall a. Enum a => a -> a
succ Int
i) (n
v n -> n -> n
forall a. Num a => a -> a -> a
+ n
c) (n
v n -> [n] -> [n]
forall a. a -> [a] -> [a]
: [n]
l)
    minAda :: n
minAda = n
3_000_000 -- For fee and min Ada for tx outs

knownXPrvs :: [Crypto.XPrv]
knownXPrvs :: [PrivateKey]
knownXPrvs = PaymentPrivateKey -> PrivateKey
unPaymentPrivateKey (PaymentPrivateKey -> PrivateKey)
-> [PaymentPrivateKey] -> [PrivateKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PaymentPrivateKey]
CW.knownPaymentPrivateKeys

-- | Seed suitable for testing a seed but not for actual wallets as ScrubbedBytes isn't used to ensure
--  memory isn't inspectable
genSeed :: MonadGen m => m BS.ByteString
genSeed :: m ByteString
genSeed =  Range Int -> m ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Range Int -> m ByteString) -> Range Int -> m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Range Int
forall a. a -> Range a
Range.singleton Int
32

genPassphrase :: MonadGen m => m Passphrase
genPassphrase :: m Passphrase
genPassphrase =
  ByteString -> Passphrase
Passphrase (ByteString -> Passphrase) -> m ByteString -> m Passphrase
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m Char -> m ByteString
forall (m :: * -> *).
MonadGen m =>
Range Int -> m Char -> m ByteString
Gen.utf8 (Int -> Range Int
forall a. a -> Range a
Range.singleton Int
16) m Char
forall (m :: * -> *). MonadGen m => m Char
Gen.unicode

alwaysSucceedPolicy :: Script.MintingPolicy
alwaysSucceedPolicy :: MintingPolicy
alwaysSucceedPolicy = Script -> MintingPolicy
Script.MintingPolicy (PlutusScript PlutusScriptV1 -> Script
forall lang. HasTypeProxy lang => PlutusScript lang -> Script
fromCardanoPlutusScript (PlutusScript PlutusScriptV1 -> Script)
-> PlutusScript PlutusScriptV1 -> Script
forall a b. (a -> b) -> a -> b
$ WitCtx WitCtxMint -> PlutusScript PlutusScriptV1
forall witctx. WitCtx witctx -> PlutusScript PlutusScriptV1
C.examplePlutusScriptAlwaysSucceeds WitCtx WitCtxMint
C.WitCtxMint)

alwaysSucceedPolicyId :: C.PolicyId
alwaysSucceedPolicyId :: PolicyId
alwaysSucceedPolicyId = Script PlutusScriptV1 -> PolicyId
forall lang. Script lang -> PolicyId
C.scriptPolicyId (PlutusScriptVersion PlutusScriptV1
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion PlutusScriptV1
C.PlutusScriptV1 (PlutusScript PlutusScriptV1 -> Script PlutusScriptV1)
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall a b. (a -> b) -> a -> b
$ WitCtx WitCtxMint -> PlutusScript PlutusScriptV1
forall witctx. WitCtx witctx -> PlutusScript PlutusScriptV1
C.examplePlutusScriptAlwaysSucceeds WitCtx WitCtxMint
C.WitCtxMint)

someTokenValue :: C.AssetName -> Integer -> C.Value
someTokenValue :: AssetName -> Integer -> Value
someTokenValue AssetName
an Integer
i = [(AssetId, Quantity)] -> Value
C.valueFromList [(PolicyId -> AssetName -> AssetId
C.AssetId PolicyId
alwaysSucceedPolicyId AssetName
an, Integer -> Quantity
C.Quantity Integer
i)]

-- | Catch cardano error and fail wi it
failOnCardanoError :: MonadFail m => Either C.ToCardanoError a -> m a
failOnCardanoError :: Either ToCardanoError a -> m a
failOnCardanoError = (ToCardanoError -> m a)
-> (a -> m a) -> Either ToCardanoError a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a)
-> (ToCardanoError -> String) -> ToCardanoError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> String
forall a. Show a => a -> String
show) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure