{-# LANGUAGE DuplicateRecordFields #-}

module Hydra.Chain.Direct.WalletSpec where

import Hydra.Prelude
import Test.Hydra.Prelude

import Cardano.Ledger.Api (AlonzoEraTxWits (rdmrsTxWitsL), Conway, EraTx (getMinFeeTx, witsTxL), EraTxBody (feeTxBodyL, inputsTxBodyL), PParams, bodyTxL, coinTxOutL, outputsTxBodyL)
import Cardano.Ledger.Babbage.Tx (AlonzoTx (..))
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..))
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.TxBody (ConwayTxBody (..))
import Cardano.Ledger.Core (Tx, Value)
import Cardano.Ledger.SafeHash qualified as SafeHash
import Cardano.Ledger.Shelley.API qualified as Ledger
import Cardano.Ledger.Slot (EpochInfo)
import Cardano.Ledger.Val (Val (..), invert)
import Control.Concurrent (newEmptyMVar, putMVar, takeMVar)
import Control.Lens (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 (
  LedgerEra,
  PaymentCredential (PaymentCredentialByKey),
  PaymentKey,
  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.Wallet (
  Address,
  ChainQuery,
  TinyWallet (..),
  TxIn,
  TxOut,
  WalletInfoOnChain (..),
  applyTxs,
  coverFee_,
  findLargestUTxO,
  newTinyWallet,
 )
import Test.Hydra.Tx.Fixture qualified as Fixture
import Test.Hydra.Tx.Gen (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 (PParams (ConwayEra StandardCrypto))
-> 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) IO (EpochInfo (Either Text))
mockQueryEpochInfo IO (PParams (ConwayEra StandardCrypto))
mockQueryPParams
        Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo <- STM IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> IO (Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto))
utxo Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Bool)
-> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` \Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
m -> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Int
forall k a. Map k a -> Int
Map.size Map TxIn (BabbageTxOut (ConwayEra 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 (PParams (ConwayEra StandardCrypto))
-> 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 IO (EpochInfo (Either Text))
mockQueryEpochInfo IO (PParams (ConwayEra StandardCrypto))
mockQueryPParams
        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 (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
walletUTxO <- UTxO (ConwayEra StandardCrypto)
-> Map
     (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     (TxOut (ConwayEra StandardCrypto))
forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
Ledger.unUTxO (UTxO (ConwayEra StandardCrypto)
 -> Map
      (TxIn (EraCrypto (ConwayEra StandardCrypto)))
      (TxOut (ConwayEra StandardCrypto)))
-> (UTxO -> UTxO (ConwayEra StandardCrypto))
-> UTxO
-> Map
     (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     (TxOut (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> UTxO LedgerEra
UTxO -> UTxO (ConwayEra StandardCrypto)
toLedgerUTxO (UTxO
 -> Map
      (TxIn (EraCrypto (ConwayEra StandardCrypto)))
      (TxOut (ConwayEra StandardCrypto)))
-> IO UTxO
-> IO
     (Map
        (TxIn (EraCrypto (ConwayEra StandardCrypto)))
        (TxOut (ConwayEra 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 (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
walletUTxO :: Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
$sel:walletUTxO:WalletInfoOnChain :: Map TxIn TxOut
walletUTxO
        , $sel:systemStart:WalletInfoOnChain :: SystemStart
systemStart = SystemStart
Fixture.systemStart
        , 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 (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
walletUTxO <- UTxO (ConwayEra StandardCrypto)
-> Map
     (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     (TxOut (ConwayEra StandardCrypto))
forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
Ledger.unUTxO (UTxO (ConwayEra StandardCrypto)
 -> Map
      (TxIn (EraCrypto (ConwayEra StandardCrypto)))
      (TxOut (ConwayEra StandardCrypto)))
-> (UTxO -> UTxO (ConwayEra StandardCrypto))
-> UTxO
-> Map
     (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     (TxOut (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> UTxO LedgerEra
UTxO -> UTxO (ConwayEra StandardCrypto)
toLedgerUTxO (UTxO
 -> Map
      (TxIn (EraCrypto (ConwayEra StandardCrypto)))
      (TxOut (ConwayEra StandardCrypto)))
-> IO UTxO
-> IO
     (Map
        (TxIn (EraCrypto (ConwayEra StandardCrypto)))
        (TxOut (ConwayEra 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 (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
$sel:walletUTxO:WalletInfoOnChain :: Map TxIn TxOut
walletUTxO :: Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
walletUTxO
      , $sel:systemStart:WalletInfoOnChain :: SystemStart
systemStart = SystemStart
Fixture.systemStart
      , ChainPoint
$sel:tip:WalletInfoOnChain :: ChainPoint
tip :: ChainPoint
tip
      }

mockQueryEpochInfo :: IO (EpochInfo (Either Text))
mockQueryEpochInfo :: IO (EpochInfo (Either Text))
mockQueryEpochInfo = 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

mockQueryPParams :: IO (PParams Conway)
mockQueryPParams :: IO (PParams (ConwayEra StandardCrypto))
mockQueryPParams = PParams (ConwayEra StandardCrypto)
-> IO (PParams (ConwayEra StandardCrypto))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParams LedgerEra
PParams (ConwayEra StandardCrypto)
Fixture.pparams

--
-- Generators
--

prop_wellSuitedGenerators ::
  Property
prop_wellSuitedGenerators :: Property
prop_wellSuitedGenerators =
  Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO ((Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
 -> Property)
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo ->
    Gen [AlonzoTx (ConwayEra StandardCrypto)]
-> ([AlonzoTx (ConwayEra StandardCrypto)] -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Map TxIn TxOut -> Gen [Tx LedgerEra]
genTxsSpending Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo) (([AlonzoTx (ConwayEra StandardCrypto)] -> Property) -> Property)
-> ([AlonzoTx (ConwayEra StandardCrypto)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[AlonzoTx (ConwayEra StandardCrypto)]
txs ->
      Bool -> Property
forall prop. Testable prop => prop -> Property
property ([AlonzoTx (ConwayEra StandardCrypto)] -> Bool
forall {t :: * -> *} {a}. Foldable t => t a -> Bool
smallTxSets [AlonzoTx (ConwayEra 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 (ConwayEra StandardCrypto))
-> [AlonzoTx (ConwayEra StandardCrypto)] -> Bool
noneIsOurs Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo [AlonzoTx (ConwayEra 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 (ConwayEra StandardCrypto))
-> [AlonzoTx (ConwayEra StandardCrypto)] -> Bool
someAreDependent Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo [AlonzoTx (ConwayEra 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 [Tx LedgerEra]
[AlonzoTx (ConwayEra StandardCrypto)]
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 [Tx LedgerEra]
[AlonzoTx (ConwayEra StandardCrypto)]
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 (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo [Tx LedgerEra]
[AlonzoTx (ConwayEra StandardCrypto)]
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 (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo [Tx LedgerEra]
[AlonzoTx (ConwayEra StandardCrypto)]
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 (ConwayEra StandardCrypto))
-> [AlonzoTx (ConwayEra StandardCrypto)] -> Bool
noneIsOurs Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo [AlonzoTx (ConwayEra 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 (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo [Tx LedgerEra]
[AlonzoTx (ConwayEra StandardCrypto)]
txs) Bool -> Bool -> Bool
&& [BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo [Tx LedgerEra]
[AlonzoTx (ConwayEra StandardCrypto)]
txs)

  someAreDependent :: Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> [AlonzoTx (ConwayEra StandardCrypto)] -> Bool
someAreDependent Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo [AlonzoTx (ConwayEra 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 (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo [Tx LedgerEra]
[AlonzoTx (ConwayEra StandardCrypto)]
txs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo [Tx LedgerEra]
[AlonzoTx (ConwayEra StandardCrypto)]
txs)

--
-- applyTxs
--

prop_reducesWhenNotOurs :: Property
prop_reducesWhenNotOurs :: Property
prop_reducesWhenNotOurs =
  Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO ((Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
 -> Property)
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo ->
    Gen [AlonzoTx (ConwayEra StandardCrypto)]
-> ([AlonzoTx (ConwayEra StandardCrypto)] -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Map TxIn TxOut -> Gen [Tx LedgerEra]
genTxsSpending Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo) (([AlonzoTx (ConwayEra StandardCrypto)] -> Property) -> Property)
-> ([AlonzoTx (ConwayEra StandardCrypto)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[AlonzoTx (ConwayEra StandardCrypto)]
txs ->
      let utxo' :: Map TxIn TxOut
utxo' = [Tx] -> (Address -> Bool) -> Map TxIn TxOut -> Map TxIn TxOut
applyTxs (Tx LedgerEra -> Tx
AlonzoTx (ConwayEra StandardCrypto) -> Tx
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx (AlonzoTx (ConwayEra StandardCrypto) -> Tx)
-> [AlonzoTx (ConwayEra StandardCrypto)] -> [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AlonzoTx (ConwayEra StandardCrypto)]
txs) (Bool -> Address -> Bool
forall a b. a -> b -> a
const Bool
False) Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo
       in (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Int
forall a. Map TxIn a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Int
forall a. Map TxIn a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto)) -> String
forall b a. (Show a, IsString b) => a -> b
show Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto)) -> Int
forall a. Map TxIn a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto)) -> Int
forall a. Map TxIn a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo'))

prop_seenInputsAreConsumed :: Property
prop_seenInputsAreConsumed :: Property
prop_seenInputsAreConsumed =
  Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO ((Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
 -> Property)
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo ->
    Gen [AlonzoTx (ConwayEra StandardCrypto)]
-> ([AlonzoTx (ConwayEra StandardCrypto)] -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Map TxIn TxOut -> Gen [Tx LedgerEra]
genTxsSpending Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo) (([AlonzoTx (ConwayEra StandardCrypto)] -> Property) -> Property)
-> ([AlonzoTx (ConwayEra StandardCrypto)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[AlonzoTx (ConwayEra StandardCrypto)]
txs ->
      let utxo' :: Map TxIn TxOut
utxo' = [Tx] -> (Address -> Bool) -> Map TxIn TxOut -> Map TxIn TxOut
applyTxs (Tx LedgerEra -> Tx
AlonzoTx (ConwayEra StandardCrypto) -> Tx
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx (AlonzoTx (ConwayEra StandardCrypto) -> Tx)
-> [AlonzoTx (ConwayEra StandardCrypto)] -> [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AlonzoTx (ConwayEra StandardCrypto)]
txs) (Map TxIn TxOut -> Address -> Bool
isOurs Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo) Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo [Tx LedgerEra]
[AlonzoTx (ConwayEra StandardCrypto)]
txs
       in Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Bool
forall a. Map TxIn a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Set TxIn -> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto)) -> String
forall b a. (Show a, IsString b) => a -> b
show Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo')

--
-- coverFee
--

prop_setsMinUTxOValue :: Property
prop_setsMinUTxOValue :: Property
prop_setsMinUTxOValue =
  Gen (AlonzoTx (ConwayEra StandardCrypto))
-> (AlonzoTx (ConwayEra StandardCrypto) -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Int
-> Gen (AlonzoTx (ConwayEra StandardCrypto))
-> Gen (AlonzoTx (ConwayEra StandardCrypto))
forall a. Int -> Gen a -> Gen a
resize Int
0 Gen (Tx LedgerEra)
Gen (AlonzoTx (ConwayEra StandardCrypto))
genLedgerTx) ((AlonzoTx (ConwayEra StandardCrypto) -> Property) -> Property)
-> (AlonzoTx (ConwayEra StandardCrypto) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \AlonzoTx (ConwayEra StandardCrypto)
tx ->
    Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (ConwayEra 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 Tx LedgerEra
AlonzoTx (ConwayEra StandardCrypto)
tx) ((Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
 -> Property)
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
lookupUTxO ->
      Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
forall a. Gen a -> Gen a
reasonablySized Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO) ((Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
 -> Property)
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
walletUTxO ->
        Gen (TxOut (ConwayEra StandardCrypto))
-> (TxOut (ConwayEra StandardCrypto) -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (TxOut (ConwayEra StandardCrypto))
genTxOutWithoutADA ((TxOut (ConwayEra StandardCrypto) -> Property) -> Property)
-> (TxOut (ConwayEra StandardCrypto) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \TxOut (ConwayEra StandardCrypto)
txOutWithoutADA -> do
          let newTx :: AlonzoTx (ConwayEra StandardCrypto)
newTx = AlonzoTx (ConwayEra StandardCrypto)
tx AlonzoTx (ConwayEra StandardCrypto)
-> (AlonzoTx (ConwayEra StandardCrypto)
    -> AlonzoTx (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (TxBody (ConwayEra StandardCrypto)
 -> Identity (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Identity (Tx (ConwayEra StandardCrypto))
(TxBody (ConwayEra StandardCrypto)
 -> Identity (TxBody (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Identity (AlonzoTx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
bodyTxL ((TxBody (ConwayEra StandardCrypto)
  -> Identity (TxBody (ConwayEra StandardCrypto)))
 -> AlonzoTx (ConwayEra StandardCrypto)
 -> Identity (AlonzoTx (ConwayEra StandardCrypto)))
-> ((StrictSeq (TxOut (ConwayEra StandardCrypto))
     -> Identity (StrictSeq (TxOut (ConwayEra StandardCrypto))))
    -> TxBody (ConwayEra StandardCrypto)
    -> Identity (TxBody (ConwayEra StandardCrypto)))
-> (StrictSeq (TxOut (ConwayEra StandardCrypto))
    -> Identity (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Identity (AlonzoTx (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> Identity (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Identity (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL ((StrictSeq (TxOut (ConwayEra StandardCrypto))
  -> Identity (StrictSeq (TxOut (ConwayEra StandardCrypto))))
 -> AlonzoTx (ConwayEra StandardCrypto)
 -> Identity (AlonzoTx (ConwayEra StandardCrypto)))
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
-> AlonzoTx (ConwayEra StandardCrypto)
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ TxOut (ConwayEra StandardCrypto)
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
forall a. a -> StrictSeq a
StrictSeq.singleton TxOut (ConwayEra StandardCrypto)
txOutWithoutADA
          case PParams (ConwayEra StandardCrypto)
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut (ConwayEra StandardCrypto))
-> Map TxIn (TxOut (ConwayEra StandardCrypto))
-> Tx (ConwayEra StandardCrypto)
-> Either ErrCoverFee (Tx (ConwayEra StandardCrypto))
forall era.
(EraCrypto era ~ StandardCrypto, EraPlutusContext era,
 AlonzoEraTx era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraUTxO era, BabbageEraTxBody era) =>
PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Map TxIn (TxOut era)
-> Tx era
-> Either ErrCoverFee (Tx era)
coverFee_ PParams LedgerEra
PParams (ConwayEra StandardCrypto)
Fixture.pparams SystemStart
Fixture.systemStart EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
Fixture.epochInfo Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn (TxOut (ConwayEra StandardCrypto))
lookupUTxO Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn (TxOut (ConwayEra StandardCrypto))
walletUTxO Tx (ConwayEra StandardCrypto)
AlonzoTx (ConwayEra 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 Tx (ConwayEra StandardCrypto)
balancedTx -> do
              let outs :: [TxOut (ConwayEra StandardCrypto)]
outs = StrictSeq (TxOut (ConwayEra StandardCrypto))
-> [TxOut (ConwayEra StandardCrypto)]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> [TxOut (ConwayEra StandardCrypto)])
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
-> [TxOut (ConwayEra StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ Tx (ConwayEra StandardCrypto)
AlonzoTx (ConwayEra StandardCrypto)
balancedTx AlonzoTx (ConwayEra StandardCrypto)
-> Getting
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
     (AlonzoTx (ConwayEra StandardCrypto))
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
forall s a. s -> Getting a s a -> a
^. (TxBody (ConwayEra StandardCrypto)
 -> Const
      (StrictSeq (TxOut (ConwayEra StandardCrypto)))
      (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
     (Tx (ConwayEra StandardCrypto))
(TxBody (ConwayEra StandardCrypto)
 -> Const
      (StrictSeq (TxOut (ConwayEra StandardCrypto)))
      (TxBody (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Const
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
     (AlonzoTx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
bodyTxL ((TxBody (ConwayEra StandardCrypto)
  -> Const
       (StrictSeq (TxOut (ConwayEra StandardCrypto)))
       (TxBody (ConwayEra StandardCrypto)))
 -> AlonzoTx (ConwayEra StandardCrypto)
 -> Const
      (StrictSeq (TxOut (ConwayEra StandardCrypto)))
      (AlonzoTx (ConwayEra StandardCrypto)))
-> ((StrictSeq (TxOut (ConwayEra StandardCrypto))
     -> Const
          (StrictSeq (TxOut (ConwayEra StandardCrypto)))
          (StrictSeq (TxOut (ConwayEra StandardCrypto))))
    -> TxBody (ConwayEra StandardCrypto)
    -> Const
         (StrictSeq (TxOut (ConwayEra StandardCrypto)))
         (TxBody (ConwayEra StandardCrypto)))
-> Getting
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
     (AlonzoTx (ConwayEra StandardCrypto))
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> Const
      (StrictSeq (TxOut (ConwayEra StandardCrypto)))
      (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
     (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL
              Bool -> Bool
not ((TxOut (ConwayEra StandardCrypto) -> Bool)
-> [TxOut (ConwayEra StandardCrypto)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\TxOut (ConwayEra StandardCrypto)
o -> TxOut (ConwayEra StandardCrypto)
o TxOut (ConwayEra StandardCrypto)
-> Getting Coin (TxOut (ConwayEra StandardCrypto)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut (ConwayEra StandardCrypto)) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut (ConwayEra StandardCrypto)) Coin
coinTxOutL Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
forall a. Monoid a => a
mempty) [TxOut (ConwayEra 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 (ConwayEra StandardCrypto)] -> String
forall b a. (Show a, IsString b) => a -> b
show [TxOut (ConwayEra StandardCrypto)]
outs)
 where
  -- Generate a deliberately "under-valued" TxOut
  genTxOutWithoutADA :: Gen (TxOut (ConwayEra StandardCrypto))
genTxOutWithoutADA = Gen (TxOut (ConwayEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary Gen (TxOut (ConwayEra StandardCrypto))
-> (TxOut (ConwayEra StandardCrypto)
    -> TxOut (ConwayEra StandardCrypto))
-> Gen (TxOut (ConwayEra StandardCrypto))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Coin -> Identity Coin)
-> TxOut (ConwayEra StandardCrypto)
-> Identity (TxOut (ConwayEra StandardCrypto))
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut (ConwayEra StandardCrypto)) Coin
coinTxOutL ((Coin -> Identity Coin)
 -> TxOut (ConwayEra StandardCrypto)
 -> Identity (TxOut (ConwayEra StandardCrypto)))
-> Coin
-> TxOut (ConwayEra StandardCrypto)
-> TxOut (ConwayEra 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 (ConwayEra StandardCrypto))
-> (AlonzoTx (ConwayEra StandardCrypto) -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Int
-> Gen (AlonzoTx (ConwayEra StandardCrypto))
-> Gen (AlonzoTx (ConwayEra StandardCrypto))
forall a. Int -> Gen a -> Gen a
resize Int
0 Gen (Tx LedgerEra)
Gen (AlonzoTx (ConwayEra StandardCrypto))
genLedgerTx) ((AlonzoTx (ConwayEra StandardCrypto) -> Property) -> Property)
-> (AlonzoTx (ConwayEra StandardCrypto) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \AlonzoTx (ConwayEra StandardCrypto)
tx ->
    Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (ConwayEra 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 Tx LedgerEra
AlonzoTx (ConwayEra StandardCrypto)
tx) ((Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
 -> Property)
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
lookupUTxO ->
      Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
forall a. Gen a -> Gen a
reasonablySized Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO) ((Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
 -> Property)
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
walletUTxO ->
        case PParams (ConwayEra StandardCrypto)
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut (ConwayEra StandardCrypto))
-> Map TxIn (TxOut (ConwayEra StandardCrypto))
-> Tx (ConwayEra StandardCrypto)
-> Either ErrCoverFee (Tx (ConwayEra StandardCrypto))
forall era.
(EraCrypto era ~ StandardCrypto, EraPlutusContext era,
 AlonzoEraTx era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraUTxO era, BabbageEraTxBody era) =>
PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Map TxIn (TxOut era)
-> Tx era
-> Either ErrCoverFee (Tx era)
coverFee_ PParams LedgerEra
PParams (ConwayEra StandardCrypto)
Fixture.pparams SystemStart
Fixture.systemStart EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
Fixture.epochInfo Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn (TxOut (ConwayEra StandardCrypto))
lookupUTxO Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn (TxOut (ConwayEra StandardCrypto))
walletUTxO Tx (ConwayEra StandardCrypto)
AlonzoTx (ConwayEra 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 Tx (ConwayEra StandardCrypto)
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
              -- NOTE: Testing the signed transaction as adding a witness
              -- changes the fee requirements.
              let signedTx :: Tx LedgerEra
signedTx = Tx -> Tx LedgerEra
forall 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
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx Tx LedgerEra
Tx (ConwayEra StandardCrypto)
tx')
              [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
                [ Map TxIn TxOut -> Tx LedgerEra -> Tx LedgerEra -> Property
isBalanced (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
lookupUTxO Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
forall a. Semigroup a => a -> a -> a
<> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
walletUTxO) Tx LedgerEra
AlonzoTx (ConwayEra StandardCrypto)
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
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
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
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx Tx LedgerEra
Tx (ConwayEra StandardCrypto)
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
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx Tx LedgerEra
AlonzoTx (ConwayEra StandardCrypto)
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 (ConwayEra StandardCrypto)) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto)) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
walletUTxO))
          -- XXX: This is not exercising any script cost estimation because
          -- genLedgerTx does not generate txs spending from scripts seemingly.
          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
5 (AlonzoTx (ConwayEra StandardCrypto)
tx AlonzoTx (ConwayEra StandardCrypto)
-> Getting
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (Redeemers (ConwayEra StandardCrypto))
-> Redeemers (ConwayEra StandardCrypto)
forall s a. s -> Getting a s a -> a
^. (TxWits (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (TxWits (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (Tx (ConwayEra StandardCrypto))
(TxWits (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (TxWits (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxWits (ConwayEra StandardCrypto))
witsTxL ((TxWits (ConwayEra StandardCrypto)
  -> Const
       (Redeemers (ConwayEra StandardCrypto))
       (TxWits (ConwayEra StandardCrypto)))
 -> AlonzoTx (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (AlonzoTx (ConwayEra StandardCrypto)))
-> ((Redeemers (ConwayEra StandardCrypto)
     -> Const
          (Redeemers (ConwayEra StandardCrypto))
          (Redeemers (ConwayEra StandardCrypto)))
    -> TxWits (ConwayEra StandardCrypto)
    -> Const
         (Redeemers (ConwayEra StandardCrypto))
         (TxWits (ConwayEra StandardCrypto)))
-> Getting
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (Redeemers (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (Redeemers (ConwayEra StandardCrypto)))
-> TxWits (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (TxWits (ConwayEra StandardCrypto))
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens'
  (TxWits (ConwayEra StandardCrypto))
  (Redeemers (ConwayEra StandardCrypto))
rdmrsTxWitsL Redeemers (ConwayEra StandardCrypto)
-> Redeemers (ConwayEra StandardCrypto) -> Bool
forall a. Eq a => a -> a -> Bool
/= Redeemers (ConwayEra StandardCrypto)
forall a. Monoid a => a
mempty) String
"spending script"

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 (ConwayEra StandardCrypto) -> String
forall b a. (Show a, IsString b) => a -> b
show PParams LedgerEra
PParams (ConwayEra 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 = Tx LedgerEra
AlonzoTx (ConwayEra StandardCrypto)
tx AlonzoTx (ConwayEra StandardCrypto)
-> Getting Coin (AlonzoTx (ConwayEra StandardCrypto)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody (ConwayEra StandardCrypto)
 -> Const Coin (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Const Coin (Tx (ConwayEra StandardCrypto))
(TxBody (ConwayEra StandardCrypto)
 -> Const Coin (TxBody (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Const Coin (AlonzoTx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
bodyTxL ((TxBody (ConwayEra StandardCrypto)
  -> Const Coin (TxBody (ConwayEra StandardCrypto)))
 -> AlonzoTx (ConwayEra StandardCrypto)
 -> Const Coin (AlonzoTx (ConwayEra StandardCrypto)))
-> ((Coin -> Const Coin Coin)
    -> TxBody (ConwayEra StandardCrypto)
    -> Const Coin (TxBody (ConwayEra StandardCrypto)))
-> Getting Coin (AlonzoTx (ConwayEra StandardCrypto)) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody (ConwayEra StandardCrypto)
-> Const Coin (TxBody (ConwayEra StandardCrypto))
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody (ConwayEra StandardCrypto)) Coin
feeTxBodyL

  minFee :: Coin
  minFee :: Coin
minFee = PParams (ConwayEra StandardCrypto)
-> Tx (ConwayEra StandardCrypto) -> Int -> Coin
forall era. EraTx era => PParams era -> Tx era -> Int -> Coin
getMinFeeTx PParams LedgerEra
PParams (ConwayEra StandardCrypto)
pparams Tx LedgerEra
Tx (ConwayEra StandardCrypto)
tx Int
0

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 (ConwayEra StandardCrypto)
 -> Const Coin (TxBody (ConwayEra StandardCrypto)))
-> TxBody (ConwayEra StandardCrypto) -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Coin -> Const Coin Coin)
-> TxBody (ConwayEra StandardCrypto)
-> Const Coin (TxBody (ConwayEra StandardCrypto))
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody (ConwayEra StandardCrypto)) Coin
feeTxBodyL (TxBody (ConwayEra StandardCrypto) -> Coin)
-> (AlonzoTx (ConwayEra StandardCrypto)
    -> TxBody (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (ConwayEra StandardCrypto)
-> TxBody (ConwayEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body) Tx LedgerEra
AlonzoTx (ConwayEra StandardCrypto)
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 (ConwayEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO ((Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
 -> Property)
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo1 ->
    Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
Gen (Map TxIn TxOut)
genUTxO ((Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
 -> Property)
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo2 -> do
      let combinedUTxO :: Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
combinedUTxO = Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo1 Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo2
      case Map TxIn (TxOut (ConwayEra StandardCrypto))
-> Maybe (TxIn, TxOut (ConwayEra StandardCrypto))
forall era.
EraTxOut era =>
Map TxIn (TxOut era) -> Maybe (TxIn, TxOut era)
findLargestUTxO Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn (TxOut (ConwayEra StandardCrypto))
combinedUTxO of
        Maybe (TxIn, TxOut (ConwayEra StandardCrypto))
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 (ConwayEra StandardCrypto)) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
combinedUTxO))
        Just (TxIn
_, TxOut (ConwayEra StandardCrypto)
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 era ctx.
IsShelleyBasedEra era =>
TxOut (ShelleyLedgerEra era) -> TxOut ctx era
fromLedgerTxOut TxOut
TxOut (ConwayEra StandardCrypto)
txout)
              mapToLovelace :: Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto)) -> UTxO)
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> UTxO' Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO LedgerEra -> UTxO
UTxO (ConwayEra StandardCrypto) -> UTxO
fromLedgerUTxO (UTxO (ConwayEra StandardCrypto) -> UTxO)
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
    -> UTxO (ConwayEra StandardCrypto))
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> UTxO (ConwayEra StandardCrypto)
Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
-> UTxO (ConwayEra 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 (ConwayEra StandardCrypto)) -> UTxO' Coin
mapToLovelace Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto)) -> UTxO' Coin
mapToLovelace Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto)) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
combinedUTxO))

--
-- Generators
--

-- | Generate an arbitrary list of transactions from a UTXO set such that,
-- transactions may *sometimes* consume given UTXO and produce new ones. The
-- generator is geared towards certain use-cases,
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 (ConwayEra StandardCrypto)))
  Gen
  [AlonzoTx (ConwayEra StandardCrypto)]
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Gen [AlonzoTx (ConwayEra StandardCrypto)]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT
  (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
  Gen
  [AlonzoTx (ConwayEra StandardCrypto)]
StateT (Map TxIn TxOut) Gen [Tx LedgerEra]
genTxs Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto))) Gen Int
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto)))
     Gen
     (AlonzoTx (ConwayEra StandardCrypto))
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
     Gen
     [AlonzoTx (ConwayEra StandardCrypto)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n StateT
  (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
  Gen
  (AlonzoTx (ConwayEra 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 (ConwayEra StandardCrypto)))
  Gen
  (ConwayTxBody (ConwayEra StandardCrypto))
genBody <-
      Gen
  (StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
     Gen
     (ConwayTxBody (ConwayEra StandardCrypto)))
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
     Gen
     (StateT
        (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
        Gen
        (ConwayTxBody (ConwayEra StandardCrypto)))
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen
   (StateT
      (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
      Gen
      (ConwayTxBody (ConwayEra StandardCrypto)))
 -> StateT
      (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
      Gen
      (StateT
         (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
         Gen
         (ConwayTxBody (ConwayEra StandardCrypto))))
-> Gen
     (StateT
        (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
        Gen
        (ConwayTxBody (ConwayEra StandardCrypto)))
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
     Gen
     (StateT
        (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
        Gen
        (ConwayTxBody (ConwayEra StandardCrypto)))
forall a b. (a -> b) -> a -> b
$
        [(Int,
  Gen
    (StateT
       (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
       Gen
       (ConwayTxBody (ConwayEra StandardCrypto))))]
-> Gen
     (StateT
        (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
        Gen
        (ConwayTxBody (ConwayEra StandardCrypto)))
forall a. [(Int, Gen a)] -> Gen a
frequency
          [ (Int
4, StateT
  (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
  Gen
  (ConwayTxBody (ConwayEra StandardCrypto))
-> Gen
     (StateT
        (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
        Gen
        (ConwayTxBody (ConwayEra StandardCrypto)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateT
   (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
   Gen
   (ConwayTxBody (ConwayEra StandardCrypto))
 -> Gen
      (StateT
         (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
         Gen
         (ConwayTxBody (ConwayEra StandardCrypto))))
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
     Gen
     (ConwayTxBody (ConwayEra StandardCrypto))
-> Gen
     (StateT
        (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
        Gen
        (ConwayTxBody (ConwayEra StandardCrypto)))
forall a b. (a -> b) -> a -> b
$ Gen (ConwayTxBody (ConwayEra StandardCrypto))
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
     Gen
     (ConwayTxBody (ConwayEra StandardCrypto))
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Gen (ConwayTxBody (ConwayEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary)
          , (Int
1, StateT
  (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
  Gen
  (ConwayTxBody (ConwayEra StandardCrypto))
-> Gen
     (StateT
        (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
        Gen
        (ConwayTxBody (ConwayEra StandardCrypto)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT
  (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
  Gen
  (ConwayTxBody (ConwayEra StandardCrypto))
StateT (Map TxIn TxOut) Gen (ConwayTxBody LedgerEra)
genBodyFromUTxO)
          ]
    ConwayTxBody (ConwayEra StandardCrypto)
body <- StateT
  (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
  Gen
  (ConwayTxBody (ConwayEra StandardCrypto))
genBody
    Gen (AlonzoTx (ConwayEra StandardCrypto))
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
     Gen
     (AlonzoTx (ConwayEra StandardCrypto))
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen (AlonzoTx (ConwayEra StandardCrypto))
 -> StateT
      (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
      Gen
      (AlonzoTx (ConwayEra StandardCrypto)))
-> Gen (AlonzoTx (ConwayEra StandardCrypto))
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
     Gen
     (AlonzoTx (ConwayEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$
      TxBody (ConwayEra StandardCrypto)
-> TxWits (ConwayEra StandardCrypto)
-> IsValid
-> StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody (ConwayEra StandardCrypto)
ConwayTxBody (ConwayEra StandardCrypto)
body
        (AlonzoTxWits (ConwayEra StandardCrypto)
 -> IsValid
 -> StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto))
 -> AlonzoTx (ConwayEra StandardCrypto))
-> Gen (AlonzoTxWits (ConwayEra StandardCrypto))
-> Gen
     (IsValid
      -> StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto))
      -> AlonzoTx (ConwayEra StandardCrypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTxWits (ConwayEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (IsValid
   -> StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto))
   -> AlonzoTx (ConwayEra StandardCrypto))
-> Gen IsValid
-> Gen
     (StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto))
      -> AlonzoTx (ConwayEra 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 (ConwayEra StandardCrypto))
   -> AlonzoTx (ConwayEra StandardCrypto))
-> Gen (StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto)))
-> Gen (AlonzoTx (ConwayEra 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 (ConwayEra StandardCrypto)))
forall a. Arbitrary a => Gen a
arbitrary

  -- Generate a TxBody by consuming a UTXO from the state, and generating a new
  -- one. The number of UTXO in the state after calling this function remains
  -- identical.
  genBodyFromUTxO :: StateT (Map TxIn TxOut) Gen (ConwayTxBody LedgerEra)
  genBodyFromUTxO :: StateT (Map TxIn TxOut) Gen (ConwayTxBody LedgerEra)
genBodyFromUTxO = do
    TxBody (ConwayEra StandardCrypto)
base <- Gen (TxBody (ConwayEra StandardCrypto))
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
     Gen
     (TxBody (ConwayEra StandardCrypto))
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Gen (TxBody (ConwayEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
    (TxIn (EraCrypto (ConwayEra StandardCrypto))
input, TxOut (ConwayEra StandardCrypto)
output) <- (Map
   (TxIn (EraCrypto (ConwayEra StandardCrypto)))
   (TxOut (ConwayEra StandardCrypto))
 -> (TxIn (EraCrypto (ConwayEra StandardCrypto)),
     TxOut (ConwayEra StandardCrypto)))
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
     Gen
     (TxIn (EraCrypto (ConwayEra StandardCrypto)),
      TxOut (ConwayEra StandardCrypto))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
-> (TxIn (EraCrypto (ConwayEra StandardCrypto)),
    TxOut (ConwayEra StandardCrypto))
forall k a. Map k a -> (k, a)
Map.findMax
    let body :: ConwayTxBody (ConwayEra StandardCrypto)
body =
          TxBody (ConwayEra StandardCrypto)
base
            TxBody (ConwayEra StandardCrypto)
-> (TxBody (ConwayEra StandardCrypto)
    -> TxBody (ConwayEra StandardCrypto))
-> TxBody (ConwayEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
 -> Identity (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))))
-> TxBody (ConwayEra StandardCrypto)
-> Identity (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL ((Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  -> Identity (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))))
 -> TxBody (ConwayEra StandardCrypto)
 -> Identity (TxBody (ConwayEra StandardCrypto)))
-> Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
-> TxBody (ConwayEra StandardCrypto)
-> TxBody (ConwayEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn (EraCrypto (ConwayEra StandardCrypto))
-> Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
forall a. a -> Set a
Set.singleton TxIn (EraCrypto (ConwayEra StandardCrypto))
input
            TxBody (ConwayEra StandardCrypto)
-> (TxBody (ConwayEra StandardCrypto)
    -> ConwayTxBody (ConwayEra StandardCrypto))
-> ConwayTxBody (ConwayEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> Identity (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Identity (TxBody (ConwayEra StandardCrypto))
(StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> Identity (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Identity (ConwayTxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL ((StrictSeq (TxOut (ConwayEra StandardCrypto))
  -> Identity (StrictSeq (TxOut (ConwayEra StandardCrypto))))
 -> TxBody (ConwayEra StandardCrypto)
 -> Identity (ConwayTxBody (ConwayEra StandardCrypto)))
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
-> TxBody (ConwayEra StandardCrypto)
-> ConwayTxBody (ConwayEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOut (ConwayEra StandardCrypto)
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
forall a. a -> StrictSeq a
StrictSeq.singleton TxOut (ConwayEra StandardCrypto)
output
    let input' :: TxIn (EraCrypto (ConwayEra StandardCrypto))
input' = TxId (EraCrypto (ConwayEra StandardCrypto))
-> TxIx -> TxIn (EraCrypto (ConwayEra StandardCrypto))
forall c. TxId c -> TxIx -> TxIn c
Ledger.TxIn (SafeHash
  (EraCrypto (ConwayEra StandardCrypto)) EraIndependentTxBody
-> TxId (EraCrypto (ConwayEra StandardCrypto))
forall c. SafeHash c EraIndependentTxBody -> TxId c
Ledger.TxId (SafeHash
   (EraCrypto (ConwayEra StandardCrypto)) EraIndependentTxBody
 -> TxId (EraCrypto (ConwayEra StandardCrypto)))
-> SafeHash
     (EraCrypto (ConwayEra StandardCrypto)) EraIndependentTxBody
-> TxId (EraCrypto (ConwayEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ ConwayTxBody (ConwayEra StandardCrypto)
-> SafeHash
     (EraCrypto (ConwayEra StandardCrypto)) EraIndependentTxBody
forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
SafeHash.hashAnnotated ConwayTxBody (ConwayEra StandardCrypto)
body) (Word64 -> TxIx
Ledger.TxIx Word64
0)
    (Map
   (TxIn (EraCrypto (ConwayEra StandardCrypto)))
   (TxOut (ConwayEra StandardCrypto))
 -> Map
      (TxIn (EraCrypto (ConwayEra StandardCrypto)))
      (TxOut (ConwayEra StandardCrypto)))
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) Gen ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
m -> Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
m Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
-> (Map
      (TxIn (EraCrypto (ConwayEra StandardCrypto)))
      (TxOut (ConwayEra StandardCrypto))
    -> Map
         (TxIn (EraCrypto (ConwayEra StandardCrypto)))
         (TxOut (ConwayEra StandardCrypto)))
-> Map
     (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     (TxOut (ConwayEra StandardCrypto))
forall a b. a -> (a -> b) -> b
& TxIn (EraCrypto (ConwayEra StandardCrypto))
-> Map
     (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     (TxOut (ConwayEra StandardCrypto))
-> Map
     (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     (TxOut (ConwayEra StandardCrypto))
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete TxIn (EraCrypto (ConwayEra StandardCrypto))
input Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
-> (Map
      (TxIn (EraCrypto (ConwayEra StandardCrypto)))
      (TxOut (ConwayEra StandardCrypto))
    -> Map
         (TxIn (EraCrypto (ConwayEra StandardCrypto)))
         (TxOut (ConwayEra StandardCrypto)))
-> Map
     (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     (TxOut (ConwayEra StandardCrypto))
forall a b. a -> (a -> b) -> b
& TxIn (EraCrypto (ConwayEra StandardCrypto))
-> TxOut (ConwayEra StandardCrypto)
-> Map
     (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     (TxOut (ConwayEra StandardCrypto))
-> Map
     (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     (TxOut (ConwayEra StandardCrypto))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn (EraCrypto (ConwayEra StandardCrypto))
input' TxOut (ConwayEra StandardCrypto)
output)
    ConwayTxBody (ConwayEra StandardCrypto)
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
     Gen
     (ConwayTxBody (ConwayEra StandardCrypto))
forall a.
a
-> StateT
     (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConwayTxBody (ConwayEra StandardCrypto)
body

genUTxO :: Gen (Map TxIn TxOut)
genUTxO :: Gen (Map TxIn TxOut)
genUTxO = do
  AlonzoTx (ConwayEra StandardCrypto)
tx <- Gen (AlonzoTx (ConwayEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary Gen (AlonzoTx (ConwayEra StandardCrypto))
-> (AlonzoTx (ConwayEra StandardCrypto) -> Bool)
-> Gen (AlonzoTx (ConwayEra StandardCrypto))
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Bool -> Bool
Prelude.not (Bool -> Bool)
-> (AlonzoTx (ConwayEra StandardCrypto) -> Bool)
-> AlonzoTx (ConwayEra StandardCrypto)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (TxOut (ConwayEra StandardCrypto)) -> Bool
forall a. StrictSeq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null (StrictSeq (TxOut (ConwayEra StandardCrypto)) -> Bool)
-> (AlonzoTx (ConwayEra StandardCrypto)
    -> StrictSeq (TxOut (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((StrictSeq (TxOut (ConwayEra StandardCrypto))
  -> Const
       (StrictSeq (TxOut (ConwayEra StandardCrypto)))
       (StrictSeq (TxOut (ConwayEra StandardCrypto))))
 -> TxBody (ConwayEra StandardCrypto)
 -> Const
      (StrictSeq (TxOut (ConwayEra StandardCrypto)))
      (TxBody (ConwayEra StandardCrypto)))
-> TxBody (ConwayEra StandardCrypto)
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> Const
      (StrictSeq (TxOut (ConwayEra StandardCrypto)))
      (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
     (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL (TxBody (ConwayEra StandardCrypto)
 -> StrictSeq (TxOut (ConwayEra StandardCrypto)))
-> (AlonzoTx (ConwayEra StandardCrypto)
    -> TxBody (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (ConwayEra StandardCrypto)
-> TxBody (ConwayEra 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 (ConwayEra StandardCrypto)
-> TxBody (ConwayEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body AlonzoTx (ConwayEra StandardCrypto)
tx TxBody (ConwayEra StandardCrypto)
-> Getting
     (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
     (TxBody (ConwayEra StandardCrypto))
     (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
-> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
(StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> Const
      (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
      (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
     (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL
  Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
 -> Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))))
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
forall a b. (a -> b) -> a -> b
$ TxIn
-> BabbageTxOut (ConwayEra StandardCrypto)
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
forall k a. k -> a -> Map k a
Map.singleton TxIn
txIn BabbageTxOut (ConwayEra StandardCrypto)
TxOut
txOut
 where
  scaleAda :: TxOut -> TxOut
  scaleAda :: TxOut -> TxOut
scaleAda (BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
addr Value (ConwayEra StandardCrypto)
value Datum (ConwayEra StandardCrypto)
datum StrictMaybe (Script (ConwayEra StandardCrypto))
refScript) =
    let value' :: MaryValue StandardCrypto
value' = Value (ConwayEra 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 (ConwayEra StandardCrypto))
-> Value (ConwayEra StandardCrypto)
-> Datum (ConwayEra StandardCrypto)
-> StrictMaybe (Script (ConwayEra StandardCrypto))
-> BabbageTxOut (ConwayEra StandardCrypto)
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
addr Value (ConwayEra StandardCrypto)
MaryValue StandardCrypto
value' Datum (ConwayEra StandardCrypto)
datum StrictMaybe (Script (ConwayEra StandardCrypto))
refScript

genOutputsForInputs :: Tx LedgerEra -> Gen (Map TxIn TxOut)
genOutputsForInputs :: Tx LedgerEra -> Gen (Map TxIn TxOut)
genOutputsForInputs AlonzoTx{TxBody (ConwayEra StandardCrypto)
body :: forall era. AlonzoTx era -> TxBody era
body :: TxBody (ConwayEra StandardCrypto)
body} = do
  let n :: Int
n = Set (TxIn (EraCrypto (ConwayEra StandardCrypto))) -> Int
forall a. Set a -> Int
Set.size (Getting
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
-> ConwayTxBody (ConwayEra StandardCrypto)
-> Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL TxBody (ConwayEra StandardCrypto)
ConwayTxBody (ConwayEra StandardCrypto)
body)
  [BabbageTxOut (ConwayEra StandardCrypto)]
outs <- Int
-> Gen (BabbageTxOut (ConwayEra StandardCrypto))
-> Gen [BabbageTxOut (ConwayEra StandardCrypto)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen (BabbageTxOut (ConwayEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
  Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
 -> Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))))
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Gen (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
forall a b. (a -> b) -> a -> b
$ [(TxIn, BabbageTxOut (ConwayEra StandardCrypto))]
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, BabbageTxOut (ConwayEra StandardCrypto))]
 -> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> [(TxIn, BabbageTxOut (ConwayEra StandardCrypto))]
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ [TxIn]
-> [BabbageTxOut (ConwayEra StandardCrypto)]
-> [(TxIn, BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto)) (Set TxIn)
-> ConwayTxBody (ConwayEra StandardCrypto) -> Set TxIn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set TxIn) (TxBody (ConwayEra StandardCrypto)) (Set TxIn)
(Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
 -> Const
      (Set TxIn) (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))))
-> TxBody (ConwayEra StandardCrypto)
-> Const (Set TxIn) (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL TxBody (ConwayEra StandardCrypto)
ConwayTxBody (ConwayEra StandardCrypto)
body)) [BabbageTxOut (ConwayEra StandardCrypto)]
outs

genLedgerTx :: Gen (Tx LedgerEra)
genLedgerTx :: Gen (Tx LedgerEra)
genLedgerTx = do
  Tx (ConwayEra StandardCrypto)
tx <- Gen (Tx (ConwayEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
  AlonzoTx (ConwayEra StandardCrypto)
-> Gen (AlonzoTx (ConwayEra StandardCrypto))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlonzoTx (ConwayEra StandardCrypto)
 -> Gen (AlonzoTx (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Gen (AlonzoTx (ConwayEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ Tx (ConwayEra StandardCrypto)
tx Tx (ConwayEra StandardCrypto)
-> (Tx (ConwayEra StandardCrypto)
    -> AlonzoTx (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (TxBody (ConwayEra StandardCrypto)
 -> Identity (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Identity (Tx (ConwayEra StandardCrypto))
(TxBody (ConwayEra StandardCrypto)
 -> Identity (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Identity (AlonzoTx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
bodyTxL ((TxBody (ConwayEra StandardCrypto)
  -> Identity (TxBody (ConwayEra StandardCrypto)))
 -> Tx (ConwayEra StandardCrypto)
 -> Identity (AlonzoTx (ConwayEra StandardCrypto)))
-> ((Coin -> Identity Coin)
    -> TxBody (ConwayEra StandardCrypto)
    -> Identity (TxBody (ConwayEra StandardCrypto)))
-> (Coin -> Identity Coin)
-> Tx (ConwayEra StandardCrypto)
-> Identity (AlonzoTx (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> TxBody (ConwayEra StandardCrypto)
-> Identity (TxBody (ConwayEra StandardCrypto))
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody (ConwayEra StandardCrypto)) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> Tx (ConwayEra StandardCrypto)
 -> Identity (AlonzoTx (ConwayEra StandardCrypto)))
-> Coin
-> Tx (ConwayEra StandardCrypto)
-> AlonzoTx (ConwayEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
0

--
-- Helpers
--

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 (ConwayEra StandardCrypto)) (Set TxIn)
-> TxBody (ConwayEra StandardCrypto) -> Set TxIn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set TxIn) (TxBody (ConwayEra StandardCrypto)) (Set TxIn)
(Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
 -> Const
      (Set TxIn) (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))))
-> TxBody (ConwayEra StandardCrypto)
-> Const (Set TxIn) (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL (TxBody (ConwayEra StandardCrypto) -> Set TxIn)
-> (AlonzoTx (ConwayEra StandardCrypto)
    -> TxBody (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (ConwayEra StandardCrypto)
-> TxBody (ConwayEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body (AlonzoTx (ConwayEra StandardCrypto) -> Set TxIn)
-> [AlonzoTx (ConwayEra StandardCrypto)] -> [Set TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx LedgerEra]
[AlonzoTx (ConwayEra StandardCrypto)]
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 (ConwayEra StandardCrypto))]
-> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))
forall a. Monoid a => [a] -> a
mconcat (Getting
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
  (ConwayTxBody (ConwayEra StandardCrypto))
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
-> TxBody (ConwayEra StandardCrypto)
-> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
  (ConwayTxBody (ConwayEra StandardCrypto))
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
(StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> Const
      (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
      (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
     (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL (TxBody (ConwayEra StandardCrypto)
 -> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
-> (AlonzoTx (ConwayEra StandardCrypto)
    -> TxBody (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
-> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (ConwayEra StandardCrypto)
-> TxBody (ConwayEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body (AlonzoTx (ConwayEra StandardCrypto)
 -> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
-> [AlonzoTx (ConwayEra StandardCrypto)]
-> [StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx LedgerEra]
[AlonzoTx (ConwayEra StandardCrypto)]
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 (ConwayEra StandardCrypto))
addr' Value (ConwayEra StandardCrypto)
_ Datum (ConwayEra StandardCrypto)
_ StrictMaybe (Script (ConwayEra StandardCrypto))
_) -> Address
Addr (EraCrypto (ConwayEra StandardCrypto))
addr') (BabbageTxOut (ConwayEra StandardCrypto) -> Address)
-> [BabbageTxOut (ConwayEra StandardCrypto)] -> [Address]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> [BabbageTxOut (ConwayEra StandardCrypto)]
forall k a. Map k a -> [a]
Map.elems Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo)

-- NOTE: 'direct' here means inputs that can be identified from our initial
-- UTXO set. UTXOs that are created in a transaction from that blk aren't
-- counted here.
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 (ConwayEra StandardCrypto)) -> [TxIn]
forall k a. Map k a -> [k]
Map.keys (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> [TxIn])
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> [TxIn]
forall a b. (a -> b) -> a -> b
$ Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Set TxIn -> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map TxIn (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto)]
ours = Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> [BabbageTxOut (ConwayEra StandardCrypto)]
forall k a. Map k a -> [a]
Map.elems Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo
   in (BabbageTxOut (ConwayEra StandardCrypto) -> Bool)
-> [BabbageTxOut (ConwayEra StandardCrypto)]
-> [BabbageTxOut (ConwayEra StandardCrypto)]
forall a. (a -> Bool) -> [a] -> [a]
filter (BabbageTxOut (ConwayEra StandardCrypto)
-> [BabbageTxOut (ConwayEra StandardCrypto)] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [BabbageTxOut (ConwayEra StandardCrypto)]
ours) ([Tx LedgerEra] -> [TxOut]
allTxOuts [Tx LedgerEra]
blk)

getValue :: TxOut -> Value LedgerEra
getValue :: TxOut -> Value LedgerEra
getValue (BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
_ Value (ConwayEra StandardCrypto)
value Datum (ConwayEra StandardCrypto)
_ StrictMaybe (Script (ConwayEra StandardCrypto))
_) = Value LedgerEra
Value (ConwayEra 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

-- | NOTE: This does not account for withdrawals
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 (ConwayEra StandardCrypto) -> [TxIn])
-> AlonzoTx (ConwayEra 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 (ConwayEra StandardCrypto) -> Set TxIn)
-> AlonzoTx (ConwayEra StandardCrypto)
-> [TxIn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Set TxIn) (TxBody (ConwayEra StandardCrypto)) (Set TxIn)
-> ConwayTxBody (ConwayEra StandardCrypto) -> Set TxIn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set TxIn) (TxBody (ConwayEra StandardCrypto)) (Set TxIn)
(Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
 -> Const
      (Set TxIn) (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))))
-> TxBody (ConwayEra StandardCrypto)
-> Const (Set TxIn) (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL (ConwayTxBody (ConwayEra StandardCrypto) -> Set TxIn)
-> (AlonzoTx (ConwayEra StandardCrypto)
    -> ConwayTxBody (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (ConwayEra StandardCrypto)
-> TxBody (ConwayEra StandardCrypto)
AlonzoTx (ConwayEra StandardCrypto)
-> ConwayTxBody (ConwayEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body
 where
  resolve :: TxIn -> Value LedgerEra
  resolve :: TxIn -> Value LedgerEra
resolve TxIn
k = MaryValue StandardCrypto
-> (BabbageTxOut (ConwayEra StandardCrypto)
    -> MaryValue StandardCrypto)
-> Maybe (BabbageTxOut (ConwayEra StandardCrypto))
-> MaryValue StandardCrypto
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MaryValue StandardCrypto
forall t. Val t => t
zero BabbageTxOut (ConwayEra StandardCrypto) -> MaryValue StandardCrypto
TxOut -> Value LedgerEra
getValue (TxIn
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Maybe (BabbageTxOut (ConwayEra StandardCrypto))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
k Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
utxo)

-- | NOTE: This does not account for deposits
outputBalance :: Tx LedgerEra -> Value LedgerEra
outputBalance :: Tx LedgerEra -> Value LedgerEra
outputBalance =
  (BabbageTxOut (ConwayEra StandardCrypto)
 -> MaryValue StandardCrypto)
-> StrictSeq (BabbageTxOut (ConwayEra 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 (ConwayEra StandardCrypto) -> MaryValue StandardCrypto
TxOut -> Value LedgerEra
getValue (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))
 -> MaryValue StandardCrypto)
-> (AlonzoTx (ConwayEra StandardCrypto)
    -> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> MaryValue StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
  (ConwayTxBody (ConwayEra StandardCrypto))
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
-> ConwayTxBody (ConwayEra StandardCrypto)
-> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
  (ConwayTxBody (ConwayEra StandardCrypto))
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
(StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> Const
      (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
      (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
     (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL (ConwayTxBody (ConwayEra StandardCrypto)
 -> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
-> (AlonzoTx (ConwayEra StandardCrypto)
    -> ConwayTxBody (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
-> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (ConwayEra StandardCrypto)
-> TxBody (ConwayEra StandardCrypto)
AlonzoTx (ConwayEra StandardCrypto)
-> ConwayTxBody (ConwayEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body