{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Api.Experimental.Tx.Internal.Fee
  ( TxBodyErrorAutoBalance (..)
  , TxFeeEstimationError (..)
  , collectTxBodyScriptWitnesses
  , estimateBalancedTxBody
  , evaluateTransactionExecutionUnits
  , evaluateTransactionFee
  , indexWitnessedTxProposalProcedures
  , makeTransactionBodyAutoBalance
  -- Internal
  , toUnsigned
  )
where

import Cardano.Api.Address
import Cardano.Api.Certificate.Internal
import Cardano.Api.Era.Internal.Eon.Convert
import Cardano.Api.Error
import Cardano.Api.Experimental.AnyScriptWitness
import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp
import Cardano.Api.Experimental.Era
import Cardano.Api.Experimental.Simple.Script
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
import Cardano.Api.Experimental.Tx.Internal.BodyContent.New
import Cardano.Api.Experimental.Tx.Internal.Certificate qualified as Exp
import Cardano.Api.Experimental.Tx.Internal.Type
import Cardano.Api.Key.Internal qualified as Api
import Cardano.Api.Ledger.Internal.Reexport qualified as L
import Cardano.Api.Plutus.Internal
import Cardano.Api.Plutus.Internal.Script (fromAlonzoExUnits)
import Cardano.Api.Plutus.Internal.Script qualified as Old
import Cardano.Api.Plutus.Internal.ScriptData
import Cardano.Api.Pretty
import Cardano.Api.ProtocolParameters
import Cardano.Api.Query.Internal.Type.QueryInMode
import Cardano.Api.Tx.Internal.Body
  ( CtxTx
  , ScriptWitnessIndex (..)
  , renderScriptWitnessIndex
  , toScriptIndex
  )
import Cardano.Api.Tx.Internal.Fee
  ( EvalTxExecutionUnitsLog
  , ResolvablePointers (..)
  , ScriptExecutionError (..)
  , extractScriptBytesAndLanguage
  )
import Cardano.Api.Tx.Internal.Sign
import Cardano.Api.Tx.Internal.TxIn
import Cardano.Api.Value.Internal

import Cardano.Ledger.Alonzo.Core qualified as Ledger
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Coin qualified as L
import Cardano.Ledger.Conway.Governance qualified as L
import Cardano.Ledger.Credential as Ledger (Credential)
import Cardano.Ledger.Val qualified as L

import Control.Monad
import Data.Bifunctor
import Data.Function (on, (&))
import Data.List (sortBy)
import Data.List qualified as List
import Data.Map.Ordered ()
import Data.Map.Ordered.Strict qualified as OMap
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.OSet.Strict qualified as OSet
import Data.Ord (Down (Down), comparing)
import Data.Ratio
import Data.Set (Set)
import Data.Set qualified as Set
import GHC.Exts (IsList (..))
import GHC.Stack
import Lens.Micro ((.~), (^.))
import Prettyprinter (punctuate)

data TxBodyErrorAutoBalance era
  = -- | There is not enough ada and non-ada to cover both the outputs and the fees.
    -- The transaction should be changed to provide more input assets, or
    -- otherwise adjusted to need less (e.g. outputs, script etc).
    TxBodyErrorBalanceNegative L.Coin L.MultiAsset
  | -- | There is enough ada to cover both the outputs and the fees, but the
    -- resulting change is too small: it is under the minimum value for
    -- new UTXO entries. The transaction should be changed to provide more
    -- input ada.
    TxBodyErrorAdaBalanceTooSmall
      (TxOut CtxTx era)
      -- ^ Offending TxOut
      L.Coin
      -- ^ Minimum UTxO
      L.Coin
      -- ^ Tx balance
  | -- | The minimum spendable UTxO threshold has not been met.
    TxBodyErrorMinUTxONotMet
      (TxOut CtxTx era)
      -- ^ Offending TxOut
      L.Coin
      -- ^ Minimum UTXO
  | TxBodyErrorNonAdaAssetsUnbalanced Value
  | TxBodyErrorScriptWitnessIndexMissingFromExecUnitsMap
      ScriptWitnessIndex
      (Map ScriptWitnessIndex ExecutionUnits)
  | -- | One or more scripts failed to execute correctly.
    TxBodyScriptExecutionError [(ScriptWitnessIndex, ScriptExecutionError)]
  | -- | One or more scripts were expected to fail validation, but none did.
    TxBodyScriptBadScriptValidity
  | BalanceIsNegative
      L.Coin
      -- ^ Negative balance
      (UnsignedTx ConwayEra)
      -- ^ The transaction body
  | NotEnoughAdaInUTxO
      L.MaryValue
      -- ^ Total UTxO value
      L.Coin
      -- ^ Total deposits
      L.MaryValue
      -- ^ Balance

deriving instance Show (TxBodyErrorAutoBalance era)

instance Error (TxBodyErrorAutoBalance era) where
  prettyError :: forall ann. TxBodyErrorAutoBalance era -> Doc ann
prettyError = \case
    TxBodyScriptExecutionError [(ScriptWitnessIndex, ScriptExecutionError)]
failures ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The following scripts have execution failures:\n"
        , [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
            [ [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
                [ Doc ann
"the script for " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ScriptWitnessIndex -> String
renderScriptWitnessIndex ScriptWitnessIndex
index)
                , Doc ann
" failed with: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptExecutionError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. ScriptExecutionError -> Doc ann
prettyError ScriptExecutionError
failure
                ]
            | (ScriptWitnessIndex
index, ScriptExecutionError
failure) <- [(ScriptWitnessIndex, ScriptExecutionError)]
failures
            ]
        ]
    TxBodyErrorAutoBalance era
TxBodyScriptBadScriptValidity ->
      Doc ann
"One or more of the scripts were expected to fail validation, but none did."
    TxBodyErrorBalanceNegative Coin
lovelace MultiAsset
assets ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
        [ Doc ann
"The transaction does not balance in its use of assets. The net balance "
        , Doc ann
"of the transaction is negative: "
        ]
          [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
", " ([Coin -> Doc ann
forall ann. Coin -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Coin
lovelace] [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [MultiAsset -> Doc ann
forall ann. MultiAsset -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty MultiAsset
assets | MultiAsset
assets MultiAsset -> MultiAsset -> Bool
forall a. Eq a => a -> a -> Bool
/= MultiAsset
forall a. Monoid a => a
mempty])
          [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [ Doc ann
". The usual solution is to provide more inputs, or inputs with more assets."
             ]
    TxBodyErrorAdaBalanceTooSmall TxOut CtxTx era
changeOutput Coin
minUTxO Coin
balance ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The transaction does balance in its use of ada, however the net "
        , Doc ann
"balance does not meet the minimum UTxO threshold. \n"
        , Doc ann
"Balance: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Coin -> Doc ann
forall ann. Coin -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Coin
balance Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n"
        , Doc ann
"Offending output (change output): " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TxOut CtxTx era -> String
forall a. Show a => a -> String
show TxOut CtxTx era
changeOutput) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n"
        , Doc ann
"Minimum UTxO threshold: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Coin -> Doc ann
forall ann. Coin -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Coin
minUTxO Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n"
        , Doc ann
"The usual solution is to provide more inputs, or inputs with more ada to "
        , Doc ann
"meet the minimum UTxO threshold."
        ]
    TxBodyErrorMinUTxONotMet TxOut CtxTx era
txout Coin
minUTxO ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"Minimum UTxO threshold not met for tx output: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TxOut CtxTx era -> String
forall a. Show a => a -> String
show TxOut CtxTx era
txout) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n"
        , Doc ann
"Minimum required UTxO: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Coin -> Doc ann
forall ann. Coin -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Coin
minUTxO
        ]
    TxBodyErrorNonAdaAssetsUnbalanced Value
val ->
      Doc ann
"Non-Ada assets are unbalanced: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Value -> Text
renderValue Value
val)
    TxBodyErrorScriptWitnessIndexMissingFromExecUnitsMap ScriptWitnessIndex
sIndex Map ScriptWitnessIndex ExecutionUnits
eUnitsMap ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"ScriptWitnessIndex (redeemer pointer): " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptWitnessIndex -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ScriptWitnessIndex
sIndex Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" is missing from the execution "
        , Doc ann
"units (redeemer pointer) map: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Map ScriptWitnessIndex ExecutionUnits -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Map ScriptWitnessIndex ExecutionUnits
eUnitsMap
        ]
    BalanceIsNegative Coin
negBalance UnsignedTx ConwayEra
txbody ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The transaction balance is negative: "
        , Coin -> Doc ann
forall ann. Coin -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Coin
negBalance
        , Doc ann
"\nTransaction body: "
        , UnsignedTx ConwayEra -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow UnsignedTx ConwayEra
txbody
        ]
    NotEnoughAdaInUTxO MaryValue
totalUTxOValue Coin
totalDeposits MaryValue
balance ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The total ada in the provided UTxO(s) is not enough to cover the deposits required by the "
        , Doc ann
"transaction.\nTotal UTxO value: "
        , MaryValue -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow MaryValue
totalUTxOValue
        , Doc ann
"\nTotal deposits: "
        , Coin -> Doc ann
forall ann. Coin -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Coin
totalDeposits
        , Doc ann
"\nBalance (UTxO value - deposits): "
        , MaryValue -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow MaryValue
balance
        ]

-- | Use when you do not have access to the UTxOs you intend to spend
estimateBalancedTxBody
  :: HasCallStack
  => Era era
  -> TxBodyContent (LedgerEra era)
  -> L.PParams (LedgerEra era)
  -> Set PoolId
  -- ^ The set of registered stake pools, being
  --   unregistered in this transaction.
  -> Map StakeCredential L.Coin
  -- ^ A map of all deposits for stake credentials that are being
  --   unregistered in this transaction.
  -> Map (Ledger.Credential Ledger.DRepRole) L.Coin
  -- ^ A map of all deposits for DRep credentials that are being
  --   unregistered in this transaction.
  -> Map (Ledger.PlutusPurpose Ledger.AsIx (LedgerEra era)) ExecutionUnits
  -- ^ Plutus script execution units.
  -> Coin
  -- ^ Total potential collateral amount.
  -> Int
  -- ^ The number of key witnesses to be added to the transaction.
  -> Int
  -- ^ The number of Byron key witnesses to be added to the transaction.
  -> Int
  -- ^ The size of all reference scripts in bytes.
  -> AddressInEra era
  -- ^ Change address.
  -> L.Value (LedgerEra era)
  -- ^ Total value of UTXOs being spent.
  -> Either (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
estimateBalancedTxBody :: forall era.
HasCallStack =>
Era era
-> TxBodyContent (LedgerEra era)
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole) Coin
-> Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits
-> Coin
-> Int
-> Int
-> Int
-> AddressInEra era
-> Value (LedgerEra era)
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
estimateBalancedTxBody
  Era era
w
  TxBodyContent (LedgerEra era)
txbodycontent
  PParams (LedgerEra era)
pparams
  Set PoolId
poolids
  Map StakeCredential Coin
stakeDelegDeposits
  Map (Credential 'DRepRole) Coin
drepDelegDeposits
  Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits
exUnitsMap =
    Era era
-> (EraCommonConstraints era =>
    Coin
    -> Int
    -> Int
    -> Int
    -> AddressInEra era
    -> Value (LedgerEra era)
    -> Either
         (TxFeeEstimationError era) (TxBodyContent (LedgerEra era)))
-> Coin
-> Int
-> Int
-> Int
-> AddressInEra era
-> Value (LedgerEra era)
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
w ((EraCommonConstraints era =>
  Coin
  -> Int
  -> Int
  -> Int
  -> AddressInEra era
  -> Value (LedgerEra era)
  -> Either
       (TxFeeEstimationError era) (TxBodyContent (LedgerEra era)))
 -> Coin
 -> Int
 -> Int
 -> Int
 -> AddressInEra era
 -> Value (LedgerEra era)
 -> Either
      (TxFeeEstimationError era) (TxBodyContent (LedgerEra era)))
-> (EraCommonConstraints era =>
    Coin
    -> Int
    -> Int
    -> Int
    -> AddressInEra era
    -> Value (LedgerEra era)
    -> Either
         (TxFeeEstimationError era) (TxBodyContent (LedgerEra era)))
-> Coin
-> Int
-> Int
-> Int
-> AddressInEra era
-> Value (LedgerEra era)
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
      TxBodyContent (LedgerEra era)
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole) Coin
-> Map ScriptWitnessIndex ExecutionUnits
-> Coin
-> Int
-> Int
-> Int
-> AddressInEra era
-> MaryValue
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
forall era.
(HasCallStack, IsEra era) =>
TxBodyContent (LedgerEra era)
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole) Coin
-> Map ScriptWitnessIndex ExecutionUnits
-> Coin
-> Int
-> Int
-> Int
-> AddressInEra era
-> MaryValue
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
estimateBalancedTxBody'
        TxBodyContent (LedgerEra era)
txbodycontent
        PParams (LedgerEra era)
pparams
        Set PoolId
poolids
        Map StakeCredential Coin
stakeDelegDeposits
        Map (Credential 'DRepRole) Coin
drepDelegDeposits
        ((PlutusPurpose AsIx (LedgerEra era) -> ScriptWitnessIndex)
-> Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits
-> Map ScriptWitnessIndex ExecutionUnits
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
forall era.
AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
toScriptIndex (Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
w)) Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits
exUnitsMap)

data TxFeeEstimationError era
  = TxFeeEstimationScriptExecutionError (TxBodyErrorAutoBalance (LedgerEra era))
  | TxFeeEstimationBalanceError (TxBodyErrorAutoBalance (LedgerEra era))
  deriving Int -> TxFeeEstimationError era -> ShowS
[TxFeeEstimationError era] -> ShowS
TxFeeEstimationError era -> String
(Int -> TxFeeEstimationError era -> ShowS)
-> (TxFeeEstimationError era -> String)
-> ([TxFeeEstimationError era] -> ShowS)
-> Show (TxFeeEstimationError era)
forall era. Int -> TxFeeEstimationError era -> ShowS
forall era. [TxFeeEstimationError era] -> ShowS
forall era. TxFeeEstimationError era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> TxFeeEstimationError era -> ShowS
showsPrec :: Int -> TxFeeEstimationError era -> ShowS
$cshow :: forall era. TxFeeEstimationError era -> String
show :: TxFeeEstimationError era -> String
$cshowList :: forall era. [TxFeeEstimationError era] -> ShowS
showList :: [TxFeeEstimationError era] -> ShowS
Show

instance Error (TxFeeEstimationError era) where
  prettyError :: forall ann. TxFeeEstimationError era -> Doc ann
prettyError = \case
    TxFeeEstimationScriptExecutionError TxBodyErrorAutoBalance (LedgerEra era)
e -> TxBodyErrorAutoBalance (LedgerEra era) -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxBodyErrorAutoBalance (LedgerEra era) -> Doc ann
prettyError TxBodyErrorAutoBalance (LedgerEra era)
e
    TxFeeEstimationBalanceError TxBodyErrorAutoBalance (LedgerEra era)
e -> TxBodyErrorAutoBalance (LedgerEra era) -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxBodyErrorAutoBalance (LedgerEra era) -> Doc ann
prettyError TxBodyErrorAutoBalance (LedgerEra era)
e

-- | Use when you do not have access to the UTxOs you intend to spend
estimateBalancedTxBody'
  :: forall era
   . HasCallStack
  => IsEra era
  => TxBodyContent (LedgerEra era)
  -> L.PParams (LedgerEra era)
  -> Set PoolId
  -- ^ The set of registered stake pools, being
  --   unregistered in this transaction.
  -> Map StakeCredential L.Coin
  -- ^ A map of all deposits for stake credentials that are being
  --   unregistered in this transaction.
  -> Map (Ledger.Credential Ledger.DRepRole) L.Coin
  -- ^ A map of all deposits for DRep credentials that are being
  --   unregistered in this transaction.
  -> Map ScriptWitnessIndex ExecutionUnits
  -- ^ Plutus script execution units.
  -> Coin
  -- ^ Total potential collateral amount.
  -> Int
  -- ^ The number of key witnesses to be added to the transaction.
  -> Int
  -- ^ The number of Byron key witnesses to be added to the transaction.
  -> Int
  -- ^ The size of all reference scripts in bytes.
  -> AddressInEra era
  -- ^ Change address.
  -> L.MaryValue
  -- ^ Total value of UTXOs being spent.
  -> Either (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
estimateBalancedTxBody' :: forall era.
(HasCallStack, IsEra era) =>
TxBodyContent (LedgerEra era)
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole) Coin
-> Map ScriptWitnessIndex ExecutionUnits
-> Coin
-> Int
-> Int
-> Int
-> AddressInEra era
-> MaryValue
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
estimateBalancedTxBody'
  TxBodyContent (LedgerEra era)
txbodycontent
  PParams (LedgerEra era)
pparams
  Set PoolId
poolids
  Map StakeCredential Coin
stakeDelegDeposits
  Map (Credential 'DRepRole) Coin
drepDelegDeposits
  Map ScriptWitnessIndex ExecutionUnits
exUnitsMap
  Coin
totalPotentialCollateral
  Int
intendedKeyWits
  Int
byronwits
  Int
sizeOfAllReferenceScripts
  AddressInEra era
changeaddr
  MaryValue
totalUTxOValue = do
    -- Step 1. Substitute those execution units into the tx

    txbodycontent1 <-
      (TxBodyErrorAutoBalance (LedgerEra era)
 -> TxFeeEstimationError era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxBodyContent (LedgerEra era))
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra 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 TxBodyErrorAutoBalance (LedgerEra era) -> TxFeeEstimationError era
forall era.
TxBodyErrorAutoBalance (LedgerEra era) -> TxFeeEstimationError era
TxFeeEstimationScriptExecutionError (Either
   (TxBodyErrorAutoBalance (LedgerEra era))
   (TxBodyContent (LedgerEra era))
 -> Either
      (TxFeeEstimationError era) (TxBodyContent (LedgerEra era)))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxBodyContent (LedgerEra era))
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
        Map ScriptWitnessIndex ExecutionUnits
-> TxBodyContent (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxBodyContent (LedgerEra era))
forall era.
IsEra era =>
Map ScriptWitnessIndex ExecutionUnits
-> TxBodyContent (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxBodyContent (LedgerEra era))
substituteExecutionUnits Map ScriptWitnessIndex ExecutionUnits
exUnitsMap TxBodyContent (LedgerEra era)
txbodycontent

    -- Step 2. We need to calculate the current balance of the tx. The user
    -- must at least provide the total value of the UTxOs they intend to spend
    -- for us to calulate the balance. NB: We must:
    --  1. Subtract certificate and proposal deposits
    -- from the total available Ada value!
    -- Page 24 Shelley ledger spec
    let certificates :: [L.TxCert (LedgerEra era)] =
          [ cert
          | (Exp.Certificate cert, _) <- toList . unTxCertificates $ txCertificates txbodycontent1
          ]

        proposalProcedures :: OSet.OSet (L.ProposalProcedure (LedgerEra era))
        proposalProcedures =
          Maybe (TxProposalProcedures (LedgerEra era))
-> OSet (ProposalProcedure (LedgerEra era))
forall era.
IsEra era =>
Maybe (TxProposalProcedures (LedgerEra era))
-> OSet (ProposalProcedure (LedgerEra era))
convProposalProcedures (Maybe (TxProposalProcedures (LedgerEra era))
 -> OSet (ProposalProcedure (LedgerEra era)))
-> Maybe (TxProposalProcedures (LedgerEra era))
-> OSet (ProposalProcedure (LedgerEra era))
forall a b. (a -> b) -> a -> b
$ TxBodyContent (LedgerEra era)
-> Maybe (TxProposalProcedures (LedgerEra era))
forall era. TxBodyContent era -> Maybe (TxProposalProcedures era)
txProposalProcedures TxBodyContent (LedgerEra era)
txbodycontent1

        totalDeposits :: L.Coin
        totalDeposits =
          -- Because we do not have access to the ledger state and to reduce the complexity of this function's
          -- type signature, we assume the user is trying to register a stake pool that has not been
          -- registered before and has not included duplicate stake pool registration certificates.
          let assumeStakePoolHasNotBeenRegistered :: b -> Bool
assumeStakePoolHasNotBeenRegistered = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
False
           in [Coin] -> Coin
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
                [ Era era -> (EraCommonConstraints era => Coin) -> Coin
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Coin) -> Coin)
-> (EraCommonConstraints era => Coin) -> Coin
forall a b. (a -> b) -> a -> b
$
                    PParams (LedgerEra era)
-> (KeyHash 'StakePool -> Bool) -> [TxCert (LedgerEra era)] -> Coin
forall era (f :: * -> *).
(EraTxCert era, Foldable f) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
forall (f :: * -> *).
Foldable f =>
PParams (LedgerEra era)
-> (KeyHash 'StakePool -> Bool)
-> f (TxCert (LedgerEra era))
-> Coin
L.getTotalDepositsTxCerts PParams (LedgerEra era)
pparams KeyHash 'StakePool -> Bool
forall {b}. b -> Bool
assumeStakePoolHasNotBeenRegistered [TxCert (LedgerEra era)]
certificates
                , Era era -> (EraCommonConstraints era => Coin) -> Coin
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Coin) -> Coin)
-> (EraCommonConstraints era => Coin) -> Coin
forall a b. (a -> b) -> a -> b
$
                    [Coin] -> Coin
forall a. Monoid a => [a] -> a
mconcat ([Coin] -> Coin) -> [Coin] -> Coin
forall a b. (a -> b) -> a -> b
$
                      (ProposalProcedure (LedgerEra era) -> Coin)
-> [ProposalProcedure (LedgerEra era)] -> [Coin]
forall a b. (a -> b) -> [a] -> [b]
map (ProposalProcedure (LedgerEra era)
-> Getting Coin (ProposalProcedure (LedgerEra era)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (ProposalProcedure (LedgerEra era)) Coin
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin)
-> ProposalProcedure era -> f (ProposalProcedure era)
L.pProcDepositL) ([ProposalProcedure (LedgerEra era)] -> [Coin])
-> [ProposalProcedure (LedgerEra era)] -> [Coin]
forall a b. (a -> b) -> a -> b
$
                        OSet (ProposalProcedure (LedgerEra era))
-> [Item (OSet (ProposalProcedure (LedgerEra era)))]
forall l. IsList l => l -> [Item l]
toList OSet (ProposalProcedure (LedgerEra era))
proposalProcedures
                ]
        availableUTxOValue :: L.MaryValue
        availableUTxOValue = MaryValue
totalUTxOValue MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
L.<-> Coin -> MaryValue
forall t s. Inject t s => t -> s
L.inject Coin
totalDeposits

    when (L.coin availableUTxOValue < 0) $
      Left $
        TxFeeEstimationBalanceError $
          NotEnoughAdaInUTxO
            totalUTxOValue
            totalDeposits
            availableUTxOValue
    let
      partialChange =
        MaryValue -> TxBodyContent (LedgerEra era) -> MaryValue
forall era.
IsEra era =>
MaryValue -> TxBodyContent (LedgerEra era) -> MaryValue
calculatePartialChangeValue MaryValue
availableUTxOValue TxBodyContent (LedgerEra era)
txbodycontent1
      maxLovelaceChange = Integer -> Coin
L.Coin (Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
64 :: Integer)) Coin -> Coin -> Coin
forall a. Num a => a -> a -> a
- Coin
1
      changeWithMaxLovelace = (Coin -> Coin) -> MaryValue -> MaryValue
forall t. Val t => (Coin -> Coin) -> t -> t
L.modifyCoin (Coin -> Coin -> Coin
forall a b. a -> b -> a
const Coin
maxLovelaceChange) MaryValue
partialChange
      changeTxOut :: L.TxOut (LedgerEra era)
      changeTxOut =
        Era era
-> (EraCommonConstraints era => TxOut (LedgerEra era))
-> TxOut (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => TxOut (LedgerEra era))
 -> TxOut (LedgerEra era))
-> (EraCommonConstraints era => TxOut (LedgerEra era))
-> TxOut (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
          Addr -> Value (LedgerEra era) -> TxOut (LedgerEra era)
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
L.mkBasicTxOut (AddressInEra era -> Addr
forall era. AddressInEra era -> Addr
toShelleyAddr AddressInEra era
changeaddr) Value (LedgerEra era)
MaryValue
changeWithMaxLovelace

    let (mDummyReturnCollateral, mDummyTotalCollateral) = maybeDummyTotalCollAndCollReturnOutput txbodycontent changeaddr

    -- Step 3. Create a tx body with out max lovelace fee. This is strictly for
    -- calculating our fee with evaluateTransactionFee.
    let maxLovelaceFee = Integer -> Coin
L.Coin (Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
32 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
    let txbody1ForFeeEstimateOnly =
          Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
forall era.
Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
makeUnsignedTx
            Era era
forall era. IsEra era => Era era
useEra
            TxBodyContent (LedgerEra era)
txbodycontent1
              { txFee = maxLovelaceFee
              , txOuts =
                  obtainCommonConstraints (useEra @era) (TxOut changeTxOut Nothing)
                    : txOuts txbodycontent
              , txReturnCollateral = mDummyReturnCollateral
              , txTotalCollateral = mDummyTotalCollateral
              }
    let fee =
          PParams (LedgerEra era)
-> UnsignedTx era -> Word -> Word -> Int -> Coin
forall era.
PParams (LedgerEra era)
-> UnsignedTx era -> Word -> Word -> Int -> Coin
evaluateTransactionFee
            PParams (LedgerEra era)
pparams
            UnsignedTx era
txbody1ForFeeEstimateOnly
            (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
intendedKeyWits)
            (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
byronwits)
            Int
sizeOfAllReferenceScripts

        -- Step 4. We use the fee to calculate the required collateral
        (maybeReturnTxCollateral, maybeTotalTxCollateral) =
          obtainCommonConstraints (useEra @era) $
            calcReturnAndTotalCollateral
              fee
              pparams
              (txInsCollateral txbodycontent)
              (txReturnCollateral txbodycontent)
              (txTotalCollateral txbodycontent)
              changeaddr
              (L.inject totalPotentialCollateral)

    -- Step 5. Now we can calculate the balance of the tx. What matter here are:
    --  1. The original outputs
    --  2. Tx fee
    --  3. Return and total collateral
    let
      txbody2 =
        Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
forall era.
Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
makeUnsignedTx
          Era era
forall era. IsEra era => Era era
useEra
          TxBodyContent (LedgerEra era)
txbodycontent1
            { txFee = fee
            , txReturnCollateral = maybeReturnTxCollateral
            , txTotalCollateral = maybeTotalTxCollateral
            }

    let fakeUTxO = TxBodyContent (LedgerEra era) -> Coin -> UTxO (LedgerEra era)
forall era. TxBodyContent era -> Coin -> UTxO era
createFakeUTxO TxBodyContent (LedgerEra era)
txbodycontent1 (Coin -> UTxO (LedgerEra era)) -> Coin -> UTxO (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ MaryValue -> Coin
forall t. Val t => t -> Coin
L.coin MaryValue
availableUTxOValue
        balance :: Ledger.Value (LedgerEra era) =
          evaluateTransactionBalance pparams poolids stakeDelegDeposits drepDelegDeposits fakeUTxO txbody2

        coinBalance :: L.Coin
        coinBalance = Era era -> (EraCommonConstraints era => Coin) -> Coin
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Coin) -> Coin)
-> (EraCommonConstraints era => Coin) -> Coin
forall a b. (a -> b) -> a -> b
$ MaryValue -> Coin
forall t. Val t => t -> Coin
L.coin Value (LedgerEra era)
MaryValue
balance

        balanceTxOut :: TxOut CtxTx (LedgerEra era)
        balanceTxOut =
          Era era
-> (EraCommonConstraints era => TxOut CtxTx (LedgerEra era))
-> TxOut CtxTx (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => TxOut CtxTx (LedgerEra era))
 -> TxOut CtxTx (LedgerEra era))
-> (EraCommonConstraints era => TxOut CtxTx (LedgerEra era))
-> TxOut CtxTx (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
            TxOut (LedgerEra era)
-> Maybe (Datum CtxTx (LedgerEra era))
-> TxOut CtxTx (LedgerEra era)
forall era ctx.
EraTxOut era =>
TxOut era -> Maybe (Datum ctx era) -> TxOut ctx era
TxOut (Addr -> Value (LedgerEra era) -> TxOut (LedgerEra era)
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
L.mkBasicTxOut (AddressInEra era -> Addr
forall era. AddressInEra era -> Addr
toShelleyAddr AddressInEra era
changeaddr) Value (LedgerEra era)
balance) Maybe (Datum CtxTx (LedgerEra era))
forall a. Maybe a
Nothing
    case useEra @era of
      Era era
DijkstraEra -> String
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
forall a. HasCallStack => String -> a
error String
"estimateBalancedTxBody: DijkstraEra is not supported for fee estimation"
      Era era
ConwayEra -> do
        Bool
-> Either (TxFeeEstimationError era) ()
-> Either (TxFeeEstimationError era) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Coin
coinBalance Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
0) (Either (TxFeeEstimationError era) ()
 -> Either (TxFeeEstimationError era) ())
-> Either (TxFeeEstimationError era) ()
-> Either (TxFeeEstimationError era) ()
forall a b. (a -> b) -> a -> b
$
          TxFeeEstimationError era -> Either (TxFeeEstimationError era) ()
forall a b. a -> Either a b
Left (TxFeeEstimationError era -> Either (TxFeeEstimationError era) ())
-> TxFeeEstimationError era -> Either (TxFeeEstimationError era) ()
forall a b. (a -> b) -> a -> b
$
            TxBodyErrorAutoBalance (LedgerEra era) -> TxFeeEstimationError era
forall era.
TxBodyErrorAutoBalance (LedgerEra era) -> TxFeeEstimationError era
TxFeeEstimationBalanceError (TxBodyErrorAutoBalance (LedgerEra era)
 -> TxFeeEstimationError era)
-> TxBodyErrorAutoBalance (LedgerEra era)
-> TxFeeEstimationError era
forall a b. (a -> b) -> a -> b
$
              Coin -> UnsignedTx ConwayEra -> TxBodyErrorAutoBalance ConwayEra
forall era.
Coin -> UnsignedTx ConwayEra -> TxBodyErrorAutoBalance era
BalanceIsNegative Coin
coinBalance UnsignedTx era
UnsignedTx ConwayEra
txbody2

        -- Step 6. Check all txouts have the min required UTxO value
        -- TOOD: Fix me. You need a new error type to accomodate your new types
        ((TxOut CtxTx ConwayEra, Coin) -> TxFeeEstimationError era)
-> Either (TxOut CtxTx ConwayEra, Coin) ()
-> Either (TxFeeEstimationError 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 (TxBodyErrorAutoBalance ConwayEra -> TxFeeEstimationError era
TxBodyErrorAutoBalance (LedgerEra era) -> TxFeeEstimationError era
forall era.
TxBodyErrorAutoBalance (LedgerEra era) -> TxFeeEstimationError era
TxFeeEstimationBalanceError (TxBodyErrorAutoBalance ConwayEra -> TxFeeEstimationError era)
-> ((TxOut CtxTx ConwayEra, Coin)
    -> TxBodyErrorAutoBalance ConwayEra)
-> (TxOut CtxTx ConwayEra, Coin)
-> TxFeeEstimationError era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut CtxTx ConwayEra -> Coin -> TxBodyErrorAutoBalance ConwayEra)
-> (TxOut CtxTx ConwayEra, Coin)
-> TxBodyErrorAutoBalance ConwayEra
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxOut CtxTx ConwayEra -> Coin -> TxBodyErrorAutoBalance ConwayEra
forall era. TxOut CtxTx era -> Coin -> TxBodyErrorAutoBalance era
TxBodyErrorMinUTxONotMet)
          (Either (TxOut CtxTx ConwayEra, Coin) ()
 -> Either (TxFeeEstimationError era) ())
-> ([TxOut CtxTx (LedgerEra era)]
    -> Either (TxOut CtxTx ConwayEra, Coin) ())
-> [TxOut CtxTx (LedgerEra era)]
-> Either (TxFeeEstimationError era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut CtxTx (LedgerEra era)
 -> Either (TxOut CtxTx ConwayEra, Coin) ())
-> [TxOut CtxTx (LedgerEra era)]
-> Either (TxOut CtxTx ConwayEra, Coin) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (PParams (LedgerEra ConwayEra)
-> TxOut CtxTx (LedgerEra ConwayEra)
-> Either (TxOut CtxTx (LedgerEra ConwayEra), Coin) ()
forall era.
PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> Either (TxOut CtxTx (LedgerEra era), Coin) ()
checkMinUTxOValue PParams (LedgerEra era)
PParams (LedgerEra ConwayEra)
pparams)
          ([TxOut CtxTx (LedgerEra era)]
 -> Either (TxFeeEstimationError era) ())
-> [TxOut CtxTx (LedgerEra era)]
-> Either (TxFeeEstimationError era) ()
forall a b. (a -> b) -> a -> b
$ TxBodyContent (LedgerEra era) -> [TxOut CtxTx (LedgerEra era)]
forall era. TxBodyContent era -> [TxOut CtxTx era]
txOuts TxBodyContent (LedgerEra era)
txbodycontent1

        -- check if the balance is positive or negative
        -- in one case we can produce change, in the other the inputs are insufficient
        finalTxOuts <-
          (TxBodyErrorAutoBalance ConwayEra -> TxFeeEstimationError era)
-> Either
     (TxBodyErrorAutoBalance ConwayEra) [TxOut CtxTx (LedgerEra era)]
-> Either (TxFeeEstimationError era) [TxOut CtxTx (LedgerEra 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 TxBodyErrorAutoBalance ConwayEra -> TxFeeEstimationError era
TxBodyErrorAutoBalance (LedgerEra era) -> TxFeeEstimationError era
forall era.
TxBodyErrorAutoBalance (LedgerEra era) -> TxFeeEstimationError era
TxFeeEstimationBalanceError (Either
   (TxBodyErrorAutoBalance ConwayEra) [TxOut CtxTx (LedgerEra era)]
 -> Either (TxFeeEstimationError era) [TxOut CtxTx (LedgerEra era)])
-> Either
     (TxBodyErrorAutoBalance ConwayEra) [TxOut CtxTx (LedgerEra era)]
-> Either (TxFeeEstimationError era) [TxOut CtxTx (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$
            PParams (LedgerEra ConwayEra)
-> TxOut CtxTx (LedgerEra ConwayEra)
-> [TxOut CtxTx (LedgerEra ConwayEra)]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra ConwayEra))
     [TxOut CtxTx (LedgerEra ConwayEra)]
forall era.
IsEra era =>
PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> [TxOut CtxTx (LedgerEra era)]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [TxOut CtxTx (LedgerEra era)]
checkAndIncludeChange PParams (LedgerEra era)
PParams (LedgerEra ConwayEra)
pparams TxOut CtxTx (LedgerEra era)
TxOut CtxTx (LedgerEra ConwayEra)
balanceTxOut (TxBodyContent (LedgerEra era) -> [TxOut CtxTx (LedgerEra era)]
forall era. TxBodyContent era -> [TxOut CtxTx era]
txOuts TxBodyContent (LedgerEra era)
txbodycontent1)

        -- Step 7.

        -- Create the txbody with the final fee and change output. This should work
        -- provided that the fee and change are less than 2^32-1, and so will
        -- fit within the encoding size we picked above when calculating the fee.
        -- Yes this could be an over-estimate by a few bytes if the fee or change
        -- would fit within 2^16-1. That's a possible optimisation.
        let finalTxBodyContent =
              TxBodyContent (LedgerEra era)
txbodycontent1
                { txFee = fee
                , txOuts = finalTxOuts
                , txReturnCollateral = maybeReturnTxCollateral
                , txTotalCollateral = maybeTotalTxCollateral
                }

        return finalTxBodyContent

data IsEmpty = Empty | NonEmpty
  deriving (IsEmpty -> IsEmpty -> Bool
(IsEmpty -> IsEmpty -> Bool)
-> (IsEmpty -> IsEmpty -> Bool) -> Eq IsEmpty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsEmpty -> IsEmpty -> Bool
== :: IsEmpty -> IsEmpty -> Bool
$c/= :: IsEmpty -> IsEmpty -> Bool
/= :: IsEmpty -> IsEmpty -> Bool
Eq, Int -> IsEmpty -> ShowS
[IsEmpty] -> ShowS
IsEmpty -> String
(Int -> IsEmpty -> ShowS)
-> (IsEmpty -> String) -> ([IsEmpty] -> ShowS) -> Show IsEmpty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsEmpty -> ShowS
showsPrec :: Int -> IsEmpty -> ShowS
$cshow :: IsEmpty -> String
show :: IsEmpty -> String
$cshowList :: [IsEmpty] -> ShowS
showList :: [IsEmpty] -> ShowS
Show)

checkNonNegative
  :: forall era
   . IsEra era
  => Ledger.PParams (LedgerEra era)
  -> TxOut CtxTx (LedgerEra era)
  -> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
  -- ^ result of check if txout is empty
checkNonNegative :: forall era.
IsEra era =>
PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
checkNonNegative PParams (LedgerEra era)
bpparams txout :: TxOut CtxTx (LedgerEra era)
txout@(TxOut TxOut (LedgerEra era)
balance Maybe (Datum CtxTx (LedgerEra era))
_) = do
  let outValue :: MaryValue
outValue@(L.MaryValue Coin
coin MultiAsset
multiAsset) = TxOut (LedgerEra era)
balance TxOut (LedgerEra era)
-> Getting MaryValue (TxOut (LedgerEra era)) MaryValue -> MaryValue
forall s a. s -> Getting a s a -> a
^. Era era
-> (EraCommonConstraints era =>
    Getting MaryValue (TxOut (LedgerEra era)) MaryValue)
-> Getting MaryValue (TxOut (LedgerEra era)) MaryValue
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) EraCommonConstraints era =>
Getting MaryValue (TxOut (LedgerEra era)) MaryValue
(Value (LedgerEra era) -> Const MaryValue (Value (LedgerEra era)))
-> TxOut (LedgerEra era) -> Const MaryValue (TxOut (LedgerEra era))
Getting MaryValue (TxOut (LedgerEra era)) MaryValue
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut (LedgerEra era)) (Value (LedgerEra era))
L.valueTxOutL
      isPositiveValue :: Bool
isPositiveValue = (Integer -> Integer -> Bool) -> MaryValue -> MaryValue -> Bool
forall t. Val t => (Integer -> Integer -> Bool) -> t -> t -> Bool
L.pointwise Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>) MaryValue
outValue MaryValue
forall a. Monoid a => a
mempty
  if
    | MaryValue -> Bool
forall t. Val t => t -> Bool
L.isZero MaryValue
outValue -> IsEmpty -> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
forall a. a -> Either (TxBodyErrorAutoBalance (LedgerEra era)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IsEmpty
Empty -- empty TxOut - ok, it's removed at the end
    | Coin -> Bool
forall t. Val t => t -> Bool
L.isZero Coin
coin ->
        -- no ADA, just non-ADA assets: positive lovelace is required in such case
        TxBodyErrorAutoBalance (LedgerEra era)
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
forall a b. a -> Either a b
Left (TxBodyErrorAutoBalance (LedgerEra era)
 -> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty)
-> TxBodyErrorAutoBalance (LedgerEra era)
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
forall a b. (a -> b) -> a -> b
$
          TxOut CtxTx (LedgerEra era)
-> Coin -> Coin -> TxBodyErrorAutoBalance (LedgerEra era)
forall era.
TxOut CtxTx era -> Coin -> Coin -> TxBodyErrorAutoBalance era
TxBodyErrorAdaBalanceTooSmall
            TxOut CtxTx (LedgerEra era)
txout
            (PParams (LedgerEra era) -> TxOut CtxTx (LedgerEra era) -> Coin
forall era.
HasCallStack =>
PParams (LedgerEra era) -> TxOut CtxTx (LedgerEra era) -> Coin
calculateMinimumUTxO PParams (LedgerEra era)
bpparams TxOut CtxTx (LedgerEra era)
txout)
            Coin
coin
    | Bool -> Bool
not Bool
isPositiveValue -> TxBodyErrorAutoBalance (LedgerEra era)
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
forall a b. a -> Either a b
Left (TxBodyErrorAutoBalance (LedgerEra era)
 -> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty)
-> TxBodyErrorAutoBalance (LedgerEra era)
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
forall a b. (a -> b) -> a -> b
$ Coin -> MultiAsset -> TxBodyErrorAutoBalance (LedgerEra era)
forall era. Coin -> MultiAsset -> TxBodyErrorAutoBalance era
TxBodyErrorBalanceNegative Coin
coin MultiAsset
multiAsset
    | Bool
otherwise -> IsEmpty -> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
forall a. a -> Either (TxBodyErrorAutoBalance (LedgerEra era)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IsEmpty
NonEmpty

-- | In the event of spending the exact amount of lovelace and non-ada assets in
-- the specified input(s), this function excludes the change
-- output. Note that this does not save any fees because by default
-- the fee calculation includes a change address for simplicity and
-- we make no attempt to recalculate the tx fee without a change address.
checkAndIncludeChange
  :: forall era
   . IsEra era
  => Ledger.PParams (LedgerEra era)
  -> TxOut CtxTx (LedgerEra era)
  -> [TxOut CtxTx (LedgerEra era)]
  -> Either (TxBodyErrorAutoBalance (LedgerEra era)) [TxOut CtxTx (LedgerEra era)]
checkAndIncludeChange :: forall era.
IsEra era =>
PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> [TxOut CtxTx (LedgerEra era)]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [TxOut CtxTx (LedgerEra era)]
checkAndIncludeChange PParams (LedgerEra era)
pp change :: TxOut CtxTx (LedgerEra era)
change@(TxOut TxOut (LedgerEra era)
changeOutput Maybe (Datum CtxTx (LedgerEra era))
_) [TxOut CtxTx (LedgerEra era)]
rest = do
  isChangeEmpty <- PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
forall era.
IsEra era =>
PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
checkNonNegative PParams (LedgerEra era)
pp TxOut CtxTx (LedgerEra era)
change
  case isChangeEmpty of
    IsEmpty
Empty -> [TxOut CtxTx (LedgerEra era)]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [TxOut CtxTx (LedgerEra era)]
forall a. a -> Either (TxBodyErrorAutoBalance (LedgerEra era)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TxOut CtxTx (LedgerEra era)]
rest
    IsEmpty
NonEmpty -> do
      let coin :: Coin
coin = TxOut (LedgerEra era)
changeOutput TxOut (LedgerEra era)
-> Getting Coin (TxOut (LedgerEra era)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut (LedgerEra era)) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut (LedgerEra era)) Coin
L.coinTxOutL
      ((TxOut CtxTx (LedgerEra era), Coin)
 -> TxBodyErrorAutoBalance (LedgerEra era))
-> Either (TxOut CtxTx (LedgerEra era), Coin) ()
-> Either (TxBodyErrorAutoBalance (LedgerEra 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 ((Coin
coin Coin
-> (Coin -> TxBodyErrorAutoBalance (LedgerEra era))
-> TxBodyErrorAutoBalance (LedgerEra era)
forall a b. a -> (a -> b) -> b
&) ((Coin -> TxBodyErrorAutoBalance (LedgerEra era))
 -> TxBodyErrorAutoBalance (LedgerEra era))
-> ((TxOut CtxTx (LedgerEra era), Coin)
    -> Coin -> TxBodyErrorAutoBalance (LedgerEra era))
-> (TxOut CtxTx (LedgerEra era), Coin)
-> TxBodyErrorAutoBalance (LedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut CtxTx (LedgerEra era)
 -> Coin -> Coin -> TxBodyErrorAutoBalance (LedgerEra era))
-> (TxOut CtxTx (LedgerEra era), Coin)
-> Coin
-> TxBodyErrorAutoBalance (LedgerEra era)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxOut CtxTx (LedgerEra era)
-> Coin -> Coin -> TxBodyErrorAutoBalance (LedgerEra era)
forall era.
TxOut CtxTx era -> Coin -> Coin -> TxBodyErrorAutoBalance era
TxBodyErrorAdaBalanceTooSmall) (Either (TxOut CtxTx (LedgerEra era), Coin) ()
 -> Either (TxBodyErrorAutoBalance (LedgerEra era)) ())
-> Either (TxOut CtxTx (LedgerEra era), Coin) ()
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) ()
forall a b. (a -> b) -> a -> b
$
        PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> Either (TxOut CtxTx (LedgerEra era), Coin) ()
forall era.
PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> Either (TxOut CtxTx (LedgerEra era), Coin) ()
checkMinUTxOValue PParams (LedgerEra era)
pp TxOut CtxTx (LedgerEra era)
change
      -- We append change at the end so a client can predict the indexes of the outputs.
      [TxOut CtxTx (LedgerEra era)]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [TxOut CtxTx (LedgerEra era)]
forall a. a -> Either (TxBodyErrorAutoBalance (LedgerEra era)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TxOut CtxTx (LedgerEra era)]
 -> Either
      (TxBodyErrorAutoBalance (LedgerEra era))
      [TxOut CtxTx (LedgerEra era)])
-> [TxOut CtxTx (LedgerEra era)]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [TxOut CtxTx (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ [TxOut CtxTx (LedgerEra era)]
rest [TxOut CtxTx (LedgerEra era)]
-> [TxOut CtxTx (LedgerEra era)] -> [TxOut CtxTx (LedgerEra era)]
forall a. Semigroup a => a -> a -> a
<> [TxOut CtxTx (LedgerEra era)
change]

checkMinUTxOValue
  :: Ledger.PParams (LedgerEra era)
  -> TxOut CtxTx (LedgerEra era)
  -> Either (TxOut CtxTx (LedgerEra era), Coin) ()
  -- ^ @Left (offending txout, minimum required utxo)@ or @Right ()@ when txout is ok
checkMinUTxOValue :: forall era.
PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> Either (TxOut CtxTx (LedgerEra era), Coin) ()
checkMinUTxOValue PParams (LedgerEra era)
bpp txout :: TxOut CtxTx (LedgerEra era)
txout@(TxOut TxOut (LedgerEra era)
out Maybe (Datum CtxTx (LedgerEra era))
_) = do
  let minUTxO :: Coin
minUTxO = PParams (LedgerEra era) -> TxOut CtxTx (LedgerEra era) -> Coin
forall era.
HasCallStack =>
PParams (LedgerEra era) -> TxOut CtxTx (LedgerEra era) -> Coin
calculateMinimumUTxO PParams (LedgerEra era)
bpp TxOut CtxTx (LedgerEra era)
txout
  if TxOut (LedgerEra era)
out TxOut (LedgerEra era)
-> Getting Coin (TxOut (LedgerEra era)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut (LedgerEra era)) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut (LedgerEra era)) Coin
L.coinTxOutL Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
minUTxO
    then () -> Either (TxOut CtxTx (LedgerEra era), Coin) ()
forall a b. b -> Either a b
Right ()
    else (TxOut CtxTx (LedgerEra era), Coin)
-> Either (TxOut CtxTx (LedgerEra era), Coin) ()
forall a b. a -> Either a b
Left (TxOut CtxTx (LedgerEra era)
txout, Coin
minUTxO)

calculateMinimumUTxO
  :: HasCallStack
  => Ledger.PParams (LedgerEra era)
  -> TxOut CtxTx (LedgerEra era)
  -> L.Coin
calculateMinimumUTxO :: forall era.
HasCallStack =>
PParams (LedgerEra era) -> TxOut CtxTx (LedgerEra era) -> Coin
calculateMinimumUTxO PParams (LedgerEra era)
pp (TxOut TxOut (LedgerEra era)
txout Maybe (Datum CtxTx (LedgerEra era))
_) =
  let txOutWithMinCoin :: TxOut (LedgerEra era)
txOutWithMinCoin = PParams (LedgerEra era)
-> TxOut (LedgerEra era) -> TxOut (LedgerEra era)
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
L.setMinCoinTxOut PParams (LedgerEra era)
pp TxOut (LedgerEra era)
txout
   in TxOut (LedgerEra era)
txOutWithMinCoin TxOut (LedgerEra era)
-> Getting Coin (TxOut (LedgerEra era)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut (LedgerEra era)) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut (LedgerEra era)) Coin
L.coinTxOutL

-- | Compute the total balance of the proposed transaction. Ultimately, a valid
-- transaction must be fully balanced, which means that it has a total value
-- of zero.
--
-- Finding the (non-zero) balance of a partially constructed transaction is
-- useful for adjusting a transaction to be fully balanced.
evaluateTransactionBalance
  :: forall era
   . IsEra era
  => Ledger.PParams (LedgerEra era)
  -> Set PoolId
  -> Map StakeCredential L.Coin
  -> Map (Ledger.Credential Ledger.DRepRole) L.Coin
  -> L.UTxO (LedgerEra era)
  -> UnsignedTx era
  -> L.Value (LedgerEra era)
evaluateTransactionBalance :: forall era.
IsEra era =>
PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole) Coin
-> UTxO (LedgerEra era)
-> UnsignedTx era
-> Value (LedgerEra era)
evaluateTransactionBalance PParams (LedgerEra era)
pp Set PoolId
poolids Map StakeCredential Coin
stakeDelegDeposits Map (Credential 'DRepRole) Coin
drepDelegDeposits UTxO (LedgerEra era)
utxo (UnsignedTx Tx (LedgerEra era)
unsignedTx) =
  let txbody :: TxBody (LedgerEra era)
txbody = Tx (LedgerEra era)
unsignedTx Tx (LedgerEra era)
-> Getting
     (TxBody (LedgerEra era))
     (Tx (LedgerEra era))
     (TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody (LedgerEra era))
  (Tx (LedgerEra era))
  (TxBody (LedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (LedgerEra era)) (TxBody (LedgerEra era))
L.bodyTxL
   in Era era
-> (EraCommonConstraints era => Value (LedgerEra era))
-> Value (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Value (LedgerEra era))
 -> Value (LedgerEra era))
-> (EraCommonConstraints era => Value (LedgerEra era))
-> Value (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
        PParams (LedgerEra era)
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> (KeyHash 'StakePool -> Bool)
-> UTxO (LedgerEra era)
-> TxBody (LedgerEra era)
-> Value (LedgerEra era)
forall era.
EraUTxO era =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> (KeyHash 'StakePool -> Bool)
-> UTxO era
-> TxBody era
-> Value era
L.evalBalanceTxBody
          PParams (LedgerEra era)
pp
          Credential 'Staking -> Maybe Coin
lookupDelegDeposit
          Credential 'DRepRole -> Maybe Coin
lookupDRepDeposit
          KeyHash 'StakePool -> Bool
isRegPool
          UTxO (LedgerEra era)
utxo
          TxBody (LedgerEra era)
txbody
 where
  isRegPool :: Ledger.KeyHash Ledger.StakePool -> Bool
  isRegPool :: KeyHash 'StakePool -> Bool
isRegPool KeyHash 'StakePool
kh = KeyHash 'StakePool -> PoolId
Api.StakePoolKeyHash KeyHash 'StakePool
kh PoolId -> Set PoolId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PoolId
poolids

  lookupDelegDeposit
    :: Ledger.Credential 'Ledger.Staking -> Maybe L.Coin
  lookupDelegDeposit :: Credential 'Staking -> Maybe Coin
lookupDelegDeposit Credential 'Staking
stakeCred =
    StakeCredential -> Map StakeCredential Coin -> Maybe Coin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Credential 'Staking -> StakeCredential
fromShelleyStakeCredential Credential 'Staking
stakeCred) Map StakeCredential Coin
stakeDelegDeposits

  lookupDRepDeposit
    :: Ledger.Credential 'Ledger.DRepRole -> Maybe L.Coin
  lookupDRepDeposit :: Credential 'DRepRole -> Maybe Coin
lookupDRepDeposit Credential 'DRepRole
drepCred =
    Credential 'DRepRole
-> Map (Credential 'DRepRole) Coin -> Maybe Coin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
drepCred Map (Credential 'DRepRole) Coin
drepDelegDeposits

-- | This is used in the balance calculation in the event where
-- the user does not supply the UTxO(s) they intend to spend
-- but they must supply their total balance of ADA.
-- evaluateTransactionBalance calls evalBalanceTxBody which requires a UTxO value.
-- This eventually calls getConsumedMaryValue which retrieves the balance
-- from the transaction itself. This necessitated a function to create a "fake" UTxO
-- to still use evalBalanceTxBody however this will fail for transactions
-- containing multi-assets, refunds and withdrawals.
-- TODO: Include multiassets
createFakeUTxO :: TxBodyContent era -> Coin -> L.UTxO era
createFakeUTxO :: forall era. TxBodyContent era -> Coin -> UTxO era
createFakeUTxO TxBodyContent era
txbodycontent Coin
totalAdaInUTxO =
  let singleTxIn :: [TxIn]
singleTxIn = [TxIn]
-> ((TxIn, [TxIn]) -> [TxIn]) -> Maybe (TxIn, [TxIn]) -> [TxIn]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (TxIn -> [TxIn]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (TxIn -> [TxIn])
-> ((TxIn, [TxIn]) -> TxIn) -> (TxIn, [TxIn]) -> [TxIn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> TxIn
toShelleyTxIn (TxIn -> TxIn)
-> ((TxIn, [TxIn]) -> TxIn) -> (TxIn, [TxIn]) -> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, [TxIn]) -> TxIn
forall a b. (a, b) -> a
fst) (Maybe (TxIn, [TxIn]) -> [TxIn]) -> Maybe (TxIn, [TxIn]) -> [TxIn]
forall a b. (a -> b) -> a -> b
$ [TxIn] -> Maybe (TxIn, [TxIn])
forall a. [a] -> Maybe (a, [a])
List.uncons [TxIn
txin | (TxIn
txin, AnyWitness era
_) <- TxBodyContent era -> [(TxIn, AnyWitness era)]
forall era. TxBodyContent era -> [(TxIn, AnyWitness era)]
txIns TxBodyContent era
txbodycontent]
      singleTxOut :: [TxOut era]
singleTxOut =
        [TxOut era]
-> ((TxOut CtxTx era, [TxOut CtxTx era]) -> [TxOut era])
-> Maybe (TxOut CtxTx era, [TxOut CtxTx era])
-> [TxOut era]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(TxOut TxOut era
firstOut Maybe (Datum CtxTx era)
_, [TxOut CtxTx era]
_rest) -> TxOut era -> [TxOut era]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (TxOut era -> [TxOut era]) -> TxOut era -> [TxOut era]
forall a b. (a -> b) -> a -> b
$ TxOut era
firstOut 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
L.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
totalAdaInUTxO) (Maybe (TxOut CtxTx era, [TxOut CtxTx era]) -> [TxOut era])
-> Maybe (TxOut CtxTx era, [TxOut CtxTx era]) -> [TxOut era]
forall a b. (a -> b) -> a -> b
$
          [TxOut CtxTx era] -> Maybe (TxOut CtxTx era, [TxOut CtxTx era])
forall a. [a] -> Maybe (a, [a])
List.uncons ([TxOut CtxTx era] -> Maybe (TxOut CtxTx era, [TxOut CtxTx era]))
-> [TxOut CtxTx era] -> Maybe (TxOut CtxTx era, [TxOut CtxTx era])
forall a b. (a -> b) -> a -> b
$
            TxBodyContent era -> [TxOut CtxTx era]
forall era. TxBodyContent era -> [TxOut CtxTx era]
txOuts TxBodyContent era
txbodycontent
   in -- Take one txin and one txout. Replace the out value with totalAdaInUTxO
      -- Return an empty UTxO if there are no txins or txouts
      Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
L.UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ [Item (Map TxIn (TxOut era))] -> Map TxIn (TxOut era)
forall l. IsList l => [Item l] -> l
fromList ([Item (Map TxIn (TxOut era))] -> Map TxIn (TxOut era))
-> [Item (Map TxIn (TxOut era))] -> Map TxIn (TxOut era)
forall a b. (a -> b) -> a -> b
$ [TxIn] -> [TxOut era] -> [(TxIn, TxOut era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIn]
singleTxIn [TxOut era]
singleTxOut

-- Calculation taken from validateInsufficientCollateral:
-- https://github.com/input-output-hk/cardano-ledger/blob/389b266d6226dedf3d2aec7af640b3ca4984c5ea/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs#L335
-- TODO: Bug Jared to expose a function from the ledger that returns total and
-- return collateral.
calcReturnAndTotalCollateral
  :: forall era
   . Ledger.AlonzoEraPParams (LedgerEra era)
  => IsEra era
  => L.Coin
  -- ^ Fee
  -> Ledger.PParams (LedgerEra era)
  -> [TxIn]
  -- ^ Collateral inputs the initial TxBodyContent
  -> Maybe (TxReturnCollateral (LedgerEra era))
  -- ^ From the initial TxBodyContent
  -> Maybe TxTotalCollateral
  -- ^ From the initial TxBodyContent
  -> AddressInEra era
  -- ^ Change address
  -> L.MaryValue
  -- ^ Total available collateral (can include non-ada)
  -> (Maybe (TxReturnCollateral (LedgerEra era)), Maybe TxTotalCollateral)
calcReturnAndTotalCollateral :: forall era.
(AlonzoEraPParams (LedgerEra era), IsEra era) =>
Coin
-> PParams (LedgerEra era)
-> [TxIn]
-> Maybe (TxReturnCollateral (LedgerEra era))
-> Maybe TxTotalCollateral
-> AddressInEra era
-> MaryValue
-> (Maybe (TxReturnCollateral (LedgerEra era)),
    Maybe TxTotalCollateral)
calcReturnAndTotalCollateral Coin
_ PParams (LedgerEra era)
_ [] Maybe (TxReturnCollateral (LedgerEra era))
_ Maybe TxTotalCollateral
_ AddressInEra era
_ MaryValue
_ = (Maybe (TxReturnCollateral (LedgerEra era))
forall a. Maybe a
Nothing, Maybe TxTotalCollateral
forall a. Maybe a
Nothing)
calcReturnAndTotalCollateral Coin
fee PParams (LedgerEra era)
pp' [TxIn]
_ Maybe (TxReturnCollateral (LedgerEra era))
mTxReturnCollateral Maybe TxTotalCollateral
mTxTotalCollateral AddressInEra era
cAddr MaryValue
totalAvailableCollateral = do
  let colPerc :: Natural
colPerc = PParams (LedgerEra era)
pp' PParams (LedgerEra era)
-> Getting Natural (PParams (LedgerEra era)) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. Getting Natural (PParams (LedgerEra era)) Natural
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams (LedgerEra era)) Natural
Ledger.ppCollateralPercentageL
      -- We must first figure out how much lovelace we have committed
      -- as collateral and we must determine if we have enough lovelace at our
      -- collateral tx inputs to cover the tx
      totalCollateralLovelace :: Coin
totalCollateralLovelace = Era era -> (EraCommonConstraints era => Coin) -> Coin
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Coin) -> Coin)
-> (EraCommonConstraints era => Coin) -> Coin
forall a b. (a -> b) -> a -> b
$ MaryValue -> Coin
forall t. Val t => t -> Coin
L.coin MaryValue
totalAvailableCollateral
      requiredCollateral :: Coin
requiredCollateral@(L.Coin Integer
reqAmt) = Natural -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
colPerc Coin -> Coin -> Coin
forall a. Num a => a -> a -> a
* Coin
fee
      totalCollateral :: Coin
totalCollateral =
        Rational -> Coin
L.rationalToCoinViaCeiling (Rational -> Coin) -> Rational -> Coin
forall a b. (a -> b) -> a -> b
$
          Integer
reqAmt Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
100
      -- Why * 100? requiredCollateral is the product of the collateral percentage and the tx fee
      -- We choose to multiply 100 rather than divide by 100 to make the calculation
      -- easier to manage. At the end of the calculation we then use % 100 to perform our division
      -- and round the returnCollateral down which has the effect of potentially slightly
      -- overestimating the required collateral.
      L.Coin Integer
returnCollateralAmount = Coin
totalCollateralLovelace Coin -> Coin -> Coin
forall a. Num a => a -> a -> a
* Coin
100 Coin -> Coin -> Coin
forall a. Num a => a -> a -> a
- Coin
requiredCollateral
      MaryValue
returnAdaCollateral :: L.MaryValue = Coin -> MaryValue
forall t s. Inject t s => t -> s
L.inject (Coin -> MaryValue) -> Coin -> MaryValue
forall a b. (a -> b) -> a -> b
$ Rational -> Coin
L.rationalToCoinViaFloor (Rational -> Coin) -> Rational -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
returnCollateralAmount Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
100
      -- non-ada collateral is not used, so just return it as is in the return collateral output
      nonAdaCollateral :: MaryValue
nonAdaCollateral = (Coin -> Coin) -> MaryValue -> MaryValue
forall t. Val t => (Coin -> Coin) -> t -> t
L.modifyCoin (Coin -> Coin -> Coin
forall a b. a -> b -> a
const Coin
forall a. Monoid a => a
mempty) MaryValue
totalAvailableCollateral
      returnCollateral :: MaryValue
returnCollateral = MaryValue
returnAdaCollateral MaryValue -> MaryValue -> MaryValue
forall a. Semigroup a => a -> a -> a
<> MaryValue
nonAdaCollateral
  case (Maybe (TxReturnCollateral (LedgerEra era))
mTxReturnCollateral, Maybe TxTotalCollateral
mTxTotalCollateral) of
    (r :: Maybe (TxReturnCollateral (LedgerEra era))
r@Just{}, t :: Maybe TxTotalCollateral
t@Just{}) -> (Maybe (TxReturnCollateral (LedgerEra era))
r, Maybe TxTotalCollateral
t)
    (r :: Maybe (TxReturnCollateral (LedgerEra era))
r@Just{}, Maybe TxTotalCollateral
Nothing) -> (Maybe (TxReturnCollateral (LedgerEra era))
r, Maybe TxTotalCollateral
forall a. Maybe a
Nothing)
    (Maybe (TxReturnCollateral (LedgerEra era))
Nothing, t :: Maybe TxTotalCollateral
t@Just{}) -> (Maybe (TxReturnCollateral (LedgerEra era))
forall a. Maybe a
Nothing, Maybe TxTotalCollateral
t)
    (Maybe (TxReturnCollateral (LedgerEra era))
Nothing, Maybe TxTotalCollateral
Nothing)
      | Integer
returnCollateralAmount Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 ->
          (Maybe (TxReturnCollateral (LedgerEra era))
forall a. Maybe a
Nothing, Maybe TxTotalCollateral
forall a. Maybe a
Nothing)
      | Bool
otherwise ->
          ( TxReturnCollateral (LedgerEra era)
-> Maybe (TxReturnCollateral (LedgerEra era))
forall a. a -> Maybe a
Just
              (TxReturnCollateral (LedgerEra era)
 -> Maybe (TxReturnCollateral (LedgerEra era)))
-> TxReturnCollateral (LedgerEra era)
-> Maybe (TxReturnCollateral (LedgerEra era))
forall a b. (a -> b) -> a -> b
$ TxOut (LedgerEra era) -> TxReturnCollateral (LedgerEra era)
forall era. TxOut era -> TxReturnCollateral era
TxReturnCollateral
              (TxOut (LedgerEra era) -> TxReturnCollateral (LedgerEra era))
-> TxOut (LedgerEra era) -> TxReturnCollateral (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era => TxOut (LedgerEra era))
-> TxOut (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints
                (forall era. IsEra era => Era era
useEra @era)
              ((EraCommonConstraints era => TxOut (LedgerEra era))
 -> TxOut (LedgerEra era))
-> (EraCommonConstraints era => TxOut (LedgerEra era))
-> TxOut (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ Addr -> Value (LedgerEra era) -> TxOut (LedgerEra era)
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
L.mkBasicTxOut (AddressInEra era -> Addr
forall era. AddressInEra era -> Addr
toShelleyAddr AddressInEra era
cAddr) Value (LedgerEra era)
MaryValue
returnCollateral
          , TxTotalCollateral -> Maybe TxTotalCollateral
forall a. a -> Maybe a
Just (TxTotalCollateral -> Maybe TxTotalCollateral)
-> TxTotalCollateral -> Maybe TxTotalCollateral
forall a b. (a -> b) -> a -> b
$ Coin -> TxTotalCollateral
TxTotalCollateral Coin
totalCollateral
          )

-- | Transaction fees can be computed for a proposed transaction based on the
-- expected number of key witnesses (i.e. signatures).
--
-- When possible, use 'calculateMinTxFee', as it provides a more accurate
-- estimate:
evaluateTransactionFee
  :: Ledger.PParams (LedgerEra era)
  -> UnsignedTx era
  -> Word
  -- ^ The number of Shelley key witnesses
  -> Word
  -- ^ The number of Byron key witnesses
  -> Int
  -- ^ Reference script size in bytes
  -> L.Coin
evaluateTransactionFee :: forall era.
PParams (LedgerEra era)
-> UnsignedTx era -> Word -> Word -> Int -> Coin
evaluateTransactionFee PParams (LedgerEra era)
pp (UnsignedTx Tx (LedgerEra era)
tx) Word
keywitcount Word
byronwitcount Int
refScriptsSize =
  PParams (LedgerEra era)
-> Tx (LedgerEra era) -> Int -> Int -> Int -> Coin
forall era.
EraTx era =>
PParams era -> Tx era -> Int -> Int -> Int -> Coin
L.estimateMinFeeTx PParams (LedgerEra era)
pp Tx (LedgerEra era)
tx (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
keywitcount) (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
byronwitcount) Int
refScriptsSize

-- Essentially we check for the existence of collateral inputs. If they exist we
-- create a fictitious collateral return output. Why? Because we need to put dummy values
-- to get a fee estimate (i.e we overestimate the fee). The required collateral depends
-- on the tx fee as per the Alonzo spec.
maybeDummyTotalCollAndCollReturnOutput
  :: forall era
   . IsEra era
  => TxBodyContent (LedgerEra era)
  -> AddressInEra era
  -> (Maybe (TxReturnCollateral (LedgerEra era)), Maybe TxTotalCollateral)
maybeDummyTotalCollAndCollReturnOutput :: forall era.
IsEra era =>
TxBodyContent (LedgerEra era)
-> AddressInEra era
-> (Maybe (TxReturnCollateral (LedgerEra era)),
    Maybe TxTotalCollateral)
maybeDummyTotalCollAndCollReturnOutput TxBodyContent{[TxIn]
txInsCollateral :: forall era. TxBodyContent era -> [TxIn]
txInsCollateral :: [TxIn]
txInsCollateral, Maybe (TxReturnCollateral (LedgerEra era))
txReturnCollateral :: forall era. TxBodyContent era -> Maybe (TxReturnCollateral era)
txReturnCollateral :: Maybe (TxReturnCollateral (LedgerEra era))
txReturnCollateral, Maybe TxTotalCollateral
txTotalCollateral :: forall era. TxBodyContent era -> Maybe TxTotalCollateral
txTotalCollateral :: Maybe TxTotalCollateral
txTotalCollateral} AddressInEra era
cAddr =
  if [TxIn] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxIn]
txInsCollateral
    then (Maybe (TxReturnCollateral (LedgerEra era))
forall a. Maybe a
Nothing, Maybe TxTotalCollateral
forall a. Maybe a
Nothing)
    else
      let dummyRetCol :: TxReturnCollateral (LedgerEra era)
dummyRetCol =
            TxOut (LedgerEra era) -> TxReturnCollateral (LedgerEra era)
forall era. TxOut era -> TxReturnCollateral era
TxReturnCollateral (TxOut (LedgerEra era) -> TxReturnCollateral (LedgerEra era))
-> TxOut (LedgerEra era) -> TxReturnCollateral (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
              Era era
-> (EraCommonConstraints era => TxOut (LedgerEra era))
-> TxOut (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => TxOut (LedgerEra era))
 -> TxOut (LedgerEra era))
-> (EraCommonConstraints era => TxOut (LedgerEra era))
-> TxOut (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
                Addr -> Value (LedgerEra era) -> TxOut (LedgerEra era)
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
L.mkBasicTxOut (AddressInEra era -> Addr
forall era. AddressInEra era -> Addr
toShelleyAddr AddressInEra era
cAddr) (Coin -> Value (LedgerEra era)
forall t s. Inject t s => t -> s
L.inject (Coin -> Value (LedgerEra era)) -> Coin -> Value (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
L.Coin (Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
64 :: Integer)) Coin -> Coin -> Coin
forall a. Num a => a -> a -> a
- Coin
1)

          dummyTotCol :: TxTotalCollateral
dummyTotCol = Coin -> TxTotalCollateral
TxTotalCollateral (Coin -> TxTotalCollateral) -> Coin -> TxTotalCollateral
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
L.Coin (Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
32 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
       in case (Maybe (TxReturnCollateral (LedgerEra era))
txReturnCollateral, Maybe TxTotalCollateral
txTotalCollateral) of
            (r :: Maybe (TxReturnCollateral (LedgerEra era))
r@Just{}, t :: Maybe TxTotalCollateral
t@Just{}) -> (Maybe (TxReturnCollateral (LedgerEra era))
r, Maybe TxTotalCollateral
t)
            (Just TxReturnCollateral (LedgerEra era)
retCol, Maybe TxTotalCollateral
Nothing) -> (TxReturnCollateral (LedgerEra era)
-> Maybe (TxReturnCollateral (LedgerEra era))
forall a. a -> Maybe a
Just TxReturnCollateral (LedgerEra era)
retCol, TxTotalCollateral -> Maybe TxTotalCollateral
forall a. a -> Maybe a
Just TxTotalCollateral
dummyTotCol)
            (Maybe (TxReturnCollateral (LedgerEra era))
Nothing, Just TxTotalCollateral
col) -> (TxReturnCollateral (LedgerEra era)
-> Maybe (TxReturnCollateral (LedgerEra era))
forall a. a -> Maybe a
Just TxReturnCollateral (LedgerEra era)
dummyRetCol, TxTotalCollateral -> Maybe TxTotalCollateral
forall a. a -> Maybe a
Just TxTotalCollateral
col)
            (Maybe (TxReturnCollateral (LedgerEra era))
Nothing, Maybe TxTotalCollateral
Nothing) -> (TxReturnCollateral (LedgerEra era)
-> Maybe (TxReturnCollateral (LedgerEra era))
forall a. a -> Maybe a
Just TxReturnCollateral (LedgerEra era)
dummyRetCol, TxTotalCollateral -> Maybe TxTotalCollateral
forall a. a -> Maybe a
Just TxTotalCollateral
dummyTotCol)

-- | Calculate the partial change - this does not include certificates' deposits
calculatePartialChangeValue
  :: forall era
   . IsEra era
  => L.MaryValue
  -> TxBodyContent (LedgerEra era)
  -> L.MaryValue
calculatePartialChangeValue :: forall era.
IsEra era =>
MaryValue -> TxBodyContent (LedgerEra era) -> MaryValue
calculatePartialChangeValue MaryValue
incoming TxBodyContent (LedgerEra era)
txbodycontent = do
  let outgoing :: MaryValue
outgoing = MaryValue
newUtxoValue
      mintedValue :: MaryValue
mintedValue =
        [MaryValue] -> MaryValue
forall a. Monoid a => [a] -> a
mconcat
          [ Value -> MaryValue
toMaryValue (Value -> MaryValue) -> Value -> MaryValue
forall a b. (a -> b) -> a -> b
$ PolicyId -> PolicyAssets -> Value
policyAssetsToValue PolicyId
pid PolicyAssets
pAssets
          | (PolicyId
pid, (PolicyAssets
pAssets, AnyWitness (LedgerEra era)
_)) <- Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era))
-> [(PolicyId, (PolicyAssets, AnyWitness (LedgerEra era)))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era))
 -> [(PolicyId, (PolicyAssets, AnyWitness (LedgerEra era)))])
-> (TxMintValue (LedgerEra era)
    -> Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era)))
-> TxMintValue (LedgerEra era)
-> [(PolicyId, (PolicyAssets, AnyWitness (LedgerEra era)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMintValue (LedgerEra era)
-> Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era))
forall era.
TxMintValue era -> Map PolicyId (PolicyAssets, AnyWitness era)
unTxMintValue (TxMintValue (LedgerEra era)
 -> [(PolicyId, (PolicyAssets, AnyWitness (LedgerEra era)))])
-> TxMintValue (LedgerEra era)
-> [(PolicyId, (PolicyAssets, AnyWitness (LedgerEra era)))]
forall a b. (a -> b) -> a -> b
$ TxBodyContent (LedgerEra era) -> TxMintValue (LedgerEra era)
forall era. TxBodyContent era -> TxMintValue era
txMintValue TxBodyContent (LedgerEra era)
txbodycontent
          ]
  MaryValue
incoming MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
L.<+> MaryValue
mintedValue MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
L.<+> MaryValue -> MaryValue
forall t. Val t => t -> t
L.invert MaryValue
outgoing
 where
  newUtxoValue :: MaryValue
newUtxoValue =
    [MaryValue] -> MaryValue
forall a. Monoid a => [a] -> a
mconcat
      [TxOut (LedgerEra era)
out TxOut (LedgerEra era)
-> Getting MaryValue (TxOut (LedgerEra era)) MaryValue -> MaryValue
forall s a. s -> Getting a s a -> a
^. Era era
-> (EraCommonConstraints era =>
    Getting MaryValue (TxOut (LedgerEra era)) MaryValue)
-> Getting MaryValue (TxOut (LedgerEra era)) MaryValue
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) EraCommonConstraints era =>
Getting MaryValue (TxOut (LedgerEra era)) MaryValue
(Value (LedgerEra era) -> Const MaryValue (Value (LedgerEra era)))
-> TxOut (LedgerEra era) -> Const MaryValue (TxOut (LedgerEra era))
Getting MaryValue (TxOut (LedgerEra era)) MaryValue
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut (LedgerEra era)) (Value (LedgerEra era))
L.valueTxOutL | (TxOut TxOut (LedgerEra era)
out Maybe (Datum CtxTx (LedgerEra era))
_) <- TxBodyContent (LedgerEra era) -> [TxOut CtxTx (LedgerEra era)]
forall era. TxBodyContent era -> [TxOut CtxTx era]
txOuts TxBodyContent (LedgerEra era)
txbodycontent]

substituteExecutionUnits
  :: forall era
   . IsEra era
  => Map ScriptWitnessIndex ExecutionUnits
  -> TxBodyContent (LedgerEra era)
  -> Either (TxBodyErrorAutoBalance (LedgerEra era)) (TxBodyContent (LedgerEra era))
substituteExecutionUnits :: forall era.
IsEra era =>
Map ScriptWitnessIndex ExecutionUnits
-> TxBodyContent (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxBodyContent (LedgerEra era))
substituteExecutionUnits
  Map ScriptWitnessIndex ExecutionUnits
exUnitsMap
  txbodycontent :: TxBodyContent (LedgerEra era)
txbodycontent@( TxBodyContent
                    [(TxIn, AnyWitness (LedgerEra era))]
txIns
                    [TxIn]
_
                    TxInsReference (LedgerEra era)
_
                    [TxOut CtxTx (LedgerEra era)]
_
                    Maybe TxTotalCollateral
_
                    Maybe (TxReturnCollateral (LedgerEra era))
_
                    Coin
_
                    Maybe SlotNo
_
                    Maybe SlotNo
_
                    TxMetadata
_
                    [SimpleScript (LedgerEra era)]
_
                    TxExtraKeyWitnesses
_
                    Maybe (PParams (LedgerEra era))
_
                    TxWithdrawals (LedgerEra era)
txWithdrawals
                    TxCertificates (LedgerEra era)
txCertificates
                    TxMintValue (LedgerEra era)
txMintValue
                    ScriptValidity
_
                    Maybe (TxProposalProcedures (LedgerEra era))
txProposalProcedures
                    Maybe (TxVotingProcedures (LedgerEra era))
txVotingProcedures
                    Maybe Coin
_
                    Maybe Coin
_
                  ) = do
    mappedTxIns <- [(TxIn, AnyWitness (LedgerEra era))]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [(TxIn, AnyWitness (LedgerEra era))]
mapScriptWitnessesTxIns [(TxIn, AnyWitness (LedgerEra era))]
txIns
    mappedWithdrawals <- mapScriptWitnessesWithdrawals txWithdrawals
    mappedMintedVals <- mapScriptWitnessesMinting txMintValue
    mappedTxCertificates <- mapScriptWitnessesCertificates txCertificates
    mappedVotes <- mapScriptWitnessesVotes txVotingProcedures
    mappedProposals <- mapScriptWitnessesProposals txProposalProcedures

    Right $
      txbodycontent
        & setTxIns mappedTxIns
        & setTxCertificates mappedTxCertificates
        & setTxWithdrawals mappedWithdrawals
        & setTxMintValue mappedMintedVals
        & setTxVotingProcedures mappedVotes
        & setTxProposalProcedures mappedProposals
   where
    substituteExecUnits
      :: ScriptWitnessIndex
      -> AnyWitness (LedgerEra era)
      -> Either (TxBodyErrorAutoBalance (LedgerEra era)) (AnyWitness (LedgerEra era))
    substituteExecUnits :: ScriptWitnessIndex
-> AnyWitness (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
substituteExecUnits ScriptWitnessIndex
_ w :: AnyWitness (LedgerEra era)
w@AnyWitness (LedgerEra era)
AnyKeyWitnessPlaceholder = AnyWitness (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
forall a b. b -> Either a b
Right AnyWitness (LedgerEra era)
w
    substituteExecUnits ScriptWitnessIndex
_ w :: AnyWitness (LedgerEra era)
w@AnySimpleScriptWitness{} = AnyWitness (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
forall a b. b -> Either a b
Right AnyWitness (LedgerEra era)
w
    substituteExecUnits ScriptWitnessIndex
idx (AnyPlutusScriptWitness AnyPlutusScriptWitness lang purpose (LedgerEra era)
psw) =
      case ScriptWitnessIndex
-> Map ScriptWitnessIndex ExecutionUnits -> Maybe ExecutionUnits
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptWitnessIndex
idx Map ScriptWitnessIndex ExecutionUnits
exUnitsMap of
        Maybe ExecutionUnits
Nothing ->
          TxBodyErrorAutoBalance (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
forall a b. a -> Either a b
Left (TxBodyErrorAutoBalance (LedgerEra era)
 -> Either
      (TxBodyErrorAutoBalance (LedgerEra era))
      (AnyWitness (LedgerEra era)))
-> TxBodyErrorAutoBalance (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
forall a b. (a -> b) -> a -> b
$ ScriptWitnessIndex
-> Map ScriptWitnessIndex ExecutionUnits
-> TxBodyErrorAutoBalance (LedgerEra era)
forall era.
ScriptWitnessIndex
-> Map ScriptWitnessIndex ExecutionUnits
-> TxBodyErrorAutoBalance era
TxBodyErrorScriptWitnessIndexMissingFromExecUnitsMap ScriptWitnessIndex
idx Map ScriptWitnessIndex ExecutionUnits
exUnitsMap
        Just ExecutionUnits
exunits ->
          AnyWitness (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
forall a b. b -> Either a b
Right (AnyWitness (LedgerEra era)
 -> Either
      (TxBodyErrorAutoBalance (LedgerEra era))
      (AnyWitness (LedgerEra era)))
-> AnyWitness (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
            AnyPlutusScriptWitness lang purpose (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
AnyPlutusScriptWitness (AnyPlutusScriptWitness lang purpose (LedgerEra era)
 -> AnyWitness (LedgerEra era))
-> AnyPlutusScriptWitness lang purpose (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
              ExecutionUnits
-> AnyPlutusScriptWitness lang purpose (LedgerEra era)
-> AnyPlutusScriptWitness lang purpose (LedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
ExecutionUnits
-> AnyPlutusScriptWitness lang purpose era
-> AnyPlutusScriptWitness lang purpose era
updatePlutusScriptWitnessExecutionUnits ExecutionUnits
exunits AnyPlutusScriptWitness lang purpose (LedgerEra era)
psw

    mapScriptWitnessesTxIns
      :: [(TxIn, AnyWitness (LedgerEra era))]
      -> Either (TxBodyErrorAutoBalance (LedgerEra era)) [(TxIn, AnyWitness (LedgerEra era))]
    mapScriptWitnessesTxIns :: [(TxIn, AnyWitness (LedgerEra era))]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [(TxIn, AnyWitness (LedgerEra era))]
mapScriptWitnessesTxIns [(TxIn, AnyWitness (LedgerEra era))]
txins =
      let mappedScriptWitnesses
            :: [ ( TxIn
                 , Either (TxBodyErrorAutoBalance (LedgerEra era)) (AnyWitness (LedgerEra era))
                 )
               ]
          mappedScriptWitnesses :: [(TxIn,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))]
mappedScriptWitnesses =
            [ (TxIn
txin, Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
wit')
            | (ScriptWitnessIndex
ix, TxIn
txin, AnyWitness (LedgerEra era)
wit) <- [(TxIn, AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, TxIn, AnyWitness (LedgerEra era))]
forall era.
[(TxIn, AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, TxIn, AnyWitness (LedgerEra era))]
indexTxIns [(TxIn, AnyWitness (LedgerEra era))]
txins
            , let wit' :: Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
wit' = ScriptWitnessIndex
-> AnyWitness (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
substituteExecUnits ScriptWitnessIndex
ix AnyWitness (LedgerEra era)
wit
            ]
       in ((TxIn,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))
 -> Either
      (TxBodyErrorAutoBalance (LedgerEra era))
      (TxIn, AnyWitness (LedgerEra era)))
-> [(TxIn,
     Either
       (TxBodyErrorAutoBalance (LedgerEra era))
       (AnyWitness (LedgerEra era)))]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [(TxIn, AnyWitness (LedgerEra 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
txIn, Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
eWitness) -> (TxIn
txIn,) (AnyWitness (LedgerEra era) -> (TxIn, AnyWitness (LedgerEra era)))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxIn, AnyWitness (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
eWitness)
            [(TxIn,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))]
mappedScriptWitnesses

    mapScriptWitnessesWithdrawals
      :: TxWithdrawals (LedgerEra era)
      -> Either (TxBodyErrorAutoBalance (LedgerEra era)) (TxWithdrawals (LedgerEra era))
    mapScriptWitnessesWithdrawals :: TxWithdrawals (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxWithdrawals (LedgerEra era))
mapScriptWitnessesWithdrawals txWithdrawals' :: TxWithdrawals (LedgerEra era)
txWithdrawals'@(TxWithdrawals [(StakeAddress, Coin, AnyWitness (LedgerEra era))]
_) =
      let mappedWithdrawals
            :: [ ( StakeAddress
                 , L.Coin
                 , Either (TxBodyErrorAutoBalance (LedgerEra era)) (AnyWitness (LedgerEra era))
                 )
               ]
          mappedWithdrawals :: [(StakeAddress, Coin,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))]
mappedWithdrawals =
            [ (StakeAddress
addr, Coin
withdrawal, Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
mappedWitness)
            | (ScriptWitnessIndex
ix, StakeAddress
addr, Coin
withdrawal, AnyWitness (LedgerEra era)
wit) <- TxWithdrawals (LedgerEra era)
-> [(ScriptWitnessIndex, StakeAddress, Coin,
     AnyWitness (LedgerEra era))]
forall era.
TxWithdrawals era
-> [(ScriptWitnessIndex, StakeAddress, Coin, AnyWitness era)]
indexTxWithdrawals TxWithdrawals (LedgerEra era)
txWithdrawals'
            , let mappedWitness :: Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
mappedWitness = ScriptWitnessIndex
-> AnyWitness (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
substituteExecUnits ScriptWitnessIndex
ix AnyWitness (LedgerEra era)
wit
            ]
       in [(StakeAddress, Coin, AnyWitness (LedgerEra era))]
-> TxWithdrawals (LedgerEra era)
forall era.
[(StakeAddress, Coin, AnyWitness era)] -> TxWithdrawals era
TxWithdrawals
            ([(StakeAddress, Coin, AnyWitness (LedgerEra era))]
 -> TxWithdrawals (LedgerEra era))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [(StakeAddress, Coin, AnyWitness (LedgerEra era))]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxWithdrawals (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((StakeAddress, Coin,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))
 -> Either
      (TxBodyErrorAutoBalance (LedgerEra era))
      (StakeAddress, Coin, AnyWitness (LedgerEra era)))
-> [(StakeAddress, Coin,
     Either
       (TxBodyErrorAutoBalance (LedgerEra era))
       (AnyWitness (LedgerEra era)))]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [(StakeAddress, Coin, AnyWitness (LedgerEra 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
              (\(StakeAddress
sAddr, Coin
ll, Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
eWitness) -> (StakeAddress
sAddr,Coin
ll,) (AnyWitness (LedgerEra era)
 -> (StakeAddress, Coin, AnyWitness (LedgerEra era)))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (StakeAddress, Coin, AnyWitness (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
eWitness)
              [(StakeAddress, Coin,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))]
mappedWithdrawals

    mapScriptWitnessesCertificates
      :: TxCertificates (LedgerEra era)
      -> Either (TxBodyErrorAutoBalance (LedgerEra era)) (TxCertificates (LedgerEra era))
    mapScriptWitnessesCertificates :: TxCertificates (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxCertificates (LedgerEra era))
mapScriptWitnessesCertificates TxCertificates (LedgerEra era)
txCertificates' = do
      let mappedScriptWitnesses
            :: [ ( Exp.Certificate (LedgerEra era)
                 , Either
                     (TxBodyErrorAutoBalance (LedgerEra era))
                     ( Maybe
                         ( StakeCredential
                         , AnyWitness (LedgerEra era)
                         )
                     )
                 )
               ]
          mappedScriptWitnesses :: [(Certificate (LedgerEra era),
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (Maybe (StakeCredential, AnyWitness (LedgerEra era))))]
mappedScriptWitnesses =
            [ (Certificate (LedgerEra era)
cert, (StakeCredential, AnyWitness (LedgerEra era))
-> Maybe (StakeCredential, AnyWitness (LedgerEra era))
forall a. a -> Maybe a
Just ((StakeCredential, AnyWitness (LedgerEra era))
 -> Maybe (StakeCredential, AnyWitness (LedgerEra era)))
-> (AnyWitness (LedgerEra era)
    -> (StakeCredential, AnyWitness (LedgerEra era)))
-> AnyWitness (LedgerEra era)
-> Maybe (StakeCredential, AnyWitness (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StakeCredential
stakeCred,) (AnyWitness (LedgerEra era)
 -> Maybe (StakeCredential, AnyWitness (LedgerEra era)))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (Maybe (StakeCredential, AnyWitness (LedgerEra era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
eWitness')
            | (ScriptWitnessIndex
ix, Certificate (LedgerEra era)
cert, StakeCredential
stakeCred, AnyWitness (LedgerEra era)
wit) <- TxCertificates (LedgerEra era)
-> [(ScriptWitnessIndex, Certificate (LedgerEra era),
     StakeCredential, AnyWitness (LedgerEra era))]
forall era.
TxCertificates (LedgerEra era)
-> [(ScriptWitnessIndex, Certificate (LedgerEra era),
     StakeCredential, AnyWitness (LedgerEra era))]
indexTxCertificates TxCertificates (LedgerEra era)
txCertificates'
            , let eWitness' :: Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
eWitness' = ScriptWitnessIndex
-> AnyWitness (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
substituteExecUnits ScriptWitnessIndex
ix AnyWitness (LedgerEra era)
wit
            ]
      OMap
  (Certificate (LedgerEra era))
  (Maybe (StakeCredential, AnyWitness (LedgerEra era)))
-> TxCertificates (LedgerEra era)
forall era.
OMap (Certificate era) (Maybe (StakeCredential, AnyWitness era))
-> TxCertificates era
TxCertificates (OMap
   (Certificate (LedgerEra era))
   (Maybe (StakeCredential, AnyWitness (LedgerEra era)))
 -> TxCertificates (LedgerEra era))
-> ([(Certificate (LedgerEra era),
      Maybe (StakeCredential, AnyWitness (LedgerEra era)))]
    -> OMap
         (Certificate (LedgerEra era))
         (Maybe (StakeCredential, AnyWitness (LedgerEra era))))
-> [(Certificate (LedgerEra era),
     Maybe (StakeCredential, AnyWitness (LedgerEra era)))]
-> TxCertificates (LedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Certificate (LedgerEra era),
  Maybe (StakeCredential, AnyWitness (LedgerEra era)))]
-> OMap
     (Certificate (LedgerEra era))
     (Maybe (StakeCredential, AnyWitness (LedgerEra era)))
[Item
   (OMap
      (Certificate (LedgerEra era))
      (Maybe (StakeCredential, AnyWitness (LedgerEra era))))]
-> OMap
     (Certificate (LedgerEra era))
     (Maybe (StakeCredential, AnyWitness (LedgerEra era)))
forall l. IsList l => [Item l] -> l
fromList ([(Certificate (LedgerEra era),
   Maybe (StakeCredential, AnyWitness (LedgerEra era)))]
 -> TxCertificates (LedgerEra era))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [(Certificate (LedgerEra era),
       Maybe (StakeCredential, AnyWitness (LedgerEra era)))]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxCertificates (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Certificate (LedgerEra era),
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (Maybe (StakeCredential, AnyWitness (LedgerEra era))))]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [(Certificate (LedgerEra era),
       Maybe (StakeCredential, AnyWitness (LedgerEra era)))]
forall a era b.
[(a, Either (TxBodyErrorAutoBalance (LedgerEra era)) b)]
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) [(a, b)]
traverseScriptWitnesses [(Certificate (LedgerEra era),
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (Maybe (StakeCredential, AnyWitness (LedgerEra era))))]
mappedScriptWitnesses

    mapScriptWitnessesMinting
      :: TxMintValue (LedgerEra era)
      -> Either (TxBodyErrorAutoBalance (LedgerEra era)) (TxMintValue (LedgerEra era))
    mapScriptWitnessesMinting :: TxMintValue (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxMintValue (LedgerEra era))
mapScriptWitnessesMinting TxMintValue (LedgerEra era)
txMintValue' = do
      let mappedScriptWitnesses :: [(PolicyId,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (PolicyAssets, AnyWitness (LedgerEra era)))]
mappedScriptWitnesses =
            [ (PolicyId
policyId, (PolicyAssets
assets,) (AnyWitness (LedgerEra era)
 -> (PolicyAssets, AnyWitness (LedgerEra era)))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (PolicyAssets, AnyWitness (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
substitutedWitness)
            | (ScriptWitnessIndex
ix, PolicyId
policyId, PolicyAssets
assets, AnyWitness (LedgerEra era)
wit) <- TxMintValue (LedgerEra era)
-> [(ScriptWitnessIndex, PolicyId, PolicyAssets,
     AnyWitness (LedgerEra era))]
forall era.
TxMintValue era
-> [(ScriptWitnessIndex, PolicyId, PolicyAssets, AnyWitness era)]
indexTxMintValue TxMintValue (LedgerEra era)
txMintValue'
            , let substitutedWitness :: Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
substitutedWitness = ScriptWitnessIndex
-> AnyWitness (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
substituteExecUnits ScriptWitnessIndex
ix AnyWitness (LedgerEra era)
wit
            ]
          -- merge map values, wit1 == wit2 will always hold
          mergeValues :: (a, b) -> (a, b) -> (a, b)
mergeValues (a
assets1, b
wit1) (a
assets2, b
_wit2) = (a
assets1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
assets2, b
wit1)
      final <- ((PolicyAssets, AnyWitness (LedgerEra era))
 -> (PolicyAssets, AnyWitness (LedgerEra era))
 -> (PolicyAssets, AnyWitness (LedgerEra era)))
-> [(PolicyId, (PolicyAssets, AnyWitness (LedgerEra era)))]
-> Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (PolicyAssets, AnyWitness (LedgerEra era))
-> (PolicyAssets, AnyWitness (LedgerEra era))
-> (PolicyAssets, AnyWitness (LedgerEra era))
forall {a} {b} {b}. Semigroup a => (a, b) -> (a, b) -> (a, b)
mergeValues ([(PolicyId, (PolicyAssets, AnyWitness (LedgerEra era)))]
 -> Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era)))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [(PolicyId, (PolicyAssets, AnyWitness (LedgerEra era)))]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PolicyId,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (PolicyAssets, AnyWitness (LedgerEra era)))]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [(PolicyId, (PolicyAssets, AnyWitness (LedgerEra era)))]
forall a era b.
[(a, Either (TxBodyErrorAutoBalance (LedgerEra era)) b)]
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) [(a, b)]
traverseScriptWitnesses [(PolicyId,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (PolicyAssets, AnyWitness (LedgerEra era)))]
mappedScriptWitnesses
      pure $ TxMintValue final

    mapScriptWitnessesVotes
      :: Maybe (TxVotingProcedures (LedgerEra era))
      -> Either
           (TxBodyErrorAutoBalance (LedgerEra era))
           (TxVotingProcedures (LedgerEra era))
    mapScriptWitnessesVotes :: Maybe (TxVotingProcedures (LedgerEra era))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxVotingProcedures (LedgerEra era))
mapScriptWitnessesVotes Maybe (TxVotingProcedures (LedgerEra era))
Nothing = TxVotingProcedures (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxVotingProcedures (LedgerEra era))
forall a. a -> Either (TxBodyErrorAutoBalance (LedgerEra era)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxVotingProcedures (LedgerEra era)
 -> Either
      (TxBodyErrorAutoBalance (LedgerEra era))
      (TxVotingProcedures (LedgerEra era)))
-> TxVotingProcedures (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxVotingProcedures (LedgerEra era))
forall a b. (a -> b) -> a -> b
$ VotingProcedures (LedgerEra era)
-> Map Voter (AnyWitness (LedgerEra era))
-> TxVotingProcedures (LedgerEra era)
forall era.
VotingProcedures era
-> Map Voter (AnyWitness era) -> TxVotingProcedures era
TxVotingProcedures (Map Voter (Map GovActionId (VotingProcedure (LedgerEra era)))
-> VotingProcedures (LedgerEra era)
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
L.VotingProcedures Map Voter (Map GovActionId (VotingProcedure (LedgerEra era)))
forall a. Monoid a => a
mempty) Map Voter (AnyWitness (LedgerEra era))
forall a. Monoid a => a
mempty
    mapScriptWitnessesVotes (Just v :: TxVotingProcedures (LedgerEra era)
v@(TxVotingProcedures VotingProcedures (LedgerEra era)
vProcedures Map Voter (AnyWitness (LedgerEra era))
_)) = do
      let eSubstitutedExecutionUnits :: [(Voter,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))]
eSubstitutedExecutionUnits =
            [ (Voter
vote, Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
updatedWitness)
            | (ScriptWitnessIndex
ix, Voter
vote, AnyWitness (LedgerEra era)
wit) <- TxVotingProcedures (LedgerEra era)
-> [(ScriptWitnessIndex, Voter, AnyWitness (LedgerEra era))]
forall era.
TxVotingProcedures era
-> [(ScriptWitnessIndex, Voter, AnyWitness era)]
indexTxVotingProcedures TxVotingProcedures (LedgerEra era)
v
            , let updatedWitness :: Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
updatedWitness = ScriptWitnessIndex
-> AnyWitness (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
substituteExecUnits ScriptWitnessIndex
ix AnyWitness (LedgerEra era)
wit
            ]

      substitutedExecutionUnits <- [(Voter,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [(Voter, AnyWitness (LedgerEra era))]
forall a era b.
[(a, Either (TxBodyErrorAutoBalance (LedgerEra era)) b)]
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) [(a, b)]
traverseScriptWitnesses [(Voter,
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))]
eSubstitutedExecutionUnits

      return
        (TxVotingProcedures vProcedures (fromList substitutedExecutionUnits))

    mapScriptWitnessesProposals
      :: Maybe (TxProposalProcedures (LedgerEra era))
      -> Either
           (TxBodyErrorAutoBalance (LedgerEra era))
           (TxProposalProcedures (LedgerEra era))
    mapScriptWitnessesProposals :: Maybe (TxProposalProcedures (LedgerEra era))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxProposalProcedures (LedgerEra era))
mapScriptWitnessesProposals Maybe (TxProposalProcedures (LedgerEra era))
Nothing = TxProposalProcedures (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxProposalProcedures (LedgerEra era))
forall a. a -> Either (TxBodyErrorAutoBalance (LedgerEra era)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxProposalProcedures (LedgerEra era)
 -> Either
      (TxBodyErrorAutoBalance (LedgerEra era))
      (TxProposalProcedures (LedgerEra era)))
-> TxProposalProcedures (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (TxProposalProcedures (LedgerEra era))
forall a b. (a -> b) -> a -> b
$ OMap
  (ProposalProcedure (LedgerEra era)) (AnyWitness (LedgerEra era))
-> TxProposalProcedures (LedgerEra era)
forall era.
OMap (ProposalProcedure era) (AnyWitness era)
-> TxProposalProcedures era
TxProposalProcedures OMap
  (ProposalProcedure (LedgerEra era)) (AnyWitness (LedgerEra era))
forall k v. OMap k v
OMap.empty
    mapScriptWitnessesProposals (Just TxProposalProcedures (LedgerEra era)
proposals) = do
      let indexed :: [(ProposalProcedure (LedgerEra era),
  (ScriptWitnessIndex, AnyWitness (LedgerEra era)))]
indexed = TxProposalProcedures (LedgerEra era)
-> [(ProposalProcedure (LedgerEra era),
     (ScriptWitnessIndex, AnyWitness (LedgerEra era)))]
forall era.
IsEra era =>
TxProposalProcedures (LedgerEra era)
-> [(ProposalProcedure (LedgerEra era),
     (ScriptWitnessIndex, AnyWitness (LedgerEra era)))]
indexWitnessedTxProposalProcedures TxProposalProcedures (LedgerEra era)
proposals
          eSubstitutedExecutionUnits :: [(ProposalProcedure (LedgerEra era),
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))]
eSubstitutedExecutionUnits =
            [ (ProposalProcedure (LedgerEra era)
p, Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
updatedWit)
            | (ProposalProcedure (LedgerEra era)
p, (ScriptWitnessIndex
i, AnyWitness (LedgerEra era)
wit)) <- [(ProposalProcedure (LedgerEra era),
  (ScriptWitnessIndex, AnyWitness (LedgerEra era)))]
indexed
            , let updatedWit :: Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (AnyWitness (LedgerEra era))
updatedWit = ScriptWitnessIndex
-> AnyWitness (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (AnyWitness (LedgerEra era))
substituteExecUnits ScriptWitnessIndex
i AnyWitness (LedgerEra era)
wit
            ]
      substitutedExecutionUnits <- [(ProposalProcedure (LedgerEra era),
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [(ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era))]
forall a era b.
[(a, Either (TxBodyErrorAutoBalance (LedgerEra era)) b)]
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) [(a, b)]
traverseScriptWitnesses [(ProposalProcedure (LedgerEra era),
  Either
    (TxBodyErrorAutoBalance (LedgerEra era))
    (AnyWitness (LedgerEra era)))]
eSubstitutedExecutionUnits
      pure $
        mkTxProposalProcedures substitutedExecutionUnits

collectTxBodyScriptWitnesses
  :: forall era
   . IsEra era
  => TxBodyContent (LedgerEra era)
  -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
collectTxBodyScriptWitnesses :: forall era.
IsEra era =>
TxBodyContent (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
collectTxBodyScriptWitnesses
  TxBodyContent
    { [(TxIn, AnyWitness (LedgerEra era))]
txIns :: forall era. TxBodyContent era -> [(TxIn, AnyWitness era)]
txIns :: [(TxIn, AnyWitness (LedgerEra era))]
txIns
    , TxWithdrawals (LedgerEra era)
txWithdrawals :: TxWithdrawals (LedgerEra era)
txWithdrawals :: forall era. TxBodyContent era -> TxWithdrawals era
txWithdrawals
    , TxCertificates (LedgerEra era)
txCertificates :: forall era. TxBodyContent era -> TxCertificates era
txCertificates :: TxCertificates (LedgerEra era)
txCertificates
    , TxMintValue (LedgerEra era)
txMintValue :: forall era. TxBodyContent era -> TxMintValue era
txMintValue :: TxMintValue (LedgerEra era)
txMintValue
    , Maybe (TxVotingProcedures (LedgerEra era))
txVotingProcedures :: Maybe (TxVotingProcedures (LedgerEra era))
txVotingProcedures :: forall era. TxBodyContent era -> Maybe (TxVotingProcedures era)
txVotingProcedures
    , Maybe (TxProposalProcedures (LedgerEra era))
txProposalProcedures :: forall era. TxBodyContent era -> Maybe (TxProposalProcedures era)
txProposalProcedures :: Maybe (TxProposalProcedures (LedgerEra era))
txProposalProcedures
    } =
    [[(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]]
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [(TxIn, AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesTxIns [(TxIn, AnyWitness (LedgerEra era))]
txIns
      , TxWithdrawals (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesWithdrawals TxWithdrawals (LedgerEra era)
txWithdrawals
      , TxCertificates (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesCertificates TxCertificates (LedgerEra era)
txCertificates
      , TxMintValue (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesMinting TxMintValue (LedgerEra era)
txMintValue
      , [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
-> (TxVotingProcedures (LedgerEra era)
    -> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))])
-> Maybe (TxVotingProcedures (LedgerEra era))
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] TxVotingProcedures (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesVoting Maybe (TxVotingProcedures (LedgerEra era))
txVotingProcedures
      , [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
-> (TxProposalProcedures (LedgerEra era)
    -> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))])
-> Maybe (TxProposalProcedures (LedgerEra era))
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] TxProposalProcedures (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesProposing Maybe (TxProposalProcedures (LedgerEra era))
txProposalProcedures
      ]
   where
    scriptWitnessesTxIns
      :: [(TxIn, AnyWitness (LedgerEra era))]
      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
    scriptWitnessesTxIns :: [(TxIn, AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesTxIns [(TxIn, AnyWitness (LedgerEra era))]
txIns' =
      [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
forall a. Eq a => [a] -> [a]
List.nub
        [ (ScriptWitnessIndex
ix, AnyScriptWitness (LedgerEra era)
wit)
        | (ScriptWitnessIndex
ix, TxIn
_, Just wit :: AnyScriptWitness (LedgerEra era)
wit@AnyScriptWitnessPlutus{}) <- (AnyWitness (LedgerEra era)
 -> Maybe (AnyScriptWitness (LedgerEra era)))
-> (ScriptWitnessIndex, TxIn, AnyWitness (LedgerEra era))
-> (ScriptWitnessIndex, TxIn,
    Maybe (AnyScriptWitness (LedgerEra era)))
forall a b.
(a -> b)
-> (ScriptWitnessIndex, TxIn, a) -> (ScriptWitnessIndex, TxIn, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnyWitness (LedgerEra era)
-> Maybe (AnyScriptWitness (LedgerEra era))
forall era. AnyWitness era -> Maybe (AnyScriptWitness era)
toAnyScriptWitness ((ScriptWitnessIndex, TxIn, AnyWitness (LedgerEra era))
 -> (ScriptWitnessIndex, TxIn,
     Maybe (AnyScriptWitness (LedgerEra era))))
-> [(ScriptWitnessIndex, TxIn, AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, TxIn,
     Maybe (AnyScriptWitness (LedgerEra era)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxIn, AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, TxIn, AnyWitness (LedgerEra era))]
forall era.
[(TxIn, AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, TxIn, AnyWitness (LedgerEra era))]
indexTxIns [(TxIn, AnyWitness (LedgerEra era))]
txIns'
        ]

    scriptWitnessesWithdrawals
      :: TxWithdrawals (LedgerEra era)
      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
    scriptWitnessesWithdrawals :: TxWithdrawals (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesWithdrawals TxWithdrawals (LedgerEra era)
txw =
      [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
forall a. Eq a => [a] -> [a]
List.nub
        [ (ScriptWitnessIndex
ix, AnyScriptWitness (LedgerEra era)
wit)
        | (ScriptWitnessIndex
ix, StakeAddress
_, Coin
_, Just wit :: AnyScriptWitness (LedgerEra era)
wit@AnyScriptWitnessPlutus{}) <- (AnyWitness (LedgerEra era)
 -> Maybe (AnyScriptWitness (LedgerEra era)))
-> (ScriptWitnessIndex, StakeAddress, Coin,
    AnyWitness (LedgerEra era))
-> (ScriptWitnessIndex, StakeAddress, Coin,
    Maybe (AnyScriptWitness (LedgerEra era)))
forall a b.
(a -> b)
-> (ScriptWitnessIndex, StakeAddress, Coin, a)
-> (ScriptWitnessIndex, StakeAddress, Coin, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnyWitness (LedgerEra era)
-> Maybe (AnyScriptWitness (LedgerEra era))
forall era. AnyWitness era -> Maybe (AnyScriptWitness era)
toAnyScriptWitness ((ScriptWitnessIndex, StakeAddress, Coin,
  AnyWitness (LedgerEra era))
 -> (ScriptWitnessIndex, StakeAddress, Coin,
     Maybe (AnyScriptWitness (LedgerEra era))))
-> [(ScriptWitnessIndex, StakeAddress, Coin,
     AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, StakeAddress, Coin,
     Maybe (AnyScriptWitness (LedgerEra era)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxWithdrawals (LedgerEra era)
-> [(ScriptWitnessIndex, StakeAddress, Coin,
     AnyWitness (LedgerEra era))]
forall era.
TxWithdrawals era
-> [(ScriptWitnessIndex, StakeAddress, Coin, AnyWitness era)]
indexTxWithdrawals TxWithdrawals (LedgerEra era)
txw
        ]
    -- TODO: If this works you need to change the rest!
    scriptWitnessesCertificates
      :: TxCertificates (LedgerEra era)
      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
    scriptWitnessesCertificates :: TxCertificates (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesCertificates TxCertificates (LedgerEra era)
txc =
      [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
forall a. Eq a => [a] -> [a]
List.nub
        [ (ScriptWitnessIndex
ix, AnyScriptWitness (LedgerEra era)
wit)
        | (ScriptWitnessIndex
ix, Certificate (LedgerEra era)
_, StakeCredential
_, Just wit :: AnyScriptWitness (LedgerEra era)
wit@AnyScriptWitnessPlutus{}) <-
            (AnyWitness (LedgerEra era)
 -> Maybe (AnyScriptWitness (LedgerEra era)))
-> (ScriptWitnessIndex, Certificate (LedgerEra era),
    StakeCredential, AnyWitness (LedgerEra era))
-> (ScriptWitnessIndex, Certificate (LedgerEra era),
    StakeCredential, Maybe (AnyScriptWitness (LedgerEra era)))
forall a b.
(a -> b)
-> (ScriptWitnessIndex, Certificate (LedgerEra era),
    StakeCredential, a)
-> (ScriptWitnessIndex, Certificate (LedgerEra era),
    StakeCredential, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnyWitness (LedgerEra era)
-> Maybe (AnyScriptWitness (LedgerEra era))
forall era. AnyWitness era -> Maybe (AnyScriptWitness era)
toAnyScriptWitness ((ScriptWitnessIndex, Certificate (LedgerEra era), StakeCredential,
  AnyWitness (LedgerEra era))
 -> (ScriptWitnessIndex, Certificate (LedgerEra era),
     StakeCredential, Maybe (AnyScriptWitness (LedgerEra era))))
-> [(ScriptWitnessIndex, Certificate (LedgerEra era),
     StakeCredential, AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, Certificate (LedgerEra era),
     StakeCredential, Maybe (AnyScriptWitness (LedgerEra era)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxCertificates (LedgerEra era)
-> [(ScriptWitnessIndex, Certificate (LedgerEra era),
     StakeCredential, AnyWitness (LedgerEra era))]
forall era.
TxCertificates (LedgerEra era)
-> [(ScriptWitnessIndex, Certificate (LedgerEra era),
     StakeCredential, AnyWitness (LedgerEra era))]
indexTxCertificates TxCertificates (LedgerEra era)
txc
        ]

    scriptWitnessesMinting
      :: TxMintValue (LedgerEra era)
      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
    scriptWitnessesMinting :: TxMintValue (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesMinting TxMintValue (LedgerEra era)
txMintValue' =
      [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
forall a. Eq a => [a] -> [a]
List.nub
        [ (ScriptWitnessIndex
ix, AnyScriptWitness (LedgerEra era)
wit)
        | (ScriptWitnessIndex
ix, PolicyId
_, PolicyAssets
_, Just wit :: AnyScriptWitness (LedgerEra era)
wit@AnyScriptWitnessPlutus{}) <-
            (AnyWitness (LedgerEra era)
 -> Maybe (AnyScriptWitness (LedgerEra era)))
-> (ScriptWitnessIndex, PolicyId, PolicyAssets,
    AnyWitness (LedgerEra era))
-> (ScriptWitnessIndex, PolicyId, PolicyAssets,
    Maybe (AnyScriptWitness (LedgerEra era)))
forall a b.
(a -> b)
-> (ScriptWitnessIndex, PolicyId, PolicyAssets, a)
-> (ScriptWitnessIndex, PolicyId, PolicyAssets, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnyWitness (LedgerEra era)
-> Maybe (AnyScriptWitness (LedgerEra era))
forall era. AnyWitness era -> Maybe (AnyScriptWitness era)
toAnyScriptWitness ((ScriptWitnessIndex, PolicyId, PolicyAssets,
  AnyWitness (LedgerEra era))
 -> (ScriptWitnessIndex, PolicyId, PolicyAssets,
     Maybe (AnyScriptWitness (LedgerEra era))))
-> [(ScriptWitnessIndex, PolicyId, PolicyAssets,
     AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, PolicyId, PolicyAssets,
     Maybe (AnyScriptWitness (LedgerEra era)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxMintValue (LedgerEra era)
-> [(ScriptWitnessIndex, PolicyId, PolicyAssets,
     AnyWitness (LedgerEra era))]
forall era.
TxMintValue era
-> [(ScriptWitnessIndex, PolicyId, PolicyAssets, AnyWitness era)]
indexTxMintValue TxMintValue (LedgerEra era)
txMintValue'
        ]

    scriptWitnessesVoting
      :: TxVotingProcedures (LedgerEra era)
      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
    scriptWitnessesVoting :: TxVotingProcedures (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesVoting TxVotingProcedures (LedgerEra era)
txv =
      [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
forall a. Eq a => [a] -> [a]
List.nub
        [ (ScriptWitnessIndex
ix, AnyScriptWitness (LedgerEra era)
wit)
        | (ScriptWitnessIndex
ix, Voter
_, Just wit :: AnyScriptWitness (LedgerEra era)
wit@AnyScriptWitnessPlutus{}) <-
            (AnyWitness (LedgerEra era)
 -> Maybe (AnyScriptWitness (LedgerEra era)))
-> (ScriptWitnessIndex, Voter, AnyWitness (LedgerEra era))
-> (ScriptWitnessIndex, Voter,
    Maybe (AnyScriptWitness (LedgerEra era)))
forall a b.
(a -> b)
-> (ScriptWitnessIndex, Voter, a) -> (ScriptWitnessIndex, Voter, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnyWitness (LedgerEra era)
-> Maybe (AnyScriptWitness (LedgerEra era))
forall era. AnyWitness era -> Maybe (AnyScriptWitness era)
toAnyScriptWitness ((ScriptWitnessIndex, Voter, AnyWitness (LedgerEra era))
 -> (ScriptWitnessIndex, Voter,
     Maybe (AnyScriptWitness (LedgerEra era))))
-> [(ScriptWitnessIndex, Voter, AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, Voter,
     Maybe (AnyScriptWitness (LedgerEra era)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxVotingProcedures (LedgerEra era)
-> [(ScriptWitnessIndex, Voter, AnyWitness (LedgerEra era))]
forall era.
TxVotingProcedures era
-> [(ScriptWitnessIndex, Voter, AnyWitness era)]
indexTxVotingProcedures TxVotingProcedures (LedgerEra era)
txv
        ]

    scriptWitnessesProposing
      :: TxProposalProcedures (LedgerEra era)
      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
    scriptWitnessesProposing :: TxProposalProcedures (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
scriptWitnessesProposing TxProposalProcedures (LedgerEra era)
txp =
      [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
forall a. Eq a => [a] -> [a]
List.nub
        [ (ScriptWitnessIndex
ix, AnyScriptWitness (LedgerEra era)
wit)
        | (ProposalProcedure (LedgerEra era)
_, (ScriptWitnessIndex
ix, Just wit :: AnyScriptWitness (LedgerEra era)
wit@AnyScriptWitnessPlutus{})) <-
            (((ScriptWitnessIndex, AnyWitness (LedgerEra era))
 -> (ScriptWitnessIndex, Maybe (AnyScriptWitness (LedgerEra era))))
-> (ProposalProcedure (LedgerEra era),
    (ScriptWitnessIndex, AnyWitness (LedgerEra era)))
-> (ProposalProcedure (LedgerEra era),
    (ScriptWitnessIndex, Maybe (AnyScriptWitness (LedgerEra era))))
forall a b.
(a -> b)
-> (ProposalProcedure (LedgerEra era), a)
-> (ProposalProcedure (LedgerEra era), b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((ScriptWitnessIndex, AnyWitness (LedgerEra era))
  -> (ScriptWitnessIndex, Maybe (AnyScriptWitness (LedgerEra era))))
 -> (ProposalProcedure (LedgerEra era),
     (ScriptWitnessIndex, AnyWitness (LedgerEra era)))
 -> (ProposalProcedure (LedgerEra era),
     (ScriptWitnessIndex, Maybe (AnyScriptWitness (LedgerEra era)))))
-> ((AnyWitness (LedgerEra era)
     -> Maybe (AnyScriptWitness (LedgerEra era)))
    -> (ScriptWitnessIndex, AnyWitness (LedgerEra era))
    -> (ScriptWitnessIndex, Maybe (AnyScriptWitness (LedgerEra era))))
-> (AnyWitness (LedgerEra era)
    -> Maybe (AnyScriptWitness (LedgerEra era)))
-> (ProposalProcedure (LedgerEra era),
    (ScriptWitnessIndex, AnyWitness (LedgerEra era)))
-> (ProposalProcedure (LedgerEra era),
    (ScriptWitnessIndex, Maybe (AnyScriptWitness (LedgerEra era))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnyWitness (LedgerEra era)
 -> Maybe (AnyScriptWitness (LedgerEra era)))
-> (ScriptWitnessIndex, AnyWitness (LedgerEra era))
-> (ScriptWitnessIndex, Maybe (AnyScriptWitness (LedgerEra era)))
forall a b.
(a -> b) -> (ScriptWitnessIndex, a) -> (ScriptWitnessIndex, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) AnyWitness (LedgerEra era)
-> Maybe (AnyScriptWitness (LedgerEra era))
forall era. AnyWitness era -> Maybe (AnyScriptWitness era)
toAnyScriptWitness ((ProposalProcedure (LedgerEra era),
  (ScriptWitnessIndex, AnyWitness (LedgerEra era)))
 -> (ProposalProcedure (LedgerEra era),
     (ScriptWitnessIndex, Maybe (AnyScriptWitness (LedgerEra era)))))
-> [(ProposalProcedure (LedgerEra era),
     (ScriptWitnessIndex, AnyWitness (LedgerEra era)))]
-> [(ProposalProcedure (LedgerEra era),
     (ScriptWitnessIndex, Maybe (AnyScriptWitness (LedgerEra era))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxProposalProcedures (LedgerEra era)
-> [(ProposalProcedure (LedgerEra era),
     (ScriptWitnessIndex, AnyWitness (LedgerEra era)))]
forall era.
IsEra era =>
TxProposalProcedures (LedgerEra era)
-> [(ProposalProcedure (LedgerEra era),
     (ScriptWitnessIndex, AnyWitness (LedgerEra era)))]
indexWitnessedTxProposalProcedures TxProposalProcedures (LedgerEra era)
txp
        ]

toAnyScriptWitness :: AnyWitness era -> Maybe (Exp.AnyScriptWitness era)
toAnyScriptWitness :: forall era. AnyWitness era -> Maybe (AnyScriptWitness era)
toAnyScriptWitness AnyWitness era
AnyKeyWitnessPlaceholder = Maybe (AnyScriptWitness era)
forall a. Maybe a
Nothing
toAnyScriptWitness (AnySimpleScriptWitness SimpleScriptOrReferenceInput era
ssw) = AnyScriptWitness era -> Maybe (AnyScriptWitness era)
forall a. a -> Maybe a
Just (AnyScriptWitness era -> Maybe (AnyScriptWitness era))
-> AnyScriptWitness era -> Maybe (AnyScriptWitness era)
forall a b. (a -> b) -> a -> b
$ SimpleScriptOrReferenceInput era -> AnyScriptWitness era
forall era.
SimpleScriptOrReferenceInput era -> AnyScriptWitness era
AnyScriptWitnessSimple SimpleScriptOrReferenceInput era
ssw
toAnyScriptWitness (AnyPlutusScriptWitness AnyPlutusScriptWitness lang purpose era
psw) = AnyScriptWitness era -> Maybe (AnyScriptWitness era)
forall a. a -> Maybe a
Just (AnyScriptWitness era -> Maybe (AnyScriptWitness era))
-> AnyScriptWitness era -> Maybe (AnyScriptWitness era)
forall a b. (a -> b) -> a -> b
$ AnyPlutusScriptWitness lang purpose era -> AnyScriptWitness era
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyScriptWitness era
AnyScriptWitnessPlutus AnyPlutusScriptWitness lang purpose era
psw

traverseScriptWitnesses
  :: [(a, Either (TxBodyErrorAutoBalance (LedgerEra era)) b)]
  -> Either (TxBodyErrorAutoBalance (LedgerEra era)) [(a, b)]
traverseScriptWitnesses :: forall a era b.
[(a, Either (TxBodyErrorAutoBalance (LedgerEra era)) b)]
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) [(a, b)]
traverseScriptWitnesses =
  ((a, Either (TxBodyErrorAutoBalance (LedgerEra era)) b)
 -> Either (TxBodyErrorAutoBalance (LedgerEra era)) (a, b))
-> [(a, Either (TxBodyErrorAutoBalance (LedgerEra era)) b)]
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) [(a, b)]
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 (\(a
item, Either (TxBodyErrorAutoBalance (LedgerEra era)) b
eRes) -> Either (TxBodyErrorAutoBalance (LedgerEra era)) b
eRes Either (TxBodyErrorAutoBalance (LedgerEra era)) b
-> (b -> Either (TxBodyErrorAutoBalance (LedgerEra era)) (a, b))
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) (a, b)
forall a b.
Either (TxBodyErrorAutoBalance (LedgerEra era)) a
-> (a -> Either (TxBodyErrorAutoBalance (LedgerEra era)) b)
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\b
res -> (a, b) -> Either (TxBodyErrorAutoBalance (LedgerEra era)) (a, b)
forall a b. b -> Either a b
Right (a
item, b
res)))

-- | Index transaction inputs ordered by TxIn
-- Please note that the result can contain also 'KeyWitness'es.
-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf
indexTxIns
  :: [(TxIn, AnyWitness (LedgerEra era))]
  -> [(ScriptWitnessIndex, TxIn, AnyWitness (LedgerEra era))]
indexTxIns :: forall era.
[(TxIn, AnyWitness (LedgerEra era))]
-> [(ScriptWitnessIndex, TxIn, AnyWitness (LedgerEra era))]
indexTxIns [(TxIn, AnyWitness (LedgerEra era))]
txins =
  [ (Word32 -> ScriptWitnessIndex
ScriptWitnessIndexTxIn Word32
ix, TxIn
txIn, AnyWitness (LedgerEra era)
witness)
  | (Word32
ix, (TxIn
txIn, AnyWitness (LedgerEra era)
witness)) <- [Word32]
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [(Word32, (TxIn, AnyWitness (LedgerEra era)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] ([(TxIn, AnyWitness (LedgerEra era))]
 -> [(Word32, (TxIn, AnyWitness (LedgerEra era)))])
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [(Word32, (TxIn, AnyWitness (LedgerEra era)))]
forall a b. (a -> b) -> a -> b
$ [(TxIn, AnyWitness (LedgerEra era))]
-> [(TxIn, AnyWitness (LedgerEra era))]
forall v. [(TxIn, v)] -> [(TxIn, v)]
orderTxIns [(TxIn, AnyWitness (LedgerEra era))]
txins
  ]
 where
  -- This relies on the TxId Ord instance being consistent with the
  -- Ledger.TxId Ord instance via the toShelleyTxId conversion
  -- This is checked by prop_ord_distributive_TxId
  orderTxIns :: [(TxIn, v)] -> [(TxIn, v)]
  orderTxIns :: forall v. [(TxIn, v)] -> [(TxIn, v)]
orderTxIns = ((TxIn, v) -> (TxIn, v) -> Ordering) -> [(TxIn, v)] -> [(TxIn, v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (TxIn -> TxIn -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TxIn -> TxIn -> Ordering)
-> ((TxIn, v) -> TxIn) -> (TxIn, v) -> (TxIn, v) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (TxIn, v) -> TxIn
forall a b. (a, b) -> a
fst)

-- | Index the withdrawals with witnesses in the order of stake addresses.
-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf
indexTxWithdrawals
  :: TxWithdrawals era
  -> [(ScriptWitnessIndex, StakeAddress, L.Coin, AnyWitness era)]
indexTxWithdrawals :: forall era.
TxWithdrawals era
-> [(ScriptWitnessIndex, StakeAddress, Coin, AnyWitness era)]
indexTxWithdrawals (TxWithdrawals [(StakeAddress, Coin, AnyWitness era)]
withdrawals) =
  [ (Word32 -> ScriptWitnessIndex
ScriptWitnessIndexWithdrawal Word32
ix, StakeAddress
addr, Coin
coin, AnyWitness era
witness)
  | (Word32
ix, (StakeAddress
addr, Coin
coin, AnyWitness era
witness)) <- [Word32]
-> [(StakeAddress, Coin, AnyWitness era)]
-> [(Word32, (StakeAddress, Coin, AnyWitness era))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] ([(StakeAddress, Coin, AnyWitness era)]
-> [(StakeAddress, Coin, AnyWitness era)]
forall x v. [(StakeAddress, x, v)] -> [(StakeAddress, x, v)]
orderStakeAddrs [(StakeAddress, Coin, AnyWitness era)]
withdrawals)
  ]
 where
  -- This relies on the StakeAddress Ord instance being consistent with the
  -- Shelley.RewardAcnt Ord instance via the toShelleyStakeAddr conversion
  -- This is checked by prop_ord_distributive_StakeAddress
  orderStakeAddrs :: [(StakeAddress, x, v)] -> [(StakeAddress, x, v)]
  orderStakeAddrs :: forall x v. [(StakeAddress, x, v)] -> [(StakeAddress, x, v)]
orderStakeAddrs = ((StakeAddress, x, v) -> (StakeAddress, x, v) -> Ordering)
-> [(StakeAddress, x, v)] -> [(StakeAddress, x, v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (StakeAddress -> StakeAddress -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (StakeAddress -> StakeAddress -> Ordering)
-> ((StakeAddress, x, v) -> StakeAddress)
-> (StakeAddress, x, v)
-> (StakeAddress, x, v)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\(StakeAddress
k, x
_, v
_) -> StakeAddress
k))

-- | Index certificates with witnesses by the order they appear in the list (in the transaction).
-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf
indexTxCertificates
  :: TxCertificates (LedgerEra era)
  -> [ ( ScriptWitnessIndex
       , Exp.Certificate (LedgerEra era)
       , StakeCredential
       , AnyWitness (LedgerEra era)
       )
     ]
indexTxCertificates :: forall era.
TxCertificates (LedgerEra era)
-> [(ScriptWitnessIndex, Certificate (LedgerEra era),
     StakeCredential, AnyWitness (LedgerEra era))]
indexTxCertificates (TxCertificates OMap
  (Certificate (LedgerEra era))
  (Maybe (StakeCredential, AnyWitness (LedgerEra era)))
certsWits) =
  [ (Word32 -> ScriptWitnessIndex
ScriptWitnessIndexCertificate Word32
ix, Certificate (LedgerEra era)
cert, StakeCredential
stakeCred, AnyWitness (LedgerEra era)
witness)
  | (Word32
ix, (Certificate (LedgerEra era)
cert, Just (StakeCredential
stakeCred, AnyWitness (LedgerEra era)
witness))) <- [Word32]
-> [(Certificate (LedgerEra era),
     Maybe (StakeCredential, AnyWitness (LedgerEra era)))]
-> [(Word32,
     (Certificate (LedgerEra era),
      Maybe (StakeCredential, AnyWitness (LedgerEra era))))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] ([(Certificate (LedgerEra era),
   Maybe (StakeCredential, AnyWitness (LedgerEra era)))]
 -> [(Word32,
      (Certificate (LedgerEra era),
       Maybe (StakeCredential, AnyWitness (LedgerEra era))))])
-> [(Certificate (LedgerEra era),
     Maybe (StakeCredential, AnyWitness (LedgerEra era)))]
-> [(Word32,
     (Certificate (LedgerEra era),
      Maybe (StakeCredential, AnyWitness (LedgerEra era))))]
forall a b. (a -> b) -> a -> b
$ OMap
  (Certificate (LedgerEra era))
  (Maybe (StakeCredential, AnyWitness (LedgerEra era)))
-> [Item
      (OMap
         (Certificate (LedgerEra era))
         (Maybe (StakeCredential, AnyWitness (LedgerEra era))))]
forall l. IsList l => l -> [Item l]
toList OMap
  (Certificate (LedgerEra era))
  (Maybe (StakeCredential, AnyWitness (LedgerEra era)))
certsWits
  ]

-- | Index the assets with witnesses in the order of policy ids.
-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf
indexTxMintValue
  :: TxMintValue era
  -> [ ( ScriptWitnessIndex
       , PolicyId
       , PolicyAssets
       , AnyWitness era
       )
     ]
indexTxMintValue :: forall era.
TxMintValue era
-> [(ScriptWitnessIndex, PolicyId, PolicyAssets, AnyWitness era)]
indexTxMintValue (TxMintValue Map PolicyId (PolicyAssets, AnyWitness era)
policiesWithAssets) =
  [ (Word32 -> ScriptWitnessIndex
ScriptWitnessIndexMint Word32
ix, PolicyId
policyId, PolicyAssets
assets, AnyWitness era
witness)
  | (Word32
ix, (PolicyId
policyId, (PolicyAssets
assets, AnyWitness era
witness))) <- [Word32]
-> [(PolicyId, (PolicyAssets, AnyWitness era))]
-> [(Word32, (PolicyId, (PolicyAssets, AnyWitness era)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] ([(PolicyId, (PolicyAssets, AnyWitness era))]
 -> [(Word32, (PolicyId, (PolicyAssets, AnyWitness era)))])
-> [(PolicyId, (PolicyAssets, AnyWitness era))]
-> [(Word32, (PolicyId, (PolicyAssets, AnyWitness era)))]
forall a b. (a -> b) -> a -> b
$ Map PolicyId (PolicyAssets, AnyWitness era)
-> [Item (Map PolicyId (PolicyAssets, AnyWitness era))]
forall l. IsList l => l -> [Item l]
toList Map PolicyId (PolicyAssets, AnyWitness era)
policiesWithAssets
  ]

-- | Index voting procedures by the order of the votes ('Ord').
indexTxVotingProcedures
  :: TxVotingProcedures era
  -> [ ( ScriptWitnessIndex
       , L.Voter
       , AnyWitness era
       )
     ]
indexTxVotingProcedures :: forall era.
TxVotingProcedures era
-> [(ScriptWitnessIndex, Voter, AnyWitness era)]
indexTxVotingProcedures (TxVotingProcedures VotingProcedures era
vProcedures Map Voter (AnyWitness era)
sWitMap) =
  [ (Word32 -> ScriptWitnessIndex
ScriptWitnessIndexVoting (Word32 -> ScriptWitnessIndex) -> Word32 -> ScriptWitnessIndex
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index, Voter
vote, AnyWitness era
scriptWitness)
  | let allVoteMap :: Map Voter (Map GovActionId (VotingProcedure era))
allVoteMap = VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
L.unVotingProcedures VotingProcedures era
vProcedures
  , (Voter
vote, AnyWitness era
scriptWitness) <- Map Voter (AnyWitness era) -> [Item (Map Voter (AnyWitness era))]
forall l. IsList l => l -> [Item l]
toList Map Voter (AnyWitness era)
sWitMap
  , Int
index <- Maybe Int -> [Int]
forall a. Maybe a -> [a]
maybeToList (Maybe Int -> [Int]) -> Maybe Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Voter
-> Map Voter (Map GovActionId (VotingProcedure era)) -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex Voter
vote Map Voter (Map GovActionId (VotingProcedure era))
allVoteMap
  ]

-- | Index proposal procedures by their order ('Ord').
indexWitnessedTxProposalProcedures
  :: forall era
   . IsEra era
  => TxProposalProcedures (LedgerEra era)
  -> [ ( L.ProposalProcedure (LedgerEra era)
       , (ScriptWitnessIndex, AnyWitness (LedgerEra era))
       )
     ]
indexWitnessedTxProposalProcedures :: forall era.
IsEra era =>
TxProposalProcedures (LedgerEra era)
-> [(ProposalProcedure (LedgerEra era),
     (ScriptWitnessIndex, AnyWitness (LedgerEra era)))]
indexWitnessedTxProposalProcedures (TxProposalProcedures OMap
  (ProposalProcedure (LedgerEra era)) (AnyWitness (LedgerEra era))
proposals) = do
  let allProposalsList :: [(Word32,
  (ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era)))]
allProposalsList = [Word32]
-> [(ProposalProcedure (LedgerEra era),
     AnyWitness (LedgerEra era))]
-> [(Word32,
     (ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] ([(ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era))]
 -> [(Word32,
      (ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era)))])
-> [(ProposalProcedure (LedgerEra era),
     AnyWitness (LedgerEra era))]
-> [(Word32,
     (ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era)))]
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era =>
    [(ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era))])
-> [(ProposalProcedure (LedgerEra era),
     AnyWitness (LedgerEra era))]
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era =>
  [(ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era))])
 -> [(ProposalProcedure (LedgerEra era),
      AnyWitness (LedgerEra era))])
-> (EraCommonConstraints era =>
    [(ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era))])
-> [(ProposalProcedure (LedgerEra era),
     AnyWitness (LedgerEra era))]
forall a b. (a -> b) -> a -> b
$ OMap
  (ProposalProcedure (LedgerEra era)) (AnyWitness (LedgerEra era))
-> [Item
      (OMap
         (ProposalProcedure (LedgerEra era)) (AnyWitness (LedgerEra era)))]
forall l. IsList l => l -> [Item l]
toList OMap
  (ProposalProcedure (LedgerEra era)) (AnyWitness (LedgerEra era))
proposals
  [ (ProposalProcedure (LedgerEra era)
proposal, (Word32 -> ScriptWitnessIndex
ScriptWitnessIndexProposing Word32
ix, AnyWitness (LedgerEra era)
anyWitness))
    | (Word32
ix, (ProposalProcedure (LedgerEra era)
proposal, AnyWitness (LedgerEra era)
anyWitness)) <- [(Word32,
  (ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era)))]
allProposalsList
    ]

toUnsigned :: forall era. Era era -> L.Tx (LedgerEra era) -> UnsignedTx era
toUnsigned :: forall era. Era era -> Tx (LedgerEra era) -> UnsignedTx era
toUnsigned Era era
e Tx (LedgerEra era)
tx =
  Era era
-> (EraCommonConstraints era => UnsignedTx era) -> UnsignedTx era
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
e ((EraCommonConstraints era => UnsignedTx era) -> UnsignedTx era)
-> (EraCommonConstraints era => UnsignedTx era) -> UnsignedTx era
forall a b. (a -> b) -> a -> b
$
    Tx (LedgerEra era) -> UnsignedTx era
forall era.
EraTx (LedgerEra era) =>
Tx (LedgerEra era) -> UnsignedTx era
UnsignedTx Tx (LedgerEra era)
tx

-- | Compute the 'ExecutionUnits' required for each script in the transaction.
--
-- This process involves executing all scripts and counting the actual execution units
-- consumed.
evaluateTransactionExecutionUnits
  :: forall era
   . IsEra era
  => SystemStart
  -> LedgerEpochInfo
  -> L.PParams (LedgerEra era)
  -> L.UTxO (LedgerEra era)
  -> L.Tx (LedgerEra era)
  -> Map ScriptWitnessIndex (Either ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
evaluateTransactionExecutionUnits :: forall era.
IsEra era =>
SystemStart
-> LedgerEpochInfo
-> PParams (LedgerEra era)
-> UTxO (LedgerEra era)
-> Tx (LedgerEra era)
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
evaluateTransactionExecutionUnits SystemStart
systemstart LedgerEpochInfo
epochInfo PParams (LedgerEra era)
pp UTxO (LedgerEra era)
utxo Tx (LedgerEra era)
tx =
  Era era
-> (EraCommonConstraints era =>
    Map
      ScriptWitnessIndex
      (Either
         ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era =>
  Map
    ScriptWitnessIndex
    (Either
       ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
 -> Map
      ScriptWitnessIndex
      (Either
         ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
-> (EraCommonConstraints era =>
    Map
      ScriptWitnessIndex
      (Either
         ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
forall a b. (a -> b) -> a -> b
$
    Map
  (PlutusPurpose AsIx (LedgerEra era))
  (Either
     (TransactionScriptFailure (LedgerEra era))
     (EvalTxExecutionUnitsLog, ExUnits))
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
AlonzoEraScript (LedgerEra era) =>
Map
  (PlutusPurpose AsIx (LedgerEra era))
  (Either
     (TransactionScriptFailure (LedgerEra era))
     (EvalTxExecutionUnitsLog, ExUnits))
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
fromLedgerScriptExUnitsMap (Map
   (PlutusPurpose AsIx (LedgerEra era))
   (Either
      (TransactionScriptFailure (LedgerEra era))
      (EvalTxExecutionUnitsLog, ExUnits))
 -> Map
      ScriptWitnessIndex
      (Either
         ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
-> Map
     (PlutusPurpose AsIx (LedgerEra era))
     (Either
        (TransactionScriptFailure (LedgerEra era))
        (EvalTxExecutionUnitsLog, ExUnits))
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
forall a b. (a -> b) -> a -> b
$
      PParams (LedgerEra era)
-> Tx (LedgerEra era)
-> UTxO (LedgerEra era)
-> EpochInfo (Either Text)
-> SystemStart
-> Map
     (PlutusPurpose AsIx (LedgerEra era))
     (Either
        (TransactionScriptFailure (LedgerEra era))
        (EvalTxExecutionUnitsLog, ExUnits))
forall era.
(AlonzoEraTx era, EraUTxO era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
PParams era
-> Tx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> RedeemerReportWithLogs era
L.evalTxExUnitsWithLogs PParams (LedgerEra era)
pp Tx (LedgerEra era)
tx UTxO (LedgerEra era)
utxo EpochInfo (Either Text)
ledgerEpochInfo SystemStart
systemstart
 where
  LedgerEpochInfo EpochInfo (Either Text)
ledgerEpochInfo = LedgerEpochInfo
epochInfo

  fromLedgerScriptExUnitsMap
    :: L.AlonzoEraScript (LedgerEra era)
    => Map
         (L.PlutusPurpose L.AsIx (LedgerEra era))
         (Either (L.TransactionScriptFailure (LedgerEra era)) (EvalTxExecutionUnitsLog, L.ExUnits))
    -> Map ScriptWitnessIndex (Either ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
  fromLedgerScriptExUnitsMap :: AlonzoEraScript (LedgerEra era) =>
Map
  (PlutusPurpose AsIx (LedgerEra era))
  (Either
     (TransactionScriptFailure (LedgerEra era))
     (EvalTxExecutionUnitsLog, ExUnits))
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
fromLedgerScriptExUnitsMap Map
  (PlutusPurpose AsIx (LedgerEra era))
  (Either
     (TransactionScriptFailure (LedgerEra era))
     (EvalTxExecutionUnitsLog, ExUnits))
exmap =
    [Item
   (Map
      ScriptWitnessIndex
      (Either
         ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))]
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
forall l. IsList l => [Item l] -> l
fromList
      [ ( Era era
-> (EraCommonConstraints era => ScriptWitnessIndex)
-> ScriptWitnessIndex
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => ScriptWitnessIndex)
 -> ScriptWitnessIndex)
-> (EraCommonConstraints era => ScriptWitnessIndex)
-> ScriptWitnessIndex
forall a b. (a -> b) -> a -> b
$ AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
forall era.
AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
toScriptIndex (Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
useEra) PlutusPurpose AsIx (ShelleyLedgerEra era)
PlutusPurpose AsIx (LedgerEra era)
rdmrptr
        , (TransactionScriptFailure (LedgerEra era) -> ScriptExecutionError)
-> ((EvalTxExecutionUnitsLog, ExUnits)
    -> (EvalTxExecutionUnitsLog, ExecutionUnits))
-> Either
     (TransactionScriptFailure (LedgerEra era))
     (EvalTxExecutionUnitsLog, ExUnits)
-> Either
     ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap AlonzoEraScript (LedgerEra era) =>
TransactionScriptFailure (LedgerEra era) -> ScriptExecutionError
TransactionScriptFailure (LedgerEra era) -> ScriptExecutionError
fromAlonzoScriptExecutionError ((ExUnits -> ExecutionUnits)
-> (EvalTxExecutionUnitsLog, ExUnits)
-> (EvalTxExecutionUnitsLog, ExecutionUnits)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ExUnits -> ExecutionUnits
fromAlonzoExUnits) Either
  (TransactionScriptFailure (LedgerEra era))
  (EvalTxExecutionUnitsLog, ExUnits)
exunitsOrFailure
        )
      | (PlutusPurpose AsIx (LedgerEra era)
rdmrptr, Either
  (TransactionScriptFailure (LedgerEra era))
  (EvalTxExecutionUnitsLog, ExUnits)
exunitsOrFailure) <- Map
  (PlutusPurpose AsIx (LedgerEra era))
  (Either
     (TransactionScriptFailure (LedgerEra era))
     (EvalTxExecutionUnitsLog, ExUnits))
-> [Item
      (Map
         (PlutusPurpose AsIx (LedgerEra era))
         (Either
            (TransactionScriptFailure (LedgerEra era))
            (EvalTxExecutionUnitsLog, ExUnits)))]
forall l. IsList l => l -> [Item l]
toList Map
  (PlutusPurpose AsIx (LedgerEra era))
  (Either
     (TransactionScriptFailure (LedgerEra era))
     (EvalTxExecutionUnitsLog, ExUnits))
exmap
      ]

  fromAlonzoScriptExecutionError
    :: L.AlonzoEraScript (LedgerEra era)
    => L.TransactionScriptFailure (LedgerEra era)
    -> ScriptExecutionError
  fromAlonzoScriptExecutionError :: AlonzoEraScript (LedgerEra era) =>
TransactionScriptFailure (LedgerEra era) -> ScriptExecutionError
fromAlonzoScriptExecutionError =
    \case
      L.UnknownTxIn TxIn
txin -> TxIn -> ScriptExecutionError
ScriptErrorMissingTxIn TxIn
txin'
       where
        txin' :: TxIn
txin' = TxIn -> TxIn
fromShelleyTxIn TxIn
txin
      L.InvalidTxIn TxIn
txin -> TxIn -> ScriptExecutionError
ScriptErrorTxInWithoutDatum TxIn
txin'
       where
        txin' :: TxIn
txin' = TxIn -> TxIn
fromShelleyTxIn TxIn
txin
      L.MissingDatum DataHash
dh -> Hash ScriptData -> ScriptExecutionError
ScriptErrorWrongDatum (DataHash -> Hash ScriptData
ScriptDataHash DataHash
dh)
      L.ValidationFailure ExUnits
execUnits EvaluationError
evalErr EvalTxExecutionUnitsLog
logs PlutusWithContext
scriptWithContext ->
        DebugPlutusFailure -> ScriptExecutionError
ScriptErrorEvaluationFailed (DebugPlutusFailure -> ScriptExecutionError)
-> DebugPlutusFailure -> ScriptExecutionError
forall a b. (a -> b) -> a -> b
$ EvaluationError
-> PlutusWithContext
-> ExUnits
-> EvalTxExecutionUnitsLog
-> DebugPlutusFailure
DebugPlutusFailure EvaluationError
evalErr PlutusWithContext
scriptWithContext ExUnits
execUnits EvalTxExecutionUnitsLog
logs
      L.IncompatibleBudget ExBudget
_ -> ScriptExecutionError
ScriptErrorExecutionUnitsOverflow
      L.RedeemerPointsToUnknownScriptHash PlutusPurpose AsIx (LedgerEra era)
rdmrPtr ->
        ScriptWitnessIndex -> ScriptExecutionError
ScriptErrorRedeemerPointsToUnknownScriptHash (ScriptWitnessIndex -> ScriptExecutionError)
-> ScriptWitnessIndex -> ScriptExecutionError
forall a b. (a -> b) -> a -> b
$
          Era era
-> (EraCommonConstraints era => ScriptWitnessIndex)
-> ScriptWitnessIndex
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => ScriptWitnessIndex)
 -> ScriptWitnessIndex)
-> (EraCommonConstraints era => ScriptWitnessIndex)
-> ScriptWitnessIndex
forall a b. (a -> b) -> a -> b
$
            AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
forall era.
AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
toScriptIndex (Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
useEra) PlutusPurpose AsIx (ShelleyLedgerEra era)
PlutusPurpose AsIx (LedgerEra era)
rdmrPtr
      -- This should not occur while using cardano-cli because we zip together
      -- the Plutus script and the use site (txin, certificate etc). Therefore
      -- the redeemer pointer will always point to a Plutus script.
      L.MissingScript PlutusPurpose AsIx (LedgerEra era)
indexOfScriptWitnessedItem Map
  (PlutusPurpose AsIx (LedgerEra era))
  (PlutusPurpose AsItem (LedgerEra era),
   Maybe (PlutusScript (LedgerEra era)), ScriptHash)
resolveable ->
        let scriptWitnessedItemIndex :: ScriptWitnessIndex
scriptWitnessedItemIndex = Era era
-> (EraCommonConstraints era => ScriptWitnessIndex)
-> ScriptWitnessIndex
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => ScriptWitnessIndex)
 -> ScriptWitnessIndex)
-> (EraCommonConstraints era => ScriptWitnessIndex)
-> ScriptWitnessIndex
forall a b. (a -> b) -> a -> b
$ AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
forall era.
AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
toScriptIndex (Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
useEra) PlutusPurpose AsIx (ShelleyLedgerEra era)
PlutusPurpose AsIx (LedgerEra era)
indexOfScriptWitnessedItem
         in ScriptWitnessIndex -> ResolvablePointers -> ScriptExecutionError
ScriptErrorMissingScript
              ScriptWitnessIndex
scriptWitnessedItemIndex
              (ResolvablePointers -> ScriptExecutionError)
-> ResolvablePointers -> ScriptExecutionError
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era => ResolvablePointers)
-> ResolvablePointers
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era)
              ((EraCommonConstraints era => ResolvablePointers)
 -> ResolvablePointers)
-> (EraCommonConstraints era => ResolvablePointers)
-> ResolvablePointers
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (PlutusPurpose AsItem (ShelleyLedgerEra era),
      Maybe (PlutusScriptBytes, Language), ScriptHash)
-> ResolvablePointers
forall era.
(Era (ShelleyLedgerEra era),
 Show (PlutusPurpose AsIx (ShelleyLedgerEra era)),
 Show (PlutusPurpose AsItem (ShelleyLedgerEra era)),
 Show (PlutusScript (ShelleyLedgerEra era))) =>
ShelleyBasedEra era
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (PlutusPurpose AsItem (ShelleyLedgerEra era),
      Maybe (PlutusScriptBytes, Language), ScriptHash)
-> ResolvablePointers
ResolvablePointers (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
useEra)
              (Map
   (PlutusPurpose AsIx (ShelleyLedgerEra era))
   (PlutusPurpose AsItem (ShelleyLedgerEra era),
    Maybe (PlutusScriptBytes, Language), ScriptHash)
 -> ResolvablePointers)
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (PlutusPurpose AsItem (ShelleyLedgerEra era),
      Maybe (PlutusScriptBytes, Language), ScriptHash)
-> ResolvablePointers
forall a b. (a -> b) -> a -> b
$ ((PlutusPurpose AsItem (ShelleyLedgerEra era),
  Maybe (PlutusScript (ShelleyLedgerEra era)), ScriptHash)
 -> (PlutusPurpose AsItem (ShelleyLedgerEra era),
     Maybe (PlutusScriptBytes, Language), ScriptHash))
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (PlutusPurpose AsItem (ShelleyLedgerEra era),
      Maybe (PlutusScript (ShelleyLedgerEra era)), ScriptHash)
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (PlutusPurpose AsItem (ShelleyLedgerEra era),
      Maybe (PlutusScriptBytes, Language), ScriptHash)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (PlutusPurpose AsItem (ShelleyLedgerEra era),
 Maybe (PlutusScript (ShelleyLedgerEra era)), ScriptHash)
-> (PlutusPurpose AsItem (ShelleyLedgerEra era),
    Maybe (PlutusScriptBytes, Language), ScriptHash)
forall era.
AlonzoEraScript (ShelleyLedgerEra era) =>
(PlutusPurpose AsItem (ShelleyLedgerEra era),
 Maybe (PlutusScript (ShelleyLedgerEra era)), ScriptHash)
-> (PlutusPurpose AsItem (ShelleyLedgerEra era),
    Maybe (PlutusScriptBytes, Language), ScriptHash)
extractScriptBytesAndLanguage Map
  (PlutusPurpose AsIx (ShelleyLedgerEra era))
  (PlutusPurpose AsItem (ShelleyLedgerEra era),
   Maybe (PlutusScript (ShelleyLedgerEra era)), ScriptHash)
Map
  (PlutusPurpose AsIx (LedgerEra era))
  (PlutusPurpose AsItem (LedgerEra era),
   Maybe (PlutusScript (LedgerEra era)), ScriptHash)
resolveable
      L.NoCostModelInLedgerState Language
l -> Language -> ScriptExecutionError
ScriptErrorMissingCostModel Language
l
      L.ContextError ContextError (LedgerEra era)
e ->
        Era era
-> (EraCommonConstraints era => ScriptExecutionError)
-> ScriptExecutionError
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => ScriptExecutionError)
 -> ScriptExecutionError)
-> (EraCommonConstraints era => ScriptExecutionError)
-> ScriptExecutionError
forall a b. (a -> b) -> a -> b
$ ContextError (ShelleyLedgerEra era) -> ScriptExecutionError
forall era.
(EraPlutusContext (ShelleyLedgerEra era),
 Show (ContextError (ShelleyLedgerEra era))) =>
ContextError (ShelleyLedgerEra era) -> ScriptExecutionError
ScriptErrorTranslationError ContextError (ShelleyLedgerEra era)
ContextError (LedgerEra era)
e

-- | This is similar to 'makeTransactionBody' but with greater automation to
-- calculate suitable values for several things.
--
-- In particular:
--
-- * It calculates the correct script 'ExecutionUnits' (ignoring the provided
--   values, which can thus be zero).
--
-- * It calculates the transaction fees based on the script 'ExecutionUnits',
--   the current 'ProtocolParameters', and an estimate of the number of
--   key witnesses (i.e. signatures). There is an override for the number of
--   key witnesses.
--
-- * It accepts a change address, calculates the balance of the transaction
--   and puts the excess change into the change output.
--
-- * It also checks that the balance is positive and the change is above the
--   minimum threshold.
--
-- To do this, it requires more information than 'makeTransactionBody', all of
-- which can be queried from a local node.
makeTransactionBodyAutoBalance
  :: forall era
   . ()
  => HasCallStack
  => IsEra era
  => SystemStart
  -> LedgerEpochInfo
  -> L.PParams (LedgerEra era)
  -> Set PoolId
  -- ^ The set of registered stake pools, being
  --   unregistered in this transaction.
  -> Map StakeCredential L.Coin
  -- ^ The map of all deposits for stake credentials that are being
  --   unregistered in this transaction
  -> Map (Ledger.Credential Ledger.DRepRole) L.Coin
  -- ^ The map of all deposits for DRep credentials that are being
  --   unregistered in this transaction
  -> L.UTxO (LedgerEra era)
  -- ^ The transaction inputs (including reference and collateral ones), not the entire 'UTxO'.
  -> TxBodyContent (LedgerEra era)
  -> AddressInEra era
  -- ^ Change address
  -> Maybe Word
  -- ^ Override key witnesses
  -> Either (TxBodyErrorAutoBalance (LedgerEra era)) (UnsignedTx era, TxBodyContent (LedgerEra era))
makeTransactionBodyAutoBalance :: forall era.
(HasCallStack, IsEra era) =>
SystemStart
-> LedgerEpochInfo
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole) Coin
-> UTxO (LedgerEra era)
-> TxBodyContent (LedgerEra era)
-> AddressInEra era
-> Maybe Word
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (UnsignedTx era, TxBodyContent (LedgerEra era))
makeTransactionBodyAutoBalance
  SystemStart
systemstart
  LedgerEpochInfo
history
  PParams (LedgerEra era)
pp
  Set PoolId
poolids
  Map StakeCredential Coin
stakeDelegDeposits
  Map (Credential 'DRepRole) Coin
drepDelegDeposits
  UTxO (LedgerEra era)
utxo
  TxBodyContent (LedgerEra era)
txbodycontent
  AddressInEra era
changeaddr
  Maybe Word
mnkeys = do
    -- Our strategy is to:
    -- 1. evaluate all the scripts to get the exec units, update with ex units
    -- 2. figure out the overall min fees
    -- 3. update tx with fees
    -- 4. balance the transaction and update tx change output

    let txbodyForChange :: UnsignedTx era
txbodyForChange =
          Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
forall era.
Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
makeUnsignedTx
            Era era
forall era. IsEra era => Era era
useEra
            TxBodyContent (LedgerEra era)
txbodycontent

    let Value (LedgerEra era)
initialChangeTxOutValue :: Ledger.Value (LedgerEra era) =
          PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole) Coin
-> UTxO (LedgerEra era)
-> UnsignedTx era
-> Value (LedgerEra era)
forall era.
IsEra era =>
PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole) Coin
-> UTxO (LedgerEra era)
-> UnsignedTx era
-> Value (LedgerEra era)
evaluateTransactionBalance PParams (LedgerEra era)
pp Set PoolId
poolids Map StakeCredential Coin
stakeDelegDeposits Map (Credential 'DRepRole) Coin
drepDelegDeposits UTxO (LedgerEra era)
utxo UnsignedTx era
txbodyForChange
        TxOut CtxTx (LedgerEra era)
initialChangeTxOut :: TxOut CtxTx (LedgerEra era) =
          Era era
-> (EraCommonConstraints era => TxOut CtxTx (LedgerEra era))
-> TxOut CtxTx (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => TxOut CtxTx (LedgerEra era))
 -> TxOut CtxTx (LedgerEra era))
-> (EraCommonConstraints era => TxOut CtxTx (LedgerEra era))
-> TxOut CtxTx (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
            TxOut (LedgerEra era)
-> Maybe (Datum CtxTx (LedgerEra era))
-> TxOut CtxTx (LedgerEra era)
forall era ctx.
EraTxOut era =>
TxOut era -> Maybe (Datum ctx era) -> TxOut ctx era
TxOut (Addr -> Value (LedgerEra era) -> TxOut (LedgerEra era)
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
L.mkBasicTxOut (AddressInEra era -> Addr
forall era. AddressInEra era -> Addr
toShelleyAddr AddressInEra era
changeaddr) Value (LedgerEra era)
initialChangeTxOutValue) Maybe (Datum CtxTx (LedgerEra era))
forall a. Maybe a
Nothing

    -- Initial change is only used for execution units evaluation, so we don't require minimum UTXO requirement
    -- to be satisfied at this point
    _ <- PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
forall era.
IsEra era =>
PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) IsEmpty
checkNonNegative PParams (LedgerEra era)
pp TxOut CtxTx (LedgerEra era)
initialChangeTxOut

    -- Tx body used only for evaluating execution units. Because txout exact
    -- values do not matter much here, we are using an initial change value,
    -- which is slightly overestimated, because it does not include fee or
    -- scripts execution costs.
    -- TODO: The txbody is made (leder tx) so this
    -- is where the execution units map is made
    let UnsignedTx txbody =
          makeUnsignedTx
            useEra
            ( txbodycontent
                & modTxOuts
                  (<> [initialChangeTxOut])
            )
    let exUnitsMapWithLogs =
          SystemStart
-> LedgerEpochInfo
-> PParams (LedgerEra era)
-> UTxO (LedgerEra era)
-> Tx (LedgerEra era)
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
forall era.
IsEra era =>
SystemStart
-> LedgerEpochInfo
-> PParams (LedgerEra era)
-> UTxO (LedgerEra era)
-> Tx (LedgerEra era)
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
evaluateTransactionExecutionUnits
            SystemStart
systemstart
            LedgerEpochInfo
history
            PParams (LedgerEra era)
pp
            UTxO (LedgerEra era)
utxo
            Tx (LedgerEra era)
txbody

    let exUnitsMap = (Either
   ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)
 -> Either ScriptExecutionError ExecutionUnits)
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
-> Map
     ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (((EvalTxExecutionUnitsLog, ExecutionUnits) -> ExecutionUnits)
-> Either
     ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)
-> Either ScriptExecutionError ExecutionUnits
forall a b.
(a -> b)
-> Either ScriptExecutionError a -> Either ScriptExecutionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EvalTxExecutionUnitsLog, ExecutionUnits) -> ExecutionUnits
forall a b. (a, b) -> b
snd) Map
  ScriptWitnessIndex
  (Either
     ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
exUnitsMapWithLogs

    exUnitsMap' <-
      case Map.mapEither id exUnitsMap of
        (Map ScriptWitnessIndex ScriptExecutionError
failures, Map ScriptWitnessIndex ExecutionUnits
exUnitsMap') ->
          ScriptValidity
-> Map ScriptWitnessIndex ScriptExecutionError
-> Map ScriptWitnessIndex ExecutionUnits
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (Map ScriptWitnessIndex ExecutionUnits)
forall era.
ScriptValidity
-> Map ScriptWitnessIndex ScriptExecutionError
-> Map ScriptWitnessIndex ExecutionUnits
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (Map ScriptWitnessIndex ExecutionUnits)
handleExUnitsErrors
            (TxBodyContent (LedgerEra era) -> ScriptValidity
forall era. TxBodyContent era -> ScriptValidity
txScriptValidity TxBodyContent (LedgerEra era)
txbodycontent)
            Map ScriptWitnessIndex ScriptExecutionError
failures
            Map ScriptWitnessIndex ExecutionUnits
exUnitsMap'

    txbodycontent1 <-
      substituteExecutionUnits exUnitsMap' txbodycontent

    -- Make a txbody that we will use for calculating the fees. For the purpose
    -- of fees we just need to make a txbody of the right size in bytes. We
    -- do not need the right values for the fee. We use "big enough" value
    -- for the fee and set so that the CBOR encoding size of the tx will be
    -- big enough to cover the size of the final output and fee. Yes this
    -- means this current code will only work for final fee of less than
    -- around 4000 ada (2^32-1 lovelace).
    let maxLovelaceFee = Integer -> Coin
L.Coin (Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
32 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
    -- Make a txbody that we will use for calculating the fees.
    let (maybeDummyReturnTxCollateral, maybeDummyTotalTxCollateral) = maybeDummyTotalCollAndCollReturnOutput txbodycontent changeaddr
    let txbody1 =
          Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
forall era.
Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
makeUnsignedTx
            Era era
forall era. IsEra era => Era era
useEra
            TxBodyContent (LedgerEra era)
txbodycontent1
              { txFee = maxLovelaceFee
              , txReturnCollateral = maybeDummyReturnTxCollateral
              , txTotalCollateral = maybeDummyTotalTxCollateral
              , txOuts =
                  txOuts txbodycontent
                    <> [initialChangeTxOut]
              }

    -- NB: This has the potential to over estimate the fees because estimateTransactionKeyWitnessCount
    -- makes the conservative assumption that all inputs are from distinct
    -- addresses.
    let nkeys =
          Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe
            (TxBodyContent (LedgerEra era) -> Word
forall era. IsEra era => TxBodyContent (LedgerEra era) -> Word
estimateTransactionKeyWitnessCount TxBodyContent (LedgerEra era)
txbodycontent1)
            Maybe Word
mnkeys
        fee = PParams (LedgerEra era)
-> UTxO (LedgerEra era) -> UnsignedTx era -> Word -> Coin
forall era.
IsEra era =>
PParams (LedgerEra era)
-> UTxO (LedgerEra era) -> UnsignedTx era -> Word -> Coin
calculateMinTxFee PParams (LedgerEra era)
pp UTxO (LedgerEra era)
utxo UnsignedTx era
txbody1 Word
nkeys
        totalPotentialCollateral =
          [MaryValue] -> MaryValue
forall a. Monoid a => [a] -> a
mconcat
            [ (TxOut (LedgerEra era)
txOut TxOut (LedgerEra era)
-> Getting MaryValue (TxOut (LedgerEra era)) MaryValue -> MaryValue
forall s a. s -> Getting a s a -> a
^. Era era
-> (EraCommonConstraints era =>
    Getting MaryValue (TxOut (LedgerEra era)) MaryValue)
-> Getting MaryValue (TxOut (LedgerEra era)) MaryValue
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) EraCommonConstraints era =>
Getting MaryValue (TxOut (LedgerEra era)) MaryValue
(Value (LedgerEra era) -> Const MaryValue (Value (LedgerEra era)))
-> TxOut (LedgerEra era) -> Const MaryValue (TxOut (LedgerEra era))
Getting MaryValue (TxOut (LedgerEra era)) MaryValue
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut (LedgerEra era)) (Value (LedgerEra era))
L.valueTxOutL :: L.MaryValue)
            | let collInputs :: [TxIn]
collInputs = TxBodyContent (LedgerEra era) -> [TxIn]
forall era. TxBodyContent era -> [TxIn]
txInsCollateral TxBodyContent (LedgerEra era)
txbodycontent
            , TxIn
collTxIn <- [TxIn]
collInputs
            , Just TxOut (LedgerEra era)
txOut <- Maybe (TxOut (LedgerEra era)) -> [Maybe (TxOut (LedgerEra era))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TxOut (LedgerEra era)) -> [Maybe (TxOut (LedgerEra era))])
-> Maybe (TxOut (LedgerEra era)) -> [Maybe (TxOut (LedgerEra era))]
forall a b. (a -> b) -> a -> b
$ TxIn
-> Map TxIn (TxOut (LedgerEra era))
-> Maybe (TxOut (LedgerEra era))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (TxIn -> TxIn
toShelleyTxIn TxIn
collTxIn) (UTxO (LedgerEra era) -> Map TxIn (TxOut (LedgerEra era))
forall era. UTxO era -> Map TxIn (TxOut era)
L.unUTxO UTxO (LedgerEra era)
utxo)
            ]
        (maybeReturnTxCollateral, maybeTotalTxCollateral) =
          obtainCommonConstraints (useEra @era) $
            calcReturnAndTotalCollateral
              fee
              pp
              (txInsCollateral txbodycontent)
              (txReturnCollateral txbodycontent)
              (txTotalCollateral txbodycontent)
              changeaddr
              totalPotentialCollateral

    -- Make a txbody for calculating the balance. For this the size of the tx
    -- does not matter, instead it's just the values of the fee and outputs.
    -- Here we do not want to start with any change output, since that's what
    -- we need to calculate.
    let txbody2 =
          Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
forall era.
Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
makeUnsignedTx
            Era era
forall era. IsEra era => Era era
useEra
            TxBodyContent (LedgerEra era)
txbodycontent1
              { txFee = fee
              , txReturnCollateral = maybeReturnTxCollateral
              , txTotalCollateral = maybeTotalTxCollateral
              }

    case useEra @era of
      Era era
DijkstraEra -> String
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (UnsignedTx era, TxBodyContent (LedgerEra era))
forall a. HasCallStack => String -> a
error String
"makeTransactionBodyAutoBalance: DijkstraEra not supported"
      Era era
ConwayEra -> do
        let MaryValue
balance :: L.MaryValue = PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole) Coin
-> UTxO (LedgerEra era)
-> UnsignedTx era
-> Value (LedgerEra era)
forall era.
IsEra era =>
PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole) Coin
-> UTxO (LedgerEra era)
-> UnsignedTx era
-> Value (LedgerEra era)
evaluateTransactionBalance PParams (LedgerEra era)
pp Set PoolId
poolids Map StakeCredential Coin
stakeDelegDeposits Map (Credential 'DRepRole) Coin
drepDelegDeposits UTxO (LedgerEra era)
utxo UnsignedTx era
txbody2
            adaBalance :: Coin
adaBalance = Era era -> Value (LedgerEra era) -> Coin
forall era. Era era -> Value (LedgerEra era) -> Coin
getAda (forall era. IsEra era => Era era
useEra @era) Value (LedgerEra era)
MaryValue
balance
        Bool
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) ()
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Coin
adaBalance Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
0) (Either (TxBodyErrorAutoBalance (LedgerEra era)) ()
 -> Either (TxBodyErrorAutoBalance (LedgerEra era)) ())
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) ()
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) ()
forall a b. (a -> b) -> a -> b
$
          TxBodyErrorAutoBalance ConwayEra
-> Either (TxBodyErrorAutoBalance ConwayEra) ()
forall a b. a -> Either a b
Left (TxBodyErrorAutoBalance ConwayEra
 -> Either (TxBodyErrorAutoBalance ConwayEra) ())
-> TxBodyErrorAutoBalance ConwayEra
-> Either (TxBodyErrorAutoBalance ConwayEra) ()
forall a b. (a -> b) -> a -> b
$
            Coin -> UnsignedTx ConwayEra -> TxBodyErrorAutoBalance ConwayEra
forall era.
Coin -> UnsignedTx ConwayEra -> TxBodyErrorAutoBalance era
BalanceIsNegative Coin
adaBalance UnsignedTx era
UnsignedTx ConwayEra
txbodyForChange

        let
          -- The multiasset output of evaluateTransactionBalance will be negative when
          -- minting a multiasset. Therefore we must make the multiasset balance positive
          TxOut CtxTx (LedgerEra era)
balanceTxOut :: TxOut CtxTx (LedgerEra era) =
            Era era
-> (EraCommonConstraints era => TxOut CtxTx ConwayEra)
-> TxOut CtxTx ConwayEra
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => TxOut CtxTx ConwayEra)
 -> TxOut CtxTx ConwayEra)
-> (EraCommonConstraints era => TxOut CtxTx ConwayEra)
-> TxOut CtxTx ConwayEra
forall a b. (a -> b) -> a -> b
$
              TxOut ConwayEra
-> Maybe (Datum CtxTx ConwayEra) -> TxOut CtxTx ConwayEra
forall era ctx.
EraTxOut era =>
TxOut era -> Maybe (Datum ctx era) -> TxOut ctx era
TxOut (Addr -> Value ConwayEra -> TxOut ConwayEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
L.mkBasicTxOut (AddressInEra era -> Addr
forall era. AddressInEra era -> Addr
toShelleyAddr AddressInEra era
changeaddr) Value ConwayEra
MaryValue
balance) Maybe (Datum CtxTx ConwayEra)
forall a. Maybe a
Nothing
        ((TxOut CtxTx ConwayEra, Coin) -> TxBodyErrorAutoBalance ConwayEra)
-> Either (TxOut CtxTx ConwayEra, Coin) ()
-> Either (TxBodyErrorAutoBalance ConwayEra) ()
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 ((TxOut CtxTx ConwayEra -> Coin -> TxBodyErrorAutoBalance ConwayEra)
-> (TxOut CtxTx ConwayEra, Coin)
-> TxBodyErrorAutoBalance ConwayEra
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxOut CtxTx ConwayEra -> Coin -> TxBodyErrorAutoBalance ConwayEra
forall era. TxOut CtxTx era -> Coin -> TxBodyErrorAutoBalance era
TxBodyErrorMinUTxONotMet)
          (Either (TxOut CtxTx ConwayEra, Coin) ()
 -> Either (TxBodyErrorAutoBalance (LedgerEra era)) ())
-> ([TxOut CtxTx (LedgerEra era)]
    -> Either (TxOut CtxTx ConwayEra, Coin) ())
-> [TxOut CtxTx (LedgerEra era)]
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut CtxTx (LedgerEra era)
 -> Either (TxOut CtxTx ConwayEra, Coin) ())
-> [TxOut CtxTx (LedgerEra era)]
-> Either (TxOut CtxTx ConwayEra, Coin) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (PParams (LedgerEra ConwayEra)
-> TxOut CtxTx (LedgerEra ConwayEra)
-> Either (TxOut CtxTx (LedgerEra ConwayEra), Coin) ()
forall era.
PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> Either (TxOut CtxTx (LedgerEra era), Coin) ()
checkMinUTxOValue PParams (LedgerEra era)
PParams (LedgerEra ConwayEra)
pp)
          ([TxOut CtxTx (LedgerEra era)]
 -> Either (TxBodyErrorAutoBalance (LedgerEra era)) ())
-> [TxOut CtxTx (LedgerEra era)]
-> Either (TxBodyErrorAutoBalance (LedgerEra era)) ()
forall a b. (a -> b) -> a -> b
$ TxBodyContent (LedgerEra era) -> [TxOut CtxTx (LedgerEra era)]
forall era. TxBodyContent era -> [TxOut CtxTx era]
txOuts TxBodyContent (LedgerEra era)
txbodycontent1

        -- check if change meets txout criteria, and include if non-zero
        finalTxOuts <- PParams (LedgerEra ConwayEra)
-> TxOut CtxTx (LedgerEra ConwayEra)
-> [TxOut CtxTx (LedgerEra ConwayEra)]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra ConwayEra))
     [TxOut CtxTx (LedgerEra ConwayEra)]
forall era.
IsEra era =>
PParams (LedgerEra era)
-> TxOut CtxTx (LedgerEra era)
-> [TxOut CtxTx (LedgerEra era)]
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     [TxOut CtxTx (LedgerEra era)]
checkAndIncludeChange PParams (LedgerEra era)
PParams (LedgerEra ConwayEra)
pp TxOut CtxTx (LedgerEra era)
TxOut CtxTx (LedgerEra ConwayEra)
balanceTxOut (TxBodyContent (LedgerEra era) -> [TxOut CtxTx (LedgerEra era)]
forall era. TxBodyContent era -> [TxOut CtxTx era]
txOuts TxBodyContent (LedgerEra era)
txbodycontent1)

        -- TODO: we could add the extra fee for the CBOR encoding of the change,
        -- now that we know the magnitude of the change: i.e. 1-8 bytes extra.
        -- The txbody with the final fee and change output. This should work
        -- provided that the fee and change are less than 2^32-1, and so will
        -- fit within the encoding size we picked above when calculating the fee.
        -- Yes this could be an over-estimate by a few bytes if the fee or change
        -- would fit within 2^16-1. That's a possible optimisation.
        let finalTxBodyContent =
              TxBodyContent (LedgerEra era)
txbodycontent1
                { txFee = fee
                , txOuts = finalTxOuts
                , txReturnCollateral = maybeReturnTxCollateral
                , txTotalCollateral = maybeTotalTxCollateral
                }
        let txbody3 =
              Era ConwayEra
-> TxBodyContent (LedgerEra ConwayEra) -> UnsignedTx ConwayEra
forall era.
Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
makeUnsignedTx
                Era ConwayEra
forall era. IsEra era => Era era
useEra
                TxBodyContent (LedgerEra era)
TxBodyContent (LedgerEra ConwayEra)
finalTxBodyContent
        return
          (txbody3, finalTxBodyContent)

getAda :: Era era -> L.Value (LedgerEra era) -> L.Coin
getAda :: forall era. Era era -> Value (LedgerEra era) -> Coin
getAda Era era
e Value (LedgerEra era)
val = case Era era
e of
  Era era
ConwayEra -> MaryValue -> Coin
forall t. Val t => t -> Coin
L.coin Value (LedgerEra era)
MaryValue
val
  Era era
DijkstraEra -> MaryValue -> Coin
forall t. Val t => t -> Coin
L.coin Value (LedgerEra era)
MaryValue
val

handleExUnitsErrors
  :: ScriptValidity
  -- ^ Mark script as expected to pass or fail validation
  -> Map ScriptWitnessIndex ScriptExecutionError
  -> Map ScriptWitnessIndex ExecutionUnits
  -> Either (TxBodyErrorAutoBalance (LedgerEra era)) (Map ScriptWitnessIndex ExecutionUnits)
handleExUnitsErrors :: forall era.
ScriptValidity
-> Map ScriptWitnessIndex ScriptExecutionError
-> Map ScriptWitnessIndex ExecutionUnits
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (Map ScriptWitnessIndex ExecutionUnits)
handleExUnitsErrors ScriptValidity
ScriptValid Map ScriptWitnessIndex ScriptExecutionError
failuresMap Map ScriptWitnessIndex ExecutionUnits
exUnitsMap =
  if [(ScriptWitnessIndex, ScriptExecutionError)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ScriptWitnessIndex, ScriptExecutionError)]
failures
    then Map ScriptWitnessIndex ExecutionUnits
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (Map ScriptWitnessIndex ExecutionUnits)
forall a b. b -> Either a b
Right Map ScriptWitnessIndex ExecutionUnits
exUnitsMap
    else TxBodyErrorAutoBalance (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (Map ScriptWitnessIndex ExecutionUnits)
forall a b. a -> Either a b
Left ([(ScriptWitnessIndex, ScriptExecutionError)]
-> TxBodyErrorAutoBalance (LedgerEra era)
forall era.
[(ScriptWitnessIndex, ScriptExecutionError)]
-> TxBodyErrorAutoBalance era
TxBodyScriptExecutionError [(ScriptWitnessIndex, ScriptExecutionError)]
failures)
 where
  failures :: [(ScriptWitnessIndex, ScriptExecutionError)]
  failures :: [(ScriptWitnessIndex, ScriptExecutionError)]
failures = Map ScriptWitnessIndex ScriptExecutionError
-> [Item (Map ScriptWitnessIndex ScriptExecutionError)]
forall l. IsList l => l -> [Item l]
toList Map ScriptWitnessIndex ScriptExecutionError
failuresMap
handleExUnitsErrors ScriptValidity
ScriptInvalid Map ScriptWitnessIndex ScriptExecutionError
failuresMap Map ScriptWitnessIndex ExecutionUnits
exUnitsMap
  | Map ScriptWitnessIndex ScriptExecutionError -> Bool
forall a. Map ScriptWitnessIndex a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map ScriptWitnessIndex ScriptExecutionError
failuresMap = TxBodyErrorAutoBalance (LedgerEra era)
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (Map ScriptWitnessIndex ExecutionUnits)
forall a b. a -> Either a b
Left TxBodyErrorAutoBalance (LedgerEra era)
forall era. TxBodyErrorAutoBalance era
TxBodyScriptBadScriptValidity
  | Bool
otherwise = Map ScriptWitnessIndex ExecutionUnits
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (Map ScriptWitnessIndex ExecutionUnits)
forall a b. b -> Either a b
Right (Map ScriptWitnessIndex ExecutionUnits
 -> Either
      (TxBodyErrorAutoBalance (LedgerEra era))
      (Map ScriptWitnessIndex ExecutionUnits))
-> Map ScriptWitnessIndex ExecutionUnits
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (Map ScriptWitnessIndex ExecutionUnits)
forall a b. (a -> b) -> a -> b
$ (ScriptExecutionError -> ExecutionUnits)
-> Map ScriptWitnessIndex ScriptExecutionError
-> Map ScriptWitnessIndex ExecutionUnits
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\ScriptExecutionError
_ -> Natural -> Natural -> ExecutionUnits
ExecutionUnits Natural
0 Natural
0) Map ScriptWitnessIndex ScriptExecutionError
failuresMap Map ScriptWitnessIndex ExecutionUnits
-> Map ScriptWitnessIndex ExecutionUnits
-> Map ScriptWitnessIndex ExecutionUnits
forall a. Semigroup a => a -> a -> a
<> Map ScriptWitnessIndex ExecutionUnits
exUnitsMap

-- | Provide and approximate count of the key witnesses (i.e. signatures)
-- required for a transaction.
--
-- This estimate is not exact and may overestimate the required number of witnesses.
-- The function makes conservative assumptions, including:
--
-- * Treating all inputs as originating from distinct addresses. In reality,
--   multiple inputs may share the same address, requiring only one witness per address.
--
-- * Assuming regular and collateral inputs are distinct, even though they may overlap.
--
-- TODO: Consider implementing a more precise calculation that leverages the UTXO set
-- to determine which inputs correspond to distinct addresses. Additionally, the
-- estimate can be refined by distinguishing between Shelley and Byron-style witnesses.
estimateTransactionKeyWitnessCount :: forall era. IsEra era => TxBodyContent (LedgerEra era) -> Word
estimateTransactionKeyWitnessCount :: forall era. IsEra era => TxBodyContent (LedgerEra era) -> Word
estimateTransactionKeyWitnessCount
  TxBodyContent
    { [(TxIn, AnyWitness (LedgerEra era))]
txIns :: forall era. TxBodyContent era -> [(TxIn, AnyWitness era)]
txIns :: [(TxIn, AnyWitness (LedgerEra era))]
txIns
    , [TxIn]
txInsCollateral :: forall era. TxBodyContent era -> [TxIn]
txInsCollateral :: [TxIn]
txInsCollateral
    , TxExtraKeyWitnesses
txExtraKeyWits :: TxExtraKeyWitnesses
txExtraKeyWits :: forall era. TxBodyContent era -> TxExtraKeyWitnesses
txExtraKeyWits
    , TxWithdrawals (LedgerEra era)
txWithdrawals :: forall era. TxBodyContent era -> TxWithdrawals era
txWithdrawals :: TxWithdrawals (LedgerEra era)
txWithdrawals
    , TxCertificates (LedgerEra era)
txCertificates :: forall era. TxBodyContent era -> TxCertificates era
txCertificates :: TxCertificates (LedgerEra era)
txCertificates
    , Maybe (TxProposalProcedures (LedgerEra era))
txProposalProcedures :: forall era. TxBodyContent era -> Maybe (TxProposalProcedures era)
txProposalProcedures :: Maybe (TxProposalProcedures (LedgerEra era))
txProposalProcedures
    } =
    Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$
      [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((TxIn, AnyWitness (LedgerEra era)) -> Int)
-> [(TxIn, AnyWitness (LedgerEra era))] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, AnyWitness (LedgerEra era)) -> Int
estimateTxInWitnesses [(TxIn, AnyWitness (LedgerEra era))]
txIns)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxIn]
txInsCollateral
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case TxExtraKeyWitnesses
txExtraKeyWits of
          TxExtraKeyWitnesses [Hash PaymentKey]
khs ->
            [Hash PaymentKey] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Hash PaymentKey]
khs
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case TxWithdrawals (LedgerEra era)
txWithdrawals of
          TxWithdrawals [(StakeAddress, Coin, AnyWitness (LedgerEra era))]
withdrawals ->
            [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | (StakeAddress
_, Coin
_, AnyWitness (LedgerEra era)
AnyKeyWitnessPlaceholder) <- [(StakeAddress, Coin, AnyWitness (LedgerEra era))]
withdrawals]
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case TxCertificates (LedgerEra era)
txCertificates of
          TxCertificates OMap
  (Certificate (LedgerEra era))
  (Maybe (StakeCredential, AnyWitness (LedgerEra era)))
credWits ->
            [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
              [() | (Certificate (LedgerEra era)
_, Just (StakeCredential
_, AnyWitness (LedgerEra era)
AnyKeyWitnessPlaceholder)) <- OMap
  (Certificate (LedgerEra era))
  (Maybe (StakeCredential, AnyWitness (LedgerEra era)))
-> [Item
      (OMap
         (Certificate (LedgerEra era))
         (Maybe (StakeCredential, AnyWitness (LedgerEra era))))]
forall l. IsList l => l -> [Item l]
toList OMap
  (Certificate (LedgerEra era))
  (Maybe (StakeCredential, AnyWitness (LedgerEra era)))
credWits]
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case Maybe (TxProposalProcedures (LedgerEra era))
txProposalProcedures of
          Just (TxProposalProcedures OMap
  (ProposalProcedure (LedgerEra era)) (AnyWitness (LedgerEra era))
m) ->
            OMap
  (ProposalProcedure (LedgerEra era)) (AnyWitness (LedgerEra era))
-> Int
forall k v. OMap k v -> Int
OMap.size OMap
  (ProposalProcedure (LedgerEra era)) (AnyWitness (LedgerEra era))
m
          Maybe (TxProposalProcedures (LedgerEra era))
Nothing -> Int
0
   where
    estimateTxInWitnesses :: (TxIn, AnyWitness (LedgerEra era)) -> Int
    estimateTxInWitnesses :: (TxIn, AnyWitness (LedgerEra era)) -> Int
estimateTxInWitnesses (TxIn
_, AnyWitness (LedgerEra era)
AnyKeyWitnessPlaceholder) = Int
1
    estimateTxInWitnesses (TxIn
_, AnySimpleScriptWitness (SScript (SimpleScript NativeScript (LedgerEra era)
simpleScript))) =
      SimpleScript -> Int
maxWitnessesInSimpleScript (SimpleScript -> Int) -> SimpleScript -> Int
forall a b. (a -> b) -> a -> b
$
        Era era
-> (EraCommonConstraints era => SimpleScript) -> SimpleScript
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => SimpleScript) -> SimpleScript)
-> (EraCommonConstraints era => SimpleScript) -> SimpleScript
forall a b. (a -> b) -> a -> b
$
          NativeScript (LedgerEra era) -> SimpleScript
forall era.
AllegraEraScript era =>
NativeScript era -> SimpleScript
Old.fromAllegraTimelock NativeScript (LedgerEra era)
simpleScript
    estimateTxInWitnesses (TxIn
_, AnySimpleScriptWitness (SReferenceScript TxIn
_)) = Int
0
    estimateTxInWitnesses (TxIn
_, AnyPlutusScriptWitness{}) = Int
0
    -- This is a rough conservative estimate of the maximum number of witnesses
    -- needed for a simple script to be satisfied. It is conservative because it
    -- assumes that each key hash only appears once, and it assumes the worst
    -- scenario. A more accurate estimate for the maximum could be computed by
    -- keeping track of the possible combinations of key hashes that have
    -- potentially already been counted, but that would increase complexity a lot,
    -- and it would still be a conservative estimate.
    maxWitnessesInSimpleScript :: Old.SimpleScript -> Int
    maxWitnessesInSimpleScript :: SimpleScript -> Int
maxWitnessesInSimpleScript (Old.RequireSignature Hash PaymentKey
_) = Int
1
    maxWitnessesInSimpleScript (Old.RequireTimeBefore SlotNo
_) = Int
0
    maxWitnessesInSimpleScript (Old.RequireTimeAfter SlotNo
_) = Int
0
    maxWitnessesInSimpleScript (Old.RequireAllOf [SimpleScript]
simpleScripts) = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (SimpleScript -> Int) -> [SimpleScript] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Int
maxWitnessesInSimpleScript [SimpleScript]
simpleScripts
    maxWitnessesInSimpleScript (Old.RequireAnyOf [SimpleScript]
simpleScripts) = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (SimpleScript -> Int) -> [SimpleScript] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Int
maxWitnessesInSimpleScript [SimpleScript]
simpleScripts
    maxWitnessesInSimpleScript (Old.RequireMOf Int
n [SimpleScript]
simpleScripts) = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Int -> Down Int) -> Int -> Int -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Int -> Down Int
forall a. a -> Down a
Down) ((SimpleScript -> Int) -> [SimpleScript] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Int
maxWitnessesInSimpleScript [SimpleScript]
simpleScripts)

-- | Estimate the minimum transaction fee by analyzing the transaction structure
-- and determining the required number and type of key witnesses.
--
-- It requires access to the relevant portion of the UTXO set to look up any
-- transaction inputs (txins) included in the transaction. However, it cannot
-- reliably determine the number of witnesses required for native scripts.
--
-- Therefore, the number of witnesses needed for native scripts must be provided
-- as an additional argument.
calculateMinTxFee
  :: forall era
   . IsEra era
  => Ledger.PParams (LedgerEra era)
  -> L.UTxO (LedgerEra era)
  -> UnsignedTx era
  -> Word
  -- ^ The number of Shelley key witnesses
  -> L.Coin
calculateMinTxFee :: forall era.
IsEra era =>
PParams (LedgerEra era)
-> UTxO (LedgerEra era) -> UnsignedTx era -> Word -> Coin
calculateMinTxFee PParams (LedgerEra era)
pp UTxO (LedgerEra era)
utxo (UnsignedTx Tx (LedgerEra era)
txbody) Word
keywitcount =
  Era era -> (EraCommonConstraints era => Coin) -> Coin
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Coin) -> Coin)
-> (EraCommonConstraints era => Coin) -> Coin
forall a b. (a -> b) -> a -> b
$
    UTxO (LedgerEra era)
-> PParams (LedgerEra era) -> Tx (LedgerEra era) -> Int -> Coin
forall era.
(EraUTxO era, EraCertState era) =>
UTxO era -> PParams era -> Tx era -> Int -> Coin
L.calcMinFeeTx UTxO (LedgerEra era)
utxo PParams (LedgerEra era)
pp Tx (LedgerEra era)
txbody (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
keywitcount)