{-# LANGUAGE DuplicateRecordFields #-}

-- | Companion tiny-wallet for the direct chain component. This module provide
-- some useful utilities to tracking the wallet's UTXO, and accessing it
module Hydra.Chain.Direct.Wallet where

import Hydra.Prelude

import Cardano.Api.Ledger (ExUnits)
import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Address qualified as Ledger
import Cardano.Ledger.Alonzo.Plutus.Context (ContextError, EraPlutusContext)
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoEraScript (..),
  AsIx (..),
 )
import Cardano.Ledger.Alonzo.Tx (hashScriptIntegrity, mkScriptIntegrity)
import Cardano.Ledger.Alonzo.TxWits (
  Redeemers (..),
 )
import Cardano.Ledger.Alonzo.UTxO (AlonzoScriptsNeeded)
import Cardano.Ledger.Api (
  AlonzoEraTx,
  ConwayEra,
  PParams,
  TransactionScriptFailure (..),
  bodyTxL,
  calcMinFeeTx,
  coinTxOutL,
  collateralInputsTxBodyL,
  ensureMinCoinTxOut,
  evalTxExUnits,
  feeTxBodyL,
  inputsTxBodyL,
  outputsTxBodyL,
  rdmrsTxWitsL,
  scriptIntegrityHashTxBodyL,
  witsTxL,
  pattern SpendingPurpose,
 )
import Cardano.Ledger.Api.UTxO (EraUTxO, ScriptsNeeded, getScriptsHashesNeeded, getScriptsNeeded, getScriptsProvided)
import Cardano.Ledger.Babbage.TxBody qualified as Babbage
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core (TxLevel (..), ppMaxTxSizeL)
import Cardano.Ledger.Core qualified as Core
import Cardano.Ledger.Core qualified as Ledger
import Cardano.Ledger.Shelley.API (unUTxO)
import Cardano.Ledger.Shelley.API qualified as Ledger
import Cardano.Ledger.Val (invert)
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart (..))
import Control.Concurrent.Class.MonadSTM (readTVarIO, writeTVar)
import Control.Lens (view, (%~), (.~), (^.))
import Data.ByteString qualified as BS
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Sequence.Strict ((|>))
import Data.Set qualified as Set
import Data.Text qualified as Text
import Hydra.Cardano.Api (
  BlockHeader,
  CardanoSigningKey,
  ChainPoint,
  LedgerEra,
  NetworkId,
  PaymentCredential (PaymentCredentialByKey),
  PaymentKey,
  SerialiseAsCBOR (serialiseToCBOR),
  ShelleyAddr,
  StakeAddressReference (NoStakeAddress),
  VerificationKey,
  fromLedgerTx,
  fromLedgerTxIn,
  getChainPoint,
  makeShelleyAddress,
  shelleyAddressInEra,
  signTxWith,
  toLedgerAddr,
  toLedgerTx,
  verificationKeyHash,
 )
import Hydra.Cardano.Api qualified as Api
import Hydra.Chain.CardanoClient (QueryPoint (..))
import Hydra.Ledger.Cardano ()
import Hydra.Ledger.Cardano.Evaluate (EvaluationError, EvaluationReport, evaluateTxWith)
import Hydra.Logging (Tracer, traceWith)
import Hydra.Tx.Secret (Secret, withSecret)

type Address = Ledger.Addr
type TxIn = Ledger.TxIn
type TxOut = Ledger.TxOut LedgerEra

-- | A 'TinyWallet' is a small abstraction of a wallet with basic UTXO
-- management. The wallet is assumed to have only one address, and only one UTXO
-- at that address. It can sign transactions and keeps track of its UTXO behind
-- the scene.
--
-- The wallet is connecting to the node initially and when asked to 'reset'.
-- Otherwise it can be fed blocks via 'update' as the chain rolls forward.
data TinyWallet m = TinyWallet
  { forall (m :: * -> *). TinyWallet m -> STM m (Map TxIn TxOut)
getUTxO :: STM m (Map TxIn TxOut)
  -- ^ Return all known UTxO addressed to this wallet.
  , forall (m :: * -> *). TinyWallet m -> STM m (Maybe TxIn)
getSeedInput :: STM m (Maybe Api.TxIn)
  -- ^ Returns the /seed input/
  -- This is the special input needed by `Direct` chain component to initialise
  -- a head
  , forall (m :: * -> *). TinyWallet m -> Tx -> Tx
sign :: Api.Tx -> Api.Tx
  , forall (m :: * -> *).
TinyWallet m -> UTxO -> Tx -> m (Either ErrCoverFee Tx)
coverFee ::
      Api.UTxO ->
      Api.Tx ->
      m (Either ErrCoverFee Api.Tx)
  , forall (m :: * -> *).
TinyWallet m
-> Tx -> UTxO -> m (Either EvaluationError EvaluationReport)
evaluateScriptCosts ::
      Api.Tx ->
      Api.UTxO ->
      m (Either EvaluationError EvaluationReport)
  -- ^ Evaluate script execution costs for a transaction using current protocol
  -- parameters from the node. Returns Right if all scripts succeed within
  -- budget, Left otherwise.
  , forall (m :: * -> *). TinyWallet m -> Tx -> m Bool
isTxWithinSizeLimits ::
      Api.Tx ->
      m Bool
  -- ^ Check whether the serialised transaction fits within the maximum
  -- transaction size permitted by the current protocol parameters.
  , forall (m :: * -> *). TinyWallet m -> m (PParams LedgerEra)
getPParams :: m (PParams LedgerEra)
  -- ^ Query current protocol parameters.
  , forall (m :: * -> *). TinyWallet m -> m ()
reset :: m ()
  -- ^ Re-initializ wallet against the latest tip of the node and start to
  -- ignore 'update' calls until reaching that tip.
  , forall (m :: * -> *). TinyWallet m -> BlockHeader -> [Tx] -> m ()
update :: BlockHeader -> [Api.Tx] -> m ()
  -- ^ Update the wallet state given a block and list of txs. May be ignored if
  -- wallet is still initializing.
  }

data WalletInfoOnChain = WalletInfoOnChain
  { WalletInfoOnChain -> Map TxIn TxOut
walletUTxO :: Map TxIn TxOut
  , WalletInfoOnChain -> SystemStart
systemStart :: SystemStart
  , WalletInfoOnChain -> ChainPoint
tip :: ChainPoint
  -- ^ Latest point on chain the wallet knows of.
  }

type ChainQuery m = QueryPoint -> Api.Address ShelleyAddr -> m WalletInfoOnChain

-- | Create a new tiny wallet handle.
newTinyWallet ::
  -- | A tracer for logging
  Tracer IO TinyWalletLog ->
  -- | Network identifier to generate our address.
  NetworkId ->
  -- | Credentials of the wallet. The signing-key half is wrapped in
  -- 'Secret' to prevent accidental serialisation or logging.
  (VerificationKey PaymentKey, Secret CardanoSigningKey) ->
  -- | A function to query UTxO, pparams, system start and epoch info from the
  -- node. Initially and on demand later.
  ChainQuery IO ->
  IO (EpochInfo (Either Text)) ->
  -- | A means to query some pparams.
  IO (PParams ConwayEra) ->
  IO (TinyWallet IO)
newTinyWallet :: Tracer IO TinyWalletLog
-> NetworkId
-> (VerificationKey PaymentKey, Secret CardanoSigningKey)
-> ChainQuery IO
-> IO (EpochInfo (Either Text))
-> IO (PParams ConwayEra)
-> IO (TinyWallet IO)
newTinyWallet Tracer IO TinyWalletLog
tracer NetworkId
networkId (VerificationKey PaymentKey
vk, Secret CardanoSigningKey
sk) ChainQuery IO
queryWalletInfo IO (EpochInfo (Either Text))
queryEpochInfo IO (PParams ConwayEra)
querySomePParams = do
  TVar WalletInfoOnChain
walletInfoVar <- String -> WalletInfoOnChain -> IO (TVar IO WalletInfoOnChain)
forall (m :: * -> *) a.
MonadLabelledSTM m =>
String -> a -> m (TVar m a)
newLabelledTVarIO String
"tiny-wallet" (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 ConwayEra))
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 ConwayEra))
-> STM IO (Map TxIn (BabbageTxOut ConwayEra))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> WalletInfoOnChain -> Map TxIn (BabbageTxOut ConwayEra)
WalletInfoOnChain -> Map TxIn TxOut
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 (BabbageTxOut ConwayEra))
STM IO (Map TxIn TxOut)
$sel:getUTxO:TinyWallet :: STM IO (Map TxIn TxOut)
getUTxO :: STM IO (Map TxIn (BabbageTxOut ConwayEra))
getUTxO
      , $sel:getSeedInput:TinyWallet :: STM IO (Maybe TxIn)
getSeedInput = ((TxIn, BabbageTxOut ConwayEra) -> TxIn)
-> Maybe (TxIn, BabbageTxOut ConwayEra) -> 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 ConwayEra) -> TxIn)
-> (TxIn, BabbageTxOut ConwayEra)
-> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, BabbageTxOut ConwayEra) -> TxIn
forall a b. (a, b) -> a
fst) (Maybe (TxIn, BabbageTxOut ConwayEra) -> Maybe TxIn)
-> (Map TxIn (BabbageTxOut ConwayEra)
    -> Maybe (TxIn, BabbageTxOut ConwayEra))
-> Map TxIn (BabbageTxOut ConwayEra)
-> Maybe TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn (BabbageTxOut ConwayEra)
-> Maybe (TxIn, BabbageTxOut ConwayEra)
Map TxIn (TxOut ConwayEra) -> Maybe (TxIn, TxOut ConwayEra)
forall era.
EraTxOut era =>
Map TxIn (TxOut era) -> Maybe (TxIn, TxOut era)
findLargestUTxO (Map TxIn (BabbageTxOut ConwayEra) -> Maybe TxIn)
-> STM IO (Map TxIn (BabbageTxOut ConwayEra))
-> STM IO (Maybe TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM IO (Map TxIn (BabbageTxOut ConwayEra))
getUTxO
      , $sel:sign:TinyWallet :: Tx -> Tx
sign = \Tx
tx -> Secret CardanoSigningKey -> (CardanoSigningKey -> Tx) -> Tx
forall a r. Secret a -> (a -> r) -> r
withSecret Secret CardanoSigningKey
sk (CardanoSigningKey -> Tx -> Tx
forall era.
IsShelleyBasedEra era =>
CardanoSigningKey -> Tx era -> Tx era
`signTxWith` Tx
tx)
      , $sel:coverFee:TinyWallet :: UTxO -> Tx -> IO (Either ErrCoverFee Tx)
coverFee = \UTxO
lookupUTxO Tx
partialTx -> do
          let ledgerLookupUTxO :: Map TxIn (TxOut ConwayEra)
ledgerLookupUTxO = UTxO ConwayEra -> Map TxIn (TxOut ConwayEra)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO (UTxO ConwayEra -> Map TxIn (TxOut ConwayEra))
-> UTxO ConwayEra -> Map TxIn (TxOut ConwayEra)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra Era -> UTxO -> UTxO LedgerEra
forall era.
HasCallStack =>
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
UTxO.toShelleyUTxO ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
Api.shelleyBasedEra UTxO
lookupUTxO
          WalletInfoOnChain{Map TxIn TxOut
$sel:walletUTxO:WalletInfoOnChain :: WalletInfoOnChain -> Map TxIn TxOut
walletUTxO :: Map TxIn TxOut
walletUTxO, 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
          EpochInfo (Either Text)
epochInfo <- IO (EpochInfo (Either Text))
queryEpochInfo
          -- We query pparams here again as it's possible that a hardfork
          -- occurred and the pparams changed.
          PParams ConwayEra
pparams <- IO (PParams ConwayEra)
querySomePParams
          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 TopTx ConwayEra -> Tx
Tx TopTx LedgerEra -> Tx
forall era.
IsShelleyBasedEra era =>
Tx TopTx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx
              (Tx TopTx ConwayEra -> Tx)
-> Either ErrCoverFee (Tx TopTx ConwayEra) -> Either ErrCoverFee Tx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PParams ConwayEra
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut ConwayEra)
-> Map TxIn (TxOut ConwayEra)
-> Tx TopTx ConwayEra
-> Either ErrCoverFee (Tx TopTx ConwayEra)
forall era.
(EraPlutusContext era, EraCertState era, AlonzoEraTx era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era, EraUTxO era) =>
PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Map TxIn (TxOut era)
-> Tx TopTx era
-> Either ErrCoverFee (Tx TopTx era)
coverFee_ PParams ConwayEra
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo Map TxIn (TxOut ConwayEra)
ledgerLookupUTxO Map TxIn (TxOut ConwayEra)
Map TxIn TxOut
walletUTxO (Tx -> Tx TopTx LedgerEra
forall era. Tx era -> Tx TopTx (ShelleyLedgerEra era)
toLedgerTx Tx
partialTx)
      , $sel:evaluateScriptCosts:TinyWallet :: Tx -> UTxO -> IO (Either EvaluationError EvaluationReport)
evaluateScriptCosts = \Tx
tx UTxO
lookupUTxO -> do
          WalletInfoOnChain{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
          EpochInfo (Either Text)
epochInfo <- IO (EpochInfo (Either Text))
queryEpochInfo
          PParams ConwayEra
pparams <- IO (PParams ConwayEra)
querySomePParams
          Either EvaluationError EvaluationReport
-> IO (Either EvaluationError EvaluationReport)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either EvaluationError EvaluationReport
 -> IO (Either EvaluationError EvaluationReport))
-> Either EvaluationError EvaluationReport
-> IO (Either EvaluationError EvaluationReport)
forall a b. (a -> b) -> a -> b
$ SystemStart
-> EpochInfo (Either Text)
-> PParams LedgerEra
-> Tx
-> UTxO
-> Either EvaluationError EvaluationReport
evaluateTxWith SystemStart
systemStart EpochInfo (Either Text)
epochInfo PParams ConwayEra
PParams LedgerEra
pparams Tx
tx UTxO
lookupUTxO
      , $sel:isTxWithinSizeLimits:TinyWallet :: Tx -> IO Bool
isTxWithinSizeLimits = \Tx
tx -> do
          PParams ConwayEra
pparams <- IO (PParams ConwayEra)
querySomePParams
          let txBytes :: Word32
txBytes = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Tx -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR Tx
tx
          Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Word32
txBytes Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= PParams ConwayEra
pparams PParams ConwayEra
-> Getting Word32 (PParams ConwayEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams ConwayEra) Word32
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams ConwayEra) Word32
ppMaxTxSizeL
      , $sel:getPParams:TinyWallet :: IO (PParams LedgerEra)
getPParams = IO (PParams ConwayEra)
IO (PParams LedgerEra)
querySomePParams
      , 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 ConwayEra)
utxo' <- STM IO (Map TxIn (BabbageTxOut ConwayEra))
-> IO (Map TxIn (BabbageTxOut ConwayEra))
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 ConwayEra))
 -> IO (Map TxIn (BabbageTxOut ConwayEra)))
-> STM IO (Map TxIn (BabbageTxOut ConwayEra))
-> IO (Map TxIn (BabbageTxOut ConwayEra))
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 -> Bool) -> Map TxIn TxOut -> Map TxIn TxOut
applyTxs [Tx]
txs (Addr -> Addr -> Bool
forall a. Eq a => a -> a -> Bool
== Addr
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 ConwayEra)
-> STM (Map TxIn (BabbageTxOut ConwayEra))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map TxIn (BabbageTxOut ConwayEra)
Map TxIn TxOut
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 (ShelleyBasedEra Era -> UTxO LedgerEra -> UTxO
forall era.
ShelleyBasedEra era -> UTxO (ShelleyLedgerEra era) -> UTxO era
UTxO.fromShelleyUTxO ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
Api.shelleyBasedEra (Map TxIn (TxOut ConwayEra) -> UTxO ConwayEra
forall era. Map TxIn (TxOut era) -> UTxO era
Ledger.UTxO Map TxIn (BabbageTxOut ConwayEra)
Map TxIn (TxOut ConwayEra)
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 = ShelleyBasedEra Era -> UTxO LedgerEra -> UTxO
forall era.
ShelleyBasedEra era -> UTxO (ShelleyLedgerEra era) -> UTxO era
UTxO.fromShelleyUTxO ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
Api.shelleyBasedEra (Map TxIn (TxOut ConwayEra) -> UTxO ConwayEra
forall era. Map TxIn (TxOut era) -> UTxO era
Ledger.UTxO Map TxIn (TxOut ConwayEra)
Map TxIn TxOut
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
ledgerAddress = AddressInEra Era -> Addr
forall era. AddressInEra era -> Addr
toLedgerAddr (AddressInEra Era -> Addr) -> AddressInEra Era -> Addr
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

-- | Apply a block to our wallet. Does nothing if the transaction does not
-- modify the UTXO set, or else, remove consumed utxos and add produced ones.
--
-- To determine whether a produced output is ours, we apply the given function
-- checking the output's address.
applyTxs :: [Api.Tx] -> (Address -> Bool) -> Map TxIn TxOut -> Map TxIn TxOut
applyTxs :: [Tx] -> (Addr -> Bool) -> Map TxIn TxOut -> Map TxIn TxOut
applyTxs [Tx]
txs Addr -> Bool
isOurs Map TxIn TxOut
utxo =
  (State (Map TxIn (BabbageTxOut ConwayEra)) ()
 -> Map TxIn (BabbageTxOut ConwayEra) -> Map TxIn TxOut)
-> Map TxIn (BabbageTxOut ConwayEra)
-> State (Map TxIn (BabbageTxOut ConwayEra)) ()
-> Map TxIn TxOut
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (Map TxIn (BabbageTxOut ConwayEra)) ()
-> Map TxIn (BabbageTxOut ConwayEra)
-> Map TxIn (BabbageTxOut ConwayEra)
State (Map TxIn (BabbageTxOut ConwayEra)) ()
-> Map TxIn (BabbageTxOut ConwayEra) -> Map TxIn TxOut
forall s a. State s a -> s -> s
execState Map TxIn (BabbageTxOut ConwayEra)
Map TxIn TxOut
utxo (State (Map TxIn (BabbageTxOut ConwayEra)) () -> Map TxIn TxOut)
-> State (Map TxIn (BabbageTxOut ConwayEra)) () -> Map TxIn TxOut
forall a b. (a -> b) -> a -> b
$ do
    [Tx]
-> (Tx -> State (Map TxIn (BabbageTxOut ConwayEra)) ())
-> State (Map TxIn (BabbageTxOut ConwayEra)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Tx]
txs ((Tx -> State (Map TxIn (BabbageTxOut ConwayEra)) ())
 -> State (Map TxIn (BabbageTxOut ConwayEra)) ())
-> (Tx -> State (Map TxIn (BabbageTxOut ConwayEra)) ())
-> State (Map TxIn (BabbageTxOut ConwayEra)) ()
forall a b. (a -> b) -> a -> b
$ \Tx
apiTx -> do
      -- XXX: Use cardano-api types instead here
      let tx :: Tx TopTx LedgerEra
tx = Tx -> Tx TopTx LedgerEra
forall era. Tx era -> Tx TopTx (ShelleyLedgerEra era)
toLedgerTx Tx
apiTx
      let txId :: TxId
txId = Tx TopTx ConwayEra -> TxId
forall era (l :: TxLevel). EraTx era => Tx l era -> TxId
Ledger.txIdTx Tx TopTx ConwayEra
Tx TopTx LedgerEra
tx
      (Map TxIn (BabbageTxOut ConwayEra)
 -> Map TxIn (BabbageTxOut ConwayEra))
-> State (Map TxIn (BabbageTxOut ConwayEra)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Map TxIn (BabbageTxOut ConwayEra)
-> Set TxIn -> Map TxIn (BabbageTxOut ConwayEra)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Getting (Set TxIn) (Tx TopTx ConwayEra) (Set TxIn)
-> Tx TopTx ConwayEra -> Set TxIn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TxBody TopTx ConwayEra
 -> Const (Set TxIn) (TxBody TopTx ConwayEra))
-> Tx TopTx ConwayEra -> Const (Set TxIn) (Tx TopTx ConwayEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxBody l ConwayEra)
bodyTxL ((TxBody TopTx ConwayEra
  -> Const (Set TxIn) (TxBody TopTx ConwayEra))
 -> Tx TopTx ConwayEra -> Const (Set TxIn) (Tx TopTx ConwayEra))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody TopTx ConwayEra
    -> Const (Set TxIn) (TxBody TopTx ConwayEra))
-> Getting (Set TxIn) (Tx TopTx ConwayEra) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody TopTx ConwayEra
-> Const (Set TxIn) (TxBody TopTx ConwayEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) (Set TxIn)
inputsTxBodyL) Tx TopTx ConwayEra
Tx TopTx LedgerEra
tx)
      let indexedOutputs :: [(TxIx, BabbageTxOut ConwayEra)]
indexedOutputs =
            [TxIx]
-> [BabbageTxOut ConwayEra] -> [(TxIx, BabbageTxOut ConwayEra)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word16 -> TxIx
Ledger.TxIx Word16
0 ..] (StrictSeq (BabbageTxOut ConwayEra) -> [BabbageTxOut ConwayEra]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (BabbageTxOut ConwayEra) -> [BabbageTxOut ConwayEra])
-> StrictSeq (BabbageTxOut ConwayEra) -> [BabbageTxOut ConwayEra]
forall a b. (a -> b) -> a -> b
$ Getting
  (StrictSeq (BabbageTxOut ConwayEra))
  (Tx TopTx ConwayEra)
  (StrictSeq (BabbageTxOut ConwayEra))
-> Tx TopTx ConwayEra -> StrictSeq (BabbageTxOut ConwayEra)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TxBody TopTx ConwayEra
 -> Const
      (StrictSeq (BabbageTxOut ConwayEra)) (TxBody TopTx ConwayEra))
-> Tx TopTx ConwayEra
-> Const (StrictSeq (BabbageTxOut ConwayEra)) (Tx TopTx ConwayEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxBody l ConwayEra)
bodyTxL ((TxBody TopTx ConwayEra
  -> Const
       (StrictSeq (BabbageTxOut ConwayEra)) (TxBody TopTx ConwayEra))
 -> Tx TopTx ConwayEra
 -> Const (StrictSeq (BabbageTxOut ConwayEra)) (Tx TopTx ConwayEra))
-> ((StrictSeq (BabbageTxOut ConwayEra)
     -> Const
          (StrictSeq (BabbageTxOut ConwayEra))
          (StrictSeq (BabbageTxOut ConwayEra)))
    -> TxBody TopTx ConwayEra
    -> Const
         (StrictSeq (BabbageTxOut ConwayEra)) (TxBody TopTx ConwayEra))
-> Getting
     (StrictSeq (BabbageTxOut ConwayEra))
     (Tx TopTx ConwayEra)
     (StrictSeq (BabbageTxOut ConwayEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (BabbageTxOut ConwayEra)
 -> Const
      (StrictSeq (BabbageTxOut ConwayEra))
      (StrictSeq (BabbageTxOut ConwayEra)))
-> TxBody TopTx ConwayEra
-> Const
     (StrictSeq (BabbageTxOut ConwayEra)) (TxBody TopTx ConwayEra)
(StrictSeq (TxOut ConwayEra)
 -> Const
      (StrictSeq (BabbageTxOut ConwayEra)) (StrictSeq (TxOut ConwayEra)))
-> TxBody TopTx ConwayEra
-> Const
     (StrictSeq (BabbageTxOut ConwayEra)) (TxBody TopTx ConwayEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l ConwayEra) (StrictSeq (TxOut ConwayEra))
outputsTxBodyL) Tx TopTx ConwayEra
Tx TopTx LedgerEra
tx)
      [(TxIx, BabbageTxOut ConwayEra)]
-> ((TxIx, BabbageTxOut ConwayEra)
    -> State (Map TxIn (BabbageTxOut ConwayEra)) ())
-> State (Map TxIn (BabbageTxOut ConwayEra)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(TxIx, BabbageTxOut ConwayEra)]
indexedOutputs (((TxIx, BabbageTxOut ConwayEra)
  -> State (Map TxIn (BabbageTxOut ConwayEra)) ())
 -> State (Map TxIn (BabbageTxOut ConwayEra)) ())
-> ((TxIx, BabbageTxOut ConwayEra)
    -> State (Map TxIn (BabbageTxOut ConwayEra)) ())
-> State (Map TxIn (BabbageTxOut ConwayEra)) ()
forall a b. (a -> b) -> a -> b
$ \(TxIx
ix, out :: BabbageTxOut ConwayEra
out@(Babbage.BabbageTxOut Addr
addr Value ConwayEra
_ Datum ConwayEra
_ StrictMaybe (Script ConwayEra)
_)) ->
        Bool
-> State (Map TxIn (BabbageTxOut ConwayEra)) ()
-> State (Map TxIn (BabbageTxOut ConwayEra)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Addr -> Bool
isOurs Addr
addr) (State (Map TxIn (BabbageTxOut ConwayEra)) ()
 -> State (Map TxIn (BabbageTxOut ConwayEra)) ())
-> State (Map TxIn (BabbageTxOut ConwayEra)) ()
-> State (Map TxIn (BabbageTxOut ConwayEra)) ()
forall a b. (a -> b) -> a -> b
$ (Map TxIn (BabbageTxOut ConwayEra)
 -> Map TxIn (BabbageTxOut ConwayEra))
-> State (Map TxIn (BabbageTxOut ConwayEra)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (TxIn
-> BabbageTxOut ConwayEra
-> Map TxIn (BabbageTxOut ConwayEra)
-> Map TxIn (BabbageTxOut ConwayEra)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (TxId -> TxIx -> TxIn
Ledger.TxIn TxId
txId TxIx
ix) BabbageTxOut ConwayEra
out)

-- | This are all the error that can happen during coverFee.
data ErrCoverFee
  = ErrNotEnoughFunds ChangeError
  | ErrNoFuelUTxOFound
  | ErrUnknownInput {ErrCoverFee -> TxIn
input :: TxIn}
  | ErrScriptExecutionFailed {ErrCoverFee -> Text
redeemerPointer :: Text, ErrCoverFee -> Text
scriptFailure :: Text}
  | ErrTranslationError (ContextError LedgerEra)
  | ErrMissingScript {ErrCoverFee -> Text
scriptHash :: Text, ErrCoverFee -> Text
purpose :: Text}
  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)

-- | Cover fee for a transaction body using the given UTXO set. This calculate
-- necessary fees and augments inputs / outputs / collateral accordingly to
-- cover for the transaction cost and get the change back.
--
-- XXX: All call sites of this function use cardano-api types
coverFee_ ::
  forall era.
  ( EraPlutusContext era
  , Ledger.EraCertState era
  , AlonzoEraTx era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , EraUTxO era
  ) =>
  PParams era ->
  SystemStart ->
  EpochInfo (Either Text) ->
  Map TxIn (Ledger.TxOut era) ->
  Map TxIn (Ledger.TxOut era) ->
  Ledger.Tx TopTx era ->
  Either ErrCoverFee (Ledger.Tx TopTx era)
coverFee_ :: forall era.
(EraPlutusContext era, EraCertState era, AlonzoEraTx era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era, EraUTxO era) =>
PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Map TxIn (TxOut era)
-> Tx TopTx era
-> Either ErrCoverFee (Tx TopTx era)
coverFee_ PParams era
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo Map TxIn (TxOut era)
lookupUTxO Map TxIn (TxOut era)
walletUTxO Tx TopTx era
partialTx = do
  let body :: TxBody TopTx era
body = Tx TopTx era
partialTx Tx TopTx era
-> Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
-> TxBody TopTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL
  let wits :: TxWits era
wits = Tx TopTx era
partialTx Tx TopTx era
-> Getting (TxWits era) (Tx TopTx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx TopTx era) (TxWits era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL
  (TxIn
feeTxIn, TxOut era
feeTxOut) <- Map TxIn (TxOut era) -> Either ErrCoverFee (TxIn, TxOut era)
findUTxOToPayFees Map TxIn (TxOut era)
walletUTxO

  let newInputs :: Set TxIn
newInputs = TxBody TopTx era
body TxBody TopTx era
-> Getting (Set TxIn) (TxBody TopTx era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx era) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL 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
  [TxOut era]
resolvedInputs <- (TxIn -> Either ErrCoverFee (TxOut era))
-> [TxIn] -> Either ErrCoverFee [TxOut era]
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 era)
resolveInput (Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set TxIn
newInputs)

  -- Ensure we have at least the minimum amount of ada. NOTE: setMinCoinTxOut
  -- would invalidate most Hydra protocol transactions.
  let txOuts :: StrictSeq (TxOut era)
txOuts = TxBody TopTx era
body TxBody TopTx era
-> Getting
     (StrictSeq (TxOut era)) (TxBody TopTx era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody TopTx era) (StrictSeq (TxOut era))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
outputsTxBodyL StrictSeq (TxOut era)
-> (TxOut era -> TxOut era) -> StrictSeq (TxOut era)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> PParams era -> TxOut era -> TxOut era
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
ensureMinCoinTxOut PParams era
pparams

  let utxo :: Map TxIn (TxOut era)
utxo = Map TxIn (TxOut era)
lookupUTxO Map TxIn (TxOut era)
-> Map TxIn (TxOut era) -> Map TxIn (TxOut era)
forall a. Semigroup a => a -> a -> a
<> Map TxIn (TxOut era)
walletUTxO
      ledgerUTxO :: UTxO era
ledgerUTxO = Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
Ledger.UTxO Map TxIn (TxOut era)
utxo

  -- First, adjust redeemer indices for the fee input (keeping original execution units)
  let redeemersWithAdjustedIndices :: Redeemers era
redeemersWithAdjustedIndices =
        Set TxIn -> Set TxIn -> Redeemers era -> Redeemers era
adjustRedeemerIndices (TxBody TopTx era
body TxBody TopTx era
-> Getting (Set TxIn) (TxBody TopTx era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx era) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL) Set TxIn
newInputs (TxWits era
wits TxWits era
-> Getting (Redeemers era) (TxWits era) (Redeemers era)
-> Redeemers era
forall s a. s -> Getting a s a -> a
^. Getting (Redeemers era) (TxWits era) (Redeemers era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL)

  -- Build a transaction with the fee input and change output included for cost
  -- estimation. We use feeTxOut as a placeholder for the change output since
  -- the script context (number of outputs, addresses) affects execution costs.
  let txForEstimation :: Tx TopTx era
txForEstimation =
        Tx TopTx era
partialTx
          Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((Set TxIn -> Identity (Set TxIn))
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (Set TxIn -> Identity (Set TxIn))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> Set TxIn -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
newInputs
          Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> StrictSeq (TxOut era) -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (StrictSeq (TxOut era)
txOuts StrictSeq (TxOut era) -> TxOut era -> StrictSeq (TxOut era)
forall a. StrictSeq a -> a -> StrictSeq a
|> TxOut era
feeTxOut)
          Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> Redeemers era -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
redeemersWithAdjustedIndices

  -- Estimate script costs on the transaction WITH the fee input already added
  Map (PlutusPurpose AsIx era) ExUnits
estimatedScriptCosts <- PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Tx TopTx era
-> Either ErrCoverFee (Map (PlutusPurpose AsIx era) ExUnits)
forall era.
(AlonzoEraTx era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era, EraUTxO era) =>
PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Tx TopTx era
-> Either ErrCoverFee (Map (PlutusPurpose AsIx era) ExUnits)
estimateScriptsCost PParams era
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo Map TxIn (TxOut era)
utxo Tx TopTx era
txForEstimation
  let adjustedRedeemers :: Redeemers era
adjustedRedeemers =
        Map (PlutusPurpose AsIx era) ExUnits
-> Redeemers era -> Redeemers era
applyEstimatedCosts Map (PlutusPurpose AsIx era) ExUnits
estimatedScriptCosts Redeemers era
redeemersWithAdjustedIndices

  -- Compute the script integrity hash exactly like the ledger's UTXOW rule:
  -- only scripts the transaction actually needs contribute their language
  -- view, so a reference script merely carried by a reference input is
  -- ignored. NOTE: mkScriptIntegrity reads redeemers and datums off the given
  -- transaction, so it must see the adjusted redeemers (with estimated
  -- ExUnits), not the estimation placeholders.
  let txWithAdjustedRedeemers :: Tx TopTx era
txWithAdjustedRedeemers = Tx TopTx era
txForEstimation Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> Redeemers era -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
adjustedRedeemers
      scriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
scriptIntegrityHash =
        ScriptIntegrity era -> ScriptIntegrityHash
forall era. Era era => ScriptIntegrity era -> ScriptIntegrityHash
hashScriptIntegrity
          (ScriptIntegrity era -> ScriptIntegrityHash)
-> StrictMaybe (ScriptIntegrity era)
-> StrictMaybe ScriptIntegrityHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PParams era
-> Tx TopTx era
-> ScriptsProvided era
-> Set ScriptHash
-> StrictMaybe (ScriptIntegrity era)
forall era (l :: TxLevel).
(AlonzoEraPParams era, AlonzoEraTxWits era, EraUTxO era) =>
PParams era
-> Tx l era
-> ScriptsProvided era
-> Set ScriptHash
-> StrictMaybe (ScriptIntegrity era)
mkScriptIntegrity
            PParams era
pparams
            Tx TopTx era
txWithAdjustedRedeemers
            (UTxO era -> Tx TopTx era -> ScriptsProvided era
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> Tx t era -> ScriptsProvided era
forall (t :: TxLevel). UTxO era -> Tx t era -> ScriptsProvided era
getScriptsProvided UTxO era
ledgerUTxO Tx TopTx era
txWithAdjustedRedeemers)
            (ScriptsNeeded era -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (ScriptsNeeded era -> Set ScriptHash)
-> ScriptsNeeded era -> Set ScriptHash
forall a b. (a -> b) -> a -> b
$ UTxO era -> TxBody TopTx era -> ScriptsNeeded era
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> TxBody t era -> ScriptsNeeded era
forall (t :: TxLevel).
UTxO era -> TxBody t era -> ScriptsNeeded era
getScriptsNeeded UTxO era
ledgerUTxO (Tx TopTx era
txWithAdjustedRedeemers Tx TopTx era
-> Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
-> TxBody TopTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL))
  let
    unbalancedBody :: TxBody TopTx era
unbalancedBody =
      TxBody TopTx era
body
        TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> Set TxIn -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
newInputs
        TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> StrictSeq (TxOut era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxOut era)
txOuts
        TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody TopTx era) (Set TxIn)
Lens' (TxBody TopTx era) (Set TxIn)
collateralInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> Set TxIn -> TxBody TopTx era -> TxBody TopTx era
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
        TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe ScriptIntegrityHash)
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL ((StrictMaybe ScriptIntegrityHash
  -> Identity (StrictMaybe ScriptIntegrityHash))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> StrictMaybe ScriptIntegrityHash
-> TxBody TopTx era
-> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ScriptIntegrityHash
scriptIntegrityHash
    unbalancedTx :: Tx TopTx era
unbalancedTx =
      Tx TopTx era
partialTx
        Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> TxBody TopTx era -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxBody TopTx era
unbalancedBody
        Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> Redeemers era -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
adjustedRedeemers

  -- Compute fee using a body with selected txOut to pay fees (= full change)
  let fee :: Coin
fee = UTxO era -> PParams era -> Tx TopTx era -> Int -> Coin
forall era.
(EraUTxO era, EraCertState era) =>
UTxO era -> PParams era -> Tx TopTx era -> Int -> Coin
calcMinFeeTx UTxO era
ledgerUTxO PParams era
pparams Tx TopTx era
costingTx Int
0
      costingTx :: Tx TopTx era
costingTx =
        Tx TopTx era
unbalancedTx
          Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> (StrictSeq (TxOut era) -> StrictSeq (TxOut era))
-> Tx TopTx era
-> Tx TopTx era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (StrictSeq (TxOut era) -> TxOut era -> StrictSeq (TxOut era)
forall a. StrictSeq a -> a -> StrictSeq a
|> TxOut era
feeTxOut)
          Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((Coin -> Identity Coin)
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (Coin -> Identity Coin)
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> Coin -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
10_000_000

  -- Balance tx with a change output and computed fee
  TxOut era
change <-
    (ChangeError -> ErrCoverFee)
-> Either ChangeError (TxOut era) -> Either ErrCoverFee (TxOut era)
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 era) -> Either ErrCoverFee (TxOut era))
-> Either ChangeError (TxOut era) -> Either ErrCoverFee (TxOut era)
forall a b. (a -> b) -> a -> b
$
      TxOut era
-> [TxOut era]
-> [TxOut era]
-> Coin
-> Either ChangeError (TxOut era)
mkChange
        TxOut era
feeTxOut
        [TxOut era]
resolvedInputs
        (StrictSeq (TxOut era) -> [TxOut era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxOut era)
txOuts)
        Coin
fee
  Tx TopTx era -> Either ErrCoverFee (Tx TopTx era)
forall a. a -> Either ErrCoverFee a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx TopTx era -> Either ErrCoverFee (Tx TopTx era))
-> Tx TopTx era -> Either ErrCoverFee (Tx TopTx era)
forall a b. (a -> b) -> a -> b
$
    Tx TopTx era
unbalancedTx
      Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> (StrictSeq (TxOut era) -> StrictSeq (TxOut era))
-> Tx TopTx era
-> Tx TopTx era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (StrictSeq (TxOut era) -> TxOut era -> StrictSeq (TxOut era)
forall a. StrictSeq a -> a -> StrictSeq a
|> TxOut era
change)
      Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((Coin -> Identity Coin)
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (Coin -> Identity Coin)
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> Coin -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
fee
 where
  findUTxOToPayFees :: Map TxIn (Ledger.TxOut era) -> Either ErrCoverFee (TxIn, Ledger.TxOut era)
  findUTxOToPayFees :: Map TxIn (TxOut era) -> Either ErrCoverFee (TxIn, TxOut era)
findUTxOToPayFees Map TxIn (TxOut era)
utxo = case Map TxIn (TxOut era) -> Maybe (TxIn, TxOut era)
forall era.
EraTxOut era =>
Map TxIn (TxOut era) -> Maybe (TxIn, TxOut era)
findLargestUTxO Map TxIn (TxOut era)
utxo of
    Maybe (TxIn, TxOut era)
Nothing ->
      ErrCoverFee -> Either ErrCoverFee (TxIn, TxOut era)
forall a b. a -> Either a b
Left ErrCoverFee
ErrNoFuelUTxOFound
    Just (TxIn
i, TxOut era
o) ->
      (TxIn, TxOut era) -> Either ErrCoverFee (TxIn, TxOut era)
forall a b. b -> Either a b
Right (TxIn
i, TxOut era
o)

  resolveInput :: TxIn -> Either ErrCoverFee (TxOut era)
resolveInput TxIn
i = do
    case TxIn -> Map TxIn (TxOut era) -> Maybe (TxOut era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
i (Map TxIn (TxOut era)
lookupUTxO Map TxIn (TxOut era)
-> Map TxIn (TxOut era) -> Map TxIn (TxOut era)
forall a. Semigroup a => a -> a -> a
<> Map TxIn (TxOut era)
walletUTxO) of
      Maybe (TxOut era)
Nothing -> ErrCoverFee -> Either ErrCoverFee (TxOut era)
forall a b. a -> Either a b
Left (ErrCoverFee -> Either ErrCoverFee (TxOut era))
-> ErrCoverFee -> Either ErrCoverFee (TxOut era)
forall a b. (a -> b) -> a -> b
$ TxIn -> ErrCoverFee
ErrUnknownInput TxIn
i
      Just TxOut era
o -> TxOut era -> Either ErrCoverFee (TxOut era)
forall a b. b -> Either a b
Right TxOut era
o

  mkChange :: Ledger.TxOut era -> [Ledger.TxOut era] -> [Ledger.TxOut era] -> Coin -> Either ChangeError (Ledger.TxOut era)
  mkChange :: TxOut era
-> [TxOut era]
-> [TxOut era]
-> Coin
-> Either ChangeError (TxOut era)
mkChange TxOut era
feeTxOut [TxOut era]
resolvedInputs [TxOut era]
otherOutputs Coin
fee
    -- FIXME: The delta between in and out must be greater than the min utxo value!
    | Coin
totalIn Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
totalOut =
        ChangeError -> Either ChangeError (TxOut era)
forall a b. a -> Either a b
Left (ChangeError -> Either ChangeError (TxOut era))
-> ChangeError -> Either ChangeError (TxOut era)
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 era -> Either ChangeError (TxOut era)
forall a b. b -> Either a b
Right (TxOut era -> Either ChangeError (TxOut era))
-> TxOut era -> Either ChangeError (TxOut era)
forall a b. (a -> b) -> a -> b
$ TxOut era
feeTxOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era)
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL ((Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era))
-> Coin -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
changeOut
   where
    totalOut :: Coin
totalOut = (TxOut era -> Coin) -> [TxOut era] -> Coin
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Getting Coin (TxOut era) Coin -> TxOut era -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL) [TxOut era]
otherOutputs Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
fee
    totalIn :: Coin
totalIn = (TxOut era -> Coin) -> [TxOut era] -> Coin
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Getting Coin (TxOut era) Coin -> TxOut era -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL) [TxOut era]
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

  -- Apply estimated execution units to redeemers. This replaces the existing
  -- execution units with the estimated costs.
  applyEstimatedCosts ::
    Map (PlutusPurpose AsIx era) ExUnits ->
    Redeemers era ->
    Redeemers era
  applyEstimatedCosts :: Map (PlutusPurpose AsIx era) ExUnits
-> Redeemers era -> Redeemers era
applyEstimatedCosts Map (PlutusPurpose AsIx era) ExUnits
estimatedCosts (Redeemers Map (PlutusPurpose AsIx era) (Data era, ExUnits)
redeemers) =
    Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Redeemers era
forall a b. (a -> b) -> a -> b
$ (PlutusPurpose AsIx era
 -> (Data era, ExUnits) -> (Data era, ExUnits))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey PlutusPurpose AsIx era
-> (Data era, ExUnits) -> (Data era, ExUnits)
updateExUnits Map (PlutusPurpose AsIx era) (Data era, ExUnits)
redeemers
   where
    updateExUnits :: PlutusPurpose AsIx era
-> (Data era, ExUnits) -> (Data era, ExUnits)
updateExUnits PlutusPurpose AsIx era
ptr (Data era
d, ExUnits
_oldExUnits) =
      let exUnits :: ExUnits
exUnits =
            ExUnits -> Maybe ExUnits -> ExUnits
forall a. a -> Maybe a -> a
fromMaybe (Text -> ExUnits
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> ExUnits) -> Text -> ExUnits
forall a b. (a -> b) -> a -> b
$ Text
"applyEstimatedCosts: missing cost for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PlutusPurpose AsIx era -> Text
forall b a. (Show a, IsString b) => a -> b
show PlutusPurpose AsIx era
ptr) (Maybe ExUnits -> ExUnits) -> Maybe ExUnits -> ExUnits
forall a b. (a -> b) -> a -> b
$
              PlutusPurpose AsIx era
-> Map (PlutusPurpose AsIx era) ExUnits -> Maybe ExUnits
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PlutusPurpose AsIx era
ptr Map (PlutusPurpose AsIx era) ExUnits
estimatedCosts
       in (Data era
d, ExUnits
exUnits)

  -- Adjust redeemer indices when inputs change. When a fee input is added,
  -- it may shift the position of existing inputs in the sorted order, which
  -- requires updating spending purpose indices accordingly.
  adjustRedeemerIndices ::
    Set TxIn ->
    Set TxIn ->
    Redeemers era ->
    Redeemers era
  adjustRedeemerIndices :: Set TxIn -> Set TxIn -> Redeemers era -> Redeemers era
adjustRedeemerIndices Set TxIn
initialInputs Set TxIn
finalInputs (Redeemers Map (PlutusPurpose AsIx era) (Data era, ExUnits)
redeemers) =
    Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Redeemers era
forall a b. (a -> b) -> a -> b
$ (PlutusPurpose AsIx era -> PlutusPurpose AsIx era)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys PlutusPurpose AsIx era -> PlutusPurpose AsIx era
adjustPurpose Map (PlutusPurpose AsIx era) (Data era, ExUnits)
redeemers
   where
    sortedInitialInputs :: [TxIn]
sortedInitialInputs = [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

    -- Map from TxIn to its index in the final sorted inputs
    finalInputIndex :: Map TxIn Word32
    finalInputIndex :: Map TxIn Word32
finalInputIndex = [(TxIn, Word32)] -> Map TxIn Word32
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, Word32)] -> Map TxIn Word32)
-> [(TxIn, Word32)] -> Map TxIn Word32
forall a b. (a -> b) -> a -> b
$ [TxIn] -> [Word32] -> [(TxIn, Word32)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIn]
sortedFinalInputs [Word32
0 ..]

    -- Map from original index to TxIn
    initialIndexToTxIn :: Map Word32 TxIn
    initialIndexToTxIn :: Map Word32 TxIn
initialIndexToTxIn = [(Word32, TxIn)] -> Map Word32 TxIn
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Word32, TxIn)] -> Map Word32 TxIn)
-> [(Word32, TxIn)] -> Map Word32 TxIn
forall a b. (a -> b) -> a -> b
$ [Word32] -> [TxIn] -> [(Word32, TxIn)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] [TxIn]
sortedInitialInputs

    adjustPurpose :: PlutusPurpose AsIx era -> PlutusPurpose AsIx era
    adjustPurpose :: PlutusPurpose AsIx era -> PlutusPurpose AsIx era
adjustPurpose purpose :: PlutusPurpose AsIx era
purpose@(SpendingPurpose (AsIx Word32
idx)) =
      -- Get the TxIn that was at this index in the original sorted inputs,
      -- then find its new index in the final sorted inputs
      PlutusPurpose AsIx era
-> Maybe (PlutusPurpose AsIx era) -> PlutusPurpose AsIx era
forall a. a -> Maybe a -> a
fromMaybe PlutusPurpose AsIx era
purpose (Maybe (PlutusPurpose AsIx era) -> PlutusPurpose AsIx era)
-> Maybe (PlutusPurpose AsIx era) -> PlutusPurpose AsIx era
forall a b. (a -> b) -> a -> b
$ do
        TxIn
txIn <- Word32 -> Map Word32 TxIn -> Maybe TxIn
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word32
idx Map Word32 TxIn
initialIndexToTxIn
        Word32
newIdx <- TxIn -> Map TxIn Word32 -> Maybe Word32
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
txIn Map TxIn Word32
finalInputIndex
        PlutusPurpose AsIx era -> Maybe (PlutusPurpose AsIx era)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlutusPurpose AsIx era -> Maybe (PlutusPurpose AsIx era))
-> PlutusPurpose AsIx era -> Maybe (PlutusPurpose AsIx era)
forall a b. (a -> b) -> a -> b
$ AsIx Word32 TxIn -> PlutusPurpose AsIx era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose (Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
newIdx)
    adjustPurpose PlutusPurpose AsIx era
other = PlutusPurpose AsIx era
other

findLargestUTxO :: Ledger.EraTxOut era => Map TxIn (Ledger.TxOut era) -> Maybe (TxIn, Ledger.TxOut era)
findLargestUTxO :: forall era.
EraTxOut era =>
Map TxIn (TxOut era) -> Maybe (TxIn, TxOut era)
findLargestUTxO Map TxIn (TxOut era)
utxo =
  [(TxIn, TxOut era)] -> Maybe (TxIn, TxOut era)
forall a. [a] -> Maybe a
listToMaybe
    ([(TxIn, TxOut era)] -> Maybe (TxIn, TxOut era))
-> ([(TxIn, TxOut era)] -> [(TxIn, TxOut era)])
-> [(TxIn, TxOut era)]
-> Maybe (TxIn, TxOut era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxIn, TxOut era) -> Down Coin)
-> [(TxIn, TxOut era)] -> [(TxIn, TxOut 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 era) -> Coin) -> (TxIn, TxOut era) -> Down Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Coin (TxOut era) Coin -> TxOut era -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL (TxOut era -> Coin)
-> ((TxIn, TxOut era) -> TxOut era) -> (TxIn, TxOut era) -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, TxOut era) -> TxOut era
forall a b. (a, b) -> b
snd)
    ([(TxIn, TxOut era)] -> Maybe (TxIn, TxOut era))
-> [(TxIn, TxOut era)] -> Maybe (TxIn, TxOut era)
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut era) -> [(TxIn, TxOut era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut era)
utxo

-- | Estimate cost of script executions on the transaction. This is only an
-- estimates because the transaction isn't sealed at this point and adding new
-- elements to it like change outputs or script integrity hash may increase that
-- cost a little.
estimateScriptsCost ::
  forall era.
  (AlonzoEraTx era, EraPlutusContext era, ScriptsNeeded era ~ AlonzoScriptsNeeded era, EraUTxO era) =>
  -- | Protocol parameters
  Core.PParams era ->
  -- | Start of the blockchain, for converting slots to UTC times
  SystemStart ->
  -- | Information about epoch sizes, for converting slots to UTC times
  EpochInfo (Either Text) ->
  -- | A UTXO needed to resolve inputs
  Map TxIn (Ledger.TxOut era) ->
  -- | The pre-constructed transaction
  Ledger.Tx TopTx era ->
  Either ErrCoverFee (Map (PlutusPurpose AsIx era) ExUnits)
estimateScriptsCost :: forall era.
(AlonzoEraTx era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era, EraUTxO era) =>
PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Tx TopTx era
-> Either ErrCoverFee (Map (PlutusPurpose AsIx era) ExUnits)
estimateScriptsCost PParams era
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo Map TxIn (TxOut era)
utxo Tx TopTx era
tx = do
  (PlutusPurpose AsIx era
 -> Either (TransactionScriptFailure era) ExUnits
 -> Either ErrCoverFee ExUnits)
-> Map
     (PlutusPurpose AsIx era)
     (Either (TransactionScriptFailure era) ExUnits)
-> Either ErrCoverFee (Map (PlutusPurpose AsIx era) ExUnits)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey PlutusPurpose AsIx era
-> Either (TransactionScriptFailure era) ExUnits
-> Either ErrCoverFee ExUnits
convertResult Map
  (PlutusPurpose AsIx era)
  (Either (TransactionScriptFailure era) ExUnits)
result
 where
  result ::
    Map
      (PlutusPurpose AsIx era)
      (Either (TransactionScriptFailure era) ExUnits)
  result :: Map
  (PlutusPurpose AsIx era)
  (Either (TransactionScriptFailure era) ExUnits)
result =
    PParams era
-> Tx TopTx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> Map
     (PlutusPurpose AsIx era)
     (Either (TransactionScriptFailure era) ExUnits)
forall era.
(AlonzoEraTx era, EraUTxO era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
PParams era
-> Tx TopTx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> RedeemerReport era
evalTxExUnits
      PParams era
pparams
      Tx TopTx era
tx
      (Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
Ledger.UTxO Map TxIn (TxOut era)
utxo)
      EpochInfo (Either Text)
epochInfo
      SystemStart
systemStart

  convertResult :: PlutusPurpose AsIx era -> Either (TransactionScriptFailure era) ExUnits -> Either ErrCoverFee ExUnits
  convertResult :: PlutusPurpose AsIx era
-> Either (TransactionScriptFailure era) ExUnits
-> Either ErrCoverFee ExUnits
convertResult PlutusPurpose AsIx era
ptr = \case
    Right ExUnits
exUnits -> ExUnits -> Either ErrCoverFee ExUnits
forall a b. b -> Either a b
Right ExUnits
exUnits
    Left TransactionScriptFailure era
failure ->
      case TransactionScriptFailure era
failure of
        -- Missing script witness - provide helpful error message
        MissingScript PlutusPurpose AsIx era
_ Map
  (PlutusPurpose AsIx era)
  (PlutusPurpose AsItem era, Maybe (PlutusScript era), ScriptHash)
scriptHash ->
          ErrCoverFee -> Either ErrCoverFee ExUnits
forall a b. a -> Either a b
Left (ErrCoverFee -> Either ErrCoverFee ExUnits)
-> ErrCoverFee -> Either ErrCoverFee ExUnits
forall a b. (a -> b) -> a -> b
$
            ErrMissingScript
              { $sel:scriptHash:ErrNotEnoughFunds :: Text
scriptHash = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Map
  (PlutusPurpose AsIx era)
  (PlutusPurpose AsItem era, Maybe (PlutusScript era), ScriptHash)
-> String
forall b a. (Show a, IsString b) => a -> b
show Map
  (PlutusPurpose AsIx era)
  (PlutusPurpose AsItem era, Maybe (PlutusScript era), ScriptHash)
scriptHash
              , $sel:purpose:ErrNotEnoughFunds :: Text
purpose = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PlutusPurpose AsIx era -> String
forall b a. (Show a, IsString b) => a -> b
show PlutusPurpose AsIx era
ptr
              }
        -- Any other script execution failure
        TransactionScriptFailure era
_ ->
          ErrCoverFee -> Either ErrCoverFee ExUnits
forall a b. a -> Either a b
Left (ErrCoverFee -> Either ErrCoverFee ExUnits)
-> ErrCoverFee -> Either ErrCoverFee ExUnits
forall a b. (a -> b) -> a -> b
$
            ErrScriptExecutionFailed
              { $sel:redeemerPointer:ErrNotEnoughFunds :: Text
redeemerPointer = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PlutusPurpose AsIx era -> String
forall b a. (Show a, IsString b) => a -> b
show PlutusPurpose AsIx era
ptr
              , $sel:scriptFailure:ErrNotEnoughFunds :: Text
scriptFailure = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TransactionScriptFailure era -> String
forall b a. (Show a, IsString b) => a -> b
show TransactionScriptFailure era
failure
              }

--
-- Logs
--

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