{-# 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(..),
    TxInputWitnessed(..),
    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,
    genSizedByteStringExact,
    genSeed,
    genPassphrase,
    splitVal,
    validateMockchain,
    signAll,
    CW.knownAddresses,
    CW.knownPaymentPublicKeys,
    CW.knownPaymentPrivateKeys,
    CW.knownPaymentKeys,
    knownXPrvs,
    alwaysSucceedPolicy,
    alwaysSucceedPolicyId,
    someTokenValue,
    emptyTxBodyContent
    ) where

import Control.Monad (guard, replicateM)
import Data.Bifunctor (Bifunctor (first))
import Data.ByteString qualified as BS
import Data.Default (Default (def), def)
import Data.Either.Combinators (leftToMaybe)
import Data.Foldable (fold, foldl')
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 GHC.Stack (HasCallStack)
import Gen.Cardano.Api.Typed qualified as Gen
import Hedgehog
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range

import Cardano.Api qualified as C
import Cardano.Api.Shelley (ProtocolParameters (..))
import Cardano.Api.Shelley qualified as C
import Cardano.Crypto.Wallet qualified as Crypto
import Cardano.Node.Emulator.Params (Params (pSlotConfig))
import Cardano.Node.Emulator.TimeSlot (SlotConfig)
import Cardano.Node.Emulator.TimeSlot qualified as TimeSlot
import Cardano.Node.Emulator.Validation (validateCardanoTx)
import Control.Lens.Lens ((<&>))
import Data.Functor (($>))
import Data.String (fromString)
import Gen.Cardano.Api.Typed (genTxIn)
import Ledger (CardanoTx (CardanoEmulatorEraTx), Interval, MintingPolicy (getMintingPolicy),
               POSIXTime (POSIXTime, getPOSIXTime), POSIXTimeRange, Passphrase (Passphrase),
               PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey, Slot (Slot), SlotRange,
               TxInType (ConsumePublicKeyAddress, ConsumeSimpleScriptAddress, ScriptAddress), TxInput, TxInputType,
               TxOut, TxOutRef (TxOutRef), ValidationErrorInPhase, addCardanoTxSignature, maxFee, minAdaTxOutEstimated,
               minLovelaceTxOutEstimated, pubKeyTxOut, txOutValue, validatorHash)
import Ledger.CardanoWallet qualified as CW
import Ledger.Index.Internal qualified as Index (UtxoIndex (UtxoIndex))
import Ledger.Tx qualified as Tx
import Ledger.Tx.CardanoAPI (fromCardanoPlutusScript, fromPlutusIndex)
import Ledger.Tx.CardanoAPI qualified as C hiding (makeTransactionBody)
import Ledger.Value.CardanoAPI qualified as Value
import Numeric.Natural (Natural)
import Plutus.Script.Utils.Ada qualified as Ada
import Plutus.Script.Utils.Scripts (datumHash)
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
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 TxOutRef TxOut
mockchainUtxo          :: Map TxOutRef 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 TxOutRef TxOut -> Params -> Mockchain
Mockchain [] Map TxOutRef 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 TxOutRef TxOut -> Params -> Mockchain
Mockchain {
        mockchainInitialTxPool :: [CardanoTx]
mockchainInitialTxPool = [CardanoTx
txn],
        mockchainUtxo :: Map TxOutRef TxOut
mockchainUtxo = [(TxOutRef, TxOut)] -> Map TxOutRef TxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxOutRef, TxOut)] -> Map TxOutRef TxOut)
-> [(TxOutRef, TxOut)] -> Map TxOutRef TxOut
forall a b. (a -> b) -> a -> b
$ (Integer -> TxOutRef) -> (Integer, TxOut) -> (TxOutRef, TxOut)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (TxId -> Integer -> TxOutRef
TxOutRef TxId
tid) ((Integer, TxOut) -> (TxOutRef, TxOut))
-> [(Integer, TxOut)] -> [(TxOutRef, TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer] -> [TxOut] -> [(Integer, TxOut)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
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
g = do
    (TxBodyContent BuildTx BabbageEra
body, [TxOut]
o) <- GeneratorModel -> Gen (TxBodyContent BuildTx BabbageEra, [TxOut])
initialTxBody GeneratorModel
g
    (,[TxOut]
o) (CardanoTx -> (CardanoTx, [TxOut]))
-> GenT Identity CardanoTx -> Gen (CardanoTx, [TxOut])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBodyContent BuildTx BabbageEra -> GenT Identity CardanoTx
forall (m :: * -> *).
MonadFail m =>
TxBodyContent BuildTx BabbageEra -> m CardanoTx
makeTx TxBodyContent BuildTx BabbageEra
body

emptyTxBodyContent :: C.TxBodyContent C.BuildTx C.BabbageEra
emptyTxBodyContent :: TxBodyContent BuildTx BabbageEra
emptyTxBodyContent = TxBodyContent :: forall build era.
TxIns build era
-> TxInsCollateral era
-> TxInsReference build era
-> [TxOut CtxTx era]
-> TxTotalCollateral era
-> TxReturnCollateral CtxTx era
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> TxExtraKeyWitnesses era
-> BuildTxWith build (Maybe ProtocolParameters)
-> TxWithdrawals build era
-> TxCertificates build era
-> TxUpdateProposal era
-> TxMintValue build era
-> TxScriptValidity era
-> TxBodyContent build era
C.TxBodyContent
   { txIns :: TxIns BuildTx BabbageEra
txIns = []
   , txInsCollateral :: TxInsCollateral BabbageEra
txInsCollateral = TxInsCollateral BabbageEra
forall era. TxInsCollateral era
C.TxInsCollateralNone
   , txMintValue :: TxMintValue BuildTx BabbageEra
txMintValue = TxMintValue BuildTx BabbageEra
forall build era. TxMintValue build era
C.TxMintNone
   , txFee :: TxFee BabbageEra
txFee = Lovelace -> TxFee BabbageEra
C.toCardanoFee Lovelace
0
   , txOuts :: [TxOut CtxTx BabbageEra]
txOuts = []
   , txProtocolParams :: BuildTxWith BuildTx (Maybe ProtocolParameters)
txProtocolParams = Maybe ProtocolParameters
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
forall a. a -> BuildTxWith BuildTx a
C.BuildTxWith (Maybe ProtocolParameters
 -> BuildTxWith BuildTx (Maybe ProtocolParameters))
-> Maybe ProtocolParameters
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Maybe ProtocolParameters
forall a. a -> Maybe a
Just (ProtocolParameters -> Maybe ProtocolParameters)
-> ProtocolParameters -> Maybe ProtocolParameters
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra BabbageEra
-> PParams (ShelleyLedgerEra BabbageEra) -> ProtocolParameters
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era) -> ProtocolParameters
C.fromLedgerPParams ShelleyBasedEra BabbageEra
C.ShelleyBasedEraBabbage PParams (ShelleyLedgerEra BabbageEra)
forall a. Default a => a
def
   , txInsReference :: TxInsReference BuildTx BabbageEra
txInsReference = TxInsReference BuildTx BabbageEra
forall build era. TxInsReference build era
C.TxInsReferenceNone
   , txTotalCollateral :: TxTotalCollateral BabbageEra
txTotalCollateral = TxTotalCollateral BabbageEra
forall era. TxTotalCollateral era
C.TxTotalCollateralNone
   , txReturnCollateral :: TxReturnCollateral CtxTx BabbageEra
txReturnCollateral = TxReturnCollateral CtxTx BabbageEra
forall ctx era. TxReturnCollateral ctx era
C.TxReturnCollateralNone
   , txValidityRange :: (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
txValidityRange = ( TxValidityLowerBound BabbageEra
forall era. TxValidityLowerBound era
C.TxValidityNoLowerBound
                       , ValidityNoUpperBoundSupportedInEra BabbageEra
-> TxValidityUpperBound BabbageEra
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
C.TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra BabbageEra
C.ValidityNoUpperBoundInBabbageEra)
   , txScriptValidity :: TxScriptValidity BabbageEra
txScriptValidity = TxScriptValidity BabbageEra
forall era. TxScriptValidity era
C.TxScriptValidityNone
   , txExtraKeyWits :: TxExtraKeyWitnesses BabbageEra
txExtraKeyWits = TxExtraKeyWitnesses BabbageEra
forall era. TxExtraKeyWitnesses era
C.TxExtraKeyWitnessesNone
   , txMetadata :: TxMetadataInEra BabbageEra
txMetadata = TxMetadataInEra BabbageEra
forall era. TxMetadataInEra era
C.TxMetadataNone
   , txAuxScripts :: TxAuxScripts BabbageEra
txAuxScripts = TxAuxScripts BabbageEra
forall era. TxAuxScripts era
C.TxAuxScriptsNone
   , txWithdrawals :: TxWithdrawals BuildTx BabbageEra
txWithdrawals = TxWithdrawals BuildTx BabbageEra
forall build era. TxWithdrawals build era
C.TxWithdrawalsNone
   , txCertificates :: TxCertificates BuildTx BabbageEra
txCertificates = TxCertificates BuildTx BabbageEra
forall build era. TxCertificates build era
C.TxCertificatesNone
   , txUpdateProposal :: TxUpdateProposal BabbageEra
txUpdateProposal = TxUpdateProposal BabbageEra
forall era. TxUpdateProposal era
C.TxUpdateProposalNone
   }

initialTxBody ::
       GeneratorModel
    -> Gen (C.TxBodyContent C.BuildTx C.BabbageEra, [TxOut])
initialTxBody :: GeneratorModel -> Gen (TxBodyContent BuildTx BabbageEra, [TxOut])
initialTxBody GeneratorModel{Maybe Natural
Set PaymentPubKey
Map PaymentPubKey Lovelace
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 o :: [TxOut]
o = (ToCardanoError -> [TxOut])
-> ([TxOut] -> [TxOut]) -> Either ToCardanoError [TxOut] -> [TxOut]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> [TxOut]
forall a. HasCallStack => String -> a
error (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
$ ((PaymentPubKey, Value) -> Either ToCardanoError TxOut)
-> [(PaymentPubKey, Value)] -> Either ToCardanoError [TxOut]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(PaymentPubKey
ppk, Value
v) -> Value
-> PaymentPubKey
-> Maybe StakingCredential
-> Either ToCardanoError TxOut
pubKeyTxOut Value
v PaymentPubKey
ppk Maybe StakingCredential
forall a. Maybe a
Nothing) ([(PaymentPubKey, Value)] -> Either ToCardanoError [TxOut])
-> [(PaymentPubKey, Value)] -> Either ToCardanoError [TxOut]
forall a b. (a -> b) -> a -> b
$ Map PaymentPubKey Value -> [(PaymentPubKey, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map PaymentPubKey Value -> [(PaymentPubKey, Value)])
-> Map PaymentPubKey Value -> [(PaymentPubKey, 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
    -- we use a generated tx in input it's unbalanced but it's "fine" as we don't validate this tx
    TxIns BuildTx BabbageEra
txIns <- (TxIn
 -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> [TxIn] -> TxIns BuildTx 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 (KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn BabbageEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
C.KeyWitness KeyWitnessInCtx WitCtxTxIn
C.KeyWitnessForSpending))
                 ([TxIn] -> TxIns BuildTx BabbageEra)
-> GenT Identity [TxIn] -> GenT Identity (TxIns BuildTx BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity TxIn -> GenT Identity [TxIn]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
1 Int
10) GenT Identity TxIn
genTxIn
    (TxBodyContent BuildTx BabbageEra, [TxOut])
-> Gen (TxBodyContent BuildTx BabbageEra, [TxOut])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBodyContent BuildTx BabbageEra
emptyTxBodyContent
           { TxIns BuildTx BabbageEra
txIns :: TxIns BuildTx BabbageEra
txIns :: TxIns BuildTx BabbageEra
C.txIns
           , 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]
o
           }, [TxOut]
o)

-- | 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 -> GenT Identity CardanoTx
genValidTransaction = GeneratorModel -> Mockchain -> GenT Identity 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 -> GenT Identity CardanoTx
genValidTransaction' GeneratorModel
g Mockchain
chain = GeneratorModel
-> Mockchain -> Gen (TxBodyContent BuildTx BabbageEra)
genValidTransactionBody' GeneratorModel
g Mockchain
chain Gen (TxBodyContent BuildTx BabbageEra)
-> (TxBodyContent BuildTx BabbageEra -> GenT Identity CardanoTx)
-> GenT Identity CardanoTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxBodyContent BuildTx BabbageEra -> GenT Identity CardanoTx
forall (m :: * -> *).
MonadFail m =>
TxBodyContent BuildTx BabbageEra -> m CardanoTx
makeTx

genValidTransactionSpending
    :: [TxInputWitnessed]
    -> C.Value
    -> Gen CardanoTx
genValidTransactionSpending :: [TxInputWitnessed] -> Value -> GenT Identity CardanoTx
genValidTransactionSpending = GeneratorModel
-> [TxInputWitnessed] -> Value -> GenT Identity CardanoTx
genValidTransactionSpending' GeneratorModel
generatorModel


-- | A transaction input, consisting of a transaction output reference and an input type with data witnesses.
data TxInputWitnessed = TxInputWitnessed !TxOutRef !Ledger.TxInType


genValidTransactionSpending'
    :: GeneratorModel
    -> [TxInputWitnessed]
    -> C.Value
    -> Gen CardanoTx
genValidTransactionSpending' :: GeneratorModel
-> [TxInputWitnessed] -> Value -> GenT Identity CardanoTx
genValidTransactionSpending' GeneratorModel
g [TxInputWitnessed]
ins Value
totalVal =
    GeneratorModel
-> [TxInputWitnessed]
-> Value
-> Gen (TxBodyContent BuildTx BabbageEra)
genValidTransactionBodySpending' GeneratorModel
g [TxInputWitnessed]
ins Value
totalVal Gen (TxBodyContent BuildTx BabbageEra)
-> (TxBodyContent BuildTx BabbageEra -> GenT Identity CardanoTx)
-> GenT Identity CardanoTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxBodyContent BuildTx BabbageEra -> GenT Identity 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
"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 TxOutRef TxOut
ops Params
_) = do
    -- Take a random number of UTXO from the input
    Int
nUtxo <- if Map TxOutRef TxOut -> Bool
forall k a. Map k a -> Bool
Map.null Map TxOutRef 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 TxOutRef TxOut -> Int
forall k a. Map k a -> Int
Map.size Map TxOutRef TxOut
ops))
    let ins :: [TxInputWitnessed]
ins = (TxOutRef -> TxInType -> TxInputWitnessed
`TxInputWitnessed` TxInType
ConsumePublicKeyAddress) (TxOutRef -> TxInputWitnessed)
-> ((TxOutRef, TxOut) -> TxOutRef)
-> (TxOutRef, TxOut)
-> TxInputWitnessed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxOut) -> TxOutRef
forall a b. (a, b) -> a
fst ((TxOutRef, TxOut) -> TxInputWitnessed)
-> [(TxOutRef, TxOut)] -> [TxInputWitnessed]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxOutRef, TxOut)]
inUTXO
        inUTXO :: [(TxOutRef, TxOut)]
inUTXO = Int -> [(TxOutRef, TxOut)] -> [(TxOutRef, TxOut)]
forall a. Int -> [a] -> [a]
take Int
nUtxo ([(TxOutRef, TxOut)] -> [(TxOutRef, TxOut)])
-> [(TxOutRef, TxOut)] -> [(TxOutRef, TxOut)]
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxOut -> [(TxOutRef, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxOutRef TxOut
ops
        totalVal :: Value
totalVal = ((TxOutRef, TxOut) -> Value) -> [(TxOutRef, TxOut)] -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TxOut -> Value
txOutValue (TxOut -> Value)
-> ((TxOutRef, TxOut) -> TxOut) -> (TxOutRef, TxOut) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxOut) -> TxOut
forall a b. (a, b) -> b
snd) [(TxOutRef, TxOut)]
inUTXO
    GeneratorModel
-> [TxInputWitnessed]
-> Value
-> Gen (TxBodyContent BuildTx BabbageEra)
genValidTransactionBodySpending' GeneratorModel
g [TxInputWitnessed]
ins Value
totalVal

genValidTransactionBodySpending'
    :: GeneratorModel
    -> [TxInputWitnessed]
    -> C.Value
    -> Gen (C.TxBodyContent C.BuildTx C.BabbageEra)
genValidTransactionBodySpending' :: GeneratorModel
-> [TxInputWitnessed]
-> Value
-> Gen (TxBodyContent BuildTx BabbageEra)
genValidTransactionBodySpending' GeneratorModel
g [TxInputWitnessed]
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
    TxIns BuildTx BabbageEra
txIns <- Either ToCardanoError (TxIns BuildTx BabbageEra)
-> GenT Identity (TxIns BuildTx BabbageEra)
forall (m :: * -> *) a.
MonadFail m =>
Either ToCardanoError a -> m a
failOnCardanoError (Either ToCardanoError (TxIns BuildTx BabbageEra)
 -> GenT Identity (TxIns BuildTx BabbageEra))
-> Either ToCardanoError (TxIns BuildTx BabbageEra)
-> GenT Identity (TxIns BuildTx BabbageEra)
forall a b. (a -> b) -> a -> b
$ (TxInputWitnessed
 -> Either
      ToCardanoError
      (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> [TxInputWitnessed]
-> Either ToCardanoError (TxIns BuildTx BabbageEra)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TxInputWitnessed
-> Either
     ToCardanoError
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
txInToCardanoTxInput [TxInputWitnessed]
ins
    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))
    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")
        (Either ToCardanoError (TxInsCollateral BabbageEra)
-> GenT Identity (TxInsCollateral BabbageEra)
forall (m :: * -> *) a.
MonadFail m =>
Either ToCardanoError a -> m a
failOnCardanoError (Either ToCardanoError (TxInsCollateral BabbageEra)
 -> GenT Identity (TxInsCollateral BabbageEra))
-> (Natural -> Either ToCardanoError (TxInsCollateral BabbageEra))
-> Natural
-> GenT Identity (TxInsCollateral BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxInput] -> Either ToCardanoError (TxInsCollateral BabbageEra)
C.toCardanoTxInsCollateral ([TxInput] -> Either ToCardanoError (TxInsCollateral BabbageEra))
-> (Natural -> [TxInput])
-> Natural
-> Either ToCardanoError (TxInsCollateral BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxInputWitnessed -> TxInput) -> [TxInputWitnessed] -> [TxInput]
forall a b. (a -> b) -> [a] -> [b]
map TxInputWitnessed -> TxInput
toTxInput ([TxInputWitnessed] -> [TxInput])
-> (Natural -> [TxInputWitnessed]) -> Natural -> [TxInput]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [TxInputWitnessed] -> [TxInputWitnessed])
-> [TxInputWitnessed] -> Int -> [TxInputWitnessed]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [TxInputWitnessed] -> [TxInputWitnessed]
forall a. Int -> [a] -> [a]
take [TxInputWitnessed]
ins (Int -> [TxInputWitnessed])
-> (Natural -> Int) -> Natural -> [TxInputWitnessed]
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
emptyTxBodyContent
           { TxIns BuildTx BabbageEra
txIns :: TxIns BuildTx BabbageEra
txIns :: TxIns BuildTx 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
           }
    where
        -- | Translate TxIn to TxInput taking out data witnesses if present.
        txInToCardanoTxInput :: TxInputWitnessed ->
            Either C.ToCardanoError (C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn C.BabbageEra))
        txInToCardanoTxInput :: TxInputWitnessed
-> Either
     ToCardanoError
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
txInToCardanoTxInput (TxInputWitnessed TxOutRef
outref TxInType
txInType) = case TxInType
txInType of
            TxInType
Ledger.ConsumePublicKeyAddress ->
                 TxOutRef -> Either ToCardanoError TxIn
C.toCardanoTxIn TxOutRef
outref Either ToCardanoError TxIn
-> (TxIn
    -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> Either
     ToCardanoError
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (, 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)
            TxInType
Ledger.ConsumeSimpleScriptAddress ->
                 ToCardanoError
-> Either
     ToCardanoError
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
forall a b. a -> Either a b
Left ToCardanoError
C.SimpleScriptsNotSupportedToCardano
            Ledger.ScriptAddress Either (Versioned Validator) (Versioned TxOutRef)
valOrRef Redeemer
rd Maybe Datum
dt -> do
                 WitnessHeader
mkWitness  <- case Either (Versioned Validator) (Versioned TxOutRef)
valOrRef of
                     Left Versioned Validator
vl    -> Versioned Script -> Either ToCardanoError WitnessHeader
C.toCardanoTxInScriptWitnessHeader (Versioned Script -> Either ToCardanoError WitnessHeader)
-> Versioned Script -> Either ToCardanoError WitnessHeader
forall a b. (a -> b) -> a -> b
$ (Validator -> Script) -> Versioned Validator -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Validator -> Script
Script.getValidator Versioned Validator
vl
                     Right Versioned TxOutRef
vref -> Versioned TxOutRef -> Either ToCardanoError WitnessHeader
C.toCardanoTxInReferenceWitnessHeader Versioned TxOutRef
vref
                 let Script.Redeemer BuiltinData
r = Redeemer
rd
                     sw :: ScriptWitness WitCtxTxIn BabbageEra
sw = WitnessHeader
mkWitness (Maybe Datum -> ScriptDatum WitCtxTxIn
C.toCardanoDatumWitness Maybe Datum
dt) (BuiltinData -> ScriptRedeemer
C.toCardanoScriptData BuiltinData
r) ExecutionUnits
C.zeroExecutionUnits
                 TxOutRef -> Either ToCardanoError TxIn
C.toCardanoTxIn TxOutRef
outref Either ToCardanoError TxIn
-> (TxIn
    -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> Either
     ToCardanoError
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (, 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
$ ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn BabbageEra
-> Witness WitCtxTxIn BabbageEra
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
C.ScriptWitness ScriptWitnessInCtx WitCtxTxIn
C.ScriptWitnessForSpending ScriptWitness WitCtxTxIn BabbageEra
sw)
        toTxInput :: TxInputWitnessed -> TxInput
        toTxInput :: TxInputWitnessed -> TxInput
toTxInput (TxInputWitnessed TxOutRef
outref TxInType
txin) = TxOutRef -> TxInputType -> TxInput
Tx.TxInput TxOutRef
outref (TxInputType -> TxInput) -> TxInputType -> TxInput
forall a b. (a -> b) -> a -> b
$ TxInType -> TxInputType
toTxInType TxInType
txin

        toTxInType :: TxInType -> TxInputType
        toTxInType :: TxInType -> TxInputType
toTxInType TxInType
Tx.ConsumeSimpleScriptAddress = TxInputType
Tx.TxConsumeSimpleScriptAddress
        toTxInType TxInType
Tx.ConsumePublicKeyAddress = TxInputType
Tx.TxConsumePublicKeyAddress
        toTxInType (Tx.ScriptAddress Either (Versioned Validator) (Versioned TxOutRef)
valOrRef Redeemer
rd Maybe Datum
dat) = Redeemer
-> Either ValidatorHash (Versioned TxOutRef)
-> Maybe DatumHash
-> TxInputType
Tx.TxScriptAddress Redeemer
rd ((Versioned Validator -> ValidatorHash)
-> Either (Versioned Validator) (Versioned TxOutRef)
-> Either ValidatorHash (Versioned TxOutRef)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Versioned Validator -> ValidatorHash
validatorHash Either (Versioned Validator) (Versioned TxOutRef)
valOrRef) (Maybe DatumHash -> TxInputType) -> Maybe DatumHash -> TxInputType
forall a b. (a -> b) -> a -> b
$ (Datum -> DatumHash) -> Maybe Datum -> Maybe DatumHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Datum -> DatumHash
datumHash Maybe Datum
dat

-- | Validate a transaction in a mockchain.
validateMockchain :: Mockchain -> CardanoTx -> Maybe Ledger.ValidationErrorInPhase
validateMockchain :: Mockchain -> CardanoTx -> Maybe ValidationErrorInPhase
validateMockchain (Mockchain [CardanoTx]
_ Map TxOutRef TxOut
utxo Params
params) CardanoTx
tx = Maybe ValidationErrorInPhase
result where
    cUtxoIndex :: UTxO (BabbageEra StandardCrypto)
cUtxoIndex = (Either ValidationErrorInPhase ToCardanoError
 -> UTxO (BabbageEra StandardCrypto))
-> (UTxO (BabbageEra StandardCrypto)
    -> UTxO (BabbageEra StandardCrypto))
-> Either
     (Either ValidationErrorInPhase ToCardanoError)
     (UTxO (BabbageEra StandardCrypto))
-> UTxO (BabbageEra StandardCrypto)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> UTxO (BabbageEra StandardCrypto)
forall a. HasCallStack => String -> a
error (String -> UTxO (BabbageEra StandardCrypto))
-> (Either ValidationErrorInPhase ToCardanoError -> String)
-> Either ValidationErrorInPhase ToCardanoError
-> UTxO (BabbageEra StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ValidationErrorInPhase ToCardanoError -> String
forall a. Show a => a -> String
show) UTxO (BabbageEra StandardCrypto)
-> UTxO (BabbageEra StandardCrypto)
forall a. a -> a
id (Either
   (Either ValidationErrorInPhase ToCardanoError)
   (UTxO (BabbageEra StandardCrypto))
 -> UTxO (BabbageEra StandardCrypto))
-> Either
     (Either ValidationErrorInPhase ToCardanoError)
     (UTxO (BabbageEra StandardCrypto))
-> UTxO (BabbageEra StandardCrypto)
forall a b. (a -> b) -> a -> b
$ UtxoIndex
-> Either
     (Either ValidationErrorInPhase ToCardanoError)
     (UTxO (BabbageEra StandardCrypto))
fromPlutusIndex (Map TxOutRef TxOut -> UtxoIndex
Index.UtxoIndex Map TxOutRef TxOut
utxo)
    result :: Maybe ValidationErrorInPhase
result = Either ValidationErrorInPhase ValidationSuccess
-> Maybe ValidationErrorInPhase
forall a b. Either a b -> Maybe a
leftToMaybe (Either ValidationErrorInPhase ValidationSuccess
 -> Maybe ValidationErrorInPhase)
-> Either ValidationErrorInPhase ValidationSuccess
-> Maybe ValidationErrorInPhase
forall a b. (a -> b) -> a -> b
$ Params
-> Slot
-> UTxO (BabbageEra StandardCrypto)
-> CardanoTx
-> Either ValidationErrorInPhase ValidationSuccess
validateCardanoTx Params
params Slot
1 UTxO (BabbageEra StandardCrypto)
cUtxoIndex CardanoTx
tx

-- | 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

-- | Generate a 'ByteString s' of exactly @s@ bytes.
genSizedByteStringExact :: forall m. MonadGen m => Int -> m BS.ByteString
genSizedByteStringExact :: Int -> m ByteString
genSizedByteStringExact Int
s =
    let range :: Range Int
range = Int -> Range Int
forall a. a -> Range a
Range.singleton 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 ()
Hedgehog.annotateShow Maybe ValidationErrorInPhase
res
    Bool -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
Hedgehog.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 = Integer -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> n) -> Integer -> n
forall a b. (a -> b) -> a -> b
$ Ada -> Integer
Ada.getLovelace (Ada -> Integer) -> Ada -> Integer
forall a b. (a -> b) -> a -> b
$ Ada
Ledger.minAdaTxOutEstimated Ada -> Ada -> Ada
forall a. Num a => a -> a -> a
+ Ada
Ledger.maxFee

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