{-# LANGUAGE DuplicateRecordFields #-}
module Hydra.Chain.Direct.Wallet where
import Hydra.Prelude
import Cardano.Api.UTxO (UTxO)
import Cardano.Api.UTxO qualified as UTxO
import Cardano.Crypto.Hash.Class
import Cardano.Ledger.Address qualified as Ledger
import Cardano.Ledger.Alonzo.Plutus.Context (ContextError)
import Cardano.Ledger.Alonzo.Scripts (
AlonzoEraScript (..),
AlonzoPlutusPurpose (AlonzoSpending),
AsIndex (..),
ExUnits (ExUnits),
plutusScriptLanguage,
unAsIndex,
)
import Cardano.Ledger.Alonzo.TxWits (
AlonzoTxWits (..),
Redeemers (..),
txdats,
txscripts,
)
import Cardano.Ledger.Api (
TransactionScriptFailure,
bodyTxL,
collateralInputsTxBodyL,
ensureMinCoinTxOut,
estimateMinFeeTx,
evalTxExUnits,
feeTxBodyL,
inputsTxBodyL,
outputsTxBodyL,
ppMaxTxExUnitsL,
rdmrsTxWitsL,
referenceInputsTxBodyL,
scriptIntegrityHashTxBodyL,
witsTxL,
)
import Cardano.Ledger.Babbage.Tx (body, getLanguageView, hashScriptIntegrity, wits)
import Cardano.Ledger.Babbage.Tx qualified as Babbage
import Cardano.Ledger.Babbage.TxBody qualified as Babbage
import Cardano.Ledger.Babbage.UTxO (getReferenceScripts)
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core (isNativeScript)
import Cardano.Ledger.Core qualified as Core
import Cardano.Ledger.Core qualified as Ledger
import Cardano.Ledger.Crypto (HASH, StandardCrypto)
import Cardano.Ledger.Hashes (EraIndependentTxBody)
import Cardano.Ledger.SafeHash qualified as SafeHash
import Cardano.Ledger.Shelley.API (unUTxO)
import Cardano.Ledger.Shelley.API qualified as Ledger
import Cardano.Ledger.Val (Val (..), invert)
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart (..))
import Control.Arrow (left)
import Control.Concurrent.Class.MonadSTM (check, newTVarIO, readTVarIO, writeTVar)
import Control.Lens (view, (%~), (.~), (^.))
import Data.List qualified as List
import Data.Map.Strict ((!))
import Data.Map.Strict qualified as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Ratio ((%))
import Data.Sequence.Strict ((|>))
import Data.Set qualified as Set
import Hydra.Cardano.Api (
BlockHeader,
ChainPoint,
LedgerEra,
NetworkId,
PaymentCredential (PaymentCredentialByKey),
PaymentKey,
ShelleyAddr,
SigningKey,
StakeAddressReference (NoStakeAddress),
VerificationKey,
fromLedgerTx,
fromLedgerTxIn,
fromLedgerTxOut,
fromLedgerUTxO,
getChainPoint,
makeShelleyAddress,
selectLovelace,
shelleyAddressInEra,
toLedgerAddr,
toLedgerTx,
toLedgerTxIn,
toLedgerTxOut,
toLedgerUTxO,
verificationKeyHash,
)
import Hydra.Cardano.Api qualified as Api
import Hydra.Chain.CardanoClient (QueryPoint (..))
import Hydra.Ledger.Cardano ()
import Hydra.Logging (Tracer, traceWith)
type Address = Ledger.Addr StandardCrypto
type TxIn = Ledger.TxIn StandardCrypto
type TxOut = Ledger.TxOut LedgerEra
data TinyWallet m = TinyWallet
{ forall (m :: * -> *). TinyWallet m -> STM m (Map TxIn TxOut)
getUTxO :: STM m (Map TxIn TxOut)
, forall (m :: * -> *). TinyWallet m -> STM m (Maybe TxIn)
getSeedInput :: STM m (Maybe Api.TxIn)
, forall (m :: * -> *). TinyWallet m -> Tx -> Tx
sign :: Api.Tx -> Api.Tx
, forall (m :: * -> *).
TinyWallet m -> UTxO -> Tx -> m (Either ErrCoverFee Tx)
coverFee ::
UTxO ->
Api.Tx ->
m (Either ErrCoverFee Api.Tx)
, forall (m :: * -> *). TinyWallet m -> m ()
reset :: m ()
, forall (m :: * -> *). TinyWallet m -> BlockHeader -> [Tx] -> m ()
update :: BlockHeader -> [Api.Tx] -> m ()
}
data WalletInfoOnChain = WalletInfoOnChain
{ WalletInfoOnChain -> Map TxIn TxOut
walletUTxO :: Map TxIn TxOut
, WalletInfoOnChain -> PParams LedgerEra
pparams :: Core.PParams LedgerEra
, WalletInfoOnChain -> SystemStart
systemStart :: SystemStart
, WalletInfoOnChain -> EpochInfo (Either Text)
epochInfo :: EpochInfo (Either Text)
, WalletInfoOnChain -> ChainPoint
tip :: ChainPoint
}
type ChainQuery m = QueryPoint -> Api.Address ShelleyAddr -> m WalletInfoOnChain
watchUTxOUntil :: (Map TxIn TxOut -> Bool) -> TinyWallet IO -> IO (Map TxIn TxOut)
watchUTxOUntil :: (Map TxIn TxOut -> Bool) -> TinyWallet IO -> IO (Map TxIn TxOut)
watchUTxOUntil Map TxIn TxOut -> Bool
predicate TinyWallet{STM IO (Map TxIn TxOut)
$sel:getUTxO:TinyWallet :: forall (m :: * -> *). TinyWallet m -> STM m (Map TxIn TxOut)
getUTxO :: STM IO (Map TxIn TxOut)
getUTxO} = STM IO (Map TxIn TxOut) -> IO (Map TxIn TxOut)
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (Map TxIn TxOut) -> IO (Map TxIn TxOut))
-> STM IO (Map TxIn TxOut) -> IO (Map TxIn TxOut)
forall a b. (a -> b) -> a -> b
$ do
Map TxIn (BabbageTxOut StandardBabbage)
u <- STM (Map TxIn (BabbageTxOut StandardBabbage))
STM IO (Map TxIn TxOut)
getUTxO
Map TxIn (BabbageTxOut StandardBabbage)
u Map TxIn (BabbageTxOut StandardBabbage)
-> STM () -> STM (Map TxIn (BabbageTxOut StandardBabbage))
forall a b. a -> STM b -> STM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> STM IO ()
forall (m :: * -> *). MonadSTM m => Bool -> STM m ()
check (Map TxIn TxOut -> Bool
predicate Map TxIn TxOut
Map TxIn (BabbageTxOut StandardBabbage)
u)
newTinyWallet ::
Tracer IO TinyWalletLog ->
NetworkId ->
(VerificationKey PaymentKey, SigningKey PaymentKey) ->
ChainQuery IO ->
IO (EpochInfo (Either Text)) ->
IO (TinyWallet IO)
newTinyWallet :: Tracer IO TinyWalletLog
-> NetworkId
-> (VerificationKey PaymentKey, SigningKey PaymentKey)
-> ChainQuery IO
-> IO (EpochInfo (Either Text))
-> IO (TinyWallet IO)
newTinyWallet Tracer IO TinyWalletLog
tracer NetworkId
networkId (VerificationKey PaymentKey
vk, SigningKey PaymentKey
sk) ChainQuery IO
queryWalletInfo IO (EpochInfo (Either Text))
queryEpochInfo = do
TVar WalletInfoOnChain
walletInfoVar <- WalletInfoOnChain -> IO (TVar WalletInfoOnChain)
WalletInfoOnChain -> IO (TVar IO WalletInfoOnChain)
forall a. a -> IO (TVar IO a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO (WalletInfoOnChain -> IO (TVar WalletInfoOnChain))
-> IO WalletInfoOnChain -> IO (TVar WalletInfoOnChain)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO WalletInfoOnChain
initialize
let getUTxO :: STM IO (Map TxIn (BabbageTxOut StandardBabbage))
getUTxO = TVar IO WalletInfoOnChain -> STM IO WalletInfoOnChain
forall a. TVar IO a -> STM IO a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar STM IO WalletInfoOnChain
-> (WalletInfoOnChain -> Map TxIn (BabbageTxOut StandardBabbage))
-> STM IO (Map TxIn (BabbageTxOut StandardBabbage))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> WalletInfoOnChain -> Map TxIn TxOut
WalletInfoOnChain -> Map TxIn (BabbageTxOut StandardBabbage)
walletUTxO
TinyWallet IO -> IO (TinyWallet IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
TinyWallet
{ STM IO (Map TxIn TxOut)
STM IO (Map TxIn (BabbageTxOut StandardBabbage))
$sel:getUTxO:TinyWallet :: STM IO (Map TxIn TxOut)
getUTxO :: STM IO (Map TxIn (BabbageTxOut StandardBabbage))
getUTxO
, $sel:getSeedInput:TinyWallet :: STM IO (Maybe TxIn)
getSeedInput = ((TxIn, BabbageTxOut StandardBabbage) -> TxIn)
-> Maybe (TxIn, BabbageTxOut StandardBabbage) -> Maybe TxIn
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxIn -> TxIn
fromLedgerTxIn (TxIn -> TxIn)
-> ((TxIn, BabbageTxOut StandardBabbage) -> TxIn)
-> (TxIn, BabbageTxOut StandardBabbage)
-> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, BabbageTxOut StandardBabbage) -> TxIn
forall a b. (a, b) -> a
fst) (Maybe (TxIn, BabbageTxOut StandardBabbage) -> Maybe TxIn)
-> (Map TxIn (BabbageTxOut StandardBabbage)
-> Maybe (TxIn, BabbageTxOut StandardBabbage))
-> Map TxIn (BabbageTxOut StandardBabbage)
-> Maybe TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn TxOut -> Maybe (TxIn, TxOut)
Map TxIn (BabbageTxOut StandardBabbage)
-> Maybe (TxIn, BabbageTxOut StandardBabbage)
findLargestUTxO (Map TxIn (BabbageTxOut StandardBabbage) -> Maybe TxIn)
-> STM IO (Map TxIn (BabbageTxOut StandardBabbage))
-> STM IO (Maybe TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM IO (Map TxIn (BabbageTxOut StandardBabbage))
getUTxO
, $sel:sign:TinyWallet :: Tx -> Tx
sign = SigningKey PaymentKey -> Tx -> Tx
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
Api.signTx SigningKey PaymentKey
sk
, $sel:coverFee:TinyWallet :: UTxO -> Tx -> IO (Either ErrCoverFee Tx)
coverFee = \UTxO
lookupUTxO Tx
partialTx -> do
EpochInfo (Either Text)
epochInfo <- IO (EpochInfo (Either Text))
queryEpochInfo
WalletInfoOnChain{Map TxIn TxOut
$sel:walletUTxO:WalletInfoOnChain :: WalletInfoOnChain -> Map TxIn TxOut
walletUTxO :: Map TxIn TxOut
walletUTxO, PParams LedgerEra
$sel:pparams:WalletInfoOnChain :: WalletInfoOnChain -> PParams LedgerEra
pparams :: PParams LedgerEra
pparams, SystemStart
$sel:systemStart:WalletInfoOnChain :: WalletInfoOnChain -> SystemStart
systemStart :: SystemStart
systemStart} <- TVar IO WalletInfoOnChain -> IO WalletInfoOnChain
forall a. TVar IO a -> IO a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar
Either ErrCoverFee Tx -> IO (Either ErrCoverFee Tx)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ErrCoverFee Tx -> IO (Either ErrCoverFee Tx))
-> Either ErrCoverFee Tx -> IO (Either ErrCoverFee Tx)
forall a b. (a -> b) -> a -> b
$
Tx LedgerEra -> Tx
AlonzoTx StandardBabbage -> Tx
fromLedgerTx
(AlonzoTx StandardBabbage -> Tx)
-> Either ErrCoverFee (AlonzoTx StandardBabbage)
-> Either ErrCoverFee Tx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PParams LedgerEra
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn TxOut
-> Map TxIn TxOut
-> AlonzoTx LedgerEra
-> Either ErrCoverFee (AlonzoTx LedgerEra)
coverFee_ PParams LedgerEra
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo (UTxO LedgerEra -> Map (TxIn (EraCrypto LedgerEra)) TxOut
forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO (UTxO LedgerEra -> Map (TxIn (EraCrypto LedgerEra)) TxOut)
-> UTxO LedgerEra -> Map (TxIn (EraCrypto LedgerEra)) TxOut
forall a b. (a -> b) -> a -> b
$ UTxO -> UTxO LedgerEra
toLedgerUTxO UTxO
lookupUTxO) Map TxIn TxOut
walletUTxO (Tx -> Tx LedgerEra
forall era.
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto,
AlonzoEraTx (ShelleyLedgerEra era)) =>
Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
partialTx)
, reset :: IO ()
reset = IO WalletInfoOnChain
initialize IO WalletInfoOnChain -> (WalletInfoOnChain -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> IO ()
STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM () -> IO ())
-> (WalletInfoOnChain -> STM ()) -> WalletInfoOnChain -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar IO WalletInfoOnChain -> WalletInfoOnChain -> STM IO ()
forall a. TVar IO a -> a -> STM IO ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar
, update :: BlockHeader -> [Tx] -> IO ()
update = \BlockHeader
header [Tx]
txs -> do
let point :: ChainPoint
point = BlockHeader -> ChainPoint
getChainPoint BlockHeader
header
ChainPoint
walletTip <- STM IO ChainPoint -> IO ChainPoint
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO ChainPoint -> IO ChainPoint)
-> STM IO ChainPoint -> IO ChainPoint
forall a b. (a -> b) -> a -> b
$ TVar IO WalletInfoOnChain -> STM IO WalletInfoOnChain
forall a. TVar IO a -> STM IO a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar STM WalletInfoOnChain
-> (WalletInfoOnChain -> ChainPoint) -> STM ChainPoint
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \WalletInfoOnChain{ChainPoint
$sel:tip:WalletInfoOnChain :: WalletInfoOnChain -> ChainPoint
tip :: ChainPoint
tip} -> ChainPoint
tip
if ChainPoint
point ChainPoint -> ChainPoint -> Bool
forall a. Ord a => a -> a -> Bool
< ChainPoint
walletTip
then Tracer IO TinyWalletLog -> TinyWalletLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TinyWalletLog
tracer (TinyWalletLog -> IO ()) -> TinyWalletLog -> IO ()
forall a b. (a -> b) -> a -> b
$ SkipUpdate{ChainPoint
point :: ChainPoint
$sel:point:BeginInitialize :: ChainPoint
point}
else do
Tracer IO TinyWalletLog -> TinyWalletLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TinyWalletLog
tracer (TinyWalletLog -> IO ()) -> TinyWalletLog -> IO ()
forall a b. (a -> b) -> a -> b
$ BeginUpdate{ChainPoint
point :: ChainPoint
$sel:point:BeginInitialize :: ChainPoint
point}
Map TxIn (BabbageTxOut StandardBabbage)
utxo' <- STM IO (Map TxIn (BabbageTxOut StandardBabbage))
-> IO (Map TxIn (BabbageTxOut StandardBabbage))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (Map TxIn (BabbageTxOut StandardBabbage))
-> IO (Map TxIn (BabbageTxOut StandardBabbage)))
-> STM IO (Map TxIn (BabbageTxOut StandardBabbage))
-> IO (Map TxIn (BabbageTxOut StandardBabbage))
forall a b. (a -> b) -> a -> b
$ do
walletInfo :: WalletInfoOnChain
walletInfo@WalletInfoOnChain{Map TxIn TxOut
$sel:walletUTxO:WalletInfoOnChain :: WalletInfoOnChain -> Map TxIn TxOut
walletUTxO :: Map TxIn TxOut
walletUTxO} <- TVar IO WalletInfoOnChain -> STM IO WalletInfoOnChain
forall a. TVar IO a -> STM IO a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar
let utxo' :: Map TxIn TxOut
utxo' = [Tx]
-> (Addr StandardCrypto -> Bool)
-> Map TxIn TxOut
-> Map TxIn TxOut
applyTxs [Tx]
txs (Addr StandardCrypto -> Addr StandardCrypto -> Bool
forall a. Eq a => a -> a -> Bool
== Addr StandardCrypto
ledgerAddress) Map TxIn TxOut
walletUTxO
TVar IO WalletInfoOnChain -> WalletInfoOnChain -> STM IO ()
forall a. TVar IO a -> a -> STM IO ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar (WalletInfoOnChain -> STM IO ()) -> WalletInfoOnChain -> STM IO ()
forall a b. (a -> b) -> a -> b
$ WalletInfoOnChain
walletInfo{walletUTxO = utxo', tip = point}
Map TxIn (BabbageTxOut StandardBabbage)
-> STM (Map TxIn (BabbageTxOut StandardBabbage))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map TxIn TxOut
Map TxIn (BabbageTxOut StandardBabbage)
utxo'
Tracer IO TinyWalletLog -> TinyWalletLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TinyWalletLog
tracer (TinyWalletLog -> IO ()) -> TinyWalletLog -> IO ()
forall a b. (a -> b) -> a -> b
$ UTxO -> TinyWalletLog
EndUpdate (UTxO LedgerEra -> UTxO
fromLedgerUTxO (Map (TxIn (EraCrypto StandardBabbage)) (TxOut StandardBabbage)
-> UTxO StandardBabbage
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO Map TxIn (BabbageTxOut StandardBabbage)
Map (TxIn (EraCrypto StandardBabbage)) (TxOut StandardBabbage)
utxo'))
}
where
initialize :: IO WalletInfoOnChain
initialize = do
Tracer IO TinyWalletLog -> TinyWalletLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TinyWalletLog
tracer TinyWalletLog
BeginInitialize
walletInfo :: WalletInfoOnChain
walletInfo@WalletInfoOnChain{Map TxIn TxOut
$sel:walletUTxO:WalletInfoOnChain :: WalletInfoOnChain -> Map TxIn TxOut
walletUTxO :: Map TxIn TxOut
walletUTxO, ChainPoint
$sel:tip:WalletInfoOnChain :: WalletInfoOnChain -> ChainPoint
tip :: ChainPoint
tip} <- ChainQuery IO
queryWalletInfo QueryPoint
QueryTip Address ShelleyAddr
address
Tracer IO TinyWalletLog -> TinyWalletLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TinyWalletLog
tracer (TinyWalletLog -> IO ()) -> TinyWalletLog -> IO ()
forall a b. (a -> b) -> a -> b
$ EndInitialize{$sel:initialUTxO:BeginInitialize :: UTxO
initialUTxO = UTxO LedgerEra -> UTxO
fromLedgerUTxO (Map (TxIn (EraCrypto StandardBabbage)) (TxOut StandardBabbage)
-> UTxO StandardBabbage
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO Map TxIn TxOut
Map (TxIn (EraCrypto StandardBabbage)) (TxOut StandardBabbage)
walletUTxO), ChainPoint
tip :: ChainPoint
$sel:tip:BeginInitialize :: ChainPoint
tip}
WalletInfoOnChain -> IO WalletInfoOnChain
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WalletInfoOnChain
walletInfo
address :: Address ShelleyAddr
address =
NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress NetworkId
networkId (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (Hash PaymentKey -> PaymentCredential)
-> Hash PaymentKey -> PaymentCredential
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
vk) StakeAddressReference
NoStakeAddress
ledgerAddress :: Addr StandardCrypto
ledgerAddress = AddressInEra Era -> Addr StandardCrypto
forall era. AddressInEra era -> Addr StandardCrypto
toLedgerAddr (AddressInEra Era -> Addr StandardCrypto)
-> AddressInEra Era -> Addr StandardCrypto
forall a b. (a -> b) -> a -> b
$ forall era.
ShelleyBasedEra era -> Address ShelleyAddr -> AddressInEra era
shelleyAddressInEra @Api.Era ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
Api.shelleyBasedEra Address ShelleyAddr
address
applyTxs :: [Api.Tx] -> (Address -> Bool) -> Map TxIn TxOut -> Map TxIn TxOut
applyTxs :: [Tx]
-> (Addr StandardCrypto -> Bool)
-> Map TxIn TxOut
-> Map TxIn TxOut
applyTxs [Tx]
txs Addr StandardCrypto -> Bool
isOurs Map TxIn TxOut
utxo =
(State (Map TxIn (BabbageTxOut StandardBabbage)) ()
-> Map TxIn (BabbageTxOut StandardBabbage) -> Map TxIn TxOut)
-> Map TxIn (BabbageTxOut StandardBabbage)
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
-> Map TxIn TxOut
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (Map TxIn (BabbageTxOut StandardBabbage)) ()
-> Map TxIn (BabbageTxOut StandardBabbage) -> Map TxIn TxOut
State (Map TxIn (BabbageTxOut StandardBabbage)) ()
-> Map TxIn (BabbageTxOut StandardBabbage)
-> Map TxIn (BabbageTxOut StandardBabbage)
forall s a. State s a -> s -> s
execState Map TxIn TxOut
Map TxIn (BabbageTxOut StandardBabbage)
utxo (State (Map TxIn (BabbageTxOut StandardBabbage)) ()
-> Map TxIn TxOut)
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
-> Map TxIn TxOut
forall a b. (a -> b) -> a -> b
$ do
[Tx]
-> (Tx -> State (Map TxIn (BabbageTxOut StandardBabbage)) ())
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Tx]
txs ((Tx -> State (Map TxIn (BabbageTxOut StandardBabbage)) ())
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ())
-> (Tx -> State (Map TxIn (BabbageTxOut StandardBabbage)) ())
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
forall a b. (a -> b) -> a -> b
$ \Tx
apiTx -> do
let tx :: Tx LedgerEra
tx = Tx -> Tx LedgerEra
forall era.
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto,
AlonzoEraTx (ShelleyLedgerEra era)) =>
Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
apiTx
let txId :: TxId StandardCrypto
txId = AlonzoTx StandardBabbage -> TxId StandardCrypto
forall crypto (era :: * -> *).
(HashAlgorithm (HASH crypto),
HashAnnotated (TxBody (era crypto)) EraIndependentTxBody crypto) =>
AlonzoTx (era crypto) -> TxId crypto
getTxId Tx LedgerEra
AlonzoTx StandardBabbage
tx
(Map
(TxIn (EraCrypto StandardBabbage)) (BabbageTxOut StandardBabbage)
-> Map
(TxIn (EraCrypto StandardBabbage)) (BabbageTxOut StandardBabbage))
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Map
(TxIn (EraCrypto StandardBabbage)) (BabbageTxOut StandardBabbage)
-> Set (TxIn (EraCrypto StandardBabbage))
-> Map
(TxIn (EraCrypto StandardBabbage)) (BabbageTxOut StandardBabbage)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Getting
(Set (TxIn (EraCrypto StandardBabbage)))
(TxBody StandardBabbage)
(Set (TxIn (EraCrypto StandardBabbage)))
-> TxBody StandardBabbage -> Set (TxIn (EraCrypto StandardBabbage))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(Set (TxIn (EraCrypto StandardBabbage)))
(TxBody StandardBabbage)
(Set (TxIn (EraCrypto StandardBabbage)))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody StandardBabbage) (Set (TxIn (EraCrypto StandardBabbage)))
inputsTxBodyL (AlonzoTx StandardBabbage -> TxBody StandardBabbage
forall era. AlonzoTx era -> TxBody era
body Tx LedgerEra
AlonzoTx StandardBabbage
tx))
let indexedOutputs :: [(TxIx, BabbageTxOut StandardBabbage)]
indexedOutputs =
let outs :: [BabbageTxOut StandardBabbage]
outs = StrictSeq (BabbageTxOut StandardBabbage)
-> [BabbageTxOut StandardBabbage]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (BabbageTxOut StandardBabbage)
-> [BabbageTxOut StandardBabbage])
-> StrictSeq (BabbageTxOut StandardBabbage)
-> [BabbageTxOut StandardBabbage]
forall a b. (a -> b) -> a -> b
$ AlonzoTx StandardBabbage -> TxBody StandardBabbage
forall era. AlonzoTx era -> TxBody era
body Tx LedgerEra
AlonzoTx StandardBabbage
tx TxBody StandardBabbage
-> Getting
(StrictSeq (BabbageTxOut StandardBabbage))
(TxBody StandardBabbage)
(StrictSeq (BabbageTxOut StandardBabbage))
-> StrictSeq (BabbageTxOut StandardBabbage)
forall s a. s -> Getting a s a -> a
^. (StrictSeq (TxOut StandardBabbage)
-> Const
(StrictSeq (BabbageTxOut StandardBabbage))
(StrictSeq (TxOut StandardBabbage)))
-> TxBody StandardBabbage
-> Const
(StrictSeq (BabbageTxOut StandardBabbage)) (TxBody StandardBabbage)
Getting
(StrictSeq (BabbageTxOut StandardBabbage))
(TxBody StandardBabbage)
(StrictSeq (BabbageTxOut StandardBabbage))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody StandardBabbage) (StrictSeq (TxOut StandardBabbage))
outputsTxBodyL
maxIx :: Word64
maxIx = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [BabbageTxOut StandardBabbage] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BabbageTxOut StandardBabbage]
outs
in [TxIx]
-> [BabbageTxOut StandardBabbage]
-> [(TxIx, BabbageTxOut StandardBabbage)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64 -> TxIx
Ledger.TxIx Word64
ix | Word64
ix <- [Word64
0 .. Word64
maxIx]] [BabbageTxOut StandardBabbage]
outs
[(TxIx, BabbageTxOut StandardBabbage)]
-> ((TxIx, BabbageTxOut StandardBabbage)
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ())
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(TxIx, BabbageTxOut StandardBabbage)]
indexedOutputs (((TxIx, BabbageTxOut StandardBabbage)
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ())
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ())
-> ((TxIx, BabbageTxOut StandardBabbage)
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ())
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
forall a b. (a -> b) -> a -> b
$ \(TxIx
ix, out :: BabbageTxOut StandardBabbage
out@(Babbage.BabbageTxOut Addr (EraCrypto StandardBabbage)
addr Value StandardBabbage
_ Datum StandardBabbage
_ StrictMaybe (Script StandardBabbage)
_)) ->
Bool
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Addr StandardCrypto -> Bool
isOurs Addr StandardCrypto
Addr (EraCrypto StandardBabbage)
addr) (State (Map TxIn (BabbageTxOut StandardBabbage)) ()
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ())
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
forall a b. (a -> b) -> a -> b
$ (Map TxIn (BabbageTxOut StandardBabbage)
-> Map TxIn (BabbageTxOut StandardBabbage))
-> State (Map TxIn (BabbageTxOut StandardBabbage)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (TxIn
-> BabbageTxOut StandardBabbage
-> Map TxIn (BabbageTxOut StandardBabbage)
-> Map TxIn (BabbageTxOut StandardBabbage)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (TxId StandardCrypto -> TxIx -> TxIn
forall c. TxId c -> TxIx -> TxIn c
Ledger.TxIn TxId StandardCrypto
txId TxIx
ix) BabbageTxOut StandardBabbage
out)
getTxId ::
( HashAlgorithm (HASH crypto)
, SafeHash.HashAnnotated
(Ledger.TxBody (era crypto))
EraIndependentTxBody
crypto
) =>
Babbage.AlonzoTx (era crypto) ->
Ledger.TxId crypto
getTxId :: forall crypto (era :: * -> *).
(HashAlgorithm (HASH crypto),
HashAnnotated (TxBody (era crypto)) EraIndependentTxBody crypto) =>
AlonzoTx (era crypto) -> TxId crypto
getTxId AlonzoTx (era crypto)
tx = SafeHash crypto EraIndependentTxBody -> TxId crypto
forall c. SafeHash c EraIndependentTxBody -> TxId c
Ledger.TxId (SafeHash crypto EraIndependentTxBody -> TxId crypto)
-> SafeHash crypto EraIndependentTxBody -> TxId crypto
forall a b. (a -> b) -> a -> b
$ TxBody (era crypto) -> SafeHash crypto EraIndependentTxBody
forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
SafeHash.hashAnnotated (AlonzoTx (era crypto) -> TxBody (era crypto)
forall era. AlonzoTx era -> TxBody era
body AlonzoTx (era crypto)
tx)
data ErrCoverFee
= ErrNotEnoughFunds ChangeError
| ErrNoFuelUTxOFound
| ErrUnknownInput {ErrCoverFee -> TxIn
input :: TxIn}
| ErrScriptExecutionFailed {ErrCoverFee
-> (PlutusPurpose AsIndex LedgerEra,
TransactionScriptFailure LedgerEra)
scriptFailure :: (PlutusPurpose AsIndex LedgerEra, TransactionScriptFailure LedgerEra)}
| ErrTranslationError (ContextError LedgerEra)
deriving stock (Int -> ErrCoverFee -> ShowS
[ErrCoverFee] -> ShowS
ErrCoverFee -> String
(Int -> ErrCoverFee -> ShowS)
-> (ErrCoverFee -> String)
-> ([ErrCoverFee] -> ShowS)
-> Show ErrCoverFee
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrCoverFee -> ShowS
showsPrec :: Int -> ErrCoverFee -> ShowS
$cshow :: ErrCoverFee -> String
show :: ErrCoverFee -> String
$cshowList :: [ErrCoverFee] -> ShowS
showList :: [ErrCoverFee] -> ShowS
Show)
data ChangeError = ChangeError {ChangeError -> Coin
inputBalance :: Coin, ChangeError -> Coin
outputBalance :: Coin}
deriving stock (Int -> ChangeError -> ShowS
[ChangeError] -> ShowS
ChangeError -> String
(Int -> ChangeError -> ShowS)
-> (ChangeError -> String)
-> ([ChangeError] -> ShowS)
-> Show ChangeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeError -> ShowS
showsPrec :: Int -> ChangeError -> ShowS
$cshow :: ChangeError -> String
show :: ChangeError -> String
$cshowList :: [ChangeError] -> ShowS
showList :: [ChangeError] -> ShowS
Show)
coverFee_ ::
Core.PParams LedgerEra ->
SystemStart ->
EpochInfo (Either Text) ->
Map TxIn TxOut ->
Map TxIn TxOut ->
Babbage.AlonzoTx LedgerEra ->
Either ErrCoverFee (Babbage.AlonzoTx LedgerEra)
coverFee_ :: PParams LedgerEra
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn TxOut
-> Map TxIn TxOut
-> AlonzoTx LedgerEra
-> Either ErrCoverFee (AlonzoTx LedgerEra)
coverFee_ PParams LedgerEra
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo Map TxIn TxOut
lookupUTxO Map TxIn TxOut
walletUTxO partialTx :: AlonzoTx LedgerEra
partialTx@Babbage.AlonzoTx{TxBody LedgerEra
body :: forall era. AlonzoTx era -> TxBody era
body :: TxBody LedgerEra
body, TxWits LedgerEra
wits :: forall era. AlonzoTx era -> TxWits era
wits :: TxWits LedgerEra
wits} = do
(TxIn
feeTxIn, BabbageTxOut StandardBabbage
feeTxOut) <- Map TxIn (BabbageTxOut StandardBabbage)
-> Either ErrCoverFee (TxIn, BabbageTxOut StandardBabbage)
findUTxOToPayFees Map TxIn TxOut
Map TxIn (BabbageTxOut StandardBabbage)
walletUTxO
let newInputs :: Set TxIn
newInputs = Getting (Set TxIn) (TxBody StandardBabbage) (Set TxIn)
-> BabbageTxBody StandardBabbage -> Set TxIn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set TxIn) (TxBody StandardBabbage) (Set TxIn)
(Set (TxIn (EraCrypto StandardBabbage))
-> Const (Set TxIn) (Set (TxIn (EraCrypto StandardBabbage))))
-> TxBody StandardBabbage
-> Const (Set TxIn) (TxBody StandardBabbage)
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody StandardBabbage) (Set (TxIn (EraCrypto StandardBabbage)))
inputsTxBodyL TxBody LedgerEra
BabbageTxBody StandardBabbage
body Set TxIn -> Set TxIn -> Set TxIn
forall a. Semigroup a => a -> a -> a
<> TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
feeTxIn
[BabbageTxOut StandardBabbage]
resolvedInputs <- (TxIn -> Either ErrCoverFee (BabbageTxOut StandardBabbage))
-> [TxIn] -> Either ErrCoverFee [BabbageTxOut StandardBabbage]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse TxIn -> Either ErrCoverFee TxOut
TxIn -> Either ErrCoverFee (BabbageTxOut StandardBabbage)
resolveInput (Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set TxIn
newInputs)
let txOuts :: StrictSeq (BabbageTxOut StandardBabbage)
txOuts = TxBody LedgerEra
BabbageTxBody StandardBabbage
body BabbageTxBody StandardBabbage
-> Getting
(StrictSeq (TxOut StandardBabbage))
(BabbageTxBody StandardBabbage)
(StrictSeq (TxOut StandardBabbage))
-> StrictSeq (TxOut StandardBabbage)
forall s a. s -> Getting a s a -> a
^. (StrictSeq (TxOut StandardBabbage)
-> Const
(StrictSeq (TxOut StandardBabbage))
(StrictSeq (TxOut StandardBabbage)))
-> TxBody StandardBabbage
-> Const
(StrictSeq (TxOut StandardBabbage)) (TxBody StandardBabbage)
Getting
(StrictSeq (TxOut StandardBabbage))
(BabbageTxBody StandardBabbage)
(StrictSeq (TxOut StandardBabbage))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody StandardBabbage) (StrictSeq (TxOut StandardBabbage))
outputsTxBodyL StrictSeq (TxOut StandardBabbage)
-> (TxOut StandardBabbage -> BabbageTxOut StandardBabbage)
-> StrictSeq (BabbageTxOut StandardBabbage)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> PParams StandardBabbage
-> TxOut StandardBabbage -> TxOut StandardBabbage
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
ensureMinCoinTxOut PParams LedgerEra
PParams StandardBabbage
pparams
let utxo :: Map TxIn (BabbageTxOut StandardBabbage)
utxo = Map TxIn TxOut
Map TxIn (BabbageTxOut StandardBabbage)
lookupUTxO Map TxIn (BabbageTxOut StandardBabbage)
-> Map TxIn (BabbageTxOut StandardBabbage)
-> Map TxIn (BabbageTxOut StandardBabbage)
forall a. Semigroup a => a -> a -> a
<> Map TxIn TxOut
Map TxIn (BabbageTxOut StandardBabbage)
walletUTxO
Map (AlonzoPlutusPurpose AsIndex StandardBabbage) ExUnits
estimatedScriptCosts <- PParams LedgerEra
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn TxOut
-> AlonzoTx LedgerEra
-> Either
ErrCoverFee (Map (PlutusPurpose AsIndex LedgerEra) ExUnits)
estimateScriptsCost PParams LedgerEra
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo Map TxIn TxOut
Map TxIn (BabbageTxOut StandardBabbage)
utxo AlonzoTx LedgerEra
partialTx
let adjustedRedeemers :: Redeemers LedgerEra
adjustedRedeemers =
Set TxIn
-> Set TxIn
-> Map (PlutusPurpose AsIndex LedgerEra) ExUnits
-> Redeemers LedgerEra
-> Redeemers LedgerEra
adjustRedeemers
(Getting (Set TxIn) (TxBody StandardBabbage) (Set TxIn)
-> BabbageTxBody StandardBabbage -> Set TxIn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set TxIn) (TxBody StandardBabbage) (Set TxIn)
(Set (TxIn (EraCrypto StandardBabbage))
-> Const (Set TxIn) (Set (TxIn (EraCrypto StandardBabbage))))
-> TxBody StandardBabbage
-> Const (Set TxIn) (TxBody StandardBabbage)
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody StandardBabbage) (Set (TxIn (EraCrypto StandardBabbage)))
inputsTxBodyL TxBody LedgerEra
BabbageTxBody StandardBabbage
body)
Set TxIn
newInputs
Map (PlutusPurpose AsIndex LedgerEra) ExUnits
Map (AlonzoPlutusPurpose AsIndex StandardBabbage) ExUnits
estimatedScriptCosts
(AlonzoTxWits StandardBabbage -> Redeemers StandardBabbage
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Redeemers era
txrdmrs TxWits LedgerEra
AlonzoTxWits StandardBabbage
wits)
let referenceScripts :: Map (ScriptHash (EraCrypto LedgerEra)) (Script LedgerEra)
referenceScripts = forall era.
BabbageEraTxOut era =>
UTxO era
-> Set (TxIn (EraCrypto era))
-> Map (ScriptHash (EraCrypto era)) (Script era)
getReferenceScripts @LedgerEra (Map (TxIn (EraCrypto StandardBabbage)) (TxOut StandardBabbage)
-> UTxO StandardBabbage
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO Map TxIn (BabbageTxOut StandardBabbage)
Map (TxIn (EraCrypto StandardBabbage)) (TxOut StandardBabbage)
utxo) (Getting (Set TxIn) (TxBody StandardBabbage) (Set TxIn)
-> BabbageTxBody StandardBabbage -> Set TxIn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set TxIn) (TxBody StandardBabbage) (Set TxIn)
(Set (TxIn (EraCrypto StandardBabbage))
-> Const (Set TxIn) (Set (TxIn (EraCrypto StandardBabbage))))
-> TxBody StandardBabbage
-> Const (Set TxIn) (TxBody StandardBabbage)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody StandardBabbage) (Set (TxIn (EraCrypto StandardBabbage)))
referenceInputsTxBodyL TxBody LedgerEra
BabbageTxBody StandardBabbage
body)
langs :: [LangDepView]
langs =
[ PParams StandardBabbage -> Language -> LangDepView
forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
getLanguageView PParams LedgerEra
PParams StandardBabbage
pparams Language
l
| (ScriptHash (EraCrypto StandardBabbage)
_hash, Script StandardBabbage
script) <- Map
(ScriptHash (EraCrypto StandardBabbage)) (Script StandardBabbage)
-> [(ScriptHash (EraCrypto StandardBabbage),
Script StandardBabbage)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map
(ScriptHash (EraCrypto StandardBabbage)) (Script StandardBabbage)
-> [(ScriptHash (EraCrypto StandardBabbage),
Script StandardBabbage)])
-> Map
(ScriptHash (EraCrypto StandardBabbage)) (Script StandardBabbage)
-> [(ScriptHash (EraCrypto StandardBabbage),
Script StandardBabbage)]
forall a b. (a -> b) -> a -> b
$ Map
(ScriptHash (EraCrypto StandardBabbage)) (Script StandardBabbage)
-> Map
(ScriptHash (EraCrypto StandardBabbage)) (Script StandardBabbage)
-> Map
(ScriptHash (EraCrypto StandardBabbage)) (Script StandardBabbage)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (AlonzoTxWits StandardBabbage
-> Map
(ScriptHash (EraCrypto StandardBabbage)) (Script StandardBabbage)
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map (ScriptHash (EraCrypto era)) (Script era)
txscripts TxWits LedgerEra
AlonzoTxWits StandardBabbage
wits) Map (ScriptHash (EraCrypto LedgerEra)) (Script LedgerEra)
Map
(ScriptHash (EraCrypto StandardBabbage)) (Script StandardBabbage)
referenceScripts
, (Bool -> Bool
not (Bool -> Bool)
-> (Script StandardBabbage -> Bool)
-> Script StandardBabbage
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => Script era -> Bool
isNativeScript @LedgerEra) Script StandardBabbage
script
, Language
l <- Maybe Language -> [Language]
forall a. Maybe a -> [a]
maybeToList (Maybe Language -> [Language]) -> Maybe Language -> [Language]
forall a b. (a -> b) -> a -> b
$ PlutusScript StandardBabbage -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage (PlutusScript StandardBabbage -> Language)
-> Maybe (PlutusScript StandardBabbage) -> Maybe Language
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script StandardBabbage -> Maybe (PlutusScript StandardBabbage)
forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
toPlutusScript Script StandardBabbage
script
]
scriptIntegrityHash :: StrictMaybe (ScriptIntegrityHash (EraCrypto StandardBabbage))
scriptIntegrityHash =
Set LangDepView
-> Redeemers StandardBabbage
-> TxDats StandardBabbage
-> StrictMaybe (ScriptIntegrityHash (EraCrypto StandardBabbage))
forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
hashScriptIntegrity
([LangDepView] -> Set LangDepView
forall a. Ord a => [a] -> Set a
Set.fromList [LangDepView]
langs)
Redeemers LedgerEra
Redeemers StandardBabbage
adjustedRedeemers
(AlonzoTxWits StandardBabbage -> TxDats StandardBabbage
forall era. AlonzoEraScript era => AlonzoTxWits era -> TxDats era
txdats TxWits LedgerEra
AlonzoTxWits StandardBabbage
wits)
let
unbalancedBody :: BabbageTxBody StandardBabbage
unbalancedBody =
TxBody LedgerEra
BabbageTxBody StandardBabbage
body
BabbageTxBody StandardBabbage
-> (BabbageTxBody StandardBabbage -> BabbageTxBody StandardBabbage)
-> BabbageTxBody StandardBabbage
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto StandardBabbage)) -> Identity (Set TxIn))
-> BabbageTxBody StandardBabbage
-> Identity (BabbageTxBody StandardBabbage)
(Set (TxIn (EraCrypto StandardBabbage))
-> Identity (Set (TxIn (EraCrypto StandardBabbage))))
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage)
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody StandardBabbage) (Set (TxIn (EraCrypto StandardBabbage)))
inputsTxBodyL ((Set (TxIn (EraCrypto StandardBabbage)) -> Identity (Set TxIn))
-> BabbageTxBody StandardBabbage
-> Identity (BabbageTxBody StandardBabbage))
-> Set TxIn
-> BabbageTxBody StandardBabbage
-> BabbageTxBody StandardBabbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
newInputs
BabbageTxBody StandardBabbage
-> (BabbageTxBody StandardBabbage -> BabbageTxBody StandardBabbage)
-> BabbageTxBody StandardBabbage
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut StandardBabbage)
-> Identity (StrictSeq (TxOut StandardBabbage)))
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage)
(StrictSeq (TxOut StandardBabbage)
-> Identity (StrictSeq (BabbageTxOut StandardBabbage)))
-> BabbageTxBody StandardBabbage
-> Identity (BabbageTxBody StandardBabbage)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody StandardBabbage) (StrictSeq (TxOut StandardBabbage))
outputsTxBodyL ((StrictSeq (TxOut StandardBabbage)
-> Identity (StrictSeq (BabbageTxOut StandardBabbage)))
-> BabbageTxBody StandardBabbage
-> Identity (BabbageTxBody StandardBabbage))
-> StrictSeq (BabbageTxOut StandardBabbage)
-> BabbageTxBody StandardBabbage
-> BabbageTxBody StandardBabbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (BabbageTxOut StandardBabbage)
txOuts
BabbageTxBody StandardBabbage
-> (BabbageTxBody StandardBabbage -> BabbageTxBody StandardBabbage)
-> BabbageTxBody StandardBabbage
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto StandardBabbage)) -> Identity (Set TxIn))
-> BabbageTxBody StandardBabbage
-> Identity (BabbageTxBody StandardBabbage)
(Set (TxIn (EraCrypto StandardBabbage))
-> Identity (Set (TxIn (EraCrypto StandardBabbage))))
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody StandardBabbage) (Set (TxIn (EraCrypto StandardBabbage)))
collateralInputsTxBodyL ((Set (TxIn (EraCrypto StandardBabbage)) -> Identity (Set TxIn))
-> BabbageTxBody StandardBabbage
-> Identity (BabbageTxBody StandardBabbage))
-> Set TxIn
-> BabbageTxBody StandardBabbage
-> BabbageTxBody StandardBabbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
feeTxIn
BabbageTxBody StandardBabbage
-> (BabbageTxBody StandardBabbage -> BabbageTxBody StandardBabbage)
-> BabbageTxBody StandardBabbage
forall a b. a -> (a -> b) -> b
& (StrictMaybe (ScriptIntegrityHash (EraCrypto StandardBabbage))
-> Identity
(StrictMaybe (ScriptIntegrityHash (EraCrypto StandardBabbage))))
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage)
(StrictMaybe (ScriptIntegrityHash (EraCrypto StandardBabbage))
-> Identity
(StrictMaybe (ScriptIntegrityHash (EraCrypto StandardBabbage))))
-> BabbageTxBody StandardBabbage
-> Identity (BabbageTxBody StandardBabbage)
forall era.
AlonzoEraTxBody era =>
Lens'
(TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
Lens'
(TxBody StandardBabbage)
(StrictMaybe (ScriptIntegrityHash (EraCrypto StandardBabbage)))
scriptIntegrityHashTxBodyL ((StrictMaybe (ScriptIntegrityHash (EraCrypto StandardBabbage))
-> Identity
(StrictMaybe (ScriptIntegrityHash (EraCrypto StandardBabbage))))
-> BabbageTxBody StandardBabbage
-> Identity (BabbageTxBody StandardBabbage))
-> StrictMaybe (ScriptIntegrityHash (EraCrypto StandardBabbage))
-> BabbageTxBody StandardBabbage
-> BabbageTxBody StandardBabbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (ScriptIntegrityHash (EraCrypto StandardBabbage))
scriptIntegrityHash
unbalancedTx :: AlonzoTx StandardBabbage
unbalancedTx =
AlonzoTx LedgerEra
AlonzoTx StandardBabbage
partialTx
AlonzoTx StandardBabbage
-> (AlonzoTx StandardBabbage -> AlonzoTx StandardBabbage)
-> AlonzoTx StandardBabbage
forall a b. a -> (a -> b) -> b
& (TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> Tx StandardBabbage -> Identity (Tx StandardBabbage)
(TxBody StandardBabbage
-> Identity (BabbageTxBody StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx StandardBabbage) (TxBody StandardBabbage)
bodyTxL ((TxBody StandardBabbage
-> Identity (BabbageTxBody StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage))
-> BabbageTxBody StandardBabbage
-> AlonzoTx StandardBabbage
-> AlonzoTx StandardBabbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BabbageTxBody StandardBabbage
unbalancedBody
AlonzoTx StandardBabbage
-> (AlonzoTx StandardBabbage -> AlonzoTx StandardBabbage)
-> AlonzoTx StandardBabbage
forall a b. a -> (a -> b) -> b
& (TxWits StandardBabbage -> Identity (TxWits StandardBabbage))
-> Tx StandardBabbage -> Identity (Tx StandardBabbage)
(TxWits StandardBabbage -> Identity (TxWits StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx StandardBabbage) (TxWits StandardBabbage)
witsTxL ((TxWits StandardBabbage -> Identity (TxWits StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage))
-> ((Redeemers StandardBabbage
-> Identity (Redeemers StandardBabbage))
-> TxWits StandardBabbage -> Identity (TxWits StandardBabbage))
-> (Redeemers StandardBabbage
-> Identity (Redeemers StandardBabbage))
-> AlonzoTx StandardBabbage
-> Identity (AlonzoTx StandardBabbage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers StandardBabbage -> Identity (Redeemers StandardBabbage))
-> TxWits StandardBabbage -> Identity (TxWits StandardBabbage)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits StandardBabbage) (Redeemers StandardBabbage)
rdmrsTxWitsL ((Redeemers StandardBabbage
-> Identity (Redeemers StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage))
-> Redeemers StandardBabbage
-> AlonzoTx StandardBabbage
-> AlonzoTx StandardBabbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers LedgerEra
Redeemers StandardBabbage
adjustedRedeemers
let fee :: Coin
fee = PParams StandardBabbage -> Tx StandardBabbage -> Int -> Int -> Coin
forall era.
EraTx era =>
PParams era -> Tx era -> Int -> Int -> Coin
estimateMinFeeTx PParams LedgerEra
PParams StandardBabbage
pparams Tx StandardBabbage
AlonzoTx StandardBabbage
costingTx Int
additionalWitnesses Int
0
costingTx :: AlonzoTx StandardBabbage
costingTx =
AlonzoTx StandardBabbage
unbalancedTx
AlonzoTx StandardBabbage
-> (AlonzoTx StandardBabbage -> AlonzoTx StandardBabbage)
-> AlonzoTx StandardBabbage
forall a b. a -> (a -> b) -> b
& (TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> Tx StandardBabbage -> Identity (Tx StandardBabbage)
(TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx StandardBabbage) (TxBody StandardBabbage)
bodyTxL ((TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage))
-> ((StrictSeq (BabbageTxOut StandardBabbage)
-> Identity (StrictSeq (BabbageTxOut StandardBabbage)))
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> (StrictSeq (BabbageTxOut StandardBabbage)
-> Identity (StrictSeq (BabbageTxOut StandardBabbage)))
-> AlonzoTx StandardBabbage
-> Identity (AlonzoTx StandardBabbage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut StandardBabbage)
-> Identity (StrictSeq (TxOut StandardBabbage)))
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage)
(StrictSeq (BabbageTxOut StandardBabbage)
-> Identity (StrictSeq (BabbageTxOut StandardBabbage)))
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody StandardBabbage) (StrictSeq (TxOut StandardBabbage))
outputsTxBodyL ((StrictSeq (BabbageTxOut StandardBabbage)
-> Identity (StrictSeq (BabbageTxOut StandardBabbage)))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage))
-> (StrictSeq (BabbageTxOut StandardBabbage)
-> StrictSeq (BabbageTxOut StandardBabbage))
-> AlonzoTx StandardBabbage
-> AlonzoTx StandardBabbage
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (StrictSeq (BabbageTxOut StandardBabbage)
-> BabbageTxOut StandardBabbage
-> StrictSeq (BabbageTxOut StandardBabbage)
forall a. StrictSeq a -> a -> StrictSeq a
|> BabbageTxOut StandardBabbage
feeTxOut)
AlonzoTx StandardBabbage
-> (AlonzoTx StandardBabbage -> AlonzoTx StandardBabbage)
-> AlonzoTx StandardBabbage
forall a b. a -> (a -> b) -> b
& (TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> Tx StandardBabbage -> Identity (Tx StandardBabbage)
(TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx StandardBabbage) (TxBody StandardBabbage)
bodyTxL ((TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage))
-> ((Coin -> Identity Coin)
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> (Coin -> Identity Coin)
-> AlonzoTx StandardBabbage
-> Identity (AlonzoTx StandardBabbage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody StandardBabbage) Coin
feeTxBodyL ((Coin -> Identity Coin)
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage))
-> Coin -> AlonzoTx StandardBabbage -> AlonzoTx StandardBabbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
10_000_000
additionalWitnesses :: Int
additionalWitnesses = Int
2
BabbageTxOut StandardBabbage
change <-
(ChangeError -> ErrCoverFee)
-> Either ChangeError TxOut -> Either ErrCoverFee TxOut
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ChangeError -> ErrCoverFee
ErrNotEnoughFunds (Either ChangeError TxOut -> Either ErrCoverFee TxOut)
-> Either ChangeError TxOut -> Either ErrCoverFee TxOut
forall a b. (a -> b) -> a -> b
$
TxOut -> [TxOut] -> [TxOut] -> Coin -> Either ChangeError TxOut
mkChange
TxOut
BabbageTxOut StandardBabbage
feeTxOut
[TxOut]
[BabbageTxOut StandardBabbage]
resolvedInputs
(StrictSeq (BabbageTxOut StandardBabbage)
-> [BabbageTxOut StandardBabbage]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (BabbageTxOut StandardBabbage)
txOuts)
Coin
fee
AlonzoTx StandardBabbage
-> Either ErrCoverFee (AlonzoTx StandardBabbage)
forall a. a -> Either ErrCoverFee a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlonzoTx StandardBabbage
-> Either ErrCoverFee (AlonzoTx StandardBabbage))
-> AlonzoTx StandardBabbage
-> Either ErrCoverFee (AlonzoTx StandardBabbage)
forall a b. (a -> b) -> a -> b
$
AlonzoTx StandardBabbage
unbalancedTx
AlonzoTx StandardBabbage
-> (AlonzoTx StandardBabbage -> AlonzoTx StandardBabbage)
-> AlonzoTx StandardBabbage
forall a b. a -> (a -> b) -> b
& (TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> Tx StandardBabbage -> Identity (Tx StandardBabbage)
(TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx StandardBabbage) (TxBody StandardBabbage)
bodyTxL ((TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage))
-> ((StrictSeq (BabbageTxOut StandardBabbage)
-> Identity (StrictSeq (BabbageTxOut StandardBabbage)))
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> (StrictSeq (BabbageTxOut StandardBabbage)
-> Identity (StrictSeq (BabbageTxOut StandardBabbage)))
-> AlonzoTx StandardBabbage
-> Identity (AlonzoTx StandardBabbage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut StandardBabbage)
-> Identity (StrictSeq (TxOut StandardBabbage)))
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage)
(StrictSeq (BabbageTxOut StandardBabbage)
-> Identity (StrictSeq (BabbageTxOut StandardBabbage)))
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody StandardBabbage) (StrictSeq (TxOut StandardBabbage))
outputsTxBodyL ((StrictSeq (BabbageTxOut StandardBabbage)
-> Identity (StrictSeq (BabbageTxOut StandardBabbage)))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage))
-> (StrictSeq (BabbageTxOut StandardBabbage)
-> StrictSeq (BabbageTxOut StandardBabbage))
-> AlonzoTx StandardBabbage
-> AlonzoTx StandardBabbage
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (StrictSeq (BabbageTxOut StandardBabbage)
-> BabbageTxOut StandardBabbage
-> StrictSeq (BabbageTxOut StandardBabbage)
forall a. StrictSeq a -> a -> StrictSeq a
|> BabbageTxOut StandardBabbage
change)
AlonzoTx StandardBabbage
-> (AlonzoTx StandardBabbage -> AlonzoTx StandardBabbage)
-> AlonzoTx StandardBabbage
forall a b. a -> (a -> b) -> b
& (TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> Tx StandardBabbage -> Identity (Tx StandardBabbage)
(TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx StandardBabbage) (TxBody StandardBabbage)
bodyTxL ((TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage))
-> ((Coin -> Identity Coin)
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage))
-> (Coin -> Identity Coin)
-> AlonzoTx StandardBabbage
-> Identity (AlonzoTx StandardBabbage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> TxBody StandardBabbage -> Identity (TxBody StandardBabbage)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody StandardBabbage) Coin
feeTxBodyL ((Coin -> Identity Coin)
-> AlonzoTx StandardBabbage -> Identity (AlonzoTx StandardBabbage))
-> Coin -> AlonzoTx StandardBabbage -> AlonzoTx StandardBabbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
fee
where
findUTxOToPayFees :: Map TxIn (BabbageTxOut StandardBabbage)
-> Either ErrCoverFee (TxIn, BabbageTxOut StandardBabbage)
findUTxOToPayFees Map TxIn (BabbageTxOut StandardBabbage)
utxo = case Map TxIn TxOut -> Maybe (TxIn, TxOut)
findLargestUTxO Map TxIn TxOut
Map TxIn (BabbageTxOut StandardBabbage)
utxo of
Maybe (TxIn, TxOut)
Nothing ->
ErrCoverFee
-> Either ErrCoverFee (TxIn, BabbageTxOut StandardBabbage)
forall a b. a -> Either a b
Left ErrCoverFee
ErrNoFuelUTxOFound
Just (TxIn
i, TxOut
o) ->
(TxIn, BabbageTxOut StandardBabbage)
-> Either ErrCoverFee (TxIn, BabbageTxOut StandardBabbage)
forall a b. b -> Either a b
Right (TxIn
i, TxOut
BabbageTxOut StandardBabbage
o)
getAdaValue :: TxOut -> Coin
getAdaValue :: TxOut -> Coin
getAdaValue (Babbage.BabbageTxOut Addr (EraCrypto StandardBabbage)
_ Value StandardBabbage
value Datum StandardBabbage
_ StrictMaybe (Script StandardBabbage)
_) =
MaryValue StandardCrypto -> Coin
forall t. Val t => t -> Coin
coin Value StandardBabbage
MaryValue StandardCrypto
value
resolveInput :: TxIn -> Either ErrCoverFee TxOut
resolveInput :: TxIn -> Either ErrCoverFee TxOut
resolveInput TxIn
i = do
case TxIn
-> Map TxIn (BabbageTxOut StandardBabbage)
-> Maybe (BabbageTxOut StandardBabbage)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
i (Map TxIn TxOut
Map TxIn (BabbageTxOut StandardBabbage)
lookupUTxO Map TxIn (BabbageTxOut StandardBabbage)
-> Map TxIn (BabbageTxOut StandardBabbage)
-> Map TxIn (BabbageTxOut StandardBabbage)
forall a. Semigroup a => a -> a -> a
<> Map TxIn TxOut
Map TxIn (BabbageTxOut StandardBabbage)
walletUTxO) of
Maybe (BabbageTxOut StandardBabbage)
Nothing -> ErrCoverFee -> Either ErrCoverFee TxOut
forall a b. a -> Either a b
Left (ErrCoverFee -> Either ErrCoverFee TxOut)
-> ErrCoverFee -> Either ErrCoverFee TxOut
forall a b. (a -> b) -> a -> b
$ TxIn -> ErrCoverFee
ErrUnknownInput TxIn
i
Just BabbageTxOut StandardBabbage
o -> BabbageTxOut StandardBabbage
-> Either ErrCoverFee (BabbageTxOut StandardBabbage)
forall a b. b -> Either a b
Right BabbageTxOut StandardBabbage
o
mkChange ::
TxOut ->
[TxOut] ->
[TxOut] ->
Coin ->
Either ChangeError TxOut
mkChange :: TxOut -> [TxOut] -> [TxOut] -> Coin -> Either ChangeError TxOut
mkChange (Babbage.BabbageTxOut Addr (EraCrypto StandardBabbage)
addr Value StandardBabbage
_ Datum StandardBabbage
datum StrictMaybe (Script StandardBabbage)
_) [TxOut]
resolvedInputs [TxOut]
otherOutputs Coin
fee
| Coin
totalIn Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
totalOut =
ChangeError -> Either ChangeError TxOut
forall a b. a -> Either a b
Left (ChangeError -> Either ChangeError TxOut)
-> ChangeError -> Either ChangeError TxOut
forall a b. (a -> b) -> a -> b
$
ChangeError
{ $sel:inputBalance:ChangeError :: Coin
inputBalance = Coin
totalIn
, $sel:outputBalance:ChangeError :: Coin
outputBalance = Coin
totalOut
}
| Bool
otherwise =
TxOut -> Either ChangeError TxOut
forall a b. b -> Either a b
Right (TxOut -> Either ChangeError TxOut)
-> TxOut -> Either ChangeError TxOut
forall a b. (a -> b) -> a -> b
$ Addr (EraCrypto StandardBabbage)
-> Value StandardBabbage
-> Datum StandardBabbage
-> StrictMaybe (Script StandardBabbage)
-> BabbageTxOut StandardBabbage
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
Babbage.BabbageTxOut Addr (EraCrypto StandardBabbage)
addr (Coin -> MaryValue StandardCrypto
forall t s. Inject t s => t -> s
Ledger.inject Coin
changeOut) Datum StandardBabbage
datum StrictMaybe (Script StandardBabbage)
StrictMaybe (AlonzoScript StandardBabbage)
forall {a}. StrictMaybe a
refScript
where
totalOut :: Coin
totalOut = (BabbageTxOut StandardBabbage -> Coin)
-> [BabbageTxOut StandardBabbage] -> Coin
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Coin
BabbageTxOut StandardBabbage -> Coin
getAdaValue [TxOut]
[BabbageTxOut StandardBabbage]
otherOutputs Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
fee
totalIn :: Coin
totalIn = (BabbageTxOut StandardBabbage -> Coin)
-> [BabbageTxOut StandardBabbage] -> Coin
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Coin
BabbageTxOut StandardBabbage -> Coin
getAdaValue [TxOut]
[BabbageTxOut StandardBabbage]
resolvedInputs
changeOut :: Coin
changeOut = Coin
totalIn Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin -> Coin
forall t. Val t => t -> t
invert Coin
totalOut
refScript :: StrictMaybe a
refScript = StrictMaybe a
forall {a}. StrictMaybe a
SNothing
adjustRedeemers :: Set TxIn -> Set TxIn -> Map (PlutusPurpose AsIndex LedgerEra) ExUnits -> Redeemers LedgerEra -> Redeemers LedgerEra
adjustRedeemers :: Set TxIn
-> Set TxIn
-> Map (PlutusPurpose AsIndex LedgerEra) ExUnits
-> Redeemers LedgerEra
-> Redeemers LedgerEra
adjustRedeemers Set TxIn
initialInputs Set TxIn
finalInputs Map (PlutusPurpose AsIndex LedgerEra) ExUnits
estimatedCosts (Redeemers Map
(PlutusPurpose AsIndex StandardBabbage)
(Data StandardBabbage, ExUnits)
initialRedeemers) =
Map (PlutusPurpose AsIndex LedgerEra) (Data LedgerEra, ExUnits)
-> Redeemers LedgerEra
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIndex era) (Data era, ExUnits)
-> Redeemers era
Redeemers (Map (PlutusPurpose AsIndex LedgerEra) (Data LedgerEra, ExUnits)
-> Redeemers LedgerEra)
-> Map (PlutusPurpose AsIndex LedgerEra) (Data LedgerEra, ExUnits)
-> Redeemers LedgerEra
forall a b. (a -> b) -> a -> b
$ [(PlutusPurpose AsIndex LedgerEra, (Data LedgerEra, ExUnits))]
-> Map (PlutusPurpose AsIndex LedgerEra) (Data LedgerEra, ExUnits)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PlutusPurpose AsIndex LedgerEra, (Data LedgerEra, ExUnits))]
-> Map (PlutusPurpose AsIndex LedgerEra) (Data LedgerEra, ExUnits))
-> [(PlutusPurpose AsIndex LedgerEra, (Data LedgerEra, ExUnits))]
-> Map (PlutusPurpose AsIndex LedgerEra) (Data LedgerEra, ExUnits)
forall a b. (a -> b) -> a -> b
$ ((AlonzoPlutusPurpose AsIndex StandardBabbage,
(Data StandardBabbage, ExUnits))
-> (PlutusPurpose AsIndex LedgerEra, (Data LedgerEra, ExUnits)))
-> [(AlonzoPlutusPurpose AsIndex StandardBabbage,
(Data StandardBabbage, ExUnits))]
-> [(PlutusPurpose AsIndex LedgerEra, (Data LedgerEra, ExUnits))]
forall a b. (a -> b) -> [a] -> [b]
map (AlonzoPlutusPurpose AsIndex StandardBabbage,
(Data StandardBabbage, ExUnits))
-> (PlutusPurpose AsIndex LedgerEra, (Data LedgerEra, ExUnits))
(AlonzoPlutusPurpose AsIndex StandardBabbage,
(Data StandardBabbage, ExUnits))
-> (AlonzoPlutusPurpose AsIndex StandardBabbage,
(Data StandardBabbage, ExUnits))
adjustOne ([(AlonzoPlutusPurpose AsIndex StandardBabbage,
(Data StandardBabbage, ExUnits))]
-> [(PlutusPurpose AsIndex LedgerEra, (Data LedgerEra, ExUnits))])
-> [(AlonzoPlutusPurpose AsIndex StandardBabbage,
(Data StandardBabbage, ExUnits))]
-> [(PlutusPurpose AsIndex LedgerEra, (Data LedgerEra, ExUnits))]
forall a b. (a -> b) -> a -> b
$ Map
(AlonzoPlutusPurpose AsIndex StandardBabbage)
(Data StandardBabbage, ExUnits)
-> [(AlonzoPlutusPurpose AsIndex StandardBabbage,
(Data StandardBabbage, ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList Map
(PlutusPurpose AsIndex StandardBabbage)
(Data StandardBabbage, ExUnits)
Map
(AlonzoPlutusPurpose AsIndex StandardBabbage)
(Data StandardBabbage, ExUnits)
initialRedeemers
where
sortedInputs :: [TxIn]
sortedInputs = [TxIn] -> [TxIn]
forall a. Ord a => [a] -> [a]
sort ([TxIn] -> [TxIn]) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> a -> b
$ Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set TxIn
initialInputs
sortedFinalInputs :: [TxIn]
sortedFinalInputs = [TxIn] -> [TxIn]
forall a. Ord a => [a] -> [a]
sort ([TxIn] -> [TxIn]) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> a -> b
$ Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set TxIn
finalInputs
differences :: [Int]
differences = ((TxIn, TxIn) -> Bool) -> [(TxIn, TxIn)] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
List.findIndices (Bool -> Bool
not (Bool -> Bool) -> ((TxIn, TxIn) -> Bool) -> (TxIn, TxIn) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> TxIn -> Bool) -> (TxIn, TxIn) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxIn -> TxIn -> Bool
forall a. Eq a => a -> a -> Bool
(==)) ([(TxIn, TxIn)] -> [Int]) -> [(TxIn, TxIn)] -> [Int]
forall a b. (a -> b) -> a -> b
$ [TxIn] -> [TxIn] -> [(TxIn, TxIn)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIn]
sortedInputs [TxIn]
sortedFinalInputs
adjustOne :: (AlonzoPlutusPurpose AsIndex StandardBabbage,
(Data StandardBabbage, ExUnits))
-> (AlonzoPlutusPurpose AsIndex StandardBabbage,
(Data StandardBabbage, ExUnits))
adjustOne (AlonzoPlutusPurpose AsIndex StandardBabbage
ptr, (Data StandardBabbage
d, ExUnits
_exUnits)) =
case AlonzoPlutusPurpose AsIndex StandardBabbage
ptr of
AlonzoSpending AsIndex Word32 (TxIn (EraCrypto StandardBabbage))
idx
| Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (AsIndex Word32 (TxIn (EraCrypto StandardBabbage)) -> Word32
forall ix it. AsIndex ix it -> ix
unAsIndex AsIndex Word32 (TxIn (EraCrypto StandardBabbage))
idx) Int -> [Int] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Int]
differences ->
(AsIndex Word32 (TxIn (EraCrypto StandardBabbage))
-> AlonzoPlutusPurpose AsIndex StandardBabbage
forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending (Word32 -> AsIndex Word32 (TxIn (EraCrypto StandardBabbage))
forall ix it. ix -> AsIndex ix it
AsIndex (AsIndex Word32 (TxIn (EraCrypto StandardBabbage)) -> Word32
forall ix it. AsIndex ix it -> ix
unAsIndex AsIndex Word32 (TxIn (EraCrypto StandardBabbage))
idx Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)), (Data StandardBabbage
d, PlutusPurpose AsIndex LedgerEra -> ExUnits
executionUnitsFor PlutusPurpose AsIndex LedgerEra
AlonzoPlutusPurpose AsIndex StandardBabbage
ptr))
AlonzoPlutusPurpose AsIndex StandardBabbage
_ ->
(AlonzoPlutusPurpose AsIndex StandardBabbage
ptr, (Data StandardBabbage
d, PlutusPurpose AsIndex LedgerEra -> ExUnits
executionUnitsFor PlutusPurpose AsIndex LedgerEra
AlonzoPlutusPurpose AsIndex StandardBabbage
ptr))
executionUnitsFor :: PlutusPurpose AsIndex LedgerEra -> ExUnits
executionUnitsFor :: PlutusPurpose AsIndex LedgerEra -> ExUnits
executionUnitsFor PlutusPurpose AsIndex LedgerEra
ptr =
let ExUnits Natural
maxMem Natural
maxCpu = PParams LedgerEra
PParams StandardBabbage
pparams PParams StandardBabbage
-> Getting ExUnits (PParams StandardBabbage) ExUnits -> ExUnits
forall s a. s -> Getting a s a -> a
^. Getting ExUnits (PParams StandardBabbage) ExUnits
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams StandardBabbage) ExUnits
ppMaxTxExUnitsL
ExUnits Natural
totalMem Natural
totalCpu = (ExUnits -> ExUnits)
-> Map (AlonzoPlutusPurpose AsIndex StandardBabbage) ExUnits
-> ExUnits
forall m a.
Monoid m =>
(a -> m)
-> Map (AlonzoPlutusPurpose AsIndex StandardBabbage) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExUnits -> ExUnits
forall a. a -> a
identity Map (PlutusPurpose AsIndex LedgerEra) ExUnits
Map (AlonzoPlutusPurpose AsIndex StandardBabbage) ExUnits
estimatedCosts
ExUnits Natural
approxMem Natural
approxCpu = Map (PlutusPurpose AsIndex LedgerEra) ExUnits
Map (AlonzoPlutusPurpose AsIndex StandardBabbage) ExUnits
estimatedCosts Map (AlonzoPlutusPurpose AsIndex StandardBabbage) ExUnits
-> AlonzoPlutusPurpose AsIndex StandardBabbage -> ExUnits
forall k a. Ord k => Map k a -> k -> a
! PlutusPurpose AsIndex LedgerEra
AlonzoPlutusPurpose AsIndex StandardBabbage
ptr
in Natural -> Natural -> ExUnits
ExUnits
(Ratio Natural -> Natural
forall b. Integral b => Ratio Natural -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Natural
maxMem Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
approxMem Natural -> Natural -> Ratio Natural
forall a. Integral a => a -> a -> Ratio a
% Natural
totalMem))
(Ratio Natural -> Natural
forall b. Integral b => Ratio Natural -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Natural
maxCpu Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
approxCpu Natural -> Natural -> Ratio Natural
forall a. Integral a => a -> a -> Ratio a
% Natural
totalCpu))
findLargestUTxO :: Map TxIn TxOut -> Maybe (TxIn, TxOut)
findLargestUTxO :: Map TxIn TxOut -> Maybe (TxIn, TxOut)
findLargestUTxO Map TxIn TxOut
utxo =
UTxO -> Maybe (TxIn, BabbageTxOut StandardBabbage)
maxLovelaceUTxO UTxO
apiUtxo
where
apiUtxo :: UTxO
apiUtxo = [(TxIn, TxOut CtxUTxO Era)] -> UTxO
forall out. [(TxIn, out)] -> UTxO' out
UTxO.fromPairs ([(TxIn, TxOut CtxUTxO Era)] -> UTxO)
-> [(TxIn, TxOut CtxUTxO Era)] -> UTxO
forall a b. (a -> b) -> a -> b
$ (TxIn -> TxIn)
-> (BabbageTxOut StandardBabbage -> TxOut CtxUTxO Era)
-> (TxIn, BabbageTxOut StandardBabbage)
-> (TxIn, TxOut CtxUTxO Era)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TxIn -> TxIn
fromLedgerTxIn TxOut -> TxOut CtxUTxO Era
BabbageTxOut StandardBabbage -> TxOut CtxUTxO Era
forall ctx. TxOut -> TxOut ctx Era
fromLedgerTxOut ((TxIn, BabbageTxOut StandardBabbage) -> (TxIn, TxOut CtxUTxO Era))
-> [(TxIn, BabbageTxOut StandardBabbage)]
-> [(TxIn, TxOut CtxUTxO Era)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxIn (BabbageTxOut StandardBabbage)
-> [(TxIn, BabbageTxOut StandardBabbage)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn TxOut
Map TxIn (BabbageTxOut StandardBabbage)
utxo
maxLovelaceUTxO :: UTxO -> Maybe (TxIn, BabbageTxOut StandardBabbage)
maxLovelaceUTxO =
((TxIn, TxOut CtxUTxO Era) -> (TxIn, BabbageTxOut StandardBabbage))
-> Maybe (TxIn, TxOut CtxUTxO Era)
-> Maybe (TxIn, BabbageTxOut StandardBabbage)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TxIn -> TxIn)
-> (TxOut CtxUTxO Era -> BabbageTxOut StandardBabbage)
-> (TxIn, TxOut CtxUTxO Era)
-> (TxIn, BabbageTxOut StandardBabbage)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TxIn -> TxIn
toLedgerTxIn TxOut CtxUTxO Era -> TxOut
TxOut CtxUTxO Era -> BabbageTxOut StandardBabbage
toLedgerTxOut)
(Maybe (TxIn, TxOut CtxUTxO Era)
-> Maybe (TxIn, BabbageTxOut StandardBabbage))
-> (UTxO -> Maybe (TxIn, TxOut CtxUTxO Era))
-> UTxO
-> Maybe (TxIn, BabbageTxOut StandardBabbage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxIn, TxOut CtxUTxO Era)] -> Maybe (TxIn, TxOut CtxUTxO Era)
forall a. [a] -> Maybe a
listToMaybe
([(TxIn, TxOut CtxUTxO Era)] -> Maybe (TxIn, TxOut CtxUTxO Era))
-> (UTxO -> [(TxIn, TxOut CtxUTxO Era)])
-> UTxO
-> Maybe (TxIn, TxOut CtxUTxO Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxIn, TxOut CtxUTxO Era) -> Down Coin)
-> [(TxIn, TxOut CtxUTxO Era)] -> [(TxIn, TxOut CtxUTxO Era)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Coin -> Down Coin
forall a. a -> Down a
Down (Coin -> Down Coin)
-> ((TxIn, TxOut CtxUTxO Era) -> Coin)
-> (TxIn, TxOut CtxUTxO Era)
-> Down Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Coin
selectLovelace (Value -> Coin)
-> ((TxIn, TxOut CtxUTxO Era) -> Value)
-> (TxIn, TxOut CtxUTxO Era)
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
Api.txOutValue (TxOut CtxUTxO Era -> Value)
-> ((TxIn, TxOut CtxUTxO Era) -> TxOut CtxUTxO Era)
-> (TxIn, TxOut CtxUTxO Era)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, TxOut CtxUTxO Era) -> TxOut CtxUTxO Era
forall a b. (a, b) -> b
snd)
([(TxIn, TxOut CtxUTxO Era)] -> [(TxIn, TxOut CtxUTxO Era)])
-> (UTxO -> [(TxIn, TxOut CtxUTxO Era)])
-> UTxO
-> [(TxIn, TxOut CtxUTxO Era)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.pairs
estimateScriptsCost ::
Core.PParams LedgerEra ->
SystemStart ->
EpochInfo (Either Text) ->
Map TxIn TxOut ->
Babbage.AlonzoTx LedgerEra ->
Either ErrCoverFee (Map (PlutusPurpose AsIndex LedgerEra) ExUnits)
estimateScriptsCost :: PParams LedgerEra
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn TxOut
-> AlonzoTx LedgerEra
-> Either
ErrCoverFee (Map (PlutusPurpose AsIndex LedgerEra) ExUnits)
estimateScriptsCost PParams LedgerEra
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo Map TxIn TxOut
utxo AlonzoTx LedgerEra
tx = do
case Either
(ContextError StandardBabbage) (RedeemerReport StandardBabbage)
result of
Left ContextError StandardBabbage
translationError ->
ErrCoverFee
-> Either
ErrCoverFee (Map (PlutusPurpose AsIndex LedgerEra) ExUnits)
forall a b. a -> Either a b
Left (ErrCoverFee
-> Either
ErrCoverFee (Map (PlutusPurpose AsIndex LedgerEra) ExUnits))
-> ErrCoverFee
-> Either
ErrCoverFee (Map (PlutusPurpose AsIndex LedgerEra) ExUnits)
forall a b. (a -> b) -> a -> b
$ ContextError LedgerEra -> ErrCoverFee
ErrTranslationError ContextError LedgerEra
ContextError StandardBabbage
translationError
Right RedeemerReport StandardBabbage
units ->
(AlonzoPlutusPurpose AsIndex StandardBabbage
-> Either (TransactionScriptFailure StandardBabbage) ExUnits
-> Either ErrCoverFee ExUnits)
-> Map
(AlonzoPlutusPurpose AsIndex StandardBabbage)
(Either (TransactionScriptFailure StandardBabbage) ExUnits)
-> Either
ErrCoverFee
(Map (AlonzoPlutusPurpose AsIndex StandardBabbage) ExUnits)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (\AlonzoPlutusPurpose AsIndex StandardBabbage
ptr -> (TransactionScriptFailure StandardBabbage -> ErrCoverFee)
-> Either (TransactionScriptFailure StandardBabbage) ExUnits
-> Either ErrCoverFee ExUnits
forall a b c. (a -> b) -> Either a c -> Either b c
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ((TransactionScriptFailure StandardBabbage -> ErrCoverFee)
-> Either (TransactionScriptFailure StandardBabbage) ExUnits
-> Either ErrCoverFee ExUnits)
-> (TransactionScriptFailure StandardBabbage -> ErrCoverFee)
-> Either (TransactionScriptFailure StandardBabbage) ExUnits
-> Either ErrCoverFee ExUnits
forall a b. (a -> b) -> a -> b
$ (PlutusPurpose AsIndex LedgerEra,
TransactionScriptFailure LedgerEra)
-> ErrCoverFee
(AlonzoPlutusPurpose AsIndex StandardBabbage,
TransactionScriptFailure StandardBabbage)
-> ErrCoverFee
ErrScriptExecutionFailed ((AlonzoPlutusPurpose AsIndex StandardBabbage,
TransactionScriptFailure StandardBabbage)
-> ErrCoverFee)
-> (TransactionScriptFailure StandardBabbage
-> (AlonzoPlutusPurpose AsIndex StandardBabbage,
TransactionScriptFailure StandardBabbage))
-> TransactionScriptFailure StandardBabbage
-> ErrCoverFee
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlonzoPlutusPurpose AsIndex StandardBabbage
ptr,)) RedeemerReport StandardBabbage
Map
(AlonzoPlutusPurpose AsIndex StandardBabbage)
(Either (TransactionScriptFailure StandardBabbage) ExUnits)
units
where
result :: Either
(ContextError StandardBabbage) (RedeemerReport StandardBabbage)
result =
PParams StandardBabbage
-> Tx StandardBabbage
-> UTxO StandardBabbage
-> EpochInfo (Either Text)
-> SystemStart
-> Either
(ContextError StandardBabbage) (RedeemerReport StandardBabbage)
forall era.
(AlonzoEraTx era, EraUTxO era, EraPlutusContext era,
ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
PParams era
-> Tx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> Either (ContextError era) (RedeemerReport era)
evalTxExUnits
PParams LedgerEra
PParams StandardBabbage
pparams
Tx StandardBabbage
AlonzoTx LedgerEra
tx
(Map (TxIn (EraCrypto StandardBabbage)) (TxOut StandardBabbage)
-> UTxO StandardBabbage
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO Map TxIn TxOut
Map (TxIn (EraCrypto StandardBabbage)) (TxOut StandardBabbage)
utxo)
EpochInfo (Either Text)
epochInfo
SystemStart
systemStart
data TinyWalletLog
= BeginInitialize
| EndInitialize {TinyWalletLog -> UTxO
initialUTxO :: Api.UTxO, TinyWalletLog -> ChainPoint
tip :: ChainPoint}
| BeginUpdate {TinyWalletLog -> ChainPoint
point :: ChainPoint}
| EndUpdate {TinyWalletLog -> UTxO
newUTxO :: Api.UTxO}
| SkipUpdate {point :: ChainPoint}
deriving stock (TinyWalletLog -> TinyWalletLog -> Bool
(TinyWalletLog -> TinyWalletLog -> Bool)
-> (TinyWalletLog -> TinyWalletLog -> Bool) -> Eq TinyWalletLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TinyWalletLog -> TinyWalletLog -> Bool
== :: TinyWalletLog -> TinyWalletLog -> Bool
$c/= :: TinyWalletLog -> TinyWalletLog -> Bool
/= :: TinyWalletLog -> TinyWalletLog -> Bool
Eq, (forall x. TinyWalletLog -> Rep TinyWalletLog x)
-> (forall x. Rep TinyWalletLog x -> TinyWalletLog)
-> Generic TinyWalletLog
forall x. Rep TinyWalletLog x -> TinyWalletLog
forall x. TinyWalletLog -> Rep TinyWalletLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TinyWalletLog -> Rep TinyWalletLog x
from :: forall x. TinyWalletLog -> Rep TinyWalletLog x
$cto :: forall x. Rep TinyWalletLog x -> TinyWalletLog
to :: forall x. Rep TinyWalletLog x -> TinyWalletLog
Generic, Int -> TinyWalletLog -> ShowS
[TinyWalletLog] -> ShowS
TinyWalletLog -> String
(Int -> TinyWalletLog -> ShowS)
-> (TinyWalletLog -> String)
-> ([TinyWalletLog] -> ShowS)
-> Show TinyWalletLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TinyWalletLog -> ShowS
showsPrec :: Int -> TinyWalletLog -> ShowS
$cshow :: TinyWalletLog -> String
show :: TinyWalletLog -> String
$cshowList :: [TinyWalletLog] -> ShowS
showList :: [TinyWalletLog] -> ShowS
Show)
deriving anyclass instance ToJSON TinyWalletLog
deriving anyclass instance FromJSON TinyWalletLog
instance Arbitrary TinyWalletLog where
arbitrary :: Gen TinyWalletLog
arbitrary = Gen TinyWalletLog
forall a.
(Generic a, GA UnsizedOpts (Rep a),
UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary
shrink :: TinyWalletLog -> [TinyWalletLog]
shrink = TinyWalletLog -> [TinyWalletLog]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink