{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Cardano.Node.Emulator.Generators(
Mockchain(..),
genMockchain,
genMockchain',
emptyChain,
GeneratorModel(..),
TxInputWitnessed(..),
generatorModel,
genValidTransaction,
genValidTransaction',
genValidTransactionSpending,
genValidTransactionSpending',
genInitialTransaction,
assertValid,
genInterval,
genSlotRange,
genTimeRange,
genSlot,
genPOSIXTime,
genSlotConfig,
genSomeCardanoApiTx,
genAda,
genMintingPolicyHash,
genCurrencySymbol,
genAssetClass,
genValue,
genValueNonNegative,
genSizedByteString,
genSizedByteStringExact,
genTokenName,
genSeed,
genPassphrase,
splitVal,
validateMockchain,
signAll,
signTx,
CW.knownAddresses,
CW.knownPaymentPublicKeys,
CW.knownPaymentPrivateKeys,
CW.knownPaymentKeys,
knownXPrvs,
someTokenValue
) where
import Control.Lens ((&))
import Control.Monad (guard, replicateM)
import Data.Bifunctor (Bifunctor (first), bimap)
import Data.ByteString qualified as BS
import Data.Default (Default (def), def)
import Data.Either.Combinators (leftToMaybe)
import Data.Foldable (fold, foldl')
import Data.Functor.Identity (Identity)
import Data.List (sort)
import Data.List qualified as List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes, 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.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 (fromPlutusTxSigned, validateCardanoTx)
import Control.Applicative (Alternative)
import Ledger (Ada, AssetClass, CardanoTx (EmulatorTx), CurrencySymbol, Datum, Interval, Language (PlutusV1),
POSIXTime (POSIXTime, getPOSIXTime), POSIXTimeRange, Passphrase (Passphrase),
PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey, Slot (Slot), SlotRange,
SomeCardanoApiTx (SomeTx), TokenName,
Tx (txCollateralInputs, txFee, txInputs, txMint, txOutputs, txValidRange),
TxInType (ConsumePublicKeyAddress, ConsumeSimpleScriptAddress, ScriptAddress), TxInput (TxInput),
TxInputType (TxConsumePublicKeyAddress, TxConsumeSimpleScriptAddress, TxScriptAddress), TxOut,
TxOutRef (TxOutRef), ValidationErrorInPhase, Validator, Value, Versioned, addCardanoTxSignature,
addMintingPolicy, getValidator, maxFee, minAdaTxOutEstimated, pubKeyTxOut, scriptHash, txData,
txOutValue, txScripts, validatorHash)
import Ledger.Ada qualified as Ada
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 (fromPlutusIndex)
import Ledger.Value qualified as Value
import Numeric.Natural (Natural)
import Plutus.Script.Utils.Scripts (Versioned (Versioned), datumHash)
import Plutus.Script.Utils.V1.Generators as ScriptGen
import Plutus.V1.Ledger.Interval qualified as Interval
import Plutus.V1.Ledger.Scripts qualified as Script
import PlutusTx.Prelude qualified as PlutusTx
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
data GeneratorModel = GeneratorModel {
GeneratorModel -> Map PaymentPubKey Value
gmInitialBalance :: Map PaymentPubKey Value,
GeneratorModel -> Set PaymentPubKey
gmPubKeys :: Set PaymentPubKey,
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
generatorModel :: GeneratorModel
generatorModel :: GeneratorModel
generatorModel =
let vl :: Value
vl = Integer -> Value
Ada.lovelaceValueOf Integer
100_000_000
pubKeys :: [PaymentPubKey]
pubKeys = [PaymentPubKey]
CW.knownPaymentPublicKeys
in
GeneratorModel :: Map PaymentPubKey Value
-> Set PaymentPubKey -> Maybe Natural -> GeneratorModel
GeneratorModel
{ gmInitialBalance :: Map PaymentPubKey Value
gmInitialBalance = [(PaymentPubKey, Value)] -> Map PaymentPubKey Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PaymentPubKey, Value)] -> Map PaymentPubKey Value)
-> [(PaymentPubKey, Value)] -> Map PaymentPubKey Value
forall a b. (a -> b) -> a -> b
$ [PaymentPubKey] -> [Value] -> [(PaymentPubKey, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PaymentPubKey]
pubKeys (Value -> [Value]
forall a. a -> [a]
repeat Value
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
}
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
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
genMockchain' :: MonadGen m
=> GeneratorModel
-> m Mockchain
genMockchain' :: GeneratorModel -> m Mockchain
genMockchain' GeneratorModel
gm = do
SlotConfig
slotCfg <- m SlotConfig
forall (m :: * -> *). MonadGen m => m SlotConfig
genSlotConfig
let (CardanoTx
txn, [TxOut]
ot) = GeneratorModel -> (CardanoTx, [TxOut])
genInitialTransaction GeneratorModel
gm
params :: Params
params = Params
forall a. Default a => a
def { pSlotConfig :: SlotConfig
pSlotConfig = SlotConfig
slotCfg }
signedTx :: CardanoTx
signedTx = Params -> Map TxOutRef TxOut -> CardanoTx -> CardanoTx
signTx Params
params Map TxOutRef TxOut
forall a. Monoid a => a
mempty CardanoTx
txn
tid :: TxId
tid = CardanoTx -> TxId
Tx.getCardanoTxId CardanoTx
signedTx
Mockchain -> m 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
}
genMockchain :: MonadGen m => m Mockchain
genMockchain :: m Mockchain
genMockchain = GeneratorModel -> m Mockchain
forall (m :: * -> *). MonadGen m => GeneratorModel -> m Mockchain
genMockchain' GeneratorModel
generatorModel
genInitialTransaction ::
GeneratorModel
-> (CardanoTx, [TxOut])
genInitialTransaction :: GeneratorModel -> (CardanoTx, [TxOut])
genInitialTransaction GeneratorModel{Maybe Natural
Set PaymentPubKey
Map PaymentPubKey Value
gmMaxCollateralInputs :: Maybe Natural
gmPubKeys :: Set PaymentPubKey
gmInitialBalance :: Map PaymentPubKey Value
gmMaxCollateralInputs :: GeneratorModel -> Maybe Natural
gmPubKeys :: GeneratorModel -> Set PaymentPubKey
gmInitialBalance :: GeneratorModel -> Map PaymentPubKey Value
..} =
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
gmInitialBalance
t :: Value
t = Map PaymentPubKey Value -> Value
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map PaymentPubKey Value
gmInitialBalance
in (Tx -> CardanoTx
EmulatorTx (Tx -> CardanoTx) -> Tx -> CardanoTx
forall a b. (a -> b) -> a -> b
$ Tx
forall a. Monoid a => a
mempty {
txOutputs :: [TxOut]
txOutputs = [TxOut]
o,
txMint :: Value
txMint = Value
t,
txValidRange :: SlotRange
txValidRange = Slot -> SlotRange
forall a. a -> Interval a
Interval.from Slot
0
}, [TxOut]
o)
genValidTransaction
:: Alternative m
=> MonadGen m
=> Mockchain
-> m CardanoTx
genValidTransaction :: Mockchain -> m CardanoTx
genValidTransaction = GeneratorModel -> Mockchain -> m CardanoTx
forall (m :: * -> *).
(Alternative m, MonadGen m) =>
GeneratorModel -> Mockchain -> m CardanoTx
genValidTransaction' GeneratorModel
generatorModel
genValidTransaction'
:: Alternative m
=> MonadGen m
=> GeneratorModel
-> Mockchain
-> m CardanoTx
genValidTransaction' :: GeneratorModel -> Mockchain -> m CardanoTx
genValidTransaction' GeneratorModel
g (Mockchain [CardanoTx]
_ Map TxOutRef TxOut
ops Params
_) = do
Int
nUtxo <- if Map TxOutRef TxOut -> Bool
forall k a. Map k a -> Bool
Map.null Map TxOutRef TxOut
ops
then m Int
forall (m :: * -> *) a. MonadGen m => m a
Gen.discard
else Range Int -> m 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 = (Value -> Value -> Value) -> Value -> [Value] -> Value
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
(<>) Value
forall a. Monoid a => a
mempty ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ ((TxOutRef, TxOut) -> Value) -> [(TxOutRef, TxOut)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (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 -> m CardanoTx
forall (m :: * -> *).
(Alternative m, MonadGen m) =>
GeneratorModel -> [TxInputWitnessed] -> Value -> m CardanoTx
genValidTransactionSpending' GeneratorModel
g [TxInputWitnessed]
ins Value
totalVal
genValidTransactionSpending
:: Alternative m
=> MonadGen m
=> [TxInputWitnessed]
-> Value
-> m CardanoTx
genValidTransactionSpending :: [TxInputWitnessed] -> Value -> m CardanoTx
genValidTransactionSpending = GeneratorModel -> [TxInputWitnessed] -> Value -> m CardanoTx
forall (m :: * -> *).
(Alternative m, MonadGen m) =>
GeneratorModel -> [TxInputWitnessed] -> Value -> m CardanoTx
genValidTransactionSpending' GeneratorModel
generatorModel
data TxInputWitnessed = TxInputWitnessed !TxOutRef !Ledger.TxInType
genValidTransactionSpending'
:: Alternative m
=> MonadGen m
=> GeneratorModel
-> [TxInputWitnessed]
-> Value
-> m CardanoTx
genValidTransactionSpending' :: GeneratorModel -> [TxInputWitnessed] -> Value -> m CardanoTx
genValidTransactionSpending' GeneratorModel
g [TxInputWitnessed]
ins Value
totalVal = do
Integer
mintAmount <- Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> m Int -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m 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)
TokenName
mintTokenName <- m TokenName
forall (m :: * -> *). MonadGen m => m TokenName
genTokenName
let mintValue :: Maybe Value
mintValue = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Integer
mintAmount Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0
Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ TokenName -> Integer -> Value
ScriptGen.someTokenValue TokenName
mintTokenName Integer
mintAmount
fee' :: Ada
fee' = Integer -> Ada
Ada.lovelaceOf 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 :: Ada
totalValAda = Value -> Ada
Ada.fromValue Value
totalVal
totalValTokens :: Maybe Value
totalValTokens = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Value -> Bool
Value.isZero (Value -> Value
Value.noAdaValue Value
totalVal)
Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Value -> Value
Value.noAdaValue Value
totalVal
Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Ada
fee' Ada -> Ada -> Bool
forall a. Ord a => a -> a -> Bool
< Ada
totalValAda
[Ada]
splitOutVals <- Int -> Ada -> m [Ada]
forall (m :: * -> *) n.
(MonadGen m, Integral n) =>
Int -> n -> m [n]
splitVal Int
numOut (Ada
totalValAda Ada -> Ada -> Ada
forall a. Num a => a -> a -> a
- Ada
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 -> do
(Ada -> Value) -> [Ada] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ada -> Value
Ada.toValue [Ada]
splitOutVals
Just Value
mv -> do
let outValForMint :: Ada
outValForMint =
Ada -> Maybe Ada -> Ada
forall a. a -> Maybe a -> a
fromMaybe Ada
forall a. Monoid a => a
mempty (Maybe Ada -> Ada) -> Maybe Ada -> Ada
forall a b. (a -> b) -> a -> b
$ (Ada -> Bool) -> [Ada] -> Maybe Ada
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Ada -> Ada -> Bool
forall a. Ord a => a -> a -> Bool
>= Ada
Ledger.minAdaTxOutEstimated)
([Ada] -> Maybe Ada) -> [Ada] -> Maybe Ada
forall a b. (a -> b) -> a -> b
$ [Ada] -> [Ada]
forall a. Ord a => [a] -> [a]
List.sort [Ada]
splitOutVals
Ada -> Value
Ada.toValue Ada
outValForMint Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
mv Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: (Ada -> Value) -> [Ada] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ada -> Value
Ada.toValue (Ada -> [Ada] -> [Ada]
forall a. Eq a => a -> [a] -> [a]
List.delete Ada
outValForMint [Ada]
splitOutVals)
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 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
$ ((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 (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)
([TxInput]
ins', [(Maybe (Versioned Validator), Maybe Datum)]
witnesses) = [(TxInput, (Maybe (Versioned Validator), Maybe Datum))]
-> ([TxInput], [(Maybe (Versioned Validator), Maybe Datum)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(TxInput, (Maybe (Versioned Validator), Maybe Datum))]
-> ([TxInput], [(Maybe (Versioned Validator), Maybe Datum)]))
-> [(TxInput, (Maybe (Versioned Validator), Maybe Datum))]
-> ([TxInput], [(Maybe (Versioned Validator), Maybe Datum)])
forall a b. (a -> b) -> a -> b
$ (TxInputWitnessed
-> (TxInput, (Maybe (Versioned Validator), Maybe Datum)))
-> [TxInputWitnessed]
-> [(TxInput, (Maybe (Versioned Validator), Maybe Datum))]
forall a b. (a -> b) -> [a] -> [b]
map TxInputWitnessed
-> (TxInput, (Maybe (Versioned Validator), Maybe Datum))
txInToTxInput [TxInputWitnessed]
ins
([Versioned Validator]
scripts, [Datum]
datums) = ([Maybe (Versioned Validator)] -> [Versioned Validator])
-> ([Maybe Datum] -> [Datum])
-> ([Maybe (Versioned Validator)], [Maybe Datum])
-> ([Versioned Validator], [Datum])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Maybe (Versioned Validator)] -> [Versioned Validator]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Datum] -> [Datum]
forall a. [Maybe a] -> [a]
catMaybes (([Maybe (Versioned Validator)], [Maybe Datum])
-> ([Versioned Validator], [Datum]))
-> ([Maybe (Versioned Validator)], [Maybe Datum])
-> ([Versioned Validator], [Datum])
forall a b. (a -> b) -> a -> b
$ [(Maybe (Versioned Validator), Maybe Datum)]
-> ([Maybe (Versioned Validator)], [Maybe Datum])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Maybe (Versioned Validator), Maybe Datum)]
witnesses
tx :: CardanoTx
tx = Tx
forall a. Monoid a => a
mempty
{ txInputs :: [TxInput]
txInputs = [TxInput]
ins'
, txCollateralInputs :: [TxInput]
txCollateralInputs = [TxInput] -> (Natural -> [TxInput]) -> Maybe Natural -> [TxInput]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Int -> [TxInput] -> [TxInput]) -> [TxInput] -> Int -> [TxInput]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [TxInput] -> [TxInput]
forall a. Int -> [a] -> [a]
take [TxInput]
ins' (Int -> [TxInput]) -> (Natural -> Int) -> Natural -> [TxInput]
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)
, txOutputs :: [TxOut]
txOutputs = [TxOut]
txOutputs
, txMint :: Value
txMint = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
forall a. Monoid a => a
mempty Maybe Value
mintValue
, txFee :: Value
txFee = Ada -> Value
Ada.toValue Ada
fee'
, txData :: Map DatumHash Datum
txData = [(DatumHash, Datum)] -> Map DatumHash Datum
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Datum -> (DatumHash, Datum)) -> [Datum] -> [(DatumHash, Datum)]
forall a b. (a -> b) -> [a] -> [b]
map (\Datum
d -> (Datum -> DatumHash
datumHash Datum
d, Datum
d)) [Datum]
datums)
, txScripts :: ScriptsMap
txScripts = [(ScriptHash, Versioned Script)] -> ScriptsMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Versioned Validator -> (ScriptHash, Versioned Script))
-> [Versioned Validator] -> [(ScriptHash, Versioned Script)]
forall a b. (a -> b) -> [a] -> [b]
map ((\Versioned Script
s -> (Versioned Script -> ScriptHash
scriptHash Versioned Script
s, Versioned Script
s)) (Versioned Script -> (ScriptHash, Versioned Script))
-> (Versioned Validator -> Versioned Script)
-> Versioned Validator
-> (ScriptHash, Versioned Script)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Validator -> Script) -> Versioned Validator -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Validator -> Script
getValidator) [Versioned Validator]
scripts)
}
Tx -> (Tx -> Tx) -> Tx
forall a b. a -> (a -> b) -> b
& Versioned MintingPolicy
-> (Redeemer, Maybe (Versioned TxOutRef)) -> Tx -> Tx
addMintingPolicy (MintingPolicy -> Language -> Versioned MintingPolicy
forall script. script -> Language -> Versioned script
Versioned MintingPolicy
ScriptGen.alwaysSucceedPolicy Language
PlutusV1) (Redeemer
Script.unitRedeemer, Maybe (Versioned TxOutRef)
forall a. Maybe a
Nothing)
Tx -> (Tx -> CardanoTx) -> CardanoTx
forall a b. a -> (a -> b) -> b
& Tx -> CardanoTx
EmulatorTx
CardanoTx -> m CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CardanoTx -> CardanoTx
signAll CardanoTx
tx)
where
txInToTxInput :: TxInputWitnessed -> (TxInput, (Maybe (Versioned Validator), Maybe Datum))
txInToTxInput :: TxInputWitnessed
-> (TxInput, (Maybe (Versioned Validator), Maybe Datum))
txInToTxInput (TxInputWitnessed TxOutRef
outref TxInType
txInType) = case TxInType
txInType of
TxInType
Ledger.ConsumePublicKeyAddress -> (TxOutRef -> TxInputType -> TxInput
TxInput TxOutRef
outref TxInputType
TxConsumePublicKeyAddress, (Maybe (Versioned Validator)
forall a. Maybe a
Nothing, Maybe Datum
forall a. Maybe a
Nothing))
TxInType
Ledger.ConsumeSimpleScriptAddress -> (TxOutRef -> TxInputType -> TxInput
TxInput TxOutRef
outref TxInputType
Ledger.TxConsumeSimpleScriptAddress, (Maybe (Versioned Validator)
forall a. Maybe a
Nothing, Maybe Datum
forall a. Maybe a
Nothing))
Ledger.ScriptAddress (Left Versioned Validator
vl) Redeemer
rd Maybe Datum
dt ->
(TxOutRef -> TxInputType -> TxInput
TxInput TxOutRef
outref (Redeemer
-> Either ValidatorHash (Versioned TxOutRef)
-> Maybe DatumHash
-> TxInputType
Ledger.TxScriptAddress Redeemer
rd (ValidatorHash -> Either ValidatorHash (Versioned TxOutRef)
forall a b. a -> Either a b
Left (ValidatorHash -> Either ValidatorHash (Versioned TxOutRef))
-> ValidatorHash -> Either ValidatorHash (Versioned TxOutRef)
forall a b. (a -> b) -> a -> b
$ Versioned Validator -> ValidatorHash
validatorHash Versioned Validator
vl) ((Datum -> DatumHash) -> Maybe Datum -> Maybe DatumHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Datum -> DatumHash
datumHash Maybe Datum
dt)), (Versioned Validator -> Maybe (Versioned Validator)
forall a. a -> Maybe a
Just Versioned Validator
vl, Maybe Datum
dt))
Ledger.ScriptAddress (Right Versioned TxOutRef
ref) Redeemer
rd Maybe Datum
dt ->
(TxOutRef -> TxInputType -> TxInput
TxInput TxOutRef
outref (Redeemer
-> Either ValidatorHash (Versioned TxOutRef)
-> Maybe DatumHash
-> TxInputType
Ledger.TxScriptAddress Redeemer
rd (Versioned TxOutRef -> Either ValidatorHash (Versioned TxOutRef)
forall a b. b -> Either a b
Right Versioned TxOutRef
ref) ((Datum -> DatumHash) -> Maybe Datum -> Maybe DatumHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Datum -> DatumHash
datumHash Maybe Datum
dt)), (Maybe (Versioned Validator)
forall a. Maybe a
Nothing, Maybe Datum
dt))
signTx :: Params -> Map TxOutRef TxOut -> CardanoTx -> CardanoTx
signTx :: Params -> Map TxOutRef TxOut -> CardanoTx -> CardanoTx
signTx Params
params Map TxOutRef TxOut
utxo = let
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)
in (Tx -> CardanoTx)
-> (SomeCardanoApiTx -> CardanoTx) -> CardanoTx -> CardanoTx
forall r. (Tx -> r) -> (SomeCardanoApiTx -> r) -> CardanoTx -> r
Tx.onCardanoTx
(\Tx
t -> Params
-> UTxO (BabbageEra StandardCrypto)
-> Tx
-> Map PaymentPubKey PaymentPrivateKey
-> CardanoTx
fromPlutusTxSigned Params
params UTxO (BabbageEra StandardCrypto)
cUtxoIndex Tx
t Map PaymentPubKey PaymentPrivateKey
CW.knownPaymentKeys)
SomeCardanoApiTx -> CardanoTx
Tx.CardanoApiTx
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 (Params -> Map TxOutRef TxOut -> CardanoTx -> CardanoTx
signTx Params
params Map TxOutRef TxOut
utxo CardanoTx
tx)
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
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
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
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)
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))
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 }
genSomeCardanoApiTx :: (GenBase m ~ Identity, MonadGen m) => m SomeCardanoApiTx
genSomeCardanoApiTx :: m SomeCardanoApiTx
genSomeCardanoApiTx = [m SomeCardanoApiTx] -> m SomeCardanoApiTx
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [ m SomeCardanoApiTx
forall (m :: * -> *).
(GenBase m ~ Identity, MonadGen m) =>
m SomeCardanoApiTx
genByronEraInCardanoModeTx
, m SomeCardanoApiTx
forall (m :: * -> *).
(GenBase m ~ Identity, MonadGen m) =>
m SomeCardanoApiTx
genShelleyEraInCardanoModeTx
, m SomeCardanoApiTx
forall (m :: * -> *).
(GenBase m ~ Identity, MonadGen m) =>
m SomeCardanoApiTx
genAllegraEraInCardanoModeTx
, m SomeCardanoApiTx
forall (m :: * -> *).
(GenBase m ~ Identity, MonadGen m) =>
m SomeCardanoApiTx
genMaryEraInCardanoModeTx
, m SomeCardanoApiTx
forall (m :: * -> *).
(GenBase m ~ Identity, MonadGen m) =>
m SomeCardanoApiTx
genBabbageEraInCardanoModeTx
]
genByronEraInCardanoModeTx :: (GenBase m ~ Identity, MonadGen m) => m SomeCardanoApiTx
genByronEraInCardanoModeTx :: m SomeCardanoApiTx
genByronEraInCardanoModeTx = do
Tx ByronEra
tx <- GenT (GenBase m) (Tx ByronEra) -> m (Tx ByronEra)
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (GenT (GenBase m) (Tx ByronEra) -> m (Tx ByronEra))
-> GenT (GenBase m) (Tx ByronEra) -> m (Tx ByronEra)
forall a b. (a -> b) -> a -> b
$ CardanoEra ByronEra -> Gen (Tx ByronEra)
forall era. IsCardanoEra era => CardanoEra era -> Gen (Tx era)
Gen.genTx CardanoEra ByronEra
C.ByronEra
SomeCardanoApiTx -> m SomeCardanoApiTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeCardanoApiTx -> m SomeCardanoApiTx)
-> SomeCardanoApiTx -> m SomeCardanoApiTx
forall a b. (a -> b) -> a -> b
$ Tx ByronEra -> EraInMode ByronEra CardanoMode -> SomeCardanoApiTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> SomeCardanoApiTx
SomeTx Tx ByronEra
tx EraInMode ByronEra CardanoMode
C.ByronEraInCardanoMode
genShelleyEraInCardanoModeTx :: (GenBase m ~ Identity, MonadGen m) => m SomeCardanoApiTx
genShelleyEraInCardanoModeTx :: m SomeCardanoApiTx
genShelleyEraInCardanoModeTx = do
Tx ShelleyEra
tx <- GenT (GenBase m) (Tx ShelleyEra) -> m (Tx ShelleyEra)
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (GenT (GenBase m) (Tx ShelleyEra) -> m (Tx ShelleyEra))
-> GenT (GenBase m) (Tx ShelleyEra) -> m (Tx ShelleyEra)
forall a b. (a -> b) -> a -> b
$ CardanoEra ShelleyEra -> Gen (Tx ShelleyEra)
forall era. IsCardanoEra era => CardanoEra era -> Gen (Tx era)
Gen.genTx CardanoEra ShelleyEra
C.ShelleyEra
SomeCardanoApiTx -> m SomeCardanoApiTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeCardanoApiTx -> m SomeCardanoApiTx)
-> SomeCardanoApiTx -> m SomeCardanoApiTx
forall a b. (a -> b) -> a -> b
$ Tx ShelleyEra
-> EraInMode ShelleyEra CardanoMode -> SomeCardanoApiTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> SomeCardanoApiTx
SomeTx Tx ShelleyEra
tx EraInMode ShelleyEra CardanoMode
C.ShelleyEraInCardanoMode
genAllegraEraInCardanoModeTx :: (GenBase m ~ Identity, MonadGen m) => m SomeCardanoApiTx
genAllegraEraInCardanoModeTx :: m SomeCardanoApiTx
genAllegraEraInCardanoModeTx = do
Tx AllegraEra
tx <- GenT (GenBase m) (Tx AllegraEra) -> m (Tx AllegraEra)
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (GenT (GenBase m) (Tx AllegraEra) -> m (Tx AllegraEra))
-> GenT (GenBase m) (Tx AllegraEra) -> m (Tx AllegraEra)
forall a b. (a -> b) -> a -> b
$ CardanoEra AllegraEra -> Gen (Tx AllegraEra)
forall era. IsCardanoEra era => CardanoEra era -> Gen (Tx era)
Gen.genTx CardanoEra AllegraEra
C.AllegraEra
SomeCardanoApiTx -> m SomeCardanoApiTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeCardanoApiTx -> m SomeCardanoApiTx)
-> SomeCardanoApiTx -> m SomeCardanoApiTx
forall a b. (a -> b) -> a -> b
$ Tx AllegraEra
-> EraInMode AllegraEra CardanoMode -> SomeCardanoApiTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> SomeCardanoApiTx
SomeTx Tx AllegraEra
tx EraInMode AllegraEra CardanoMode
C.AllegraEraInCardanoMode
genMaryEraInCardanoModeTx :: (GenBase m ~ Identity, MonadGen m) => m SomeCardanoApiTx
genMaryEraInCardanoModeTx :: m SomeCardanoApiTx
genMaryEraInCardanoModeTx = do
Tx MaryEra
tx <- GenT (GenBase m) (Tx MaryEra) -> m (Tx MaryEra)
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (GenT (GenBase m) (Tx MaryEra) -> m (Tx MaryEra))
-> GenT (GenBase m) (Tx MaryEra) -> m (Tx MaryEra)
forall a b. (a -> b) -> a -> b
$ CardanoEra MaryEra -> Gen (Tx MaryEra)
forall era. IsCardanoEra era => CardanoEra era -> Gen (Tx era)
Gen.genTx CardanoEra MaryEra
C.MaryEra
SomeCardanoApiTx -> m SomeCardanoApiTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeCardanoApiTx -> m SomeCardanoApiTx)
-> SomeCardanoApiTx -> m SomeCardanoApiTx
forall a b. (a -> b) -> a -> b
$ Tx MaryEra -> EraInMode MaryEra CardanoMode -> SomeCardanoApiTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> SomeCardanoApiTx
SomeTx Tx MaryEra
tx EraInMode MaryEra CardanoMode
C.MaryEraInCardanoMode
genBabbageEraInCardanoModeTx :: (GenBase m ~ Identity, MonadGen m) => m SomeCardanoApiTx
genBabbageEraInCardanoModeTx :: m SomeCardanoApiTx
genBabbageEraInCardanoModeTx = do
Tx BabbageEra
tx <- GenT (GenBase m) (Tx BabbageEra) -> m (Tx BabbageEra)
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (GenT (GenBase m) (Tx BabbageEra) -> m (Tx BabbageEra))
-> GenT (GenBase m) (Tx BabbageEra) -> m (Tx BabbageEra)
forall a b. (a -> b) -> a -> b
$ CardanoEra BabbageEra -> Gen (Tx BabbageEra)
forall era. IsCardanoEra era => CardanoEra era -> Gen (Tx era)
Gen.genTx CardanoEra BabbageEra
C.BabbageEra
SomeCardanoApiTx -> m SomeCardanoApiTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeCardanoApiTx -> m SomeCardanoApiTx)
-> SomeCardanoApiTx -> m SomeCardanoApiTx
forall a b. (a -> b) -> a -> b
$ Tx BabbageEra
-> EraInMode BabbageEra CardanoMode -> SomeCardanoApiTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> SomeCardanoApiTx
SomeTx Tx BabbageEra
tx EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode
genAda :: MonadGen m => m Ada
genAda :: m Ada
genAda = Integer -> Ada
Ada.lovelaceOf (Integer -> Ada) -> m Integer -> m Ada
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
100000 :: Integer))
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
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
genTokenName :: MonadGen m => m TokenName
genTokenName :: m TokenName
genTokenName = [m TokenName] -> m TokenName
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
[ ByteString -> TokenName
Value.tokenName (ByteString -> TokenName) -> m ByteString -> m TokenName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *). MonadGen m => Int -> m ByteString
genSizedByteString Int
32
, TokenName -> m TokenName
forall (f :: * -> *) a. Applicative f => a -> f a
pure TokenName
Ada.adaToken
]
genMintingPolicyHash :: MonadGen m => m Script.MintingPolicyHash
genMintingPolicyHash :: m MintingPolicyHash
genMintingPolicyHash =
BuiltinByteString -> MintingPolicyHash
Script.MintingPolicyHash (BuiltinByteString -> MintingPolicyHash)
-> (ByteString -> BuiltinByteString)
-> ByteString
-> MintingPolicyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (ByteString -> MintingPolicyHash)
-> m ByteString -> m MintingPolicyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *). MonadGen m => Int -> m ByteString
genSizedByteStringExact Int
28
genCurrencySymbol :: MonadGen m => m CurrencySymbol
genCurrencySymbol :: m CurrencySymbol
genCurrencySymbol = [m CurrencySymbol] -> m CurrencySymbol
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
[ MintingPolicyHash -> CurrencySymbol
Value.mpsSymbol (MintingPolicyHash -> CurrencySymbol)
-> m MintingPolicyHash -> m CurrencySymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m MintingPolicyHash
forall (m :: * -> *). MonadGen m => m MintingPolicyHash
genMintingPolicyHash
, CurrencySymbol -> m CurrencySymbol
forall (f :: * -> *) a. Applicative f => a -> f a
pure CurrencySymbol
Ada.adaSymbol
]
genAssetClass :: MonadGen m => m AssetClass
genAssetClass :: m AssetClass
genAssetClass =
[m AssetClass] -> m AssetClass
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
[ AssetClass -> m AssetClass
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssetClass
adaAssetClass
, CurrencySymbol -> TokenName -> AssetClass
Value.assetClass
(CurrencySymbol -> TokenName -> AssetClass)
-> m CurrencySymbol -> m (TokenName -> AssetClass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MintingPolicyHash -> CurrencySymbol
Value.mpsSymbol (MintingPolicyHash -> CurrencySymbol)
-> m MintingPolicyHash -> m CurrencySymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m MintingPolicyHash
forall (m :: * -> *). MonadGen m => m MintingPolicyHash
genMintingPolicyHash)
m (TokenName -> AssetClass) -> m TokenName -> m AssetClass
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m TokenName
forall (m :: * -> *). MonadGen m => m TokenName
genTokenName
]
where
adaAssetClass :: AssetClass
adaAssetClass :: AssetClass
adaAssetClass = CurrencySymbol -> TokenName -> AssetClass
Value.assetClass CurrencySymbol
Ada.adaSymbol TokenName
Ada.adaToken
genSingleton :: MonadGen m => Range Integer -> m Value
genSingleton :: Range Integer -> m Value
genSingleton Range Integer
range =
AssetClass -> Integer -> Value
Value.assetClassValue (AssetClass -> Integer -> Value)
-> m AssetClass -> m (Integer -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m AssetClass
forall (m :: * -> *). MonadGen m => m AssetClass
genAssetClass m (Integer -> Value) -> m Integer -> m Value
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Integer -> m Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral Range Integer
range
genValue' :: MonadGen m => Range Integer -> m Value
genValue' :: Range Integer -> m Value
genValue' Range Integer
valueRange = do
let
maxCurrencies :: Int
maxCurrencies = Int
5
Int
numValues <- Range Int -> m 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) -> m [Value] -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m Value) -> [Int] -> m [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (m Value -> Int -> m Value
forall a b. a -> b -> a
const (m Value -> Int -> m Value) -> m Value -> Int -> m Value
forall a b. (a -> b) -> a -> b
$ Range Integer -> m Value
forall (m :: * -> *). MonadGen m => Range Integer -> m Value
genSingleton Range Integer
valueRange) [Int
0 .. Int
numValues]
genValue :: MonadGen m => m Value
genValue :: m Value
genValue = Range Integer -> m Value
forall (m :: * -> *). MonadGen m => Range Integer -> m Value
genValue' (Range Integer -> m Value) -> Range Integer -> m 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
genValueNonNegative :: MonadGen m => m Value
genValueNonNegative :: m Value
genValueNonNegative = Range Integer -> m Value
forall (m :: * -> *). MonadGen m => Range Integer -> m Value
genValue' (Range Integer -> m Value) -> Range Integer -> m 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
assertValid :: (MonadTest m, HasCallStack)
=> CardanoTx
-> Mockchain
-> m ()
assertValid :: CardanoTx -> Mockchain -> m ()
assertValid CardanoTx
tx Mockchain
mc = 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 -> Bool)
-> Maybe ValidationErrorInPhase -> Bool
forall a b. (a -> b) -> a -> b
$ Mockchain -> CardanoTx -> Maybe ValidationErrorInPhase
validateMockchain Mockchain
mc CardanoTx
tx
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
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