{-# LANGUAGE DuplicateRecordFields #-}
module Hydra.Chain.Direct.WalletSpec where
import Hydra.Prelude
import Test.Hydra.Prelude
import Cardano.Ledger.Api (EraTx (getMinFeeTx), EraTxBody (feeTxBodyL, inputsTxBodyL), PParams, bodyTxL, coinTxOutL, outputsTxBodyL)
import Cardano.Ledger.Babbage.Tx (AlonzoTx (..))
import Cardano.Ledger.Babbage.TxBody (BabbageTxBody (..), BabbageTxOut (..))
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core (Tx, Value)
import Cardano.Ledger.SafeHash qualified as SafeHash
import Cardano.Ledger.Shelley.API qualified as Ledger
import Cardano.Ledger.Val (Val (..), invert)
import Control.Concurrent (newEmptyMVar, putMVar, takeMVar)
import Control.Lens (set, view, (.~), (<>~), (^.))
import Control.Tracer (nullTracer)
import Data.Map.Strict qualified as Map
import Data.Sequence.Strict qualified as StrictSeq
import Data.Set qualified as Set
import Hydra.Cardano.Api (
ChainPoint (ChainPoint),
Hash (HeaderHash),
LedgerEra,
PaymentCredential (PaymentCredentialByKey),
PaymentKey,
SlotNo,
VerificationKey,
fromLedgerTx,
fromLedgerTxOut,
fromLedgerUTxO,
genTxIn,
selectLovelace,
toLedgerTxIn,
toLedgerUTxO,
txOutValue,
verificationKeyHash,
)
import Hydra.Cardano.Api qualified as Api
import Hydra.Cardano.Api.Prelude (fromShelleyPaymentCredential)
import Hydra.Cardano.Api.Pretty (renderTx)
import Hydra.Cardano.Api.Tx (signTx, toLedgerTx)
import Hydra.Chain.CardanoClient (QueryPoint (..))
import Hydra.Chain.Direct.Fixture qualified as Fixture
import Hydra.Chain.Direct.Wallet (
Address,
ChainQuery,
TinyWallet (..),
TxIn,
TxOut,
WalletInfoOnChain (..),
applyTxs,
coverFee_,
findLargestUTxO,
newTinyWallet,
)
import Hydra.Ledger.Cardano (genKeyPair, genOneUTxOFor, genSigningKey)
import Test.QuickCheck (
Property,
checkCoverage,
conjoin,
counterexample,
cover,
forAll,
forAllBlind,
frequency,
generate,
getSize,
property,
resize,
scale,
suchThat,
vectorOf,
(.&&.),
)
import Prelude qualified
spec :: Spec
spec :: Spec
spec = Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"genTxsSpending / genUTxO" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"are well-suited for testing" Property
prop_wellSuitedGenerators
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"applyTxs" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"only reduces the UTXO set when no address is ours" Property
prop_reducesWhenNotOurs
String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Seen inputs are consumed and not in the resulting UTXO" Property
prop_seenInputsAreConsumed
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"coverFee" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"sets min utxo values" Property
prop_setsMinUTxOValue
String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"balances transaction with fees" Property
prop_balanceTransaction
String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"prefers largest utxo" Property
prop_picksLargestUTxOToPayTheFees
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"newTinyWallet" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"initialises wallet by querying UTxO" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> ((VerificationKey PaymentKey, SigningKey PaymentKey) -> IO ())
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair (((VerificationKey PaymentKey, SigningKey PaymentKey) -> IO ())
-> Property)
-> ((VerificationKey PaymentKey, SigningKey PaymentKey) -> IO ())
-> Property
forall a b. (a -> b) -> a -> b
$ \(VerificationKey PaymentKey
vk, SigningKey PaymentKey
sk) -> do
TinyWallet IO
wallet <- Tracer IO TinyWalletLog
-> NetworkId
-> (VerificationKey PaymentKey, SigningKey PaymentKey)
-> ChainQuery IO
-> IO (EpochInfo (Either Text))
-> IO (TinyWallet IO)
newTinyWallet Tracer IO TinyWalletLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer NetworkId
Fixture.testNetworkId (VerificationKey PaymentKey
vk, SigningKey PaymentKey
sk) (VerificationKey PaymentKey -> ChainQuery IO
mockChainQuery VerificationKey PaymentKey
vk) (EpochInfo (Either Text) -> IO (EpochInfo (Either Text))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
Fixture.epochInfo)
Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo <- STM IO (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> IO (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TinyWallet IO -> STM IO (Map TxIn TxOut)
forall (m :: * -> *). TinyWallet m -> STM m (Map TxIn TxOut)
getUTxO TinyWallet IO
wallet)
Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Bool)
-> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` \Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
m -> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Int
forall k a. Map k a -> Int
Map.size Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"re-queries UTxO from the tip, even on reset" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> ((VerificationKey PaymentKey, SigningKey PaymentKey) -> IO ())
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair (((VerificationKey PaymentKey, SigningKey PaymentKey) -> IO ())
-> Property)
-> ((VerificationKey PaymentKey, SigningKey PaymentKey) -> IO ())
-> Property
forall a b. (a -> b) -> a -> b
$ \(VerificationKey PaymentKey
vk, SigningKey PaymentKey
sk) -> do
(ChainQuery IO
queryFn, QueryPoint -> IO ()
assertQueryPoint) <- VerificationKey PaymentKey
-> IO (ChainQuery IO, QueryPoint -> IO ())
setupQuery VerificationKey PaymentKey
vk
TinyWallet IO
wallet <- Tracer IO TinyWalletLog
-> NetworkId
-> (VerificationKey PaymentKey, SigningKey PaymentKey)
-> ChainQuery IO
-> IO (EpochInfo (Either Text))
-> IO (TinyWallet IO)
newTinyWallet Tracer IO TinyWalletLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer NetworkId
Fixture.testNetworkId (VerificationKey PaymentKey
vk, SigningKey PaymentKey
sk) ChainQuery IO
queryFn (EpochInfo (Either Text) -> IO (EpochInfo (Either Text))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
Fixture.epochInfo)
QueryPoint -> IO ()
assertQueryPoint QueryPoint
QueryTip
TinyWallet IO -> IO ()
forall (m :: * -> *). TinyWallet m -> m ()
reset TinyWallet IO
wallet
QueryPoint -> IO ()
assertQueryPoint QueryPoint
QueryTip
setupQuery ::
VerificationKey PaymentKey ->
IO (ChainQuery IO, QueryPoint -> Expectation)
setupQuery :: VerificationKey PaymentKey
-> IO (ChainQuery IO, QueryPoint -> IO ())
setupQuery VerificationKey PaymentKey
vk = do
MVar QueryPoint
queryPointMVar <- IO (MVar QueryPoint)
forall a. IO (MVar a)
newEmptyMVar
(ChainQuery IO, QueryPoint -> IO ())
-> IO (ChainQuery IO, QueryPoint -> IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVar QueryPoint -> ChainQuery IO
queryFn MVar QueryPoint
queryPointMVar, MVar QueryPoint -> QueryPoint -> IO ()
forall {a}. (Show a, Eq a) => MVar a -> a -> IO ()
assertQueryPoint MVar QueryPoint
queryPointMVar)
where
queryFn :: MVar QueryPoint -> ChainQuery IO
queryFn MVar QueryPoint
queryPointMVar QueryPoint
point Address ShelleyAddr
_addr = do
MVar QueryPoint -> QueryPoint -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar QueryPoint
queryPointMVar QueryPoint
point
Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
walletUTxO <- UTxO (BabbageEra StandardCrypto)
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
Ledger.unUTxO (UTxO (BabbageEra StandardCrypto)
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto)))
-> (UTxO -> UTxO (BabbageEra StandardCrypto))
-> UTxO
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> UTxO LedgerEra
UTxO -> UTxO (BabbageEra StandardCrypto)
toLedgerUTxO (UTxO
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto)))
-> IO UTxO
-> IO
(Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UTxO -> IO UTxO
forall a. Gen a -> IO a
generate (VerificationKey PaymentKey -> Gen UTxO
genOneUTxOFor VerificationKey PaymentKey
vk)
ChainPoint
tip <- Gen ChainPoint -> IO ChainPoint
forall a. Gen a -> IO a
generate Gen ChainPoint
forall a. Arbitrary a => Gen a
arbitrary
WalletInfoOnChain -> IO WalletInfoOnChain
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalletInfoOnChain -> IO WalletInfoOnChain)
-> WalletInfoOnChain -> IO WalletInfoOnChain
forall a b. (a -> b) -> a -> b
$
WalletInfoOnChain
{ Map TxIn TxOut
Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
walletUTxO :: Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
$sel:walletUTxO:WalletInfoOnChain :: Map TxIn TxOut
walletUTxO
, $sel:pparams:WalletInfoOnChain :: PParams LedgerEra
pparams = PParams LedgerEra
Fixture.pparams
, $sel:systemStart:WalletInfoOnChain :: SystemStart
systemStart = SystemStart
Fixture.systemStart
, $sel:epochInfo:WalletInfoOnChain :: EpochInfo (Either Text)
epochInfo = EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
Fixture.epochInfo
, ChainPoint
tip :: ChainPoint
$sel:tip:WalletInfoOnChain :: ChainPoint
tip
}
assertQueryPoint :: MVar a -> a -> IO ()
assertQueryPoint MVar a
queryPointMVar a
point =
MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
queryPointMVar IO a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` a
point
mockChainQuery :: VerificationKey PaymentKey -> ChainQuery IO
mockChainQuery :: VerificationKey PaymentKey -> ChainQuery IO
mockChainQuery VerificationKey PaymentKey
vk QueryPoint
_point Address ShelleyAddr
addr = do
let Api.ShelleyAddress Network
_ PaymentCredential StandardCrypto
cred StakeReference StandardCrypto
_ = Address ShelleyAddr
addr
PaymentCredential StandardCrypto -> PaymentCredential
fromShelleyPaymentCredential PaymentCredential StandardCrypto
cred PaymentCredential -> PaymentCredential -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
vk)
Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
walletUTxO <- UTxO (BabbageEra StandardCrypto)
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
Ledger.unUTxO (UTxO (BabbageEra StandardCrypto)
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto)))
-> (UTxO -> UTxO (BabbageEra StandardCrypto))
-> UTxO
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> UTxO LedgerEra
UTxO -> UTxO (BabbageEra StandardCrypto)
toLedgerUTxO (UTxO
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto)))
-> IO UTxO
-> IO
(Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UTxO -> IO UTxO
forall a. Gen a -> IO a
generate (VerificationKey PaymentKey -> Gen UTxO
genOneUTxOFor VerificationKey PaymentKey
vk)
ChainPoint
tip <- Gen ChainPoint -> IO ChainPoint
forall a. Gen a -> IO a
generate Gen ChainPoint
forall a. Arbitrary a => Gen a
arbitrary
WalletInfoOnChain -> IO WalletInfoOnChain
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalletInfoOnChain -> IO WalletInfoOnChain)
-> WalletInfoOnChain -> IO WalletInfoOnChain
forall a b. (a -> b) -> a -> b
$
WalletInfoOnChain
{ Map TxIn TxOut
Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
$sel:walletUTxO:WalletInfoOnChain :: Map TxIn TxOut
walletUTxO :: Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
walletUTxO
, $sel:pparams:WalletInfoOnChain :: PParams LedgerEra
pparams = PParams LedgerEra
Fixture.pparams
, $sel:systemStart:WalletInfoOnChain :: SystemStart
systemStart = SystemStart
Fixture.systemStart
, $sel:epochInfo:WalletInfoOnChain :: EpochInfo (Either Text)
epochInfo = EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
Fixture.epochInfo
, ChainPoint
$sel:tip:WalletInfoOnChain :: ChainPoint
tip :: ChainPoint
tip
}
prop_wellSuitedGenerators ::
Property
prop_wellSuitedGenerators :: Property
prop_wellSuitedGenerators =
Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO ((Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Property)
-> Property)
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo ->
Gen [AlonzoTx (BabbageEra StandardCrypto)]
-> ([AlonzoTx (BabbageEra StandardCrypto)] -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Map TxIn TxOut -> Gen [Tx LedgerEra]
genTxsSpending Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo) (([AlonzoTx (BabbageEra StandardCrypto)] -> Property) -> Property)
-> ([AlonzoTx (BabbageEra StandardCrypto)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[AlonzoTx (BabbageEra StandardCrypto)]
txs ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property ([AlonzoTx (BabbageEra StandardCrypto)] -> Bool
forall {t :: * -> *} {a}. Foldable t => t a -> Bool
smallTxSets [AlonzoTx (BabbageEra StandardCrypto)]
txs)
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
0.3 (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> [AlonzoTx (BabbageEra StandardCrypto)] -> Bool
noneIsOurs Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo [AlonzoTx (BabbageEra StandardCrypto)]
txs) String
"has no tx that are ours"
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
0.2 (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> [AlonzoTx (BabbageEra StandardCrypto)] -> Bool
someAreDependent Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo [AlonzoTx (BabbageEra StandardCrypto)]
txs) String
"has dependent txs"
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& Property -> Property
forall prop. Testable prop => prop -> Property
checkCoverage
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"All TxIns: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show (Set TxIn -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Set TxIn -> Int) -> Set TxIn -> Int
forall a b. (a -> b) -> a -> b
$ [Tx LedgerEra] -> Set TxIn
allTxIns [AlonzoTx (BabbageEra StandardCrypto)]
[Tx LedgerEra]
txs))
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"All TxOuts: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show ([TxOut] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxOut] -> Int) -> [TxOut] -> Int
forall a b. (a -> b) -> a -> b
$ [Tx LedgerEra] -> [TxOut]
allTxOuts [AlonzoTx (BabbageEra StandardCrypto)]
[Tx LedgerEra]
txs))
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Our TxIns: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show ([TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxIn] -> Int) -> [TxIn] -> Int
forall a b. (a -> b) -> a -> b
$ Map TxIn TxOut -> [Tx LedgerEra] -> [TxIn]
ourDirectInputs Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo [AlonzoTx (BabbageEra StandardCrypto)]
[Tx LedgerEra]
txs))
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Our TxOuts: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show ([TxOut] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxOut] -> Int) -> [TxOut] -> Int
forall a b. (a -> b) -> a -> b
$ Map TxIn TxOut -> [Tx LedgerEra] -> [TxOut]
ourOutputs Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo [AlonzoTx (BabbageEra StandardCrypto)]
[Tx LedgerEra]
txs))
where
smallTxSets :: t a -> Bool
smallTxSets t a
txs =
t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
txs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10
noneIsOurs :: Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> [AlonzoTx (BabbageEra StandardCrypto)] -> Bool
noneIsOurs Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo [AlonzoTx (BabbageEra StandardCrypto)]
txs =
[TxIn] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map TxIn TxOut -> [Tx LedgerEra] -> [TxIn]
ourDirectInputs Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo [AlonzoTx (BabbageEra StandardCrypto)]
[Tx LedgerEra]
txs) Bool -> Bool -> Bool
&& [BabbageTxOut (BabbageEra StandardCrypto)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map TxIn TxOut -> [Tx LedgerEra] -> [TxOut]
ourOutputs Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo [AlonzoTx (BabbageEra StandardCrypto)]
[Tx LedgerEra]
txs)
someAreDependent :: Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> [AlonzoTx (BabbageEra StandardCrypto)] -> Bool
someAreDependent Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo [AlonzoTx (BabbageEra StandardCrypto)]
txs =
[TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Map TxIn TxOut -> [Tx LedgerEra] -> [TxIn]
ourDirectInputs Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo [AlonzoTx (BabbageEra StandardCrypto)]
[Tx LedgerEra]
txs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [BabbageTxOut (BabbageEra StandardCrypto)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Map TxIn TxOut -> [Tx LedgerEra] -> [TxOut]
ourOutputs Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo [AlonzoTx (BabbageEra StandardCrypto)]
[Tx LedgerEra]
txs)
prop_reducesWhenNotOurs :: Property
prop_reducesWhenNotOurs :: Property
prop_reducesWhenNotOurs =
Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO ((Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Property)
-> Property)
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo ->
Gen [AlonzoTx (BabbageEra StandardCrypto)]
-> ([AlonzoTx (BabbageEra StandardCrypto)] -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Map TxIn TxOut -> Gen [Tx LedgerEra]
genTxsSpending Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo) (([AlonzoTx (BabbageEra StandardCrypto)] -> Property) -> Property)
-> ([AlonzoTx (BabbageEra StandardCrypto)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[AlonzoTx (BabbageEra StandardCrypto)]
txs ->
let utxo' :: Map TxIn TxOut
utxo' = [Tx] -> (Address -> Bool) -> Map TxIn TxOut -> Map TxIn TxOut
applyTxs (AlonzoTx (BabbageEra StandardCrypto) -> Tx
Tx LedgerEra -> Tx
fromLedgerTx (AlonzoTx (BabbageEra StandardCrypto) -> Tx)
-> [AlonzoTx (BabbageEra StandardCrypto)] -> [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AlonzoTx (BabbageEra StandardCrypto)]
txs) (Bool -> Address -> Bool
forall a b. a -> b -> a
const Bool
False) Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo
in (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Int
forall a. Map TxIn a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Int
forall a. Map TxIn a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo)
Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"New UTXO: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> String
forall b a. (Show a, IsString b) => a -> b
show Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo')
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"UTXO size: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Int
forall a. Map TxIn a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo))
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"New UTXO size: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Int
forall a. Map TxIn a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo'))
prop_seenInputsAreConsumed :: Property
prop_seenInputsAreConsumed :: Property
prop_seenInputsAreConsumed =
Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO ((Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Property)
-> Property)
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo ->
Gen [AlonzoTx (BabbageEra StandardCrypto)]
-> ([AlonzoTx (BabbageEra StandardCrypto)] -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Map TxIn TxOut -> Gen [Tx LedgerEra]
genTxsSpending Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo) (([AlonzoTx (BabbageEra StandardCrypto)] -> Property) -> Property)
-> ([AlonzoTx (BabbageEra StandardCrypto)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[AlonzoTx (BabbageEra StandardCrypto)]
txs ->
let utxo' :: Map TxIn TxOut
utxo' = [Tx] -> (Address -> Bool) -> Map TxIn TxOut -> Map TxIn TxOut
applyTxs (AlonzoTx (BabbageEra StandardCrypto) -> Tx
Tx LedgerEra -> Tx
fromLedgerTx (AlonzoTx (BabbageEra StandardCrypto) -> Tx)
-> [AlonzoTx (BabbageEra StandardCrypto)] -> [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AlonzoTx (BabbageEra StandardCrypto)]
txs) (Map TxIn TxOut -> Address -> Bool
isOurs Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo) Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo
seenInputs :: Set TxIn
seenInputs = [Item (Set TxIn)] -> Set TxIn
forall l. IsList l => [Item l] -> l
fromList ([Item (Set TxIn)] -> Set TxIn) -> [Item (Set TxIn)] -> Set TxIn
forall a b. (a -> b) -> a -> b
$ Map TxIn TxOut -> [Tx LedgerEra] -> [TxIn]
ourDirectInputs Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo [AlonzoTx (BabbageEra StandardCrypto)]
[Tx LedgerEra]
txs
in Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Bool
forall a. Map TxIn a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Set TxIn -> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo' Set TxIn
seenInputs)
Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Seen inputs: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Set TxIn -> String
forall b a. (Show a, IsString b) => a -> b
show Set TxIn
seenInputs)
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"New UTXO: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> String
forall b a. (Show a, IsString b) => a -> b
show Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo')
prop_setsMinUTxOValue :: Property
prop_setsMinUTxOValue :: Property
prop_setsMinUTxOValue =
Gen (AlonzoTx (BabbageEra StandardCrypto))
-> (AlonzoTx (BabbageEra StandardCrypto) -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Int
-> Gen (AlonzoTx (BabbageEra StandardCrypto))
-> Gen (AlonzoTx (BabbageEra StandardCrypto))
forall a. Int -> Gen a -> Gen a
resize Int
0 Gen (AlonzoTx (BabbageEra StandardCrypto))
Gen (Tx LedgerEra)
genLedgerTx) ((AlonzoTx (BabbageEra StandardCrypto) -> Property) -> Property)
-> (AlonzoTx (BabbageEra StandardCrypto) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \AlonzoTx (BabbageEra StandardCrypto)
tx ->
Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Gen (Map TxIn TxOut) -> Gen (Map TxIn TxOut)
forall a. Gen a -> Gen a
reasonablySized (Gen (Map TxIn TxOut) -> Gen (Map TxIn TxOut))
-> Gen (Map TxIn TxOut) -> Gen (Map TxIn TxOut)
forall a b. (a -> b) -> a -> b
$ Tx LedgerEra -> Gen (Map TxIn TxOut)
genOutputsForInputs AlonzoTx (BabbageEra StandardCrypto)
Tx LedgerEra
tx) ((Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Property)
-> Property)
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
lookupUTxO ->
Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
forall a. Gen a -> Gen a
reasonablySized Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO) ((Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Property)
-> Property)
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
walletUTxO ->
Gen (TxOut (BabbageEra StandardCrypto))
-> (TxOut (BabbageEra StandardCrypto) -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (TxOut (BabbageEra StandardCrypto))
genTxOutWithoutADA ((TxOut (BabbageEra StandardCrypto) -> Property) -> Property)
-> (TxOut (BabbageEra StandardCrypto) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \TxOut (BabbageEra StandardCrypto)
txOutWithoutADA -> do
let newTx :: AlonzoTx (BabbageEra StandardCrypto)
newTx = AlonzoTx (BabbageEra StandardCrypto)
tx AlonzoTx (BabbageEra StandardCrypto)
-> (AlonzoTx (BabbageEra StandardCrypto)
-> AlonzoTx (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (TxBody (BabbageEra StandardCrypto)
-> Identity (TxBody (BabbageEra StandardCrypto)))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Identity (AlonzoTx (BabbageEra StandardCrypto))
(TxBody (BabbageEra StandardCrypto)
-> Identity (TxBody (BabbageEra StandardCrypto)))
-> Tx (BabbageEra StandardCrypto)
-> Identity (Tx (BabbageEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
(Tx (BabbageEra StandardCrypto))
(TxBody (BabbageEra StandardCrypto))
bodyTxL ((TxBody (BabbageEra StandardCrypto)
-> Identity (TxBody (BabbageEra StandardCrypto)))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Identity (AlonzoTx (BabbageEra StandardCrypto)))
-> ((StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Identity (StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Identity (TxBody (BabbageEra StandardCrypto)))
-> (StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Identity (StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Identity (AlonzoTx (BabbageEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Identity (StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Identity (TxBody (BabbageEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
(TxBody (BabbageEra StandardCrypto))
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
outputsTxBodyL ((StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Identity (StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Identity (AlonzoTx (BabbageEra StandardCrypto)))
-> StrictSeq (TxOut (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto)
-> AlonzoTx (BabbageEra StandardCrypto)
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ TxOut (BabbageEra StandardCrypto)
-> StrictSeq (TxOut (BabbageEra StandardCrypto))
forall a. a -> StrictSeq a
StrictSeq.singleton TxOut (BabbageEra StandardCrypto)
txOutWithoutADA
case PParams LedgerEra
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn TxOut
-> Map TxIn TxOut
-> AlonzoTx LedgerEra
-> Either ErrCoverFee (AlonzoTx LedgerEra)
coverFee_ PParams LedgerEra
Fixture.pparams SystemStart
Fixture.systemStart EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
Fixture.epochInfo Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
lookupUTxO Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
walletUTxO AlonzoTx LedgerEra
AlonzoTx (BabbageEra StandardCrypto)
newTx of
Left ErrCoverFee
err ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ErrCoverFee -> String
forall b a. (Show a, IsString b) => a -> b
show ErrCoverFee
err)
Right AlonzoTx LedgerEra
balancedTx -> do
let outs :: [TxOut (BabbageEra StandardCrypto)]
outs = StrictSeq (TxOut (BabbageEra StandardCrypto))
-> [TxOut (BabbageEra StandardCrypto)]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (TxOut (BabbageEra StandardCrypto))
-> [TxOut (BabbageEra StandardCrypto)])
-> StrictSeq (TxOut (BabbageEra StandardCrypto))
-> [TxOut (BabbageEra StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ AlonzoTx LedgerEra
AlonzoTx (BabbageEra StandardCrypto)
balancedTx AlonzoTx (BabbageEra StandardCrypto)
-> Getting
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(AlonzoTx (BabbageEra StandardCrypto))
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
-> StrictSeq (TxOut (BabbageEra StandardCrypto))
forall s a. s -> Getting a s a -> a
^. (TxBody (BabbageEra StandardCrypto)
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto)))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(AlonzoTx (BabbageEra StandardCrypto))
(TxBody (BabbageEra StandardCrypto)
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto)))
-> Tx (BabbageEra StandardCrypto)
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(Tx (BabbageEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
(Tx (BabbageEra StandardCrypto))
(TxBody (BabbageEra StandardCrypto))
bodyTxL ((TxBody (BabbageEra StandardCrypto)
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto)))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(AlonzoTx (BabbageEra StandardCrypto)))
-> ((StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto)))
-> Getting
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(AlonzoTx (BabbageEra StandardCrypto))
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
(TxBody (BabbageEra StandardCrypto))
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
outputsTxBodyL
Bool -> Bool
not ((TxOut (BabbageEra StandardCrypto) -> Bool)
-> [TxOut (BabbageEra StandardCrypto)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\TxOut (BabbageEra StandardCrypto)
o -> TxOut (BabbageEra StandardCrypto)
o TxOut (BabbageEra StandardCrypto)
-> Getting Coin (TxOut (BabbageEra StandardCrypto)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut (BabbageEra StandardCrypto)) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut (BabbageEra StandardCrypto)) Coin
coinTxOutL Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
forall a. Monoid a => a
mempty) [TxOut (BabbageEra StandardCrypto)]
outs)
Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"No 0 ADA outputs expected:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [TxOut (BabbageEra StandardCrypto)] -> String
forall b a. (Show a, IsString b) => a -> b
show [TxOut (BabbageEra StandardCrypto)]
outs)
where
genTxOutWithoutADA :: Gen (TxOut (BabbageEra StandardCrypto))
genTxOutWithoutADA = Gen (TxOut (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary Gen (TxOut (BabbageEra StandardCrypto))
-> (TxOut (BabbageEra StandardCrypto)
-> TxOut (BabbageEra StandardCrypto))
-> Gen (TxOut (BabbageEra StandardCrypto))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Coin -> Identity Coin)
-> TxOut (BabbageEra StandardCrypto)
-> Identity (TxOut (BabbageEra StandardCrypto))
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut (BabbageEra StandardCrypto)) Coin
coinTxOutL ((Coin -> Identity Coin)
-> TxOut (BabbageEra StandardCrypto)
-> Identity (TxOut (BabbageEra StandardCrypto)))
-> Coin
-> TxOut (BabbageEra StandardCrypto)
-> TxOut (BabbageEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
forall a. Monoid a => a
mempty
prop_balanceTransaction :: Property
prop_balanceTransaction :: Property
prop_balanceTransaction =
Gen (AlonzoTx (BabbageEra StandardCrypto))
-> (AlonzoTx (BabbageEra StandardCrypto) -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Int
-> Gen (AlonzoTx (BabbageEra StandardCrypto))
-> Gen (AlonzoTx (BabbageEra StandardCrypto))
forall a. Int -> Gen a -> Gen a
resize Int
0 Gen (AlonzoTx (BabbageEra StandardCrypto))
Gen (Tx LedgerEra)
genLedgerTx) ((AlonzoTx (BabbageEra StandardCrypto) -> Property) -> Property)
-> (AlonzoTx (BabbageEra StandardCrypto) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \AlonzoTx (BabbageEra StandardCrypto)
tx ->
Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Gen (Map TxIn TxOut) -> Gen (Map TxIn TxOut)
forall a. Gen a -> Gen a
reasonablySized (Gen (Map TxIn TxOut) -> Gen (Map TxIn TxOut))
-> Gen (Map TxIn TxOut) -> Gen (Map TxIn TxOut)
forall a b. (a -> b) -> a -> b
$ Tx LedgerEra -> Gen (Map TxIn TxOut)
genOutputsForInputs AlonzoTx (BabbageEra StandardCrypto)
Tx LedgerEra
tx) ((Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Property)
-> Property)
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
lookupUTxO ->
Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
forall a. Gen a -> Gen a
reasonablySized Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO) ((Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Property)
-> Property)
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
walletUTxO ->
case PParams LedgerEra
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn TxOut
-> Map TxIn TxOut
-> AlonzoTx LedgerEra
-> Either ErrCoverFee (AlonzoTx LedgerEra)
coverFee_ PParams LedgerEra
Fixture.pparams SystemStart
Fixture.systemStart EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
Fixture.epochInfo Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
lookupUTxO Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
walletUTxO AlonzoTx LedgerEra
AlonzoTx (BabbageEra StandardCrypto)
tx of
Left ErrCoverFee
err ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ErrCoverFee -> String
forall b a. (Show a, IsString b) => a -> b
show ErrCoverFee
err)
Right AlonzoTx LedgerEra
tx' ->
Gen (SigningKey PaymentKey)
-> (SigningKey PaymentKey -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen (SigningKey PaymentKey)
genSigningKey ((SigningKey PaymentKey -> Property) -> Property)
-> (SigningKey PaymentKey -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \SigningKey PaymentKey
sk -> do
let signedTx :: Tx LedgerEra
signedTx = Tx -> Tx LedgerEra
forall era.
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto,
AlonzoEraTx (ShelleyLedgerEra era)) =>
Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx (Tx -> Tx LedgerEra) -> Tx -> Tx LedgerEra
forall a b. (a -> b) -> a -> b
$ SigningKey PaymentKey -> Tx -> Tx
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
sk (Tx LedgerEra -> Tx
fromLedgerTx AlonzoTx LedgerEra
Tx LedgerEra
tx')
[Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
[ Map TxIn TxOut -> Tx LedgerEra -> Tx LedgerEra -> Property
isBalanced (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
lookupUTxO Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
forall a. Semigroup a => a -> a -> a
<> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
walletUTxO) AlonzoTx (BabbageEra StandardCrypto)
Tx LedgerEra
tx Tx LedgerEra
signedTx
, PParams LedgerEra -> Tx LedgerEra -> Property
hasLowFees PParams LedgerEra
Fixture.pparams Tx LedgerEra
signedTx
]
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Signed tx: \n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Tx -> String
renderTx (Tx LedgerEra -> Tx
fromLedgerTx Tx LedgerEra
signedTx))
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Balanced tx: \n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Tx -> String
renderTx (Tx LedgerEra -> Tx
fromLedgerTx AlonzoTx LedgerEra
Tx LedgerEra
tx'))
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Partial tx: \n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Tx -> String
renderTx (Tx LedgerEra -> Tx
fromLedgerTx AlonzoTx (BabbageEra StandardCrypto)
Tx LedgerEra
tx))
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Lookup UTXO: \n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
lookupUTxO))
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Wallet UTXO: \n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
walletUTxO))
hasLowFees :: PParams LedgerEra -> Tx LedgerEra -> Property
hasLowFees :: PParams LedgerEra -> Tx LedgerEra -> Property
hasLowFees PParams LedgerEra
pparams Tx LedgerEra
tx =
String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"PParams: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> PParams (BabbageEra StandardCrypto) -> String
forall b a. (Show a, IsString b) => a -> b
show PParams LedgerEra
PParams (BabbageEra StandardCrypto)
pparams) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Property
notTooLow Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. Property
notTooHigh
where
notTooLow :: Property
notTooLow =
Coin
actualFee Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
minFee
Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Fee too low: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall b a. (Show a, IsString b) => a -> b
show Coin
actualFee String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" < " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall b a. (Show a, IsString b) => a -> b
show Coin
minFee)
notTooHigh :: Property
notTooHigh =
Coin
actualFee Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
minFee Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
acceptableOverestimation
Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Fee too high: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall b a. (Show a, IsString b) => a -> b
show Coin
actualFee String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" > " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall b a. (Show a, IsString b) => a -> b
show (Coin
minFee Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
acceptableOverestimation))
acceptableOverestimation :: Coin
acceptableOverestimation = Integer -> Coin
Coin Integer
100_000
actualFee :: Coin
actualFee = AlonzoTx (BabbageEra StandardCrypto)
Tx LedgerEra
tx AlonzoTx (BabbageEra StandardCrypto)
-> Getting Coin (AlonzoTx (BabbageEra StandardCrypto)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody (BabbageEra StandardCrypto)
-> Const Coin (TxBody (BabbageEra StandardCrypto)))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Const Coin (AlonzoTx (BabbageEra StandardCrypto))
(TxBody (BabbageEra StandardCrypto)
-> Const Coin (TxBody (BabbageEra StandardCrypto)))
-> Tx (BabbageEra StandardCrypto)
-> Const Coin (Tx (BabbageEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
(Tx (BabbageEra StandardCrypto))
(TxBody (BabbageEra StandardCrypto))
bodyTxL ((TxBody (BabbageEra StandardCrypto)
-> Const Coin (TxBody (BabbageEra StandardCrypto)))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Const Coin (AlonzoTx (BabbageEra StandardCrypto)))
-> ((Coin -> Const Coin Coin)
-> TxBody (BabbageEra StandardCrypto)
-> Const Coin (TxBody (BabbageEra StandardCrypto)))
-> Getting Coin (AlonzoTx (BabbageEra StandardCrypto)) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody (BabbageEra StandardCrypto)
-> Const Coin (TxBody (BabbageEra StandardCrypto))
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody (BabbageEra StandardCrypto)) Coin
feeTxBodyL
minFee :: Coin
minFee = PParams (BabbageEra StandardCrypto)
-> Tx (BabbageEra StandardCrypto) -> Coin
forall era. EraTx era => PParams era -> Tx era -> Coin
getMinFeeTx PParams LedgerEra
PParams (BabbageEra StandardCrypto)
pparams Tx LedgerEra
Tx (BabbageEra StandardCrypto)
tx
isBalanced :: Map TxIn TxOut -> Tx LedgerEra -> Tx LedgerEra -> Property
isBalanced :: Map TxIn TxOut -> Tx LedgerEra -> Tx LedgerEra -> Property
isBalanced Map TxIn TxOut
utxo Tx LedgerEra
originalTx Tx LedgerEra
balancedTx =
let inp' :: Value LedgerEra
inp' = Map TxIn TxOut -> Tx LedgerEra -> Value LedgerEra
knownInputBalance Map TxIn TxOut
utxo Tx LedgerEra
balancedTx
out' :: Value LedgerEra
out' = Tx LedgerEra -> Value LedgerEra
outputBalance Tx LedgerEra
balancedTx
out :: Value LedgerEra
out = Tx LedgerEra -> Value LedgerEra
outputBalance Tx LedgerEra
originalTx
fee :: Coin
fee = (((Coin -> Const Coin Coin)
-> TxBody (BabbageEra StandardCrypto)
-> Const Coin (TxBody (BabbageEra StandardCrypto)))
-> TxBody (BabbageEra StandardCrypto) -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Coin -> Const Coin Coin)
-> TxBody (BabbageEra StandardCrypto)
-> Const Coin (TxBody (BabbageEra StandardCrypto))
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody (BabbageEra StandardCrypto)) Coin
feeTxBodyL (TxBody (BabbageEra StandardCrypto) -> Coin)
-> (AlonzoTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body) AlonzoTx (BabbageEra StandardCrypto)
Tx LedgerEra
balancedTx
in MaryValue StandardCrypto -> Coin
forall t. Val t => t -> Coin
coin (Value LedgerEra -> Value LedgerEra -> Value LedgerEra
deltaValue Value LedgerEra
out' Value LedgerEra
inp') Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
fee
Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Fee: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall b a. (Show a, IsString b) => a -> b
show Coin
fee)
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Delta value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall b a. (Show a, IsString b) => a -> b
show (Value LedgerEra -> Coin
forall t. Val t => t -> Coin
coin (Value LedgerEra -> Coin) -> Value LedgerEra -> Coin
forall a b. (a -> b) -> a -> b
$ Value LedgerEra -> Value LedgerEra -> Value LedgerEra
deltaValue Value LedgerEra
out' Value LedgerEra
inp'))
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Added value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall b a. (Show a, IsString b) => a -> b
show (MaryValue StandardCrypto -> Coin
forall t. Val t => t -> Coin
coin Value LedgerEra
MaryValue StandardCrypto
inp'))
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Outputs after: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall b a. (Show a, IsString b) => a -> b
show (MaryValue StandardCrypto -> Coin
forall t. Val t => t -> Coin
coin Value LedgerEra
MaryValue StandardCrypto
out'))
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Outputs before: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall b a. (Show a, IsString b) => a -> b
show (MaryValue StandardCrypto -> Coin
forall t. Val t => t -> Coin
coin Value LedgerEra
MaryValue StandardCrypto
out))
prop_picksLargestUTxOToPayTheFees :: Property
prop_picksLargestUTxOToPayTheFees :: Property
prop_picksLargestUTxOToPayTheFees =
Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO ((Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Property)
-> Property)
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo1 ->
Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO ((Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> Property)
-> Property)
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo2 -> do
let combinedUTxO :: Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
combinedUTxO = Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo1 Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo2
case Map TxIn TxOut -> Maybe (TxIn, TxOut)
findLargestUTxO Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
combinedUTxO of
Maybe (TxIn, TxOut)
Nothing ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"No utxo found: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
combinedUTxO))
Just (TxIn
_, TxOut
txout) -> do
let foundLovelace :: Coin
foundLovelace = Value -> Coin
selectLovelace (Value -> Coin) -> Value -> Coin
forall a b. (a -> b) -> a -> b
$ TxOut Any -> Value
forall ctx. TxOut ctx -> Value
txOutValue (TxOut -> TxOut Any
forall ctx. TxOut -> TxOut ctx Era
fromLedgerTxOut TxOut
txout)
mapToLovelace :: Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> UTxO' Coin
mapToLovelace = (TxOut CtxUTxO -> Coin) -> UTxO -> UTxO' Coin
forall a b. (a -> b) -> UTxO' a -> UTxO' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value -> Coin
selectLovelace (Value -> Coin)
-> (TxOut CtxUTxO -> Value) -> TxOut CtxUTxO -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxUTxO -> Value
forall ctx. TxOut ctx -> Value
txOutValue) (UTxO -> UTxO' Coin)
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> UTxO)
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> UTxO' Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO LedgerEra -> UTxO
UTxO (BabbageEra StandardCrypto) -> UTxO
fromLedgerUTxO (UTxO (BabbageEra StandardCrypto) -> UTxO)
-> (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> UTxO (BabbageEra StandardCrypto))
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> UTxO (BabbageEra StandardCrypto)
Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
-> UTxO (BabbageEra StandardCrypto)
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO
Property -> Property
forall prop. Testable prop => prop -> Property
property (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
(Coin -> Bool) -> UTxO' Coin -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Coin
foundLovelace >=) (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> UTxO' Coin
mapToLovelace Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo1)
Bool -> Bool -> Bool
&& (Coin -> Bool) -> UTxO' Coin -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Coin
foundLovelace >=) (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> UTxO' Coin
mapToLovelace Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
utxo2)
Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Found lovelace: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall b a. (Show a, IsString b) => a -> b
show Coin
foundLovelace)
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Found lovelace not greater than all of: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
combinedUTxO))
genChainPoint :: Gen ChainPoint
genChainPoint :: Gen ChainPoint
genChainPoint =
Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary Gen SlotNo -> (SlotNo -> Gen ChainPoint) -> Gen ChainPoint
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SlotNo -> Gen ChainPoint
genChainPointAt
genChainPointAt :: SlotNo -> Gen ChainPoint
genChainPointAt :: SlotNo -> Gen ChainPoint
genChainPointAt SlotNo
s =
SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint SlotNo
s (Hash BlockHeader -> ChainPoint)
-> (ShortByteString -> Hash BlockHeader)
-> ShortByteString
-> ChainPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Hash BlockHeader
HeaderHash (ShortByteString -> ChainPoint)
-> Gen ShortByteString -> Gen ChainPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ShortByteString
forall a. Arbitrary a => Gen a
arbitrary
genTxsSpending :: Map TxIn TxOut -> Gen [Tx LedgerEra]
genTxsSpending :: Map TxIn TxOut -> Gen [Tx LedgerEra]
genTxsSpending Map TxIn TxOut
utxo = (Int -> Int) -> Gen [Tx LedgerEra] -> Gen [Tx LedgerEra]
forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a b. (RealFrac a, Integral b) => a -> b
round @Double (Double -> Int) -> (Int -> Double) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Gen [Tx LedgerEra] -> Gen [Tx LedgerEra])
-> Gen [Tx LedgerEra] -> Gen [Tx LedgerEra]
forall a b. (a -> b) -> a -> b
$ do
StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
[AlonzoTx (BabbageEra StandardCrypto)]
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Gen [AlonzoTx (BabbageEra StandardCrypto)]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
[AlonzoTx (BabbageEra StandardCrypto)]
StateT (Map TxIn TxOut) Gen [Tx LedgerEra]
genTxs Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo
where
genTxs :: StateT (Map TxIn TxOut) Gen [Tx LedgerEra]
genTxs :: StateT (Map TxIn TxOut) Gen [Tx LedgerEra]
genTxs = do
Int
n <- Gen Int
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))) Gen Int
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Gen Int
getSize
Int
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(AlonzoTx (BabbageEra StandardCrypto))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
[AlonzoTx (BabbageEra StandardCrypto)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(AlonzoTx (BabbageEra StandardCrypto))
StateT (Map TxIn TxOut) Gen (Tx LedgerEra)
genTx
genTx :: StateT (Map TxIn TxOut) Gen (Tx LedgerEra)
genTx :: StateT (Map TxIn TxOut) Gen (Tx LedgerEra)
genTx = do
StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))
genBody <-
Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto)))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto)))
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto)))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))))
-> Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto)))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto)))
forall a b. (a -> b) -> a -> b
$
[(Int,
Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))))]
-> Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto)))
forall a. [(Int, Gen a)] -> Gen a
frequency
[ (Int
4, StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))
-> Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))
-> Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))
-> Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto)))
forall a b. (a -> b) -> a -> b
$ Gen (BabbageTxBody (BabbageEra StandardCrypto))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Gen (BabbageTxBody (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary)
, (Int
1, StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))
-> Gen
(StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))
StateT (Map TxIn TxOut) Gen (BabbageTxBody LedgerEra)
genBodyFromUTxO)
]
BabbageTxBody (BabbageEra StandardCrypto)
body <- StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))
genBody
Gen (AlonzoTx (BabbageEra StandardCrypto))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(AlonzoTx (BabbageEra StandardCrypto))
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen (AlonzoTx (BabbageEra StandardCrypto))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(AlonzoTx (BabbageEra StandardCrypto)))
-> Gen (AlonzoTx (BabbageEra StandardCrypto))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(AlonzoTx (BabbageEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$
TxBody (BabbageEra StandardCrypto)
-> TxWits (BabbageEra StandardCrypto)
-> IsValid
-> StrictMaybe (TxAuxData (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto)
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody (BabbageEra StandardCrypto)
BabbageTxBody (BabbageEra StandardCrypto)
body
(AlonzoTxWits (BabbageEra StandardCrypto)
-> IsValid
-> StrictMaybe (AlonzoTxAuxData (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto))
-> Gen (AlonzoTxWits (BabbageEra StandardCrypto))
-> Gen
(IsValid
-> StrictMaybe (AlonzoTxAuxData (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTxWits (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
Gen
(IsValid
-> StrictMaybe (AlonzoTxAuxData (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto))
-> Gen IsValid
-> Gen
(StrictMaybe (AlonzoTxAuxData (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen IsValid
forall a. Arbitrary a => Gen a
arbitrary
Gen
(StrictMaybe (AlonzoTxAuxData (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto))
-> Gen (StrictMaybe (AlonzoTxAuxData (BabbageEra StandardCrypto)))
-> Gen (AlonzoTx (BabbageEra StandardCrypto))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictMaybe (AlonzoTxAuxData (BabbageEra StandardCrypto)))
forall a. Arbitrary a => Gen a
arbitrary
genBodyFromUTxO :: StateT (Map TxIn TxOut) Gen (BabbageTxBody LedgerEra)
genBodyFromUTxO :: StateT (Map TxIn TxOut) Gen (BabbageTxBody LedgerEra)
genBodyFromUTxO = do
TxBody (BabbageEra StandardCrypto)
base <- Gen (TxBody (BabbageEra StandardCrypto))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(TxBody (BabbageEra StandardCrypto))
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Gen (TxBody (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
(TxIn (EraCrypto (BabbageEra StandardCrypto))
input, TxOut (BabbageEra StandardCrypto)
output) <- (Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
-> (TxIn (EraCrypto (BabbageEra StandardCrypto)),
TxOut (BabbageEra StandardCrypto)))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(TxIn (EraCrypto (BabbageEra StandardCrypto)),
TxOut (BabbageEra StandardCrypto))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
-> (TxIn (EraCrypto (BabbageEra StandardCrypto)),
TxOut (BabbageEra StandardCrypto))
forall k a. Map k a -> (k, a)
Map.findMax
let body :: BabbageTxBody (BabbageEra StandardCrypto)
body =
TxBody (BabbageEra StandardCrypto)
base
TxBody (BabbageEra StandardCrypto)
-> (TxBody (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto))
-> TxBody (BabbageEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))
-> Identity (Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))))
-> TxBody (BabbageEra StandardCrypto)
-> Identity (TxBody (BabbageEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody (BabbageEra StandardCrypto))
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto))))
inputsTxBodyL ((Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))
-> Identity (Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))))
-> TxBody (BabbageEra StandardCrypto)
-> Identity (TxBody (BabbageEra StandardCrypto)))
-> Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))
-> TxBody (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn (EraCrypto (BabbageEra StandardCrypto))
-> Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))
forall a. a -> Set a
Set.singleton TxIn (EraCrypto (BabbageEra StandardCrypto))
input
TxBody (BabbageEra StandardCrypto)
-> (TxBody (BabbageEra StandardCrypto)
-> BabbageTxBody (BabbageEra StandardCrypto))
-> BabbageTxBody (BabbageEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Identity (StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Identity (TxBody (BabbageEra StandardCrypto))
(StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Identity (StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Identity (BabbageTxBody (BabbageEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
(TxBody (BabbageEra StandardCrypto))
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
outputsTxBodyL ((StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Identity (StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Identity (BabbageTxBody (BabbageEra StandardCrypto)))
-> StrictSeq (TxOut (BabbageEra StandardCrypto))
-> TxBody (BabbageEra StandardCrypto)
-> BabbageTxBody (BabbageEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOut (BabbageEra StandardCrypto)
-> StrictSeq (TxOut (BabbageEra StandardCrypto))
forall a. a -> StrictSeq a
StrictSeq.singleton TxOut (BabbageEra StandardCrypto)
output
let input' :: TxIn (EraCrypto (BabbageEra StandardCrypto))
input' = TxId (EraCrypto (BabbageEra StandardCrypto))
-> TxIx -> TxIn (EraCrypto (BabbageEra StandardCrypto))
forall c. TxId c -> TxIx -> TxIn c
Ledger.TxIn (SafeHash
(EraCrypto (BabbageEra StandardCrypto)) EraIndependentTxBody
-> TxId (EraCrypto (BabbageEra StandardCrypto))
forall c. SafeHash c EraIndependentTxBody -> TxId c
Ledger.TxId (SafeHash
(EraCrypto (BabbageEra StandardCrypto)) EraIndependentTxBody
-> TxId (EraCrypto (BabbageEra StandardCrypto)))
-> SafeHash
(EraCrypto (BabbageEra StandardCrypto)) EraIndependentTxBody
-> TxId (EraCrypto (BabbageEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ BabbageTxBody (BabbageEra StandardCrypto)
-> SafeHash
(EraCrypto (BabbageEra StandardCrypto)) EraIndependentTxBody
forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
SafeHash.hashAnnotated BabbageTxBody (BabbageEra StandardCrypto)
body) (Word64 -> TxIx
Ledger.TxIx Word64
0)
(Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto)))
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))) Gen ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
m -> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
m Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
-> (Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto)))
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
forall a b. a -> (a -> b) -> b
& TxIn (EraCrypto (BabbageEra StandardCrypto))
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete TxIn (EraCrypto (BabbageEra StandardCrypto))
input Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
-> (Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto)))
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
forall a b. a -> (a -> b) -> b
& TxIn (EraCrypto (BabbageEra StandardCrypto))
-> TxOut (BabbageEra StandardCrypto)
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
-> Map
(TxIn (EraCrypto (BabbageEra StandardCrypto)))
(TxOut (BabbageEra StandardCrypto))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn (EraCrypto (BabbageEra StandardCrypto))
input' TxOut (BabbageEra StandardCrypto)
output)
BabbageTxBody (BabbageEra StandardCrypto)
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
Gen
(BabbageTxBody (BabbageEra StandardCrypto))
forall a.
a
-> StateT
(Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))) Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BabbageTxBody (BabbageEra StandardCrypto)
body
genUTxO :: Gen (Map TxIn TxOut)
genUTxO :: Gen (Map TxIn TxOut)
genUTxO = do
AlonzoTx (BabbageEra StandardCrypto)
tx <- Gen (AlonzoTx (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary Gen (AlonzoTx (BabbageEra StandardCrypto))
-> (AlonzoTx (BabbageEra StandardCrypto) -> Bool)
-> Gen (AlonzoTx (BabbageEra StandardCrypto))
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Bool -> Bool
Prelude.not (Bool -> Bool)
-> (AlonzoTx (BabbageEra StandardCrypto) -> Bool)
-> AlonzoTx (BabbageEra StandardCrypto)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (TxOut (BabbageEra StandardCrypto)) -> Bool
forall a. StrictSeq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null (StrictSeq (TxOut (BabbageEra StandardCrypto)) -> Bool)
-> (AlonzoTx (BabbageEra StandardCrypto)
-> StrictSeq (TxOut (BabbageEra StandardCrypto)))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto)))
-> TxBody (BabbageEra StandardCrypto)
-> StrictSeq (TxOut (BabbageEra StandardCrypto))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Const
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
(TxBody (BabbageEra StandardCrypto))
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
outputsTxBodyL (TxBody (BabbageEra StandardCrypto)
-> StrictSeq (TxOut (BabbageEra StandardCrypto)))
-> (AlonzoTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto)
-> StrictSeq (TxOut (BabbageEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body)
TxIn
txIn <- TxIn -> TxIn
toLedgerTxIn (TxIn -> TxIn) -> Gen TxIn -> Gen TxIn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
genTxIn
let txOut :: TxOut
txOut = TxOut -> TxOut
scaleAda (TxOut -> TxOut) -> TxOut -> TxOut
forall a b. (a -> b) -> a -> b
$ [TxOut] -> TxOut
forall a. HasCallStack => [a] -> a
Prelude.head ([TxOut] -> TxOut) -> [TxOut] -> TxOut
forall a b. (a -> b) -> a -> b
$ StrictSeq TxOut -> [TxOut]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq TxOut -> [TxOut]) -> StrictSeq TxOut -> [TxOut]
forall a b. (a -> b) -> a -> b
$ AlonzoTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body AlonzoTx (BabbageEra StandardCrypto)
tx TxBody (BabbageEra StandardCrypto)
-> Getting
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto))
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
-> StrictSeq (BabbageTxOut (BabbageEra StandardCrypto))
forall s a. s -> Getting a s a -> a
^. Getting
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto))
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Const
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Const
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
(TxBody (BabbageEra StandardCrypto))
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
outputsTxBodyL
Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))))
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
forall a b. (a -> b) -> a -> b
$ TxIn
-> BabbageTxOut (BabbageEra StandardCrypto)
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
forall k a. k -> a -> Map k a
Map.singleton TxIn
txIn BabbageTxOut (BabbageEra StandardCrypto)
TxOut
txOut
where
scaleAda :: TxOut -> TxOut
scaleAda :: TxOut -> TxOut
scaleAda (BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
addr Value (BabbageEra StandardCrypto)
value Datum (BabbageEra StandardCrypto)
datum StrictMaybe (Script (BabbageEra StandardCrypto))
refScript) =
let value' :: MaryValue StandardCrypto
value' = Value (BabbageEra StandardCrypto)
MaryValue StandardCrypto
value MaryValue StandardCrypto
-> MaryValue StandardCrypto -> MaryValue StandardCrypto
forall a. Semigroup a => a -> a -> a
<> Coin -> MaryValue StandardCrypto
forall t s. Inject t s => t -> s
Ledger.inject (Integer -> Coin
Coin Integer
20_000_000)
in Addr (EraCrypto (BabbageEra StandardCrypto))
-> Value (BabbageEra StandardCrypto)
-> Datum (BabbageEra StandardCrypto)
-> StrictMaybe (Script (BabbageEra StandardCrypto))
-> BabbageTxOut (BabbageEra StandardCrypto)
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
addr Value (BabbageEra StandardCrypto)
MaryValue StandardCrypto
value' Datum (BabbageEra StandardCrypto)
datum StrictMaybe (Script (BabbageEra StandardCrypto))
refScript
genOutputsForInputs :: Tx LedgerEra -> Gen (Map TxIn TxOut)
genOutputsForInputs :: Tx LedgerEra -> Gen (Map TxIn TxOut)
genOutputsForInputs AlonzoTx{TxBody (BabbageEra StandardCrypto)
body :: forall era. AlonzoTx era -> TxBody era
body :: TxBody (BabbageEra StandardCrypto)
body} = do
let n :: Int
n = Set (TxIn (EraCrypto (BabbageEra StandardCrypto))) -> Int
forall a. Set a -> Int
Set.size (Getting
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto))))
(TxBody (BabbageEra StandardCrypto))
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto))))
-> BabbageTxBody (BabbageEra StandardCrypto)
-> Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto))))
(TxBody (BabbageEra StandardCrypto))
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto))))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody (BabbageEra StandardCrypto))
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto))))
inputsTxBodyL TxBody (BabbageEra StandardCrypto)
BabbageTxBody (BabbageEra StandardCrypto)
body)
[BabbageTxOut (BabbageEra StandardCrypto)]
outs <- Int
-> Gen (BabbageTxOut (BabbageEra StandardCrypto))
-> Gen [BabbageTxOut (BabbageEra StandardCrypto)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen (BabbageTxOut (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))))
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Gen (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
forall a b. (a -> b) -> a -> b
$ [(TxIn, BabbageTxOut (BabbageEra StandardCrypto))]
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, BabbageTxOut (BabbageEra StandardCrypto))]
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)))
-> [(TxIn, BabbageTxOut (BabbageEra StandardCrypto))]
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ [TxIn]
-> [BabbageTxOut (BabbageEra StandardCrypto)]
-> [(TxIn, BabbageTxOut (BabbageEra StandardCrypto))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Getting (Set TxIn) (TxBody (BabbageEra StandardCrypto)) (Set TxIn)
-> BabbageTxBody (BabbageEra StandardCrypto) -> Set TxIn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set TxIn) (TxBody (BabbageEra StandardCrypto)) (Set TxIn)
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))
-> Const
(Set TxIn) (Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))))
-> TxBody (BabbageEra StandardCrypto)
-> Const (Set TxIn) (TxBody (BabbageEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody (BabbageEra StandardCrypto))
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto))))
inputsTxBodyL TxBody (BabbageEra StandardCrypto)
BabbageTxBody (BabbageEra StandardCrypto)
body)) [BabbageTxOut (BabbageEra StandardCrypto)]
outs
genLedgerTx :: Gen (Tx LedgerEra)
genLedgerTx :: Gen (Tx LedgerEra)
genLedgerTx = do
AlonzoTx (BabbageEra StandardCrypto)
tx <- Gen (AlonzoTx (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
TxBody (BabbageEra StandardCrypto)
body <- (\TxBody (BabbageEra StandardCrypto)
x -> TxBody (BabbageEra StandardCrypto)
x TxBody (BabbageEra StandardCrypto)
-> (TxBody (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto))
-> TxBody (BabbageEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& ASetter
(TxBody (BabbageEra StandardCrypto))
(TxBody (BabbageEra StandardCrypto))
Coin
Coin
-> Coin
-> TxBody (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(TxBody (BabbageEra StandardCrypto))
(TxBody (BabbageEra StandardCrypto))
Coin
Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody (BabbageEra StandardCrypto)) Coin
feeTxBodyL (Integer -> Coin
Coin Integer
0)) (TxBody (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto))
-> Gen (TxBody (BabbageEra StandardCrypto))
-> Gen (TxBody (BabbageEra StandardCrypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxBody (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
AlonzoTx (BabbageEra StandardCrypto)
-> Gen (AlonzoTx (BabbageEra StandardCrypto))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlonzoTx (BabbageEra StandardCrypto)
-> Gen (AlonzoTx (BabbageEra StandardCrypto)))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Gen (AlonzoTx (BabbageEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ AlonzoTx (BabbageEra StandardCrypto)
tx{body, wits = mempty}
allTxIns :: [Tx LedgerEra] -> Set TxIn
allTxIns :: [Tx LedgerEra] -> Set TxIn
allTxIns [Tx LedgerEra]
txs =
[Set TxIn] -> Set TxIn
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (Getting (Set TxIn) (TxBody (BabbageEra StandardCrypto)) (Set TxIn)
-> TxBody (BabbageEra StandardCrypto) -> Set TxIn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set TxIn) (TxBody (BabbageEra StandardCrypto)) (Set TxIn)
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))
-> Const
(Set TxIn) (Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))))
-> TxBody (BabbageEra StandardCrypto)
-> Const (Set TxIn) (TxBody (BabbageEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody (BabbageEra StandardCrypto))
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto))))
inputsTxBodyL (TxBody (BabbageEra StandardCrypto) -> Set TxIn)
-> (AlonzoTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body (AlonzoTx (BabbageEra StandardCrypto) -> Set TxIn)
-> [AlonzoTx (BabbageEra StandardCrypto)] -> [Set TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AlonzoTx (BabbageEra StandardCrypto)]
[Tx LedgerEra]
txs)
allTxOuts :: [Tx LedgerEra] -> [TxOut]
allTxOuts :: [Tx LedgerEra] -> [TxOut]
allTxOuts [Tx LedgerEra]
txs =
StrictSeq TxOut -> [TxOut]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq TxOut -> [TxOut]) -> StrictSeq TxOut -> [TxOut]
forall a b. (a -> b) -> a -> b
$ [StrictSeq (BabbageTxOut (BabbageEra StandardCrypto))]
-> StrictSeq (BabbageTxOut (BabbageEra StandardCrypto))
forall a. Monoid a => [a] -> a
mconcat (Getting
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(BabbageTxBody (BabbageEra StandardCrypto))
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
-> TxBody (BabbageEra StandardCrypto)
-> StrictSeq (BabbageTxOut (BabbageEra StandardCrypto))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(BabbageTxBody (BabbageEra StandardCrypto))
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Const
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Const
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
(TxBody (BabbageEra StandardCrypto))
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
outputsTxBodyL (TxBody (BabbageEra StandardCrypto)
-> StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
-> (AlonzoTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto)
-> StrictSeq (BabbageTxOut (BabbageEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body (AlonzoTx (BabbageEra StandardCrypto)
-> StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
-> [AlonzoTx (BabbageEra StandardCrypto)]
-> [StrictSeq (BabbageTxOut (BabbageEra StandardCrypto))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AlonzoTx (BabbageEra StandardCrypto)]
[Tx LedgerEra]
txs)
isOurs :: Map TxIn TxOut -> Address -> Bool
isOurs :: Map TxIn TxOut -> Address -> Bool
isOurs Map TxIn TxOut
utxo Address
addr =
Address
addr Address -> [Address] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` ((\(BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
addr' Value (BabbageEra StandardCrypto)
_ Datum (BabbageEra StandardCrypto)
_ StrictMaybe (Script (BabbageEra StandardCrypto))
_) -> Address
Addr (EraCrypto (BabbageEra StandardCrypto))
addr') (BabbageTxOut (BabbageEra StandardCrypto) -> Address)
-> [BabbageTxOut (BabbageEra StandardCrypto)] -> [Address]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> [BabbageTxOut (BabbageEra StandardCrypto)]
forall k a. Map k a -> [a]
Map.elems Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo)
ourDirectInputs :: Map TxIn TxOut -> [Tx LedgerEra] -> [TxIn]
ourDirectInputs :: Map TxIn TxOut -> [Tx LedgerEra] -> [TxIn]
ourDirectInputs Map TxIn TxOut
utxo [Tx LedgerEra]
txs =
Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> [TxIn]
forall k a. Map k a -> [k]
Map.keys (Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> [TxIn])
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto)) -> [TxIn]
forall a b. (a -> b) -> a -> b
$ Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Set TxIn -> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo ([Tx LedgerEra] -> Set TxIn
allTxIns [Tx LedgerEra]
txs)
ourOutputs :: Map TxIn TxOut -> [Tx LedgerEra] -> [TxOut]
ourOutputs :: Map TxIn TxOut -> [Tx LedgerEra] -> [TxOut]
ourOutputs Map TxIn TxOut
utxo [Tx LedgerEra]
blk =
let ours :: [BabbageTxOut (BabbageEra StandardCrypto)]
ours = Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> [BabbageTxOut (BabbageEra StandardCrypto)]
forall k a. Map k a -> [a]
Map.elems Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo
in (BabbageTxOut (BabbageEra StandardCrypto) -> Bool)
-> [BabbageTxOut (BabbageEra StandardCrypto)]
-> [BabbageTxOut (BabbageEra StandardCrypto)]
forall a. (a -> Bool) -> [a] -> [a]
filter (BabbageTxOut (BabbageEra StandardCrypto)
-> [BabbageTxOut (BabbageEra StandardCrypto)] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [BabbageTxOut (BabbageEra StandardCrypto)]
ours) ([Tx LedgerEra] -> [TxOut]
allTxOuts [Tx LedgerEra]
blk)
getValue :: TxOut -> Value LedgerEra
getValue :: TxOut -> Value LedgerEra
getValue (BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
_ Value (BabbageEra StandardCrypto)
value Datum (BabbageEra StandardCrypto)
_ StrictMaybe (Script (BabbageEra StandardCrypto))
_) = Value LedgerEra
Value (BabbageEra StandardCrypto)
value
deltaValue :: Value LedgerEra -> Value LedgerEra -> Value LedgerEra
deltaValue :: Value LedgerEra -> Value LedgerEra -> Value LedgerEra
deltaValue Value LedgerEra
a Value LedgerEra
b
| MaryValue StandardCrypto -> Coin
forall t. Val t => t -> Coin
coin Value LedgerEra
MaryValue StandardCrypto
a Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
> MaryValue StandardCrypto -> Coin
forall t. Val t => t -> Coin
coin Value LedgerEra
MaryValue StandardCrypto
b = Value LedgerEra
MaryValue StandardCrypto
a MaryValue StandardCrypto
-> MaryValue StandardCrypto -> MaryValue StandardCrypto
forall a. Semigroup a => a -> a -> a
<> MaryValue StandardCrypto -> MaryValue StandardCrypto
forall t. Val t => t -> t
invert Value LedgerEra
MaryValue StandardCrypto
b
| Bool
otherwise = MaryValue StandardCrypto -> MaryValue StandardCrypto
forall t. Val t => t -> t
invert Value LedgerEra
MaryValue StandardCrypto
a MaryValue StandardCrypto
-> MaryValue StandardCrypto -> MaryValue StandardCrypto
forall a. Semigroup a => a -> a -> a
<> Value LedgerEra
MaryValue StandardCrypto
b
knownInputBalance :: Map TxIn TxOut -> Tx LedgerEra -> Value LedgerEra
knownInputBalance :: Map TxIn TxOut -> Tx LedgerEra -> Value LedgerEra
knownInputBalance Map TxIn TxOut
utxo = (TxIn -> MaryValue StandardCrypto)
-> [TxIn] -> MaryValue StandardCrypto
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxIn -> Value LedgerEra
TxIn -> MaryValue StandardCrypto
resolve ([TxIn] -> MaryValue StandardCrypto)
-> (AlonzoTx (BabbageEra StandardCrypto) -> [TxIn])
-> AlonzoTx (BabbageEra StandardCrypto)
-> MaryValue StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set TxIn -> [TxIn])
-> (AlonzoTx (BabbageEra StandardCrypto) -> Set TxIn)
-> AlonzoTx (BabbageEra StandardCrypto)
-> [TxIn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Set TxIn) (TxBody (BabbageEra StandardCrypto)) (Set TxIn)
-> BabbageTxBody (BabbageEra StandardCrypto) -> Set TxIn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set TxIn) (TxBody (BabbageEra StandardCrypto)) (Set TxIn)
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))
-> Const
(Set TxIn) (Set (TxIn (EraCrypto (BabbageEra StandardCrypto)))))
-> TxBody (BabbageEra StandardCrypto)
-> Const (Set TxIn) (TxBody (BabbageEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody (BabbageEra StandardCrypto))
(Set (TxIn (EraCrypto (BabbageEra StandardCrypto))))
inputsTxBodyL (BabbageTxBody (BabbageEra StandardCrypto) -> Set TxIn)
-> (AlonzoTx (BabbageEra StandardCrypto)
-> BabbageTxBody (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto)
AlonzoTx (BabbageEra StandardCrypto)
-> BabbageTxBody (BabbageEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body
where
resolve :: TxIn -> Value LedgerEra
resolve :: TxIn -> Value LedgerEra
resolve TxIn
k = MaryValue StandardCrypto
-> (BabbageTxOut (BabbageEra StandardCrypto)
-> MaryValue StandardCrypto)
-> Maybe (BabbageTxOut (BabbageEra StandardCrypto))
-> MaryValue StandardCrypto
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MaryValue StandardCrypto
forall t. Val t => t
zero BabbageTxOut (BabbageEra StandardCrypto)
-> MaryValue StandardCrypto
TxOut -> Value LedgerEra
getValue (TxIn
-> Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
-> Maybe (BabbageTxOut (BabbageEra StandardCrypto))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
k Map TxIn (BabbageTxOut (BabbageEra StandardCrypto))
Map TxIn TxOut
utxo)
outputBalance :: Tx LedgerEra -> Value LedgerEra
outputBalance :: Tx LedgerEra -> Value LedgerEra
outputBalance =
(BabbageTxOut (BabbageEra StandardCrypto)
-> MaryValue StandardCrypto)
-> StrictSeq (BabbageTxOut (BabbageEra StandardCrypto))
-> MaryValue StandardCrypto
forall m a. Monoid m => (a -> m) -> StrictSeq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap BabbageTxOut (BabbageEra StandardCrypto)
-> MaryValue StandardCrypto
TxOut -> Value LedgerEra
getValue (StrictSeq (BabbageTxOut (BabbageEra StandardCrypto))
-> MaryValue StandardCrypto)
-> (AlonzoTx (BabbageEra StandardCrypto)
-> StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
-> AlonzoTx (BabbageEra StandardCrypto)
-> MaryValue StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(BabbageTxBody (BabbageEra StandardCrypto))
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
-> BabbageTxBody (BabbageEra StandardCrypto)
-> StrictSeq (BabbageTxOut (BabbageEra StandardCrypto))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(BabbageTxBody (BabbageEra StandardCrypto))
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(StrictSeq (TxOut (BabbageEra StandardCrypto))
-> Const
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(StrictSeq (TxOut (BabbageEra StandardCrypto))))
-> TxBody (BabbageEra StandardCrypto)
-> Const
(StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
(TxBody (BabbageEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
(TxBody (BabbageEra StandardCrypto))
(StrictSeq (TxOut (BabbageEra StandardCrypto)))
outputsTxBodyL (BabbageTxBody (BabbageEra StandardCrypto)
-> StrictSeq (BabbageTxOut (BabbageEra StandardCrypto)))
-> (AlonzoTx (BabbageEra StandardCrypto)
-> BabbageTxBody (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto)
-> StrictSeq (BabbageTxOut (BabbageEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto)
AlonzoTx (BabbageEra StandardCrypto)
-> BabbageTxBody (BabbageEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body