{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Fee calculation
module Cardano.Api.Fees
  ( -- * Transaction fees
    evaluateTransactionFee
  , calculateMinTxFee
  , estimateTransactionKeyWitnessCount

    -- * Script execution units
  , evaluateTransactionExecutionUnits
  , evaluateTransactionExecutionUnitsShelley
  , ScriptExecutionError (..)
  , TransactionValidityError (..)

    -- * Transaction balance
  , evaluateTransactionBalance

    -- * Automated transaction building
  , estimateBalancedTxBody
  , estimateOrCalculateBalancedTxBody
  , makeTransactionBodyAutoBalance
  , calcReturnAndTotalCollateral
  , AutoBalanceError (..)
  , BalancedTxBody (..)
  , FeeEstimationMode (..)
  , RequiredShelleyKeyWitnesses (..)
  , RequiredByronKeyWitnesses (..)
  , TotalReferenceScriptsSize (..)
  , TxBodyErrorAutoBalance (..)
  , TxFeeEstimationError (..)

    -- * Minimum UTxO calculation
  , calculateMinimumUTxO

    -- * Internal helpers
  , ResolvablePointers (..)
  )
where

import           Cardano.Api.Address
import           Cardano.Api.Certificate
import           Cardano.Api.Eon.AlonzoEraOnwards
import           Cardano.Api.Eon.BabbageEraOnwards
import           Cardano.Api.Eon.ConwayEraOnwards
import           Cardano.Api.Eon.MaryEraOnwards
import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.Eras.Case
import           Cardano.Api.Eras.Core
import           Cardano.Api.Error
import           Cardano.Api.Experimental.Eras (obtainCommonConstraints, sbeToEra)
import qualified Cardano.Api.Experimental.Eras as Exp
import           Cardano.Api.Experimental.Tx
import           Cardano.Api.Feature
import qualified Cardano.Api.Ledger.Lens as A
import           Cardano.Api.Pretty
import           Cardano.Api.ProtocolParameters
import           Cardano.Api.Query
import           Cardano.Api.Script
import           Cardano.Api.Tx.Body
import           Cardano.Api.Tx.Sign
import           Cardano.Api.Value

import qualified Cardano.Ledger.Alonzo.Core as Ledger
import qualified Cardano.Ledger.Alonzo.Plutus.Context as Plutus
import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
import qualified Cardano.Ledger.Api as L
import qualified Cardano.Ledger.Coin as L
import qualified Cardano.Ledger.Conway.Governance as L
import qualified Cardano.Ledger.Core as L
import           Cardano.Ledger.Credential as Ledger (Credential)
import qualified Cardano.Ledger.Crypto as Ledger
import qualified Cardano.Ledger.Keys as Ledger
import qualified Cardano.Ledger.Plutus.Language as Plutus
import qualified Cardano.Ledger.Val as L
import qualified Ouroboros.Consensus.HardFork.History as Consensus
import qualified PlutusLedgerApi.V1 as Plutus

import           Control.Monad
import           Data.Bifunctor (bimap, first, second)
import           Data.ByteString.Short (ShortByteString)
import           Data.Function ((&))
import qualified Data.List as List
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe
import qualified Data.OSet.Strict as OSet
import           Data.Ratio
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Text (Text)
import qualified Data.Text as Text
import           GHC.Exts (IsList (..))
import           Lens.Micro ((.~), (^.))

-- | Type synonym for logs returned by the ledger's @evalTxExUnitsWithLogs@ function.
-- for scripts in transactions.
type EvalTxExecutionUnitsLog = [Text]

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

instance Error (AutoBalanceError era) where
  prettyError :: forall ann. AutoBalanceError era -> Doc ann
prettyError = \case
    AutoBalanceEstimationError TxFeeEstimationError era
e -> TxFeeEstimationError era -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxFeeEstimationError era -> Doc ann
prettyError TxFeeEstimationError era
e
    AutoBalanceCalculationError TxBodyErrorAutoBalance era
e -> TxBodyErrorAutoBalance era -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxBodyErrorAutoBalance era -> Doc ann
prettyError TxBodyErrorAutoBalance era
e

estimateOrCalculateBalancedTxBody
  :: ShelleyBasedEra era
  -> FeeEstimationMode era
  -> L.PParams (ShelleyLedgerEra era)
  -> TxBodyContent BuildTx era
  -> Set PoolId
  -> Map StakeCredential L.Coin
  -> Map (Ledger.Credential Ledger.DRepRole Ledger.StandardCrypto) L.Coin
  -> AddressInEra era
  -> Either (AutoBalanceError era) (BalancedTxBody era)
estimateOrCalculateBalancedTxBody :: forall era.
ShelleyBasedEra era
-> FeeEstimationMode era
-> PParams (ShelleyLedgerEra era)
-> TxBodyContent BuildTx era
-> Set (Hash StakePoolKey)
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> AddressInEra era
-> Either (AutoBalanceError era) (BalancedTxBody era)
estimateOrCalculateBalancedTxBody ShelleyBasedEra era
era FeeEstimationMode era
feeEstMode PParams (ShelleyLedgerEra era)
pparams TxBodyContent BuildTx era
txBodyContent Set (Hash StakePoolKey)
poolids Map StakeCredential Coin
stakeDelegDeposits Map (Credential 'DRepRole StandardCrypto) Coin
drepDelegDeposits AddressInEra era
changeAddr =
  case FeeEstimationMode era
feeEstMode of
    CalculateWithSpendableUTxO UTxO era
utxo SystemStart
systemstart LedgerEpochInfo
ledgerEpochInfo Maybe Word
mOverride ->
      (TxBodyErrorAutoBalance era -> AutoBalanceError era)
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
-> Either (AutoBalanceError era) (BalancedTxBody 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 era -> AutoBalanceError era
forall era. TxBodyErrorAutoBalance era -> AutoBalanceError era
AutoBalanceCalculationError (Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
 -> Either (AutoBalanceError era) (BalancedTxBody era))
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
-> Either (AutoBalanceError era) (BalancedTxBody era)
forall a b. (a -> b) -> a -> b
$
        ShelleyBasedEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> Set (Hash StakePoolKey)
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
forall era.
ShelleyBasedEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> Set (Hash StakePoolKey)
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
makeTransactionBodyAutoBalance
          ShelleyBasedEra era
era
          SystemStart
systemstart
          LedgerEpochInfo
ledgerEpochInfo
          (PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters PParams (ShelleyLedgerEra era)
pparams)
          Set (Hash StakePoolKey)
poolids
          Map StakeCredential Coin
stakeDelegDeposits
          Map (Credential 'DRepRole StandardCrypto) Coin
drepDelegDeposits
          UTxO era
utxo
          TxBodyContent BuildTx era
txBodyContent
          AddressInEra era
changeAddr
          Maybe Word
mOverride
    EstimateWithoutSpendableUTxO
      Coin
totalPotentialCollateral
      Value
totalUTxOValue
      Map ScriptWitnessIndex ExecutionUnits
exUnitsMap
      (RequiredShelleyKeyWitnesses Int
numKeyWits)
      (RequiredByronKeyWitnesses Int
numByronWits)
      (TotalReferenceScriptsSize Int
totalRefScriptsSize) ->
        ShelleyBasedEra era
-> Either (AutoBalanceError era) (BalancedTxBody era)
-> (MaryEraOnwards era
    -> Either (AutoBalanceError era) (BalancedTxBody era))
-> Either (AutoBalanceError era) (BalancedTxBody era)
forall (eon :: * -> *) era a.
Eon eon =>
ShelleyBasedEra era -> a -> (eon era -> a) -> a
forShelleyBasedEraInEon
          ShelleyBasedEra era
era
          (AutoBalanceError era
-> Either (AutoBalanceError era) (BalancedTxBody era)
forall a b. a -> Either a b
Left (AutoBalanceError era
 -> Either (AutoBalanceError era) (BalancedTxBody era))
-> AutoBalanceError era
-> Either (AutoBalanceError era) (BalancedTxBody era)
forall a b. (a -> b) -> a -> b
$ TxFeeEstimationError era -> AutoBalanceError era
forall era. TxFeeEstimationError era -> AutoBalanceError era
AutoBalanceEstimationError TxFeeEstimationError era
forall era. TxFeeEstimationError era
TxFeeEstimationOnlyMaryOnwardsSupportedError)
          ( \MaryEraOnwards era
w ->
              (TxFeeEstimationError era -> AutoBalanceError era)
-> Either (TxFeeEstimationError era) (BalancedTxBody era)
-> Either (AutoBalanceError era) (BalancedTxBody 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 TxFeeEstimationError era -> AutoBalanceError era
forall era. TxFeeEstimationError era -> AutoBalanceError era
AutoBalanceEstimationError (Either (TxFeeEstimationError era) (BalancedTxBody era)
 -> Either (AutoBalanceError era) (BalancedTxBody era))
-> Either (TxFeeEstimationError era) (BalancedTxBody era)
-> Either (AutoBalanceError era) (BalancedTxBody era)
forall a b. (a -> b) -> a -> b
$
                MaryEraOnwards era
-> TxBodyContent BuildTx era
-> PParams (ShelleyLedgerEra era)
-> Set (Hash StakePoolKey)
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> Map ScriptWitnessIndex ExecutionUnits
-> Coin
-> Int
-> Int
-> Int
-> AddressInEra era
-> Value
-> Either (TxFeeEstimationError era) (BalancedTxBody era)
forall era.
MaryEraOnwards era
-> TxBodyContent BuildTx era
-> PParams (ShelleyLedgerEra era)
-> Set (Hash StakePoolKey)
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> Map ScriptWitnessIndex ExecutionUnits
-> Coin
-> Int
-> Int
-> Int
-> AddressInEra era
-> Value
-> Either (TxFeeEstimationError era) (BalancedTxBody era)
estimateBalancedTxBody
                  MaryEraOnwards era
w
                  TxBodyContent BuildTx era
txBodyContent
                  PParams (ShelleyLedgerEra era)
pparams
                  Set (Hash StakePoolKey)
poolids
                  Map StakeCredential Coin
stakeDelegDeposits
                  Map (Credential 'DRepRole StandardCrypto) Coin
drepDelegDeposits
                  Map ScriptWitnessIndex ExecutionUnits
exUnitsMap
                  Coin
totalPotentialCollateral
                  Int
numKeyWits
                  Int
numByronWits
                  Int
totalRefScriptsSize
                  AddressInEra era
changeAddr
                  Value
totalUTxOValue
          )

data TxFeeEstimationError era
  = TxFeeEstimationTransactionTranslationError (TransactionValidityError era)
  | TxFeeEstimationScriptExecutionError (TxBodyErrorAutoBalance era)
  | TxFeeEstimationBalanceError (TxBodyErrorAutoBalance era)
  | TxFeeEstimationxBodyError TxBodyError
  | TxFeeEstimationFinalConstructionError TxBodyError
  | TxFeeEstimationOnlyMaryOnwardsSupportedError
  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
    TxFeeEstimationTransactionTranslationError TransactionValidityError era
e -> TransactionValidityError era -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TransactionValidityError era -> Doc ann
prettyError TransactionValidityError era
e
    TxFeeEstimationScriptExecutionError TxBodyErrorAutoBalance era
e -> TxBodyErrorAutoBalance era -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxBodyErrorAutoBalance era -> Doc ann
prettyError TxBodyErrorAutoBalance era
e
    TxFeeEstimationBalanceError TxBodyErrorAutoBalance era
e -> TxBodyErrorAutoBalance era -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxBodyErrorAutoBalance era -> Doc ann
prettyError TxBodyErrorAutoBalance era
e
    TxFeeEstimationxBodyError TxBodyError
e -> TxBodyError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxBodyError -> Doc ann
prettyError TxBodyError
e
    TxFeeEstimationFinalConstructionError TxBodyError
e -> TxBodyError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxBodyError -> Doc ann
prettyError TxBodyError
e
    TxFeeEstimationError era
TxFeeEstimationOnlyMaryOnwardsSupportedError ->
      Doc ann
"Only mary era onwards supported."

-- | Use when you do not have access to the UTxOs you intend to spend
estimateBalancedTxBody
  :: forall era
   . MaryEraOnwards era
  -> TxBodyContent BuildTx era
  -> L.PParams (ShelleyLedgerEra era)
  -> Set PoolId
  -- ^ The set of registered stake pools, that are being
  --   unregistered in this transaction.
  -> Map StakeCredential L.Coin
  -- ^ Map of all deposits for stake credentials that are being
  --   unregistered in this transaction
  -> Map (Ledger.Credential Ledger.DRepRole Ledger.StandardCrypto) L.Coin
  -- ^ 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 still to be added to the transaction.
  -> Int
  -- ^ The number of Byron key witnesses still to be added to the transaction.
  -> Int
  -- ^ Size of all reference scripts in bytes
  -> AddressInEra era
  -- ^ Change address
  -> Value
  -- ^ Total value of UTxOs being spent
  -> Either (TxFeeEstimationError era) (BalancedTxBody era)
estimateBalancedTxBody :: forall era.
MaryEraOnwards era
-> TxBodyContent BuildTx era
-> PParams (ShelleyLedgerEra era)
-> Set (Hash StakePoolKey)
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> Map ScriptWitnessIndex ExecutionUnits
-> Coin
-> Int
-> Int
-> Int
-> AddressInEra era
-> Value
-> Either (TxFeeEstimationError era) (BalancedTxBody era)
estimateBalancedTxBody
  MaryEraOnwards era
w
  TxBodyContent BuildTx era
txbodycontent
  PParams (ShelleyLedgerEra era)
pparams
  Set (Hash StakePoolKey)
poolids
  Map StakeCredential Coin
stakeDelegDeposits
  Map (Credential 'DRepRole StandardCrypto) Coin
drepDelegDeposits
  Map ScriptWitnessIndex ExecutionUnits
exUnitsMap
  Coin
totalPotentialCollateral
  Int
intendedKeyWits
  Int
byronwits
  Int
sizeOfAllReferenceScripts
  AddressInEra era
changeaddr
  Value
totalUTxOValue = do
    -- Step 1. Substitute those execution units into the tx

    let sbe :: ShelleyBasedEra era
sbe = MaryEraOnwards era -> ShelleyBasedEra era
forall era. MaryEraOnwards era -> ShelleyBasedEra era
maryEraOnwardsToShelleyBasedEra MaryEraOnwards era
w
    TxBodyContent BuildTx era
txbodycontent1 <-
      MaryEraOnwards era
-> (MaryEraOnwardsConstraints era =>
    Either (TxFeeEstimationError era) (TxBodyContent BuildTx era))
-> Either (TxFeeEstimationError era) (TxBodyContent BuildTx era)
forall era a.
MaryEraOnwards era -> (MaryEraOnwardsConstraints era => a) -> a
maryEraOnwardsConstraints MaryEraOnwards era
w ((MaryEraOnwardsConstraints era =>
  Either (TxFeeEstimationError era) (TxBodyContent BuildTx era))
 -> Either (TxFeeEstimationError era) (TxBodyContent BuildTx era))
-> (MaryEraOnwardsConstraints era =>
    Either (TxFeeEstimationError era) (TxBodyContent BuildTx era))
-> Either (TxFeeEstimationError era) (TxBodyContent BuildTx era)
forall a b. (a -> b) -> a -> b
$
        (TxBodyErrorAutoBalance era -> TxFeeEstimationError era)
-> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
-> Either (TxFeeEstimationError era) (TxBodyContent BuildTx 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 era -> TxFeeEstimationError era
forall era. TxBodyErrorAutoBalance era -> TxFeeEstimationError era
TxFeeEstimationScriptExecutionError (Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
 -> Either (TxFeeEstimationError era) (TxBodyContent BuildTx era))
-> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
-> Either (TxFeeEstimationError era) (TxBodyContent BuildTx era)
forall a b. (a -> b) -> a -> b
$
          Map ScriptWitnessIndex ExecutionUnits
-> TxBodyContent BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
forall era.
Map ScriptWitnessIndex ExecutionUnits
-> TxBodyContent BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
substituteExecutionUnits Map ScriptWitnessIndex ExecutionUnits
exUnitsMap TxBodyContent BuildTx 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 :: [TxCert (ShelleyLedgerEra era)]
certificates =
          case TxBodyContent BuildTx era -> TxCertificates BuildTx era
forall build era.
TxBodyContent build era -> TxCertificates build era
txCertificates TxBodyContent BuildTx era
txbodycontent1 of
            TxCertificates BuildTx era
TxCertificatesNone -> []
            TxCertificates ShelleyBasedEra era
_ [Certificate era]
certs BuildTxWith BuildTx [(StakeCredential, Witness WitCtxStake era)]
_ -> (Certificate era -> TxCert (ShelleyLedgerEra era))
-> [Certificate era] -> [TxCert (ShelleyLedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map Certificate era -> TxCert (ShelleyLedgerEra era)
forall era. Certificate era -> TxCert (ShelleyLedgerEra era)
toShelleyCertificate [Certificate era]
certs

        proposalProcedures :: OSet.OSet (L.ProposalProcedure (ShelleyLedgerEra era))
        proposalProcedures :: OSet (ProposalProcedure (ShelleyLedgerEra era))
proposalProcedures =
          MaryEraOnwards era
-> (MaryEraOnwardsConstraints era =>
    OSet (ProposalProcedure (ShelleyLedgerEra era)))
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
forall era a.
MaryEraOnwards era -> (MaryEraOnwardsConstraints era => a) -> a
maryEraOnwardsConstraints MaryEraOnwards era
w ((MaryEraOnwardsConstraints era =>
  OSet (ProposalProcedure (ShelleyLedgerEra era)))
 -> OSet (ProposalProcedure (ShelleyLedgerEra era)))
-> (MaryEraOnwardsConstraints era =>
    OSet (ProposalProcedure (ShelleyLedgerEra era)))
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
            OSet (ProposalProcedure (ShelleyLedgerEra era))
-> (Featured
      ConwayEraOnwards era (TxProposalProcedures BuildTx era)
    -> OSet (ProposalProcedure (ShelleyLedgerEra era)))
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OSet (ProposalProcedure (ShelleyLedgerEra era))
forall a. Monoid a => a
mempty (TxProposalProcedures BuildTx era
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
forall build era.
TxProposalProcedures build era
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
convProposalProcedures (TxProposalProcedures BuildTx era
 -> OSet (ProposalProcedure (ShelleyLedgerEra era)))
-> (Featured
      ConwayEraOnwards era (TxProposalProcedures BuildTx era)
    -> TxProposalProcedures BuildTx era)
-> Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era)
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era)
-> TxProposalProcedures BuildTx era
forall (eon :: * -> *) era a. Featured eon era a -> a
unFeatured) (TxBodyContent BuildTx era
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
forall build era.
TxBodyContent build era
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures build era))
txProposalProcedures TxBodyContent BuildTx era
txbodycontent1)

        totalDeposits :: L.Coin
        totalDeposits :: 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
                [ MaryEraOnwards era
-> (MaryEraOnwardsConstraints era => Coin) -> Coin
forall era a.
MaryEraOnwards era -> (MaryEraOnwardsConstraints era => a) -> a
maryEraOnwardsConstraints MaryEraOnwards era
w ((MaryEraOnwardsConstraints era => Coin) -> Coin)
-> (MaryEraOnwardsConstraints era => Coin) -> Coin
forall a b. (a -> b) -> a -> b
$
                    PParams (ShelleyLedgerEra era)
-> (KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era)) -> Bool)
-> [TxCert (ShelleyLedgerEra era)]
-> Coin
forall era (f :: * -> *).
(EraTxCert era, Foldable f) =>
PParams era
-> (KeyHash 'StakePool (EraCrypto era) -> Bool)
-> f (TxCert era)
-> Coin
forall (f :: * -> *).
Foldable f =>
PParams (ShelleyLedgerEra era)
-> (KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era)) -> Bool)
-> f (TxCert (ShelleyLedgerEra era))
-> Coin
L.getTotalDepositsTxCerts PParams (ShelleyLedgerEra era)
pparams KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era)) -> Bool
KeyHash 'StakePool StandardCrypto -> Bool
forall {b}. b -> Bool
assumeStakePoolHasNotBeenRegistered [TxCert (ShelleyLedgerEra era)]
certificates
                , MaryEraOnwards era
-> (MaryEraOnwardsConstraints era => Coin) -> Coin
forall era a.
MaryEraOnwards era -> (MaryEraOnwardsConstraints era => a) -> a
maryEraOnwardsConstraints MaryEraOnwards era
w ((MaryEraOnwardsConstraints era => Coin) -> Coin)
-> (MaryEraOnwardsConstraints 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 (ShelleyLedgerEra era) -> Coin)
-> [ProposalProcedure (ShelleyLedgerEra era)] -> [Coin]
forall a b. (a -> b) -> [a] -> [b]
map (ProposalProcedure (ShelleyLedgerEra era)
-> Getting Coin (ProposalProcedure (ShelleyLedgerEra era)) Coin
-> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (ProposalProcedure (ShelleyLedgerEra era)) Coin
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin)
-> ProposalProcedure era -> f (ProposalProcedure era)
L.pProcDepositL) ([ProposalProcedure (ShelleyLedgerEra era)] -> [Coin])
-> [ProposalProcedure (ShelleyLedgerEra era)] -> [Coin]
forall a b. (a -> b) -> a -> b
$
                        OSet (ProposalProcedure (ShelleyLedgerEra era))
-> [Item (OSet (ProposalProcedure (ShelleyLedgerEra era)))]
forall l. IsList l => l -> [Item l]
toList OSet (ProposalProcedure (ShelleyLedgerEra era))
proposalProcedures
                ]

        availableUTxOValue :: Value
availableUTxOValue =
          [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat
            [ Value
totalUTxOValue
            , Value -> Value
negateValue (Coin -> Value
lovelaceToValue Coin
totalDeposits)
            ]

    let change :: Value (ShelleyLedgerEra era)
change = MaryEraOnwards era -> Value -> Value (ShelleyLedgerEra era)
forall era.
MaryEraOnwards era -> Value -> Value (ShelleyLedgerEra era)
toLedgerValue MaryEraOnwards era
w (Value -> Value (ShelleyLedgerEra era))
-> Value -> Value (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> Value -> TxBodyContent BuildTx era -> Value
forall era build.
ShelleyBasedEra era -> Value -> TxBodyContent build era -> Value
calculateChangeValue ShelleyBasedEra era
sbe Value
availableUTxOValue TxBodyContent BuildTx era
txbodycontent1
        maxLovelaceChange :: Coin
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 :: Value (ShelleyLedgerEra era)
changeWithMaxLovelace = Value (ShelleyLedgerEra era)
change Value (ShelleyLedgerEra era)
-> (Value (ShelleyLedgerEra era) -> Value (ShelleyLedgerEra era))
-> Value (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& ShelleyBasedEra era -> Lens' (Value (ShelleyLedgerEra era)) Coin
forall era.
ShelleyBasedEra era -> Lens' (Value (ShelleyLedgerEra era)) Coin
A.adaAssetL ShelleyBasedEra era
sbe ((Coin -> Identity Coin)
 -> Value (ShelleyLedgerEra era)
 -> Identity (Value (ShelleyLedgerEra era)))
-> Coin
-> Value (ShelleyLedgerEra era)
-> Value (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
maxLovelaceChange
        changeTxOut :: TxOutValue era
changeTxOut =
          ShelleyBasedEra era
-> TxOutValue era
-> (MaryEraOnwards era -> TxOutValue era)
-> TxOutValue era
forall (eon :: * -> *) era a.
Eon eon =>
ShelleyBasedEra era -> a -> (eon era -> a) -> a
forShelleyBasedEraInEon
            ShelleyBasedEra era
sbe
            (ShelleyBasedEra era -> Coin -> TxOutValue era
forall era. ShelleyBasedEra era -> Coin -> TxOutValue era
lovelaceToTxOutValue ShelleyBasedEra era
sbe Coin
maxLovelaceChange)
            (\MaryEraOnwards era
w' -> MaryEraOnwards era
-> (MaryEraOnwardsConstraints era => TxOutValue era)
-> TxOutValue era
forall era a.
MaryEraOnwards era -> (MaryEraOnwardsConstraints era => a) -> a
maryEraOnwardsConstraints MaryEraOnwards era
w' ((MaryEraOnwardsConstraints era => TxOutValue era)
 -> TxOutValue era)
-> (MaryEraOnwardsConstraints era => TxOutValue era)
-> TxOutValue era
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
forall era.
(Eq (Value (ShelleyLedgerEra era)),
 Show (Value (ShelleyLedgerEra era))) =>
ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
TxOutValueShelleyBased ShelleyBasedEra era
sbe Value (ShelleyLedgerEra era)
changeWithMaxLovelace)

    let (TxReturnCollateral CtxTx era
dummyCollRet, TxTotalCollateral era
dummyTotColl) = ShelleyBasedEra era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
maybeDummyTotalCollAndCollReturnOutput ShelleyBasedEra era
sbe TxBodyContent BuildTx era
txbodycontent AddressInEra era
changeaddr

    -- Step 3. Create a tx body with out max lovelace fee. This is strictly for
    -- calculating our fee with evaluateTransactionFee.
    let maxLovelaceFee :: Coin
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)
    TxBody era
txbody1ForFeeEstimateOnly <-
      (TxBodyError -> TxFeeEstimationError era)
-> Either TxBodyError (TxBody era)
-> Either (TxFeeEstimationError era) (TxBody 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 TxBodyError -> TxFeeEstimationError era
forall era. TxBodyError -> TxFeeEstimationError era
TxFeeEstimationxBodyError (Either TxBodyError (TxBody era)
 -> Either (TxFeeEstimationError era) (TxBody era))
-> Either TxBodyError (TxBody era)
-> Either (TxFeeEstimationError era) (TxBody era)
forall a b. (a -> b) -> a -> b
$ -- TODO: impossible to fail now
        ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
createTransactionBody
          ShelleyBasedEra era
sbe
          TxBodyContent BuildTx era
txbodycontent1
            { txFee = TxFeeExplicit sbe maxLovelaceFee
            , txOuts =
                TxOut changeaddr changeTxOut TxOutDatumNone ReferenceScriptNone
                  : txOuts txbodycontent
            , txReturnCollateral = dummyCollRet
            , txTotalCollateral = dummyTotColl
            }
    let fee :: Coin
fee =
          ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> TxBody era
-> Word
-> Word
-> Int
-> Coin
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> TxBody era
-> Word
-> Word
-> Int
-> Coin
evaluateTransactionFee
            ShelleyBasedEra era
sbe
            PParams (ShelleyLedgerEra era)
pparams
            TxBody 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
        (TxReturnCollateral CtxTx era
retColl, TxTotalCollateral era
reqCol) =
          (ShelleyToAlonzoEraConstraints era =>
 ShelleyToAlonzoEra era
 -> (TxReturnCollateral CtxTx era, TxTotalCollateral era))
-> (BabbageEraOnwardsConstraints era =>
    BabbageEraOnwards era
    -> (TxReturnCollateral CtxTx era, TxTotalCollateral era))
-> ShelleyBasedEra era
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
forall era a.
(ShelleyToAlonzoEraConstraints era => ShelleyToAlonzoEra era -> a)
-> (BabbageEraOnwardsConstraints era => BabbageEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToAlonzoOrBabbageEraOnwards
            ((TxReturnCollateral CtxTx era, TxTotalCollateral era)
-> ShelleyToAlonzoEra era
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
forall a b. a -> b -> a
const (TxReturnCollateral CtxTx era
forall ctx era. TxReturnCollateral ctx era
TxReturnCollateralNone, TxTotalCollateral era
forall era. TxTotalCollateral era
TxTotalCollateralNone))
            ( \BabbageEraOnwards era
w' ->
                BabbageEraOnwards era
-> Coin
-> PParams (ShelleyLedgerEra era)
-> TxInsCollateral era
-> TxReturnCollateral CtxTx era
-> TxTotalCollateral era
-> AddressInEra era
-> Value (ShelleyLedgerEra era)
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
forall era.
AlonzoEraPParams (ShelleyLedgerEra era) =>
BabbageEraOnwards era
-> Coin
-> PParams (ShelleyLedgerEra era)
-> TxInsCollateral era
-> TxReturnCollateral CtxTx era
-> TxTotalCollateral era
-> AddressInEra era
-> Value (ShelleyLedgerEra era)
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
calcReturnAndTotalCollateral
                  BabbageEraOnwards era
w'
                  Coin
fee
                  PParams (ShelleyLedgerEra era)
pparams
                  (TxBodyContent BuildTx era -> TxInsCollateral era
forall build era. TxBodyContent build era -> TxInsCollateral era
txInsCollateral TxBodyContent BuildTx era
txbodycontent)
                  (TxBodyContent BuildTx era -> TxReturnCollateral CtxTx era
forall build era.
TxBodyContent build era -> TxReturnCollateral CtxTx era
txReturnCollateral TxBodyContent BuildTx era
txbodycontent)
                  (TxBodyContent BuildTx era -> TxTotalCollateral era
forall build era. TxBodyContent build era -> TxTotalCollateral era
txTotalCollateral TxBodyContent BuildTx era
txbodycontent)
                  AddressInEra era
changeaddr
                  (ShelleyBasedEra era -> Coin -> Value (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> Coin -> Value (ShelleyLedgerEra era)
A.mkAdaValue ShelleyBasedEra era
sbe Coin
totalPotentialCollateral)
            )
            ShelleyBasedEra era
sbe

    -- 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
    TxBody era
txbody2 <-
      (TxBodyError -> TxFeeEstimationError era)
-> Either TxBodyError (TxBody era)
-> Either (TxFeeEstimationError era) (TxBody 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 TxBodyError -> TxFeeEstimationError era
forall era. TxBodyError -> TxFeeEstimationError era
TxFeeEstimationxBodyError (Either TxBodyError (TxBody era)
 -> Either (TxFeeEstimationError era) (TxBody era))
-> Either TxBodyError (TxBody era)
-> Either (TxFeeEstimationError era) (TxBody era)
forall a b. (a -> b) -> a -> b
$ -- TODO: impossible to fail now
        ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
createTransactionBody
          ShelleyBasedEra era
sbe
          TxBodyContent BuildTx era
txbodycontent1
            { txFee = TxFeeExplicit sbe fee
            , txReturnCollateral = retColl
            , txTotalCollateral = reqCol
            }

    let fakeUTxO :: UTxO era
fakeUTxO = ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Coin -> UTxO era
forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Coin -> UTxO era
createFakeUTxO ShelleyBasedEra era
sbe TxBodyContent BuildTx era
txbodycontent1 (Coin -> UTxO era) -> Coin -> UTxO era
forall a b. (a -> b) -> a -> b
$ Value -> Coin
selectLovelace Value
availableUTxOValue
        balance :: TxOutValue era
balance =
          ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> Set (Hash StakePoolKey)
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> UTxO era
-> TxBody era
-> TxOutValue era
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> Set (Hash StakePoolKey)
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> UTxO era
-> TxBody era
-> TxOutValue era
evaluateTransactionBalance ShelleyBasedEra era
sbe PParams (ShelleyLedgerEra era)
pparams Set (Hash StakePoolKey)
poolids Map StakeCredential Coin
stakeDelegDeposits Map (Credential 'DRepRole StandardCrypto) Coin
drepDelegDeposits UTxO era
fakeUTxO TxBody era
txbody2
    -- check if the balance is positive or negative
    -- in one case we can produce change, in the other the inputs are insufficient
    (TxBodyErrorAutoBalance era -> TxFeeEstimationError era)
-> Either (TxBodyErrorAutoBalance era) ()
-> 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 era -> TxFeeEstimationError era
forall era. TxBodyErrorAutoBalance era -> TxFeeEstimationError era
TxFeeEstimationBalanceError (Either (TxBodyErrorAutoBalance era) ()
 -> Either (TxFeeEstimationError era) ())
-> Either (TxBodyErrorAutoBalance era) ()
-> Either (TxFeeEstimationError era) ()
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> AddressInEra era
-> TxOutValue era
-> Either (TxBodyErrorAutoBalance era) ()
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> AddressInEra era
-> TxOutValue era
-> Either (TxBodyErrorAutoBalance era) ()
balanceCheck ShelleyBasedEra era
sbe PParams (ShelleyLedgerEra era)
pparams AddressInEra era
changeaddr TxOutValue era
balance

    -- Step 6. Check all txouts have the min required UTxO value
    [TxOut CtxTx era]
-> (TxOut CtxTx era -> Either (TxFeeEstimationError era) ())
-> Either (TxFeeEstimationError era) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (TxBodyContent BuildTx era -> [TxOut CtxTx era]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts TxBodyContent BuildTx era
txbodycontent1) ((TxOut CtxTx era -> Either (TxFeeEstimationError era) ())
 -> Either (TxFeeEstimationError era) ())
-> (TxOut CtxTx era -> Either (TxFeeEstimationError era) ())
-> Either (TxFeeEstimationError era) ()
forall a b. (a -> b) -> a -> b
$
      \TxOut CtxTx era
txout -> (TxBodyErrorAutoBalance era -> TxFeeEstimationError era)
-> Either (TxBodyErrorAutoBalance era) ()
-> 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 era -> TxFeeEstimationError era
forall era. TxBodyErrorAutoBalance era -> TxFeeEstimationError era
TxFeeEstimationBalanceError (Either (TxBodyErrorAutoBalance era) ()
 -> Either (TxFeeEstimationError era) ())
-> Either (TxBodyErrorAutoBalance era) ()
-> Either (TxFeeEstimationError era) ()
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> TxOut CtxTx era
-> PParams (ShelleyLedgerEra era)
-> Either (TxBodyErrorAutoBalance era) ()
forall era.
ShelleyBasedEra era
-> TxOut CtxTx era
-> PParams (ShelleyLedgerEra era)
-> Either (TxBodyErrorAutoBalance era) ()
checkMinUTxOValue ShelleyBasedEra era
sbe TxOut CtxTx era
txout PParams (ShelleyLedgerEra era)
pparams

    -- 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 BuildTx era
finalTxBodyContent =
          TxBodyContent BuildTx era
txbodycontent1
            { txFee = TxFeeExplicit sbe fee
            , txOuts =
                accountForNoChange
                  (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone)
                  (txOuts txbodycontent)
            , txReturnCollateral = retColl
            , txTotalCollateral = reqCol
            }
    TxBody era
txbody3 <-
      (TxBodyError -> TxFeeEstimationError era)
-> Either TxBodyError (TxBody era)
-> Either (TxFeeEstimationError era) (TxBody 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 TxBodyError -> TxFeeEstimationError era
forall era. TxBodyError -> TxFeeEstimationError era
TxFeeEstimationFinalConstructionError (Either TxBodyError (TxBody era)
 -> Either (TxFeeEstimationError era) (TxBody era))
-> Either TxBodyError (TxBody era)
-> Either (TxFeeEstimationError era) (TxBody era)
forall a b. (a -> b) -> a -> b
$ -- TODO: impossible to fail now. We need to implement a function
      -- that simply creates a transaction body because we have already
      -- validated the transaction body earlier within makeTransactionBodyAutoBalance
        ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
createTransactionBody ShelleyBasedEra era
sbe TxBodyContent BuildTx era
finalTxBodyContent
    BalancedTxBody era
-> Either (TxFeeEstimationError era) (BalancedTxBody era)
forall a. a -> Either (TxFeeEstimationError era) a
forall (m :: * -> *) a. Monad m => a -> m a
return
      ( TxBodyContent BuildTx era
-> UnsignedTx era -> TxOut CtxTx era -> Coin -> BalancedTxBody era
forall era.
TxBodyContent BuildTx era
-> UnsignedTx era -> TxOut CtxTx era -> Coin -> BalancedTxBody era
BalancedTxBody
          TxBodyContent BuildTx era
finalTxBodyContent
          (ShelleyBasedEra era -> TxBody era -> UnsignedTx era
forall era.
HasCallStack =>
ShelleyBasedEra era -> TxBody era -> UnsignedTx era
convertTxBodyToUnsignedTx ShelleyBasedEra era
sbe TxBody era
txbody3)
          (AddressInEra era
-> TxOutValue era
-> TxOutDatum CtxTx era
-> ReferenceScript era
-> TxOut CtxTx era
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
TxOut AddressInEra era
changeaddr TxOutValue era
balance TxOutDatum CtxTx era
forall ctx era. TxOutDatum ctx era
TxOutDatumNone ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone)
          Coin
fee
      )

--- ----------------------------------------------------------------------------
--- Transaction fees
---

-- | Compute the transaction fee for a proposed transaction, with the
-- assumption that there will be the given number of key witnesses (i.e.
-- signatures).
--
-- Use 'calculateMinTxFee' if possible as that function is more accurate.
evaluateTransactionFee
  :: forall era
   . ()
  => ShelleyBasedEra era
  -> Ledger.PParams (ShelleyLedgerEra era)
  -> TxBody 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.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> TxBody era
-> Word
-> Word
-> Int
-> Coin
evaluateTransactionFee ShelleyBasedEra era
sbe PParams (ShelleyLedgerEra era)
pp TxBody era
txbody Word
keywitcount Word
byronwitcount Int
refScriptsSize =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Coin) -> Coin
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Coin) -> Coin)
-> (ShelleyBasedEraConstraints era => Coin) -> Coin
forall a b. (a -> b) -> a -> b
$
    case CardanoEra era -> [KeyWitness era] -> TxBody era -> Tx era
forall era.
CardanoEra era -> [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction' (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
sbe) [] TxBody era
txbody of
      ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
tx ->
        PParams (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era) -> Int -> Int -> Int -> Coin
forall era.
EraTx era =>
PParams era -> Tx era -> Int -> Int -> Int -> Coin
L.estimateMinFeeTx PParams (ShelleyLedgerEra era)
pp Tx (ShelleyLedgerEra 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

-- | Estimate minimum transaction fee for a proposed transaction by looking
-- into the transaction and figuring out how many and what kind of key
-- witnesses this transaction needs.
--
-- It requires access to the portion of the `UTxO` that is relevant for this
-- transaction in order to lookup any txins included in the transaction.
--
-- The only type of witnesses that it cannot figure out reliably is the
-- witnesses needed for satisfying native scripts included in the transaction.
--
-- For this reason number of witnesses needed for native scripts must be
-- supplied as an extra argument.
calculateMinTxFee
  :: forall era
   . ()
  => ShelleyBasedEra era
  -> Ledger.PParams (ShelleyLedgerEra era)
  -> UTxO era
  -> TxBody era
  -> Word
  -- ^ The number of Shelley key witnesses
  -> L.Coin
calculateMinTxFee :: forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> UTxO era
-> TxBody era
-> Word
-> Coin
calculateMinTxFee ShelleyBasedEra era
sbe PParams (ShelleyLedgerEra era)
pp UTxO era
utxo TxBody era
txbody Word
keywitcount =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Coin) -> Coin
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Coin) -> Coin)
-> (ShelleyBasedEraConstraints era => Coin) -> Coin
forall a b. (a -> b) -> a -> b
$
    case CardanoEra era -> [KeyWitness era] -> TxBody era -> Tx era
forall era.
CardanoEra era -> [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction' (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
sbe) [] TxBody era
txbody of
      ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
tx ->
        UTxO (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
-> Int
-> Coin
forall era.
EraUTxO era =>
UTxO era -> PParams era -> Tx era -> Int -> Coin
L.calcMinFeeTx (ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
toLedgerUTxO ShelleyBasedEra era
sbe UTxO era
utxo) PParams (ShelleyLedgerEra era)
pp Tx (ShelleyLedgerEra era)
tx (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
keywitcount)

-- | Give an approximate count of the number of key witnesses (i.e. signatures)
-- a transaction will need.
--
-- This is an estimate not a precise count in that it can over-estimate: it
-- makes conservative assumptions such as all inputs are from distinct
-- addresses, but in principle multiple inputs can use the same address and we
-- only need a witness per address.
--
-- Similarly there can be overlap between the regular and collateral inputs,
-- but we conservatively assume they are distinct.
--
-- TODO: it is worth us considering a more precise count that relies on the
-- UTxO to resolve which inputs are for distinct addresses, and also to count
-- the number of Shelley vs Byron style witnesses.
estimateTransactionKeyWitnessCount :: TxBodyContent BuildTx era -> Word
estimateTransactionKeyWitnessCount :: forall era. TxBodyContent BuildTx era -> Word
estimateTransactionKeyWitnessCount
  TxBodyContent
    { TxIns BuildTx era
txIns :: TxIns BuildTx era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txIns
    , TxInsCollateral era
txInsCollateral :: forall build era. TxBodyContent build era -> TxInsCollateral era
txInsCollateral :: TxInsCollateral era
txInsCollateral
    , TxExtraKeyWitnesses era
txExtraKeyWits :: TxExtraKeyWitnesses era
txExtraKeyWits :: forall build era.
TxBodyContent build era -> TxExtraKeyWitnesses era
txExtraKeyWits
    , TxWithdrawals BuildTx era
txWithdrawals :: TxWithdrawals BuildTx era
txWithdrawals :: forall build era.
TxBodyContent build era -> TxWithdrawals build era
txWithdrawals
    , TxCertificates BuildTx era
txCertificates :: forall build era.
TxBodyContent build era -> TxCertificates build era
txCertificates :: TxCertificates BuildTx era
txCertificates
    , TxUpdateProposal era
txUpdateProposal :: TxUpdateProposal era
txUpdateProposal :: forall build era. TxBodyContent build era -> TxUpdateProposal era
txUpdateProposal
    } =
    Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$
      [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | (TxIn
_txin, BuildTxWith KeyWitness{}) <- TxIns BuildTx era
txIns]
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case TxInsCollateral era
txInsCollateral of
          TxInsCollateral AlonzoEraOnwards era
_ [TxIn]
txins ->
            [TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxIn]
txins
          TxInsCollateral era
_ -> Int
0
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case TxExtraKeyWitnesses era
txExtraKeyWits of
          TxExtraKeyWitnesses AlonzoEraOnwards era
_ [Hash PaymentKey]
khs ->
            [Hash PaymentKey] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Hash PaymentKey]
khs
          TxExtraKeyWitnesses era
_ -> Int
0
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case TxWithdrawals BuildTx era
txWithdrawals of
          TxWithdrawals ShelleyBasedEra era
_ [(StakeAddress, Coin,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
withdrawals ->
            [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | (StakeAddress
_, Coin
_, BuildTxWith KeyWitness{}) <- [(StakeAddress, Coin,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
withdrawals]
          TxWithdrawals BuildTx era
_ -> Int
0
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case TxCertificates BuildTx era
txCertificates of
          TxCertificates ShelleyBasedEra era
_ [Certificate era]
_ (BuildTxWith [(StakeCredential, Witness WitCtxStake era)]
witnesses) ->
            [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | (StakeCredential
_, KeyWitness{}) <- [(StakeCredential, Witness WitCtxStake era)]
witnesses]
          TxCertificates BuildTx era
_ -> Int
0
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case TxUpdateProposal era
txUpdateProposal of
          TxUpdateProposal ShelleyToBabbageEra era
_ (UpdateProposal Map (Hash GenesisKey) ProtocolParametersUpdate
updatePerGenesisKey EpochNo
_) ->
            Map (Hash GenesisKey) ProtocolParametersUpdate -> Int
forall k a. Map k a -> Int
Map.size Map (Hash GenesisKey) ProtocolParametersUpdate
updatePerGenesisKey
          TxUpdateProposal era
_ -> Int
0

-- ----------------------------------------------------------------------------
-- Script execution units
--

type PlutusScriptBytes = ShortByteString

data ResolvablePointers where
  ResolvablePointers
    :: ( Ledger.Era (ShelleyLedgerEra era)
       , Show (L.PlutusPurpose L.AsIx (ShelleyLedgerEra era))
       , Show (L.PlutusPurpose L.AsItem (ShelleyLedgerEra era))
       , Show (Alonzo.PlutusScript (ShelleyLedgerEra era))
       )
    => ShelleyBasedEra era
    -> !( Map
            (L.PlutusPurpose L.AsIx (ShelleyLedgerEra era))
            ( L.PlutusPurpose L.AsItem (ShelleyLedgerEra era)
            , Maybe (PlutusScriptBytes, Plutus.Language)
            , Ledger.ScriptHash Ledger.StandardCrypto
            )
        )
    -> ResolvablePointers

deriving instance Show ResolvablePointers

-- | The different possible reasons that executing a script can fail,
-- as reported by 'evaluateTransactionExecutionUnits'.
--
-- The first three of these are about failures before we even get to execute
-- the script, and two are the result of execution.
--
-- TODO: We should replace ScriptWitnessIndex with ledger's
-- PlutusPurpose AsIx ledgerera. This would necessitate the
-- parameterization of ScriptExecutionError.
data ScriptExecutionError
  = -- | The script depends on a 'TxIn' that has not been provided in the
    -- given 'UTxO' subset. The given 'UTxO' must cover all the inputs
    -- the transaction references.
    ScriptErrorMissingTxIn TxIn
  | -- | The 'TxIn' the script is spending does not have a 'ScriptDatum'.
    -- All inputs guarded by Plutus scripts need to have been created with
    -- a 'ScriptDatum'.
    ScriptErrorTxInWithoutDatum TxIn
  | -- | The 'ScriptDatum' provided does not match the one from the 'UTxO'.
    -- This means the wrong 'ScriptDatum' value has been provided.
    ScriptErrorWrongDatum (Hash ScriptData)
  | -- | The script evaluation failed. This usually means it evaluated to an
    -- error value. This is not a case of running out of execution units
    -- (which is not possible for 'evaluateTransactionExecutionUnits' since
    -- the whole point of it is to discover how many execution units are
    -- needed).
    ScriptErrorEvaluationFailed Plutus.EvaluationError [Text.Text]
  | -- | The execution units overflowed a 64bit word. Congratulations if
    -- you encounter this error. With the current style of cost model this
    -- would need a script to run for over 7 months, which is somewhat more
    -- than the expected maximum of a few milliseconds.
    ScriptErrorExecutionUnitsOverflow
  | -- | An attempt was made to spend a key witnessed tx input
    -- with a script witness.
    ScriptErrorNotPlutusWitnessedTxIn ScriptWitnessIndex ScriptHash
  | -- | The redeemer pointer points to a script hash that does not exist
    -- in the transaction nor in the UTxO as a reference script"
    ScriptErrorRedeemerPointsToUnknownScriptHash ScriptWitnessIndex
  | -- | A redeemer pointer points to a script that does not exist.
    ScriptErrorMissingScript
      ScriptWitnessIndex -- The invalid pointer
      ResolvablePointers -- A mapping a pointers that are possible to resolve
  | -- | A cost model was missing for a language which was used.
    ScriptErrorMissingCostModel Plutus.Language
  | forall era.
    ( Plutus.EraPlutusContext (ShelleyLedgerEra era)
    , Show (Plutus.ContextError (ShelleyLedgerEra era))
    ) =>
    ScriptErrorTranslationError (Plutus.ContextError (ShelleyLedgerEra era))

deriving instance Show ScriptExecutionError

instance Error ScriptExecutionError where
  prettyError :: forall ann. ScriptExecutionError -> Doc ann
prettyError = \case
    ScriptErrorMissingTxIn TxIn
txin ->
      Doc ann
"The supplied UTxO is missing the txin " 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 (TxIn -> Text
renderTxIn TxIn
txin)
    ScriptErrorTxInWithoutDatum TxIn
txin ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The Plutus script witness for the txin does not have a script datum "
        , Doc ann
"(according to the UTxO). The txin in question is "
        , Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TxIn -> Text
renderTxIn TxIn
txin)
        ]
    ScriptErrorWrongDatum Hash ScriptData
dh ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The Plutus script witness has the wrong datum (according to the UTxO). "
        , Doc ann
"The expected datum value has hash " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Hash ScriptData -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Hash ScriptData
dh
        ]
    ScriptErrorEvaluationFailed EvaluationError
evalErr [Text]
logs ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The Plutus script evaluation failed: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> EvaluationError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. EvaluationError -> Doc ann
pretty EvaluationError
evalErr
        , Doc ann
"\nScript debugging logs: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
t -> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
`Text.append` Text
"\n") [Text]
logs)
        ]
    ScriptExecutionError
ScriptErrorExecutionUnitsOverflow ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The execution units required by this Plutus script overflows a 64bit "
        , Doc ann
"word. In a properly configured chain this should be practically "
        , Doc ann
"impossible. So this probably indicates a chain configuration problem, "
        , Doc ann
"perhaps with the values in the cost model."
        ]
    ScriptErrorNotPlutusWitnessedTxIn ScriptWitnessIndex
scriptWitness ScriptHash
scriptHash ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ScriptWitnessIndex -> String
renderScriptWitnessIndex ScriptWitnessIndex
scriptWitness)
        , Doc ann
" is not a Plutus script witnessed tx input and cannot be spent using a "
        , Doc ann
"Plutus script witness.The script hash is " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ScriptHash
scriptHash Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."
        ]
    ScriptErrorRedeemerPointsToUnknownScriptHash ScriptWitnessIndex
scriptWitness ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ScriptWitnessIndex -> String
renderScriptWitnessIndex ScriptWitnessIndex
scriptWitness)
        , Doc ann
" points to a script hash that is not known."
        ]
    ScriptErrorMissingScript ScriptWitnessIndex
rdmrPtr ResolvablePointers
resolveable ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The 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
rdmrPtr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" points to a Plutus "
        , Doc ann
"script that does not exist.\n"
        , Doc ann
"The pointers that can be resolved are: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ResolvablePointers -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ResolvablePointers
resolveable
        ]
    ScriptErrorMissingCostModel Language
language ->
      Doc ann
"No cost model was found for language " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Language -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Language
language
    ScriptErrorTranslationError ContextError (ShelleyLedgerEra era)
e ->
      Doc ann
"Error translating the transaction context: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ContextError (ShelleyLedgerEra era) -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ContextError (ShelleyLedgerEra era)
e

data TransactionValidityError era where
  -- | The transaction validity interval is too far into the future.
  --
  -- Transactions with Plutus scripts need to have a validity interval that is
  -- not so far in the future that we cannot reliably determine the UTC time
  -- corresponding to the validity interval expressed in slot numbers.
  --
  -- This is because the Plutus scripts get given the transaction validity
  -- interval in UTC time, so that they are not sensitive to slot lengths.
  --
  -- If either end of the validity interval is beyond the so called \"time
  -- horizon\" then the consensus algorithm is not able to reliably determine
  -- the relationship between slots and time. This is this situation in which
  -- this error is reported. For the Cardano mainnet the time horizon is 36
  -- hours beyond the current time. This effectively means we cannot submit
  -- check or submit transactions that use Plutus scripts that have the end
  -- of their validity interval more than 36 hours into the future.
  TransactionValidityIntervalError
    :: Consensus.PastHorizonException -> TransactionValidityError era
  TransactionValidityCostModelError
    :: (Map AnyPlutusScriptVersion CostModel) -> String -> TransactionValidityError era

deriving instance Show (TransactionValidityError era)

instance Error (TransactionValidityError era) where
  prettyError :: forall ann. TransactionValidityError era -> Doc ann
prettyError = \case
    TransactionValidityIntervalError PastHorizonException
pastTimeHorizon ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The transaction validity interval is too far in the future. "
        , Doc ann
"For this network it must not be more than "
        , Word -> Doc ann
forall ann. Word -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (PastHorizonException -> Word
timeHorizonSlots PastHorizonException
pastTimeHorizon)
        , Doc ann
"slots ahead of the current time slot. "
        , Doc ann
"(Transactions with Plutus scripts must have validity intervals that "
        , Doc ann
"are close enough in the future that we can reliably turn the slot "
        , Doc ann
"numbers into UTC wall clock times.)"
        ]
     where
      timeHorizonSlots :: Consensus.PastHorizonException -> Word
      timeHorizonSlots :: PastHorizonException -> Word
timeHorizonSlots Consensus.PastHorizon{[EraSummary]
pastHorizonSummary :: [EraSummary]
pastHorizonSummary :: PastHorizonException -> [EraSummary]
Consensus.pastHorizonSummary}
        | eraSummaries :: [EraSummary]
eraSummaries@(EraSummary
_ : [EraSummary]
_) <- [EraSummary]
pastHorizonSummary
        , Consensus.StandardSafeZone Word64
slots <-
            (EraParams -> SafeZone
Consensus.eraSafeZone (EraParams -> SafeZone)
-> ([EraSummary] -> EraParams) -> [EraSummary] -> SafeZone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraSummary -> EraParams
Consensus.eraParams (EraSummary -> EraParams)
-> ([EraSummary] -> EraSummary) -> [EraSummary] -> EraParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EraSummary] -> EraSummary
forall a. HasCallStack => [a] -> a
last) [EraSummary]
eraSummaries =
            Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slots
        | Bool
otherwise =
            Word
0 -- This should be impossible.
    TransactionValidityCostModelError Map AnyPlutusScriptVersion CostModel
cModels String
err ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"An error occurred while converting from the cardano-api cost"
        , Doc ann
" models to the cardano-ledger cost models. Error: " 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 String
err
        , Doc ann
" Cost models: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Map AnyPlutusScriptVersion CostModel -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Map AnyPlutusScriptVersion CostModel
cModels
        ]

-- | Compute the 'ExecutionUnits' needed for each script in the transaction.
--
-- This works by running all the scripts and counting how many execution units
-- are actually used.
evaluateTransactionExecutionUnits
  :: forall era
   . ()
  => CardanoEra era
  -> SystemStart
  -> LedgerEpochInfo
  -> LedgerProtocolParameters era
  -> UTxO era
  -> TxBody era
  -> Either
      (TransactionValidityError era)
      (Map ScriptWitnessIndex (Either ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
evaluateTransactionExecutionUnits :: forall era.
CardanoEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> TxBody era
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
evaluateTransactionExecutionUnits CardanoEra era
era SystemStart
systemstart LedgerEpochInfo
epochInfo LedgerProtocolParameters era
pp UTxO era
utxo TxBody era
txbody =
  case CardanoEra era -> [KeyWitness era] -> TxBody era -> Tx era
forall era.
CardanoEra era -> [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction' CardanoEra era
era [] TxBody era
txbody of
    ShelleyTx ShelleyBasedEra era
sbe Tx (ShelleyLedgerEra era)
tx' -> ShelleyBasedEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> Tx (ShelleyLedgerEra era)
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
forall era.
ShelleyBasedEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> Tx (ShelleyLedgerEra era)
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
evaluateTransactionExecutionUnitsShelley ShelleyBasedEra era
sbe SystemStart
systemstart LedgerEpochInfo
epochInfo LedgerProtocolParameters era
pp UTxO era
utxo Tx (ShelleyLedgerEra era)
tx'

evaluateTransactionExecutionUnitsShelley
  :: forall era
   . ()
  => ShelleyBasedEra era
  -> SystemStart
  -> LedgerEpochInfo
  -> LedgerProtocolParameters era
  -> UTxO era
  -> L.Tx (ShelleyLedgerEra era)
  -> Either
      (TransactionValidityError era)
      (Map ScriptWitnessIndex (Either ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
evaluateTransactionExecutionUnitsShelley :: forall era.
ShelleyBasedEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> Tx (ShelleyLedgerEra era)
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
evaluateTransactionExecutionUnitsShelley ShelleyBasedEra era
sbe SystemStart
systemstart LedgerEpochInfo
epochInfo (LedgerProtocolParameters PParams (ShelleyLedgerEra era)
pp) UTxO era
utxo Tx (ShelleyLedgerEra era)
tx =
  (ShelleyToMaryEraConstraints era =>
 ShelleyToMaryEra era
 -> Either
      (TransactionValidityError era)
      (Map
         ScriptWitnessIndex
         (Either ScriptExecutionError ([Text], ExecutionUnits))))
-> (AlonzoEraOnwardsConstraints era =>
    AlonzoEraOnwards era
    -> Either
         (TransactionValidityError era)
         (Map
            ScriptWitnessIndex
            (Either ScriptExecutionError ([Text], ExecutionUnits))))
-> ShelleyBasedEra era
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
forall era a.
(ShelleyToMaryEraConstraints era => ShelleyToMaryEra era -> a)
-> (AlonzoEraOnwardsConstraints era => AlonzoEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToMaryOrAlonzoEraOnwards
    (Either
  (TransactionValidityError era)
  (Map
     ScriptWitnessIndex
     (Either ScriptExecutionError ([Text], ExecutionUnits)))
-> ShelleyToMaryEra era
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
forall a b. a -> b -> a
const (Map
  ScriptWitnessIndex
  (Either ScriptExecutionError ([Text], ExecutionUnits))
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
forall a b. b -> Either a b
Right Map
  ScriptWitnessIndex
  (Either ScriptExecutionError ([Text], ExecutionUnits))
forall k a. Map k a
Map.empty))
    ( \AlonzoEraOnwards era
w ->
        Map
  ScriptWitnessIndex
  (Either ScriptExecutionError ([Text], ExecutionUnits))
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
forall a. a -> Either (TransactionValidityError era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map
   ScriptWitnessIndex
   (Either ScriptExecutionError ([Text], ExecutionUnits))
 -> Either
      (TransactionValidityError era)
      (Map
         ScriptWitnessIndex
         (Either ScriptExecutionError ([Text], ExecutionUnits))))
-> (Map
      (PlutusPurpose AsIx (ShelleyLedgerEra era))
      (Either
         (TransactionScriptFailure (ShelleyLedgerEra era))
         ([Text], ExUnits))
    -> Map
         ScriptWitnessIndex
         (Either ScriptExecutionError ([Text], ExecutionUnits)))
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Either
        (TransactionScriptFailure (ShelleyLedgerEra era))
        ([Text], ExUnits))
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoEraScript (ShelleyLedgerEra era) =>
AlonzoEraOnwards era
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Either
        (TransactionScriptFailure (ShelleyLedgerEra era))
        ([Text], ExUnits))
-> Map
     ScriptWitnessIndex
     (Either ScriptExecutionError ([Text], ExecutionUnits))
AlonzoEraOnwards era
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Either
        (TransactionScriptFailure (ShelleyLedgerEra era))
        ([Text], ExUnits))
-> Map
     ScriptWitnessIndex
     (Either ScriptExecutionError ([Text], ExecutionUnits))
fromLedgerScriptExUnitsMap AlonzoEraOnwards era
w (Map
   (PlutusPurpose AsIx (ShelleyLedgerEra era))
   (Either
      (TransactionScriptFailure (ShelleyLedgerEra era))
      ([Text], ExUnits))
 -> Either
      (TransactionValidityError era)
      (Map
         ScriptWitnessIndex
         (Either ScriptExecutionError ([Text], ExecutionUnits))))
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Either
        (TransactionScriptFailure (ShelleyLedgerEra era))
        ([Text], ExUnits))
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
forall a b. (a -> b) -> a -> b
$
          AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    Map
      (PlutusPurpose AsIx (ShelleyLedgerEra era))
      (Either
         (TransactionScriptFailure (ShelleyLedgerEra era))
         ([Text], ExUnits)))
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Either
        (TransactionScriptFailure (ShelleyLedgerEra era))
        ([Text], ExUnits))
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
w ((AlonzoEraOnwardsConstraints era =>
  Map
    (PlutusPurpose AsIx (ShelleyLedgerEra era))
    (Either
       (TransactionScriptFailure (ShelleyLedgerEra era))
       ([Text], ExUnits)))
 -> Map
      (PlutusPurpose AsIx (ShelleyLedgerEra era))
      (Either
         (TransactionScriptFailure (ShelleyLedgerEra era))
         ([Text], ExUnits)))
-> (AlonzoEraOnwardsConstraints era =>
    Map
      (PlutusPurpose AsIx (ShelleyLedgerEra era))
      (Either
         (TransactionScriptFailure (ShelleyLedgerEra era))
         ([Text], ExUnits)))
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Either
        (TransactionScriptFailure (ShelleyLedgerEra era))
        ([Text], ExUnits))
forall a b. (a -> b) -> a -> b
$
            PParams (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
-> UTxO (ShelleyLedgerEra era)
-> EpochInfo (Either Text)
-> SystemStart
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Either
        (TransactionScriptFailure (ShelleyLedgerEra era))
        ([Text], 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 (ShelleyLedgerEra era)
pp Tx (ShelleyLedgerEra era)
tx (ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
toLedgerUTxO ShelleyBasedEra era
sbe UTxO era
utxo) EpochInfo (Either Text)
ledgerEpochInfo SystemStart
systemstart
    )
    ShelleyBasedEra era
sbe
 where
  LedgerEpochInfo EpochInfo (Either Text)
ledgerEpochInfo = LedgerEpochInfo
epochInfo

  fromLedgerScriptExUnitsMap
    :: Alonzo.AlonzoEraScript (ShelleyLedgerEra era)
    => AlonzoEraOnwards era
    -> Map
        (L.PlutusPurpose L.AsIx (ShelleyLedgerEra era))
        (Either (L.TransactionScriptFailure (ShelleyLedgerEra era)) (EvalTxExecutionUnitsLog, Alonzo.ExUnits))
    -> Map ScriptWitnessIndex (Either ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
  fromLedgerScriptExUnitsMap :: AlonzoEraScript (ShelleyLedgerEra era) =>
AlonzoEraOnwards era
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Either
        (TransactionScriptFailure (ShelleyLedgerEra era))
        ([Text], ExUnits))
-> Map
     ScriptWitnessIndex
     (Either ScriptExecutionError ([Text], ExecutionUnits))
fromLedgerScriptExUnitsMap AlonzoEraOnwards era
aOnwards Map
  (PlutusPurpose AsIx (ShelleyLedgerEra era))
  (Either
     (TransactionScriptFailure (ShelleyLedgerEra era))
     ([Text], ExUnits))
exmap =
    [Item
   (Map
      ScriptWitnessIndex
      (Either ScriptExecutionError ([Text], ExecutionUnits)))]
-> Map
     ScriptWitnessIndex
     (Either ScriptExecutionError ([Text], ExecutionUnits))
forall l. IsList l => [Item l] -> l
fromList
      [ ( AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
forall era.
AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
toScriptIndex AlonzoEraOnwards era
aOnwards PlutusPurpose AsIx (ShelleyLedgerEra era)
rdmrptr
        , (TransactionScriptFailure (ShelleyLedgerEra era)
 -> ScriptExecutionError)
-> (([Text], ExUnits) -> ([Text], ExecutionUnits))
-> Either
     (TransactionScriptFailure (ShelleyLedgerEra era)) ([Text], ExUnits)
-> Either ScriptExecutionError ([Text], 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 (ShelleyLedgerEra era) =>
AlonzoEraOnwards era
-> TransactionScriptFailure (ShelleyLedgerEra era)
-> ScriptExecutionError
AlonzoEraOnwards era
-> TransactionScriptFailure (ShelleyLedgerEra era)
-> ScriptExecutionError
fromAlonzoScriptExecutionError AlonzoEraOnwards era
aOnwards) ((ExUnits -> ExecutionUnits)
-> ([Text], ExUnits) -> ([Text], 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 (ShelleyLedgerEra era)) ([Text], ExUnits)
exunitsOrFailure
        )
      | (PlutusPurpose AsIx (ShelleyLedgerEra era)
rdmrptr, Either
  (TransactionScriptFailure (ShelleyLedgerEra era)) ([Text], ExUnits)
exunitsOrFailure) <- Map
  (PlutusPurpose AsIx (ShelleyLedgerEra era))
  (Either
     (TransactionScriptFailure (ShelleyLedgerEra era))
     ([Text], ExUnits))
-> [Item
      (Map
         (PlutusPurpose AsIx (ShelleyLedgerEra era))
         (Either
            (TransactionScriptFailure (ShelleyLedgerEra era))
            ([Text], ExUnits)))]
forall l. IsList l => l -> [Item l]
toList Map
  (PlutusPurpose AsIx (ShelleyLedgerEra era))
  (Either
     (TransactionScriptFailure (ShelleyLedgerEra era))
     ([Text], ExUnits))
exmap
      ]

  fromAlonzoScriptExecutionError
    :: Alonzo.AlonzoEraScript (ShelleyLedgerEra era)
    => AlonzoEraOnwards era
    -> L.TransactionScriptFailure (ShelleyLedgerEra era)
    -> ScriptExecutionError
  fromAlonzoScriptExecutionError :: AlonzoEraScript (ShelleyLedgerEra era) =>
AlonzoEraOnwards era
-> TransactionScriptFailure (ShelleyLedgerEra era)
-> ScriptExecutionError
fromAlonzoScriptExecutionError AlonzoEraOnwards era
aOnwards =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    TransactionScriptFailure (ShelleyLedgerEra era)
    -> ScriptExecutionError)
-> TransactionScriptFailure (ShelleyLedgerEra era)
-> ScriptExecutionError
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  TransactionScriptFailure (ShelleyLedgerEra era)
  -> ScriptExecutionError)
 -> TransactionScriptFailure (ShelleyLedgerEra era)
 -> ScriptExecutionError)
-> (ShelleyBasedEraConstraints era =>
    TransactionScriptFailure (ShelleyLedgerEra era)
    -> ScriptExecutionError)
-> TransactionScriptFailure (ShelleyLedgerEra era)
-> ScriptExecutionError
forall a b. (a -> b) -> a -> b
$ \case
      L.UnknownTxIn TxIn (EraCrypto (ShelleyLedgerEra era))
txin -> TxIn -> ScriptExecutionError
ScriptErrorMissingTxIn TxIn
txin'
       where
        txin' :: TxIn
txin' = TxIn StandardCrypto -> TxIn
fromShelleyTxIn TxIn (EraCrypto (ShelleyLedgerEra era))
TxIn StandardCrypto
txin
      L.InvalidTxIn TxIn (EraCrypto (ShelleyLedgerEra era))
txin -> TxIn -> ScriptExecutionError
ScriptErrorTxInWithoutDatum TxIn
txin'
       where
        txin' :: TxIn
txin' = TxIn StandardCrypto -> TxIn
fromShelleyTxIn TxIn (EraCrypto (ShelleyLedgerEra era))
TxIn StandardCrypto
txin
      L.MissingDatum DataHash (EraCrypto (ShelleyLedgerEra era))
dh -> Hash ScriptData -> ScriptExecutionError
ScriptErrorWrongDatum (DataHash StandardCrypto -> Hash ScriptData
ScriptDataHash DataHash (EraCrypto (ShelleyLedgerEra era))
DataHash StandardCrypto
dh)
      L.ValidationFailure ExUnits
_ EvaluationError
evalErr [Text]
logs PlutusWithContext (EraCrypto (ShelleyLedgerEra era))
_ ->
        -- TODO: Include additional information from ValidationFailure
        EvaluationError -> [Text] -> ScriptExecutionError
ScriptErrorEvaluationFailed EvaluationError
evalErr [Text]
logs
      L.IncompatibleBudget ExBudget
_ -> ScriptExecutionError
ScriptErrorExecutionUnitsOverflow
      L.RedeemerPointsToUnknownScriptHash PlutusPurpose AsIx (ShelleyLedgerEra era)
rdmrPtr ->
        ScriptWitnessIndex -> ScriptExecutionError
ScriptErrorRedeemerPointsToUnknownScriptHash (ScriptWitnessIndex -> ScriptExecutionError)
-> ScriptWitnessIndex -> ScriptExecutionError
forall a b. (a -> b) -> a -> b
$ AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
forall era.
AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
toScriptIndex AlonzoEraOnwards era
aOnwards PlutusPurpose AsIx (ShelleyLedgerEra 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 (ShelleyLedgerEra era)
indexOfScriptWitnessedItem Map
  (PlutusPurpose AsIx (ShelleyLedgerEra era))
  (PlutusPurpose AsItem (ShelleyLedgerEra era),
   Maybe (PlutusScript (ShelleyLedgerEra era)),
   ScriptHash (EraCrypto (ShelleyLedgerEra era)))
resolveable ->
        let scriptWitnessedItemIndex :: ScriptWitnessIndex
scriptWitnessedItemIndex = AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
forall era.
AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
toScriptIndex AlonzoEraOnwards era
aOnwards PlutusPurpose AsIx (ShelleyLedgerEra era)
indexOfScriptWitnessedItem
         in ScriptWitnessIndex -> ResolvablePointers -> ScriptExecutionError
ScriptErrorMissingScript ScriptWitnessIndex
scriptWitnessedItemIndex (ResolvablePointers -> ScriptExecutionError)
-> ResolvablePointers -> ScriptExecutionError
forall a b. (a -> b) -> a -> b
$
              ShelleyBasedEra era
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (PlutusPurpose AsItem (ShelleyLedgerEra era),
      Maybe (PlutusScriptBytes, Language), ScriptHash StandardCrypto)
-> 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 StandardCrypto)
-> ResolvablePointers
ResolvablePointers ShelleyBasedEra era
sbe (Map
   (PlutusPurpose AsIx (ShelleyLedgerEra era))
   (PlutusPurpose AsItem (ShelleyLedgerEra era),
    Maybe (PlutusScriptBytes, Language), ScriptHash StandardCrypto)
 -> ResolvablePointers)
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (PlutusPurpose AsItem (ShelleyLedgerEra era),
      Maybe (PlutusScriptBytes, Language), ScriptHash StandardCrypto)
-> ResolvablePointers
forall a b. (a -> b) -> a -> b
$
                ((PlutusPurpose AsItem (ShelleyLedgerEra era),
  Maybe (PlutusScript (ShelleyLedgerEra era)),
  ScriptHash StandardCrypto)
 -> (PlutusPurpose AsItem (ShelleyLedgerEra era),
     Maybe (PlutusScriptBytes, Language), ScriptHash StandardCrypto))
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (PlutusPurpose AsItem (ShelleyLedgerEra era),
      Maybe (PlutusScript (ShelleyLedgerEra era)),
      ScriptHash StandardCrypto)
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (PlutusPurpose AsItem (ShelleyLedgerEra era),
      Maybe (PlutusScriptBytes, Language), ScriptHash StandardCrypto)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (PlutusPurpose AsItem (ShelleyLedgerEra era),
 Maybe (PlutusScript (ShelleyLedgerEra era)),
 ScriptHash StandardCrypto)
-> (PlutusPurpose AsItem (ShelleyLedgerEra era),
    Maybe (PlutusScriptBytes, Language), ScriptHash StandardCrypto)
forall era.
AlonzoEraScript (ShelleyLedgerEra era) =>
(PlutusPurpose AsItem (ShelleyLedgerEra era),
 Maybe (PlutusScript (ShelleyLedgerEra era)),
 ScriptHash StandardCrypto)
-> (PlutusPurpose AsItem (ShelleyLedgerEra era),
    Maybe (PlutusScriptBytes, Language), ScriptHash StandardCrypto)
extractScriptBytesAndLanguage Map
  (PlutusPurpose AsIx (ShelleyLedgerEra era))
  (PlutusPurpose AsItem (ShelleyLedgerEra era),
   Maybe (PlutusScript (ShelleyLedgerEra era)),
   ScriptHash (EraCrypto (ShelleyLedgerEra era)))
Map
  (PlutusPurpose AsIx (ShelleyLedgerEra era))
  (PlutusPurpose AsItem (ShelleyLedgerEra era),
   Maybe (PlutusScript (ShelleyLedgerEra era)),
   ScriptHash StandardCrypto)
resolveable
      L.NoCostModelInLedgerState Language
l -> Language -> ScriptExecutionError
ScriptErrorMissingCostModel Language
l
      L.ContextError ContextError (ShelleyLedgerEra era)
e ->
        AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era => ScriptExecutionError)
-> ScriptExecutionError
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aOnwards ((AlonzoEraOnwardsConstraints era => ScriptExecutionError)
 -> ScriptExecutionError)
-> (AlonzoEraOnwardsConstraints 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)
e

extractScriptBytesAndLanguage
  :: Alonzo.AlonzoEraScript (ShelleyLedgerEra era)
  => ( L.PlutusPurpose L.AsItem (ShelleyLedgerEra era)
     , Maybe (Alonzo.PlutusScript (ShelleyLedgerEra era))
     , L.ScriptHash Ledger.StandardCrypto
     )
  -> ( L.PlutusPurpose L.AsItem (ShelleyLedgerEra era)
     , Maybe (PlutusScriptBytes, Plutus.Language)
     , Ledger.ScriptHash Ledger.StandardCrypto
     )
extractScriptBytesAndLanguage :: forall era.
AlonzoEraScript (ShelleyLedgerEra era) =>
(PlutusPurpose AsItem (ShelleyLedgerEra era),
 Maybe (PlutusScript (ShelleyLedgerEra era)),
 ScriptHash StandardCrypto)
-> (PlutusPurpose AsItem (ShelleyLedgerEra era),
    Maybe (PlutusScriptBytes, Language), ScriptHash StandardCrypto)
extractScriptBytesAndLanguage (PlutusPurpose AsItem (ShelleyLedgerEra era)
purpose, Maybe (PlutusScript (ShelleyLedgerEra era))
mbScript, ScriptHash StandardCrypto
scriptHash) =
  (PlutusPurpose AsItem (ShelleyLedgerEra era)
purpose, (PlutusScript (ShelleyLedgerEra era)
 -> (PlutusScriptBytes, Language))
-> Maybe (PlutusScript (ShelleyLedgerEra era))
-> Maybe (PlutusScriptBytes, Language)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlutusScript (ShelleyLedgerEra era)
-> (PlutusScriptBytes, Language)
forall era.
AlonzoEraScript (ShelleyLedgerEra era) =>
PlutusScript (ShelleyLedgerEra era)
-> (PlutusScriptBytes, Language)
extractPlutusScriptAndLanguage Maybe (PlutusScript (ShelleyLedgerEra era))
mbScript, ScriptHash StandardCrypto
scriptHash)

extractPlutusScriptAndLanguage
  :: Alonzo.AlonzoEraScript (ShelleyLedgerEra era)
  => Alonzo.PlutusScript (ShelleyLedgerEra era)
  -> (PlutusScriptBytes, Plutus.Language)
extractPlutusScriptAndLanguage :: forall era.
AlonzoEraScript (ShelleyLedgerEra era) =>
PlutusScript (ShelleyLedgerEra era)
-> (PlutusScriptBytes, Language)
extractPlutusScriptAndLanguage PlutusScript (ShelleyLedgerEra era)
p =
  let bin :: PlutusScriptBytes
bin = PlutusBinary -> PlutusScriptBytes
Plutus.unPlutusBinary (PlutusBinary -> PlutusScriptBytes)
-> PlutusBinary -> PlutusScriptBytes
forall a b. (a -> b) -> a -> b
$ PlutusScript (ShelleyLedgerEra era) -> PlutusBinary
forall era. AlonzoEraScript era => PlutusScript era -> PlutusBinary
Alonzo.plutusScriptBinary PlutusScript (ShelleyLedgerEra era)
p
      l :: Language
l = PlutusScript (ShelleyLedgerEra era) -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
Alonzo.plutusScriptLanguage PlutusScript (ShelleyLedgerEra era)
p
   in (PlutusScriptBytes
bin, Language
l)

-- ----------------------------------------------------------------------------
-- Transaction balance
--

-- | Compute the total balance of the proposed transaction. Ultimately a valid
-- transaction must be fully balanced: that is have a total value of zero.
--
-- Finding the (non-zero) balance of partially constructed transaction is
-- useful for adjusting a transaction to be fully balanced.
evaluateTransactionBalance
  :: forall era
   . ()
  => ShelleyBasedEra era
  -> Ledger.PParams (ShelleyLedgerEra era)
  -> Set PoolId
  -> Map StakeCredential L.Coin
  -> Map (Ledger.Credential Ledger.DRepRole Ledger.StandardCrypto) L.Coin
  -> UTxO era
  -> TxBody era
  -> TxOutValue era
evaluateTransactionBalance :: forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> Set (Hash StakePoolKey)
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> UTxO era
-> TxBody era
-> TxOutValue era
evaluateTransactionBalance ShelleyBasedEra era
sbe PParams (ShelleyLedgerEra era)
pp Set (Hash StakePoolKey)
poolids Map StakeCredential Coin
stakeDelegDeposits Map (Credential 'DRepRole StandardCrypto) Coin
drepDelegDeposits UTxO era
utxo (ShelleyTxBody ShelleyBasedEra era
_ TxBody (ShelleyLedgerEra era)
txbody [Script (ShelleyLedgerEra era)]
_ TxBodyScriptData era
_ Maybe (TxAuxData (ShelleyLedgerEra era))
_ TxScriptValidity era
_) =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => TxOutValue era)
-> TxOutValue era
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => TxOutValue era)
 -> TxOutValue era)
-> (ShelleyBasedEraConstraints era => TxOutValue era)
-> TxOutValue era
forall a b. (a -> b) -> a -> b
$
    ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
forall era.
(Eq (Value (ShelleyLedgerEra era)),
 Show (Value (ShelleyLedgerEra era))) =>
ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
TxOutValueShelleyBased ShelleyBasedEra era
sbe (Value (ShelleyLedgerEra era) -> TxOutValue era)
-> Value (ShelleyLedgerEra era) -> TxOutValue era
forall a b. (a -> b) -> a -> b
$
      PParams (ShelleyLedgerEra era)
-> (Credential 'Staking (EraCrypto (ShelleyLedgerEra era))
    -> Maybe Coin)
-> (Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
    -> Maybe Coin)
-> (KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era)) -> Bool)
-> UTxO (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era)
-> Value (ShelleyLedgerEra era)
forall era.
EraUTxO era =>
PParams era
-> (Credential 'Staking (EraCrypto era) -> Maybe Coin)
-> (Credential 'DRepRole (EraCrypto era) -> Maybe Coin)
-> (KeyHash 'StakePool (EraCrypto era) -> Bool)
-> UTxO era
-> TxBody era
-> Value era
L.evalBalanceTxBody
        PParams (ShelleyLedgerEra era)
pp
        (Map StakeCredential Coin
-> Credential 'Staking StandardCrypto -> Maybe Coin
lookupDelegDeposit Map StakeCredential Coin
stakeDelegDeposits)
        (Map (Credential 'DRepRole StandardCrypto) Coin
-> Credential 'DRepRole StandardCrypto -> Maybe Coin
lookupDRepDeposit Map (Credential 'DRepRole StandardCrypto) Coin
drepDelegDeposits)
        (Set (Hash StakePoolKey)
-> KeyHash 'StakePool StandardCrypto -> Bool
isRegPool Set (Hash StakePoolKey)
poolids)
        (ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
toLedgerUTxO ShelleyBasedEra era
sbe UTxO era
utxo)
        TxBody (ShelleyLedgerEra era)
txbody

isRegPool :: Set PoolId -> Ledger.KeyHash Ledger.StakePool Ledger.StandardCrypto -> Bool
isRegPool :: Set (Hash StakePoolKey)
-> KeyHash 'StakePool StandardCrypto -> Bool
isRegPool Set (Hash StakePoolKey)
poolids KeyHash 'StakePool StandardCrypto
kh = KeyHash 'StakePool StandardCrypto -> Hash StakePoolKey
StakePoolKeyHash KeyHash 'StakePool StandardCrypto
kh Hash StakePoolKey -> Set (Hash StakePoolKey) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (Hash StakePoolKey)
poolids

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

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

-- ----------------------------------------------------------------------------
-- Automated transaction building
--

-- | The possible errors that can arise from 'makeTransactionBodyAutoBalance'.
data TxBodyErrorAutoBalance era
  = -- | The same errors that can arise from 'makeTransactionBody'.
    TxBodyError TxBodyError
  | -- | One or more of the scripts fails to execute correctly.
    TxBodyScriptExecutionError [(ScriptWitnessIndex, ScriptExecutionError)]
  | -- | One or more of the scripts were expected to fail validation, but none did.
    TxBodyScriptBadScriptValidity
  | -- | There is not enough ada to cover both the outputs and the fees.
    -- The transaction should be changed to provide more input ada, or
    -- otherwise adjusted to need less (e.g. outputs, script etc).
    TxBodyErrorAdaBalanceNegative L.Coin
  | -- | 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
      -- \^ Offending TxOut
      TxOutInAnyEra
      -- ^ Minimum UTxO
      L.Coin
      -- ^ Tx balance
      L.Coin
  | -- | 'makeTransactionBodyAutoBalance' does not yet support the Byron era.
    TxBodyErrorByronEraNotSupported
  | -- | The 'ProtocolParameters' must provide the value for the min utxo
    -- parameter, for eras that use this parameter.
    TxBodyErrorMissingParamMinUTxO
  | -- | The transaction validity interval is too far into the future.
    -- See 'TransactionValidityIntervalError' for details.
    TxBodyErrorValidityInterval (TransactionValidityError era)
  | -- | The minimum spendable UTxO threshold has not been met.
    TxBodyErrorMinUTxONotMet
      -- \^ Offending TxOut
      TxOutInAnyEra
      -- ^ Minimum UTxO
      L.Coin
  | TxBodyErrorNonAdaAssetsUnbalanced Value
  | TxBodyErrorScriptWitnessIndexMissingFromExecUnitsMap
      ScriptWitnessIndex
      (Map ScriptWitnessIndex ExecutionUnits)
  | TxBodyErrorDeprecatedEra (Exp.DeprecatedEra era)
  deriving Int -> TxBodyErrorAutoBalance era -> ShowS
[TxBodyErrorAutoBalance era] -> ShowS
TxBodyErrorAutoBalance era -> String
(Int -> TxBodyErrorAutoBalance era -> ShowS)
-> (TxBodyErrorAutoBalance era -> String)
-> ([TxBodyErrorAutoBalance era] -> ShowS)
-> Show (TxBodyErrorAutoBalance era)
forall era. Int -> TxBodyErrorAutoBalance era -> ShowS
forall era. [TxBodyErrorAutoBalance era] -> ShowS
forall era. TxBodyErrorAutoBalance era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> TxBodyErrorAutoBalance era -> ShowS
showsPrec :: Int -> TxBodyErrorAutoBalance era -> ShowS
$cshow :: forall era. TxBodyErrorAutoBalance era -> String
show :: TxBodyErrorAutoBalance era -> String
$cshowList :: forall era. [TxBodyErrorAutoBalance era] -> ShowS
showList :: [TxBodyErrorAutoBalance era] -> ShowS
Show

instance Error (TxBodyErrorAutoBalance era) where
  prettyError :: forall ann. TxBodyErrorAutoBalance era -> Doc ann
prettyError = \case
    TxBodyError TxBodyError
err ->
      TxBodyError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxBodyError -> Doc ann
prettyError TxBodyError
err
    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."
    TxBodyErrorAdaBalanceNegative Coin
lovelace ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The transaction does not balance in its use of ada. The net balance "
        , Doc ann
"of the transaction is negative: " 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
lovelace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
". "
        , Doc ann
"The usual solution is to provide more inputs, or inputs with more ada."
        ]
    TxBodyErrorAdaBalanceTooSmall TxOutInAnyEra
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
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TxOutInAnyEra -> Text
prettyRenderTxOut TxOutInAnyEra
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"
        ]
    TxBodyErrorAutoBalance era
TxBodyErrorByronEraNotSupported ->
      Doc ann
"The Byron era is not yet supported by makeTransactionBodyAutoBalance"
    TxBodyErrorAutoBalance era
TxBodyErrorMissingParamMinUTxO ->
      Doc ann
"The minUTxOValue protocol parameter is required but missing"
    TxBodyErrorValidityInterval TransactionValidityError era
err ->
      TransactionValidityError era -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TransactionValidityError era -> Doc ann
prettyError TransactionValidityError era
err
    TxBodyErrorMinUTxONotMet TxOutInAnyEra
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
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TxOutInAnyEra -> Text
prettyRenderTxOut TxOutInAnyEra
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
        ]
    TxBodyErrorDeprecatedEra DeprecatedEra era
deprecatedEra ->
      Doc ann
"The era " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> DeprecatedEra era -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DeprecatedEra era -> Doc ann
pretty DeprecatedEra era
deprecatedEra Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" is deprecated and no longer supported."

handleExUnitsErrors
  :: ScriptValidity
  -- ^ Mark script as expected to pass or fail validation
  -> Map ScriptWitnessIndex ScriptExecutionError
  -> Map ScriptWitnessIndex ExecutionUnits
  -> Either (TxBodyErrorAutoBalance era) (Map ScriptWitnessIndex ExecutionUnits)
handleExUnitsErrors :: forall era.
ScriptValidity
-> Map ScriptWitnessIndex ScriptExecutionError
-> Map ScriptWitnessIndex ExecutionUnits
-> Either
     (TxBodyErrorAutoBalance 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 era)
     (Map ScriptWitnessIndex ExecutionUnits)
forall a b. b -> Either a b
Right Map ScriptWitnessIndex ExecutionUnits
exUnitsMap
    else TxBodyErrorAutoBalance era
-> Either
     (TxBodyErrorAutoBalance era)
     (Map ScriptWitnessIndex ExecutionUnits)
forall a b. a -> Either a b
Left ([(ScriptWitnessIndex, ScriptExecutionError)]
-> TxBodyErrorAutoBalance 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 era
-> Either
     (TxBodyErrorAutoBalance era)
     (Map ScriptWitnessIndex ExecutionUnits)
forall a b. a -> Either a b
Left TxBodyErrorAutoBalance era
forall era. TxBodyErrorAutoBalance era
TxBodyScriptBadScriptValidity
  | Bool
otherwise = Map ScriptWitnessIndex ExecutionUnits
-> Either
     (TxBodyErrorAutoBalance era)
     (Map ScriptWitnessIndex ExecutionUnits)
forall a b. b -> Either a b
Right (Map ScriptWitnessIndex ExecutionUnits
 -> Either
      (TxBodyErrorAutoBalance era)
      (Map ScriptWitnessIndex ExecutionUnits))
-> Map ScriptWitnessIndex ExecutionUnits
-> Either
     (TxBodyErrorAutoBalance 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

data BalancedTxBody era where
  BalancedTxBody
    :: (TxBodyContent BuildTx era)
    -> (UnsignedTx era)
    -> (TxOut CtxTx era)
    -- ^ Transaction balance (change output)
    -> L.Coin
    -- ^ Estimated transaction fee
    -> BalancedTxBody era

deriving instance
  (Exp.IsEra era, IsShelleyBasedEra era) => Show (BalancedTxBody era)

newtype RequiredShelleyKeyWitnesses
  = RequiredShelleyKeyWitnesses {RequiredShelleyKeyWitnesses -> Int
unRequiredShelleyKeyWitnesses :: Int}
  deriving Int -> RequiredShelleyKeyWitnesses -> ShowS
[RequiredShelleyKeyWitnesses] -> ShowS
RequiredShelleyKeyWitnesses -> String
(Int -> RequiredShelleyKeyWitnesses -> ShowS)
-> (RequiredShelleyKeyWitnesses -> String)
-> ([RequiredShelleyKeyWitnesses] -> ShowS)
-> Show RequiredShelleyKeyWitnesses
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequiredShelleyKeyWitnesses -> ShowS
showsPrec :: Int -> RequiredShelleyKeyWitnesses -> ShowS
$cshow :: RequiredShelleyKeyWitnesses -> String
show :: RequiredShelleyKeyWitnesses -> String
$cshowList :: [RequiredShelleyKeyWitnesses] -> ShowS
showList :: [RequiredShelleyKeyWitnesses] -> ShowS
Show

newtype RequiredByronKeyWitnesses
  = RequiredByronKeyWitnesses {RequiredByronKeyWitnesses -> Int
unRequiredByronKeyWitnesses :: Int}
  deriving Int -> RequiredByronKeyWitnesses -> ShowS
[RequiredByronKeyWitnesses] -> ShowS
RequiredByronKeyWitnesses -> String
(Int -> RequiredByronKeyWitnesses -> ShowS)
-> (RequiredByronKeyWitnesses -> String)
-> ([RequiredByronKeyWitnesses] -> ShowS)
-> Show RequiredByronKeyWitnesses
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequiredByronKeyWitnesses -> ShowS
showsPrec :: Int -> RequiredByronKeyWitnesses -> ShowS
$cshow :: RequiredByronKeyWitnesses -> String
show :: RequiredByronKeyWitnesses -> String
$cshowList :: [RequiredByronKeyWitnesses] -> ShowS
showList :: [RequiredByronKeyWitnesses] -> ShowS
Show

newtype TotalReferenceScriptsSize
  = TotalReferenceScriptsSize {TotalReferenceScriptsSize -> Int
unTotalReferenceScriptsSize :: Int}
  deriving Int -> TotalReferenceScriptsSize -> ShowS
[TotalReferenceScriptsSize] -> ShowS
TotalReferenceScriptsSize -> String
(Int -> TotalReferenceScriptsSize -> ShowS)
-> (TotalReferenceScriptsSize -> String)
-> ([TotalReferenceScriptsSize] -> ShowS)
-> Show TotalReferenceScriptsSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TotalReferenceScriptsSize -> ShowS
showsPrec :: Int -> TotalReferenceScriptsSize -> ShowS
$cshow :: TotalReferenceScriptsSize -> String
show :: TotalReferenceScriptsSize -> String
$cshowList :: [TotalReferenceScriptsSize] -> ShowS
showList :: [TotalReferenceScriptsSize] -> ShowS
Show

data FeeEstimationMode era
  = -- | Accurate fee calculation.
    CalculateWithSpendableUTxO
      (UTxO era)
      -- ^ Spendable UTxO
      SystemStart
      LedgerEpochInfo
      (Maybe Word)
      -- ^ Override number of key witnesses
  | -- | Less accurate fee estimation.
    EstimateWithoutSpendableUTxO
      Coin
      -- ^ Total potential collateral amount
      Value
      -- ^ Total value of UTxOs being spent
      (Map ScriptWitnessIndex ExecutionUnits)
      -- ^ Plutus script execution units
      RequiredShelleyKeyWitnesses
      -- ^ The number of key witnesses still to be added to the transaction.
      RequiredByronKeyWitnesses
      -- ^ The number of Byron key witnesses still to be added to the transaction.
      TotalReferenceScriptsSize
      -- ^ The total size in bytes of reference scripts

-- | This is much like '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 needs more information than 'makeTransactionBody', all of
-- which can be queried from a local node.
makeTransactionBodyAutoBalance
  :: forall era
   . ()
  => ShelleyBasedEra era
  -> SystemStart
  -> LedgerEpochInfo
  -> LedgerProtocolParameters era
  -> Set PoolId
  -- ^ The set of registered stake pools, that are being
  --   unregistered in this transaction.
  -> Map StakeCredential L.Coin
  -- ^ Map of all deposits for stake credentials that are being
  --   unregistered in this transaction
  -> Map (Ledger.Credential Ledger.DRepRole Ledger.StandardCrypto) L.Coin
  -- ^ Map of all deposits for drep credentials that are being
  --   unregistered in this transaction
  -> UTxO era
  -- ^ Just the transaction inputs, not the entire 'UTxO'.
  -> TxBodyContent BuildTx era
  -> AddressInEra era
  -- ^ Change address
  -> Maybe Word
  -- ^ Override key witnesses
  -> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
makeTransactionBodyAutoBalance :: forall era.
ShelleyBasedEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> Set (Hash StakePoolKey)
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
makeTransactionBodyAutoBalance
  ShelleyBasedEra era
sbe
  SystemStart
systemstart
  LedgerEpochInfo
history
  lpp :: LedgerProtocolParameters era
lpp@(LedgerProtocolParameters PParams (ShelleyLedgerEra era)
pp)
  Set (Hash StakePoolKey)
poolids
  Map StakeCredential Coin
stakeDelegDeposits
  Map (Credential 'DRepRole StandardCrypto) Coin
drepDelegDeposits
  UTxO era
utxo
  TxBodyContent BuildTx era
txbodycontent
  AddressInEra era
changeaddr
  Maybe Word
mnkeys =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Either (TxBodyErrorAutoBalance era) (BalancedTxBody era))
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Either (TxBodyErrorAutoBalance era) (BalancedTxBody era))
 -> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era))
-> (ShelleyBasedEraConstraints era =>
    Either (TxBodyErrorAutoBalance era) (BalancedTxBody era))
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
forall a b. (a -> b) -> a -> b
$ do
      Era era
availableEra <- (DeprecatedEra era -> TxBodyErrorAutoBalance era)
-> Either (DeprecatedEra era) (Era era)
-> Either (TxBodyErrorAutoBalance era) (Era 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 DeprecatedEra era -> TxBodyErrorAutoBalance era
forall era. DeprecatedEra era -> TxBodyErrorAutoBalance era
TxBodyErrorDeprecatedEra (Either (DeprecatedEra era) (Era era)
 -> Either (TxBodyErrorAutoBalance era) (Era era))
-> Either (DeprecatedEra era) (Era era)
-> Either (TxBodyErrorAutoBalance era) (Era era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> Either (DeprecatedEra era) (Era era)
forall era (m :: * -> *).
MonadError (DeprecatedEra era) m =>
ShelleyBasedEra era -> m (Era era)
sbeToEra ShelleyBasedEra era
sbe

      -- 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 totalValueAtSpendableUTxO :: Value
totalValueAtSpendableUTxO = ShelleyBasedEra era -> Value (ShelleyLedgerEra era) -> Value
forall era.
ShelleyBasedEra era -> Value (ShelleyLedgerEra era) -> Value
fromLedgerValue ShelleyBasedEra era
sbe (Value (ShelleyLedgerEra era) -> Value)
-> (Map TxIn (TxOut CtxUTxO era) -> Value (ShelleyLedgerEra era))
-> Map TxIn (TxOut CtxUTxO era)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOut CtxUTxO era] -> Value (ShelleyLedgerEra era)
forall era ctx.
Monoid (Value (ShelleyLedgerEra era)) =>
[TxOut ctx era] -> Value (ShelleyLedgerEra era)
calculateIncomingUTxOValue ([TxOut CtxUTxO era] -> Value (ShelleyLedgerEra era))
-> (Map TxIn (TxOut CtxUTxO era) -> [TxOut CtxUTxO era])
-> Map TxIn (TxOut CtxUTxO era)
-> Value (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn (TxOut CtxUTxO era) -> [TxOut CtxUTxO era]
forall k a. Map k a -> [a]
Map.elems (Map TxIn (TxOut CtxUTxO era) -> Value)
-> Map TxIn (TxOut CtxUTxO era) -> Value
forall a b. (a -> b) -> a -> b
$ UTxO era -> Map TxIn (TxOut CtxUTxO era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO UTxO era
utxo
          change :: Value (ShelleyLedgerEra era)
change =
            CardanoEra era
-> (MaryEraOnwards era -> Value (ShelleyLedgerEra era))
-> Value (ShelleyLedgerEra era)
forall (eon :: * -> *) a era.
(Eon eon, Monoid a) =>
CardanoEra era -> (eon era -> a) -> a
monoidForEraInEon (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
sbe) ((MaryEraOnwards era -> Value (ShelleyLedgerEra era))
 -> Value (ShelleyLedgerEra era))
-> (MaryEraOnwards era -> Value (ShelleyLedgerEra era))
-> Value (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ \MaryEraOnwards era
w ->
              MaryEraOnwards era -> Value -> Value (ShelleyLedgerEra era)
forall era.
MaryEraOnwards era -> Value -> Value (ShelleyLedgerEra era)
toLedgerValue MaryEraOnwards era
w (Value -> Value (ShelleyLedgerEra era))
-> Value -> Value (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> Value -> TxBodyContent BuildTx era -> Value
forall era build.
ShelleyBasedEra era -> Value -> TxBodyContent build era -> Value
calculateChangeValue ShelleyBasedEra era
sbe Value
totalValueAtSpendableUTxO TxBodyContent BuildTx era
txbodycontent

      UnsignedTx Tx (LedgerEra era)
unsignedTx0 <-
        (TxBodyError -> TxBodyErrorAutoBalance era)
-> Either TxBodyError (UnsignedTx era)
-> Either (TxBodyErrorAutoBalance era) (UnsignedTx 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 TxBodyError -> TxBodyErrorAutoBalance era
forall era. TxBodyError -> TxBodyErrorAutoBalance era
TxBodyError
          (Either TxBodyError (UnsignedTx era)
 -> Either (TxBodyErrorAutoBalance era) (UnsignedTx era))
-> Either TxBodyError (UnsignedTx era)
-> Either (TxBodyErrorAutoBalance era) (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$ Era era
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
forall era.
Era era
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
makeUnsignedTx
            Era era
availableEra
          (TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era))
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era => TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
availableEra
          ((EraCommonConstraints era => TxBodyContent BuildTx era)
 -> TxBodyContent BuildTx era)
-> (EraCommonConstraints era => TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era
txbodycontent
            TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& ([TxOut CtxTx era] -> [TxOut CtxTx era])
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
([TxOut CtxTx era] -> [TxOut CtxTx era])
-> TxBodyContent build era -> TxBodyContent build era
modTxOuts
              ([TxOut CtxTx era] -> [TxOut CtxTx era] -> [TxOut CtxTx era]
forall a. Semigroup a => a -> a -> a
<> [AddressInEra era
-> TxOutValue era
-> TxOutDatum CtxTx era
-> ReferenceScript era
-> TxOut CtxTx era
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
TxOut AddressInEra era
changeaddr (ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
forall era.
(Eq (Value (ShelleyLedgerEra era)),
 Show (Value (ShelleyLedgerEra era))) =>
ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
TxOutValueShelleyBased ShelleyBasedEra era
sbe Value (ShelleyLedgerEra era)
change) TxOutDatum CtxTx era
forall ctx era. TxOutDatum ctx era
TxOutDatumNone ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone])
      Map
  ScriptWitnessIndex
  (Either ScriptExecutionError ([Text], ExecutionUnits))
exUnitsMapWithLogs <-
        (TransactionValidityError era -> TxBodyErrorAutoBalance era)
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
-> Either
     (TxBodyErrorAutoBalance era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
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 TransactionValidityError era -> TxBodyErrorAutoBalance era
forall era.
TransactionValidityError era -> TxBodyErrorAutoBalance era
TxBodyErrorValidityInterval
          (Either
   (TransactionValidityError era)
   (Map
      ScriptWitnessIndex
      (Either ScriptExecutionError ([Text], ExecutionUnits)))
 -> Either
      (TxBodyErrorAutoBalance era)
      (Map
         ScriptWitnessIndex
         (Either ScriptExecutionError ([Text], ExecutionUnits))))
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
-> Either
     (TxBodyErrorAutoBalance era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> Tx (ShelleyLedgerEra era)
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
forall era.
ShelleyBasedEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> Tx (ShelleyLedgerEra era)
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
evaluateTransactionExecutionUnitsShelley
            ShelleyBasedEra era
sbe
            SystemStart
systemstart
            LedgerEpochInfo
history
            LedgerProtocolParameters era
lpp
            UTxO era
utxo
          (Tx (ShelleyLedgerEra era)
 -> Either
      (TransactionValidityError era)
      (Map
         ScriptWitnessIndex
         (Either ScriptExecutionError ([Text], ExecutionUnits))))
-> Tx (ShelleyLedgerEra era)
-> Either
     (TransactionValidityError era)
     (Map
        ScriptWitnessIndex
        (Either ScriptExecutionError ([Text], ExecutionUnits)))
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era => Tx (ShelleyLedgerEra era))
-> Tx (ShelleyLedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
availableEra Tx (ShelleyLedgerEra era)
Tx (LedgerEra era)
EraCommonConstraints era => Tx (ShelleyLedgerEra era)
unsignedTx0

      let exUnitsMap :: Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)
exUnitsMap = (Either ScriptExecutionError ([Text], ExecutionUnits)
 -> Either ScriptExecutionError ExecutionUnits)
-> Map
     ScriptWitnessIndex
     (Either ScriptExecutionError ([Text], ExecutionUnits))
-> Map
     ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((([Text], ExecutionUnits) -> ExecutionUnits)
-> Either ScriptExecutionError ([Text], 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 ([Text], ExecutionUnits) -> ExecutionUnits
forall a b. (a, b) -> b
snd) Map
  ScriptWitnessIndex
  (Either ScriptExecutionError ([Text], ExecutionUnits))
exUnitsMapWithLogs

      Map ScriptWitnessIndex ExecutionUnits
exUnitsMap' <-
        case (Either ScriptExecutionError ExecutionUnits
 -> Either ScriptExecutionError ExecutionUnits)
-> Map
     ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)
-> (Map ScriptWitnessIndex ScriptExecutionError,
    Map ScriptWitnessIndex ExecutionUnits)
forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
Map.mapEither Either ScriptExecutionError ExecutionUnits
-> Either ScriptExecutionError ExecutionUnits
forall a. a -> a
id Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)
exUnitsMap of
          (Map ScriptWitnessIndex ScriptExecutionError
failures, Map ScriptWitnessIndex ExecutionUnits
exUnitsMap') ->
            ScriptValidity
-> Map ScriptWitnessIndex ScriptExecutionError
-> Map ScriptWitnessIndex ExecutionUnits
-> Either
     (TxBodyErrorAutoBalance era)
     (Map ScriptWitnessIndex ExecutionUnits)
forall era.
ScriptValidity
-> Map ScriptWitnessIndex ScriptExecutionError
-> Map ScriptWitnessIndex ExecutionUnits
-> Either
     (TxBodyErrorAutoBalance era)
     (Map ScriptWitnessIndex ExecutionUnits)
handleExUnitsErrors
              (TxScriptValidity era -> ScriptValidity
forall era. TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity (TxBodyContent BuildTx era -> TxScriptValidity era
forall build era. TxBodyContent build era -> TxScriptValidity era
txScriptValidity TxBodyContent BuildTx era
txbodycontent))
              Map ScriptWitnessIndex ScriptExecutionError
failures
              Map ScriptWitnessIndex ExecutionUnits
exUnitsMap'

      TxBodyContent BuildTx era
txbodycontent1 <- Map ScriptWitnessIndex ExecutionUnits
-> TxBodyContent BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
forall era.
Map ScriptWitnessIndex ExecutionUnits
-> TxBodyContent BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
substituteExecutionUnits Map ScriptWitnessIndex ExecutionUnits
exUnitsMap' TxBodyContent BuildTx era
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 or change output. We use
      -- "big enough" values for the change output 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) and change output
      -- of less than around 18 trillion ada  (2^64-1 lovelace).
      -- However, since at this point we know how much non-Ada change to give
      -- we can use the true values for that.
      let maxLovelaceChange :: Coin
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
      let maxLovelaceFee :: Coin
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 changeWithMaxLovelace :: Value (ShelleyLedgerEra era)
changeWithMaxLovelace = Value (ShelleyLedgerEra era)
change Value (ShelleyLedgerEra era)
-> (Value (ShelleyLedgerEra era) -> Value (ShelleyLedgerEra era))
-> Value (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& ShelleyBasedEra era -> Lens' (Value (ShelleyLedgerEra era)) Coin
forall era.
ShelleyBasedEra era -> Lens' (Value (ShelleyLedgerEra era)) Coin
A.adaAssetL ShelleyBasedEra era
sbe ((Coin -> Identity Coin)
 -> Value (ShelleyLedgerEra era)
 -> Identity (Value (ShelleyLedgerEra era)))
-> Coin
-> Value (ShelleyLedgerEra era)
-> Value (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
maxLovelaceChange
      let changeTxOut :: TxOutValue era
changeTxOut =
            ShelleyBasedEra era
-> TxOutValue era
-> (MaryEraOnwards era -> TxOutValue era)
-> TxOutValue era
forall (eon :: * -> *) era a.
Eon eon =>
ShelleyBasedEra era -> a -> (eon era -> a) -> a
forShelleyBasedEraInEon
              ShelleyBasedEra era
sbe
              (ShelleyBasedEra era -> Coin -> TxOutValue era
forall era. ShelleyBasedEra era -> Coin -> TxOutValue era
lovelaceToTxOutValue ShelleyBasedEra era
sbe Coin
maxLovelaceChange)
              (\MaryEraOnwards era
w -> MaryEraOnwards era
-> (MaryEraOnwardsConstraints era => TxOutValue era)
-> TxOutValue era
forall era a.
MaryEraOnwards era -> (MaryEraOnwardsConstraints era => a) -> a
maryEraOnwardsConstraints MaryEraOnwards era
w ((MaryEraOnwardsConstraints era => TxOutValue era)
 -> TxOutValue era)
-> (MaryEraOnwardsConstraints era => TxOutValue era)
-> TxOutValue era
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
forall era.
(Eq (Value (ShelleyLedgerEra era)),
 Show (Value (ShelleyLedgerEra era))) =>
ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
TxOutValueShelleyBased ShelleyBasedEra era
sbe Value (ShelleyLedgerEra era)
changeWithMaxLovelace)

      let (TxReturnCollateral CtxTx era
dummyCollRet, TxTotalCollateral era
dummyTotColl) = ShelleyBasedEra era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
maybeDummyTotalCollAndCollReturnOutput ShelleyBasedEra era
sbe TxBodyContent BuildTx era
txbodycontent AddressInEra era
changeaddr
      UnsignedTx Tx (LedgerEra era)
txbody1 <-
        (TxBodyError -> TxBodyErrorAutoBalance era)
-> Either TxBodyError (UnsignedTx era)
-> Either (TxBodyErrorAutoBalance era) (UnsignedTx 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 TxBodyError -> TxBodyErrorAutoBalance era
forall era. TxBodyError -> TxBodyErrorAutoBalance era
TxBodyError
          (Either TxBodyError (UnsignedTx era)
 -> Either (TxBodyErrorAutoBalance era) (UnsignedTx era))
-> Either TxBodyError (UnsignedTx era)
-> Either (TxBodyErrorAutoBalance era) (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$ Era era
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
forall era.
Era era
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
makeUnsignedTx -- TODO: impossible to fail now
            Era era
availableEra
          (TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era))
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era => TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
availableEra
          ((EraCommonConstraints era => TxBodyContent BuildTx era)
 -> TxBodyContent BuildTx era)
-> (EraCommonConstraints era => TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era
txbodycontent1
            { txFee = TxFeeExplicit sbe maxLovelaceFee
            , txOuts =
                txOuts txbodycontent
                  <> [TxOut changeaddr changeTxOut TxOutDatumNone ReferenceScriptNone]
            , txReturnCollateral = dummyCollRet
            , txTotalCollateral = dummyTotColl
            }
      -- 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
nkeys =
            Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe
              (TxBodyContent BuildTx era -> Word
forall era. TxBodyContent BuildTx era -> Word
estimateTransactionKeyWitnessCount TxBodyContent BuildTx era
txbodycontent1)
              Maybe Word
mnkeys
          fee :: Coin
fee =
            Era era -> (EraCommonConstraints era => Coin) -> Coin
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
availableEra ((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 =>
UTxO era -> PParams era -> Tx era -> Int -> Coin
L.calcMinFeeTx (ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
toLedgerUTxO ShelleyBasedEra era
sbe UTxO era
utxo) PParams (ShelleyLedgerEra era)
PParams (LedgerEra era)
pp Tx (LedgerEra era)
txbody1 (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
nkeys)
          (TxReturnCollateral CtxTx era
retColl, TxTotalCollateral era
reqCol) =
            (ShelleyToAlonzoEraConstraints era =>
 ShelleyToAlonzoEra era
 -> (TxReturnCollateral CtxTx era, TxTotalCollateral era))
-> (BabbageEraOnwardsConstraints era =>
    BabbageEraOnwards era
    -> (TxReturnCollateral CtxTx era, TxTotalCollateral era))
-> ShelleyBasedEra era
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
forall era a.
(ShelleyToAlonzoEraConstraints era => ShelleyToAlonzoEra era -> a)
-> (BabbageEraOnwardsConstraints era => BabbageEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToAlonzoOrBabbageEraOnwards
              ((TxReturnCollateral CtxTx era, TxTotalCollateral era)
-> ShelleyToAlonzoEra era
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
forall a b. a -> b -> a
const (TxReturnCollateral CtxTx era
forall ctx era. TxReturnCollateral ctx era
TxReturnCollateralNone, TxTotalCollateral era
forall era. TxTotalCollateral era
TxTotalCollateralNone))
              ( \BabbageEraOnwards era
w -> do
                  let totalPotentialCollateral :: MaryValue StandardCrypto
totalPotentialCollateral =
                        [MaryValue StandardCrypto] -> MaryValue StandardCrypto
forall a. Monoid a => [a] -> a
mconcat
                          [ Value (ShelleyLedgerEra era)
MaryValue StandardCrypto
txOutValue
                          | TxInsCollateral AlonzoEraOnwards era
_ [TxIn]
collInputs <- TxInsCollateral era -> [TxInsCollateral era]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxInsCollateral era -> [TxInsCollateral era])
-> TxInsCollateral era -> [TxInsCollateral era]
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era -> TxInsCollateral era
forall build era. TxBodyContent build era -> TxInsCollateral era
txInsCollateral TxBodyContent BuildTx era
txbodycontent
                          , TxIn
collTxIn <- [TxIn]
collInputs
                          , Just (TxOut AddressInEra era
_ (TxOutValueShelleyBased ShelleyBasedEra era
_ Value (ShelleyLedgerEra era)
txOutValue) TxOutDatum CtxUTxO era
_ ReferenceScript era
_) <- Maybe (TxOut CtxUTxO era) -> [Maybe (TxOut CtxUTxO era)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TxOut CtxUTxO era) -> [Maybe (TxOut CtxUTxO era)])
-> Maybe (TxOut CtxUTxO era) -> [Maybe (TxOut CtxUTxO era)]
forall a b. (a -> b) -> a -> b
$ TxIn -> Map TxIn (TxOut CtxUTxO era) -> Maybe (TxOut CtxUTxO era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
collTxIn (UTxO era -> Map TxIn (TxOut CtxUTxO era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO UTxO era
utxo)
                          ]
                  BabbageEraOnwards era
-> Coin
-> PParams (ShelleyLedgerEra era)
-> TxInsCollateral era
-> TxReturnCollateral CtxTx era
-> TxTotalCollateral era
-> AddressInEra era
-> Value (ShelleyLedgerEra era)
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
forall era.
AlonzoEraPParams (ShelleyLedgerEra era) =>
BabbageEraOnwards era
-> Coin
-> PParams (ShelleyLedgerEra era)
-> TxInsCollateral era
-> TxReturnCollateral CtxTx era
-> TxTotalCollateral era
-> AddressInEra era
-> Value (ShelleyLedgerEra era)
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
calcReturnAndTotalCollateral
                    BabbageEraOnwards era
w
                    Coin
fee
                    PParams (ShelleyLedgerEra era)
pp
                    (TxBodyContent BuildTx era -> TxInsCollateral era
forall build era. TxBodyContent build era -> TxInsCollateral era
txInsCollateral TxBodyContent BuildTx era
txbodycontent)
                    (TxBodyContent BuildTx era -> TxReturnCollateral CtxTx era
forall build era.
TxBodyContent build era -> TxReturnCollateral CtxTx era
txReturnCollateral TxBodyContent BuildTx era
txbodycontent)
                    (TxBodyContent BuildTx era -> TxTotalCollateral era
forall build era. TxBodyContent build era -> TxTotalCollateral era
txTotalCollateral TxBodyContent BuildTx era
txbodycontent)
                    AddressInEra era
changeaddr
                    Value (ShelleyLedgerEra era)
MaryValue StandardCrypto
totalPotentialCollateral
              )
              ShelleyBasedEra era
sbe

      -- 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.
      UnsignedTx Tx (LedgerEra era)
txbody2 <-
        (TxBodyError -> TxBodyErrorAutoBalance era)
-> Either TxBodyError (UnsignedTx era)
-> Either (TxBodyErrorAutoBalance era) (UnsignedTx 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 TxBodyError -> TxBodyErrorAutoBalance era
forall era. TxBodyError -> TxBodyErrorAutoBalance era
TxBodyError
          (Either TxBodyError (UnsignedTx era)
 -> Either (TxBodyErrorAutoBalance era) (UnsignedTx era))
-> Either TxBodyError (UnsignedTx era)
-> Either (TxBodyErrorAutoBalance era) (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$ Era era
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
forall era.
Era era
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
makeUnsignedTx -- TODO: impossible to fail now
            Era era
availableEra
          (TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era))
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era => TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
availableEra
          ((EraCommonConstraints era => TxBodyContent BuildTx era)
 -> TxBodyContent BuildTx era)
-> (EraCommonConstraints era => TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era
txbodycontent1
            { txFee = TxFeeExplicit sbe fee
            , txReturnCollateral = retColl
            , txTotalCollateral = reqCol
            }
      let balance :: TxOutValue era
balance =
            ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
forall era.
(Eq (Value (ShelleyLedgerEra era)),
 Show (Value (ShelleyLedgerEra era))) =>
ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
TxOutValueShelleyBased ShelleyBasedEra era
sbe (Value (ShelleyLedgerEra era) -> TxOutValue era)
-> Value (ShelleyLedgerEra era) -> TxOutValue era
forall a b. (a -> b) -> a -> b
$
              Era era
-> (EraCommonConstraints era => Value (ShelleyLedgerEra era))
-> Value (ShelleyLedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
availableEra ((EraCommonConstraints era => Value (ShelleyLedgerEra era))
 -> Value (ShelleyLedgerEra era))
-> (EraCommonConstraints era => Value (ShelleyLedgerEra era))
-> Value (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
                PParams (LedgerEra era)
-> (Credential 'Staking (EraCrypto (LedgerEra era)) -> Maybe Coin)
-> (Credential 'DRepRole (EraCrypto (LedgerEra era)) -> Maybe Coin)
-> (KeyHash 'StakePool (EraCrypto (LedgerEra era)) -> Bool)
-> UTxO (LedgerEra era)
-> TxBody (LedgerEra era)
-> Value (LedgerEra era)
forall era.
EraUTxO era =>
PParams era
-> (Credential 'Staking (EraCrypto era) -> Maybe Coin)
-> (Credential 'DRepRole (EraCrypto era) -> Maybe Coin)
-> (KeyHash 'StakePool (EraCrypto era) -> Bool)
-> UTxO era
-> TxBody era
-> Value era
L.evalBalanceTxBody
                  PParams (ShelleyLedgerEra era)
PParams (LedgerEra era)
pp
                  (Map StakeCredential Coin
-> Credential 'Staking StandardCrypto -> Maybe Coin
lookupDelegDeposit Map StakeCredential Coin
stakeDelegDeposits)
                  (Map (Credential 'DRepRole StandardCrypto) Coin
-> Credential 'DRepRole StandardCrypto -> Maybe Coin
lookupDRepDeposit Map (Credential 'DRepRole StandardCrypto) Coin
drepDelegDeposits)
                  (Set (Hash StakePoolKey)
-> KeyHash 'StakePool StandardCrypto -> Bool
isRegPool Set (Hash StakePoolKey)
poolids)
                  (ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
toLedgerUTxO ShelleyBasedEra era
sbe UTxO era
utxo)
                  (Tx (LedgerEra era)
txbody2 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)

      [TxOut CtxTx era]
-> (TxOut CtxTx era -> Either (TxBodyErrorAutoBalance era) ())
-> Either (TxBodyErrorAutoBalance era) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (TxBodyContent BuildTx era -> [TxOut CtxTx era]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts TxBodyContent BuildTx era
txbodycontent1) ((TxOut CtxTx era -> Either (TxBodyErrorAutoBalance era) ())
 -> Either (TxBodyErrorAutoBalance era) ())
-> (TxOut CtxTx era -> Either (TxBodyErrorAutoBalance era) ())
-> Either (TxBodyErrorAutoBalance era) ()
forall a b. (a -> b) -> a -> b
$ \TxOut CtxTx era
txout -> ShelleyBasedEra era
-> TxOut CtxTx era
-> PParams (ShelleyLedgerEra era)
-> Either (TxBodyErrorAutoBalance era) ()
forall era.
ShelleyBasedEra era
-> TxOut CtxTx era
-> PParams (ShelleyLedgerEra era)
-> Either (TxBodyErrorAutoBalance era) ()
checkMinUTxOValue ShelleyBasedEra era
sbe TxOut CtxTx era
txout PParams (ShelleyLedgerEra era)
pp

      -- check if the balance is positive or negative
      -- in one case we can produce change, in the other the inputs are insufficient
      ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> AddressInEra era
-> TxOutValue era
-> Either (TxBodyErrorAutoBalance era) ()
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> AddressInEra era
-> TxOutValue era
-> Either (TxBodyErrorAutoBalance era) ()
balanceCheck ShelleyBasedEra era
sbe PParams (ShelleyLedgerEra era)
pp AddressInEra era
changeaddr TxOutValue era
balance

      -- 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 BuildTx era
finalTxBodyContent =
            TxBodyContent BuildTx era
txbodycontent1
              { txFee = TxFeeExplicit sbe fee
              , txOuts =
                  accountForNoChange
                    (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone)
                    (txOuts txbodycontent)
              , txReturnCollateral = retColl
              , txTotalCollateral = reqCol
              }
      UnsignedTx era
txbody3 <-
        (TxBodyError -> TxBodyErrorAutoBalance era)
-> Either TxBodyError (UnsignedTx era)
-> Either (TxBodyErrorAutoBalance era) (UnsignedTx 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 TxBodyError -> TxBodyErrorAutoBalance era
forall era. TxBodyError -> TxBodyErrorAutoBalance era
TxBodyError (Either TxBodyError (UnsignedTx era)
 -> Either (TxBodyErrorAutoBalance era) (UnsignedTx era))
-> Either TxBodyError (UnsignedTx era)
-> Either (TxBodyErrorAutoBalance era) (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$ -- TODO: impossible to fail now. We need to implement a function
        -- that simply creates a transaction body because we have already
        -- validated the transaction body earlier within makeTransactionBodyAutoBalance
          Era era
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
forall era.
Era era
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
makeUnsignedTx Era era
availableEra (TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era))
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$
            Era era
-> (EraCommonConstraints era => TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
availableEra TxBodyContent BuildTx era
EraCommonConstraints era => TxBodyContent BuildTx era
finalTxBodyContent
      BalancedTxBody era
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
forall a. a -> Either (TxBodyErrorAutoBalance era) a
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( TxBodyContent BuildTx era
-> UnsignedTx era -> TxOut CtxTx era -> Coin -> BalancedTxBody era
forall era.
TxBodyContent BuildTx era
-> UnsignedTx era -> TxOut CtxTx era -> Coin -> BalancedTxBody era
BalancedTxBody
            TxBodyContent BuildTx era
finalTxBodyContent
            UnsignedTx era
txbody3
            (AddressInEra era
-> TxOutValue era
-> TxOutDatum CtxTx era
-> ReferenceScript era
-> TxOut CtxTx era
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
TxOut AddressInEra era
changeaddr TxOutValue era
balance TxOutDatum CtxTx era
forall ctx era. TxOutDatum ctx era
TxOutDatumNone ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone)
            Coin
fee
        )

-- | In the event of spending the exact amount of lovelace 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.
accountForNoChange :: TxOut CtxTx era -> [TxOut CtxTx era] -> [TxOut CtxTx era]
accountForNoChange :: forall era.
TxOut CtxTx era -> [TxOut CtxTx era] -> [TxOut CtxTx era]
accountForNoChange change :: TxOut CtxTx era
change@(TxOut AddressInEra era
_ TxOutValue era
balance TxOutDatum CtxTx era
_ ReferenceScript era
_) [TxOut CtxTx era]
rest =
  case TxOutValue era -> Coin
forall era. TxOutValue era -> Coin
txOutValueToLovelace TxOutValue era
balance of
    L.Coin Integer
0 -> [TxOut CtxTx era]
rest
    -- We append change at the end so a client can predict the indexes
    -- of the outputs
    Coin
_ -> [TxOut CtxTx era]
rest [TxOut CtxTx era] -> [TxOut CtxTx era] -> [TxOut CtxTx era]
forall a. [a] -> [a] -> [a]
++ [TxOut CtxTx era
change]

checkMinUTxOValue
  :: ShelleyBasedEra era
  -> TxOut CtxTx era
  -> Ledger.PParams (ShelleyLedgerEra era)
  -> Either (TxBodyErrorAutoBalance era) ()
checkMinUTxOValue :: forall era.
ShelleyBasedEra era
-> TxOut CtxTx era
-> PParams (ShelleyLedgerEra era)
-> Either (TxBodyErrorAutoBalance era) ()
checkMinUTxOValue ShelleyBasedEra era
sbe txout :: TxOut CtxTx era
txout@(TxOut AddressInEra era
_ TxOutValue era
v TxOutDatum CtxTx era
_ ReferenceScript era
_) PParams (ShelleyLedgerEra era)
bpp = do
  let minUTxO :: Coin
minUTxO = ShelleyBasedEra era
-> TxOut CtxTx era -> PParams (ShelleyLedgerEra era) -> Coin
forall era.
ShelleyBasedEra era
-> TxOut CtxTx era -> PParams (ShelleyLedgerEra era) -> Coin
calculateMinimumUTxO ShelleyBasedEra era
sbe TxOut CtxTx era
txout PParams (ShelleyLedgerEra era)
bpp
  if TxOutValue era -> Coin
forall era. TxOutValue era -> Coin
txOutValueToLovelace TxOutValue era
v Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
minUTxO
    then () -> Either (TxBodyErrorAutoBalance era) ()
forall a b. b -> Either a b
Right ()
    else TxBodyErrorAutoBalance era
-> Either (TxBodyErrorAutoBalance era) ()
forall a b. a -> Either a b
Left (TxBodyErrorAutoBalance era
 -> Either (TxBodyErrorAutoBalance era) ())
-> TxBodyErrorAutoBalance era
-> Either (TxBodyErrorAutoBalance era) ()
forall a b. (a -> b) -> a -> b
$ TxOutInAnyEra -> Coin -> TxBodyErrorAutoBalance era
forall era. TxOutInAnyEra -> Coin -> TxBodyErrorAutoBalance era
TxBodyErrorMinUTxONotMet (CardanoEra era -> TxOut CtxTx era -> TxOutInAnyEra
forall era. CardanoEra era -> TxOut CtxTx era -> TxOutInAnyEra
txOutInAnyEra (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
sbe) TxOut CtxTx era
txout) Coin
minUTxO

balanceCheck
  :: ShelleyBasedEra era
  -> Ledger.PParams (ShelleyLedgerEra era)
  -> AddressInEra era
  -> TxOutValue era
  -> Either (TxBodyErrorAutoBalance era) ()
balanceCheck :: forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> AddressInEra era
-> TxOutValue era
-> Either (TxBodyErrorAutoBalance era) ()
balanceCheck ShelleyBasedEra era
sbe PParams (ShelleyLedgerEra era)
bpparams AddressInEra era
changeaddr TxOutValue era
balance
  | TxOutValue era -> Coin
forall era. TxOutValue era -> Coin
txOutValueToLovelace TxOutValue era
balance Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
0 Bool -> Bool -> Bool
&& Value -> Bool
onlyAda (TxOutValue era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue TxOutValue era
balance) = () -> Either (TxBodyErrorAutoBalance era) ()
forall a. a -> Either (TxBodyErrorAutoBalance era) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | TxOutValue era -> Coin
forall era. TxOutValue era -> Coin
txOutValueToLovelace TxOutValue era
balance Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
0 =
      TxBodyErrorAutoBalance era
-> Either (TxBodyErrorAutoBalance era) ()
forall a b. a -> Either a b
Left (TxBodyErrorAutoBalance era
 -> Either (TxBodyErrorAutoBalance era) ())
-> (Coin -> TxBodyErrorAutoBalance era)
-> Coin
-> Either (TxBodyErrorAutoBalance era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> TxBodyErrorAutoBalance era
forall era. Coin -> TxBodyErrorAutoBalance era
TxBodyErrorAdaBalanceNegative (Coin -> Either (TxBodyErrorAutoBalance era) ())
-> Coin -> Either (TxBodyErrorAutoBalance era) ()
forall a b. (a -> b) -> a -> b
$ TxOutValue era -> Coin
forall era. TxOutValue era -> Coin
txOutValueToLovelace TxOutValue era
balance
  | Bool
otherwise =
      case ShelleyBasedEra era
-> TxOut CtxTx era
-> PParams (ShelleyLedgerEra era)
-> Either (TxBodyErrorAutoBalance era) ()
forall era.
ShelleyBasedEra era
-> TxOut CtxTx era
-> PParams (ShelleyLedgerEra era)
-> Either (TxBodyErrorAutoBalance era) ()
checkMinUTxOValue ShelleyBasedEra era
sbe (AddressInEra era
-> TxOutValue era
-> TxOutDatum CtxTx era
-> ReferenceScript era
-> TxOut CtxTx era
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
TxOut AddressInEra era
changeaddr TxOutValue era
balance TxOutDatum CtxTx era
forall ctx era. TxOutDatum ctx era
TxOutDatumNone ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone) PParams (ShelleyLedgerEra era)
bpparams of
        Left (TxBodyErrorMinUTxONotMet TxOutInAnyEra
txOutAny Coin
minUTxO) ->
          TxBodyErrorAutoBalance era
-> Either (TxBodyErrorAutoBalance era) ()
forall a b. a -> Either a b
Left (TxBodyErrorAutoBalance era
 -> Either (TxBodyErrorAutoBalance era) ())
-> TxBodyErrorAutoBalance era
-> Either (TxBodyErrorAutoBalance era) ()
forall a b. (a -> b) -> a -> b
$ TxOutInAnyEra -> Coin -> Coin -> TxBodyErrorAutoBalance era
forall era.
TxOutInAnyEra -> Coin -> Coin -> TxBodyErrorAutoBalance era
TxBodyErrorAdaBalanceTooSmall TxOutInAnyEra
txOutAny Coin
minUTxO (TxOutValue era -> Coin
forall era. TxOutValue era -> Coin
txOutValueToLovelace TxOutValue era
balance)
        Left TxBodyErrorAutoBalance era
err -> TxBodyErrorAutoBalance era
-> Either (TxBodyErrorAutoBalance era) ()
forall a b. a -> Either a b
Left TxBodyErrorAutoBalance era
err
        Right ()
_ -> () -> Either (TxBodyErrorAutoBalance era) ()
forall a b. b -> Either a b
Right ()

isNotAda :: AssetId -> Bool
isNotAda :: AssetId -> Bool
isNotAda AssetId
AdaAssetId = Bool
False
isNotAda AssetId
_ = Bool
True

onlyAda :: Value -> Bool
onlyAda :: Value -> Bool
onlyAda = [(AssetId, Quantity)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(AssetId, Quantity)] -> Bool)
-> (Value -> [(AssetId, Quantity)]) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [(AssetId, Quantity)]
Value -> [Item Value]
forall l. IsList l => l -> [Item l]
toList (Value -> [(AssetId, Quantity)])
-> (Value -> Value) -> Value -> [(AssetId, Quantity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssetId -> Bool) -> Value -> Value
filterValue AssetId -> Bool
isNotAda

calculateIncomingUTxOValue
  :: Monoid (Ledger.Value (ShelleyLedgerEra era))
  => [TxOut ctx era] -> Ledger.Value (ShelleyLedgerEra era)
calculateIncomingUTxOValue :: forall era ctx.
Monoid (Value (ShelleyLedgerEra era)) =>
[TxOut ctx era] -> Value (ShelleyLedgerEra era)
calculateIncomingUTxOValue [TxOut ctx era]
providedUtxoOuts =
  [Value (ShelleyLedgerEra era)] -> Value (ShelleyLedgerEra era)
forall a. Monoid a => [a] -> a
mconcat [Value (ShelleyLedgerEra era)
v | (TxOut AddressInEra era
_ (TxOutValueShelleyBased ShelleyBasedEra era
_ Value (ShelleyLedgerEra era)
v) TxOutDatum ctx era
_ ReferenceScript era
_) <- [TxOut ctx era]
providedUtxoOuts]

-- 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
  :: ()
  => Ledger.AlonzoEraPParams (ShelleyLedgerEra era)
  => BabbageEraOnwards era
  -> L.Coin
  -- ^ Fee
  -> Ledger.PParams (ShelleyLedgerEra era)
  -> TxInsCollateral era
  -- ^ From the initial TxBodyContent
  -> TxReturnCollateral CtxTx era
  -- ^ From the initial TxBodyContent
  -> TxTotalCollateral era
  -- ^ From the initial TxBodyContent
  -> AddressInEra era
  -- ^ Change address
  -> L.Value (ShelleyLedgerEra era)
  -- ^ Total available collateral (can include non-ada)
  -> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
calcReturnAndTotalCollateral :: forall era.
AlonzoEraPParams (ShelleyLedgerEra era) =>
BabbageEraOnwards era
-> Coin
-> PParams (ShelleyLedgerEra era)
-> TxInsCollateral era
-> TxReturnCollateral CtxTx era
-> TxTotalCollateral era
-> AddressInEra era
-> Value (ShelleyLedgerEra era)
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
calcReturnAndTotalCollateral BabbageEraOnwards era
_ Coin
_ PParams (ShelleyLedgerEra era)
_ TxInsCollateral era
TxInsCollateralNone TxReturnCollateral CtxTx era
_ TxTotalCollateral era
_ AddressInEra era
_ Value (ShelleyLedgerEra era)
_ = (TxReturnCollateral CtxTx era
forall ctx era. TxReturnCollateral ctx era
TxReturnCollateralNone, TxTotalCollateral era
forall era. TxTotalCollateral era
TxTotalCollateralNone)
calcReturnAndTotalCollateral BabbageEraOnwards era
w Coin
fee PParams (ShelleyLedgerEra era)
pp' TxInsCollateral{} TxReturnCollateral CtxTx era
txReturnCollateral TxTotalCollateral era
txTotalCollateral AddressInEra era
cAddr Value (ShelleyLedgerEra era)
totalAvailableCollateral = BabbageEraOnwards era
-> (BabbageEraOnwardsConstraints era =>
    (TxReturnCollateral CtxTx era, TxTotalCollateral era))
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
forall era a.
BabbageEraOnwards era
-> (BabbageEraOnwardsConstraints era => a) -> a
babbageEraOnwardsConstraints BabbageEraOnwards era
w ((BabbageEraOnwardsConstraints era =>
  (TxReturnCollateral CtxTx era, TxTotalCollateral era))
 -> (TxReturnCollateral CtxTx era, TxTotalCollateral era))
-> (BabbageEraOnwardsConstraints era =>
    (TxReturnCollateral CtxTx era, TxTotalCollateral era))
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
forall a b. (a -> b) -> a -> b
$ do
  let sbe :: ShelleyBasedEra era
sbe = BabbageEraOnwards era -> ShelleyBasedEra era
forall era. BabbageEraOnwards era -> ShelleyBasedEra era
babbageEraOnwardsToShelleyBasedEra BabbageEraOnwards era
w
      colPerc :: Natural
colPerc = PParams (ShelleyLedgerEra era)
pp' PParams (ShelleyLedgerEra era)
-> Getting Natural (PParams (ShelleyLedgerEra era)) Natural
-> Natural
forall s a. s -> Getting a s a -> a
^. Getting Natural (PParams (ShelleyLedgerEra era)) Natural
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams (ShelleyLedgerEra 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 = Value (ShelleyLedgerEra era)
MaryValue StandardCrypto
totalAvailableCollateral MaryValue StandardCrypto
-> Getting Coin (MaryValue StandardCrypto) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. ShelleyBasedEra era -> Lens' (Value (ShelleyLedgerEra era)) Coin
forall era.
ShelleyBasedEra era -> Lens' (Value (ShelleyLedgerEra era)) Coin
A.adaAssetL ShelleyBasedEra era
sbe
      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 :: TxTotalCollateral era
totalCollateral =
        BabbageEraOnwards era -> Coin -> TxTotalCollateral era
forall era. BabbageEraOnwards era -> Coin -> TxTotalCollateral era
TxTotalCollateral BabbageEraOnwards era
w (Coin -> TxTotalCollateral era)
-> (Rational -> Coin) -> Rational -> TxTotalCollateral era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Coin
L.rationalToCoinViaCeiling (Rational -> TxTotalCollateral era)
-> Rational -> TxTotalCollateral era
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
      returnAdaCollateral :: Value (ShelleyLedgerEra era)
returnAdaCollateral = ShelleyBasedEra era -> Coin -> Value (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> Coin -> Value (ShelleyLedgerEra era)
A.mkAdaValue ShelleyBasedEra era
sbe (Coin -> Value (ShelleyLedgerEra era))
-> Coin -> Value (ShelleyLedgerEra era)
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 StandardCrypto
nonAdaCollateral = (Coin -> Coin)
-> MaryValue StandardCrypto -> MaryValue StandardCrypto
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) Value (ShelleyLedgerEra era)
MaryValue StandardCrypto
totalAvailableCollateral
      returnCollateral :: MaryValue StandardCrypto
returnCollateral = Value (ShelleyLedgerEra era)
MaryValue StandardCrypto
returnAdaCollateral MaryValue StandardCrypto
-> MaryValue StandardCrypto -> MaryValue StandardCrypto
forall a. Semigroup a => a -> a -> a
<> MaryValue StandardCrypto
nonAdaCollateral
  case (TxReturnCollateral CtxTx era
txReturnCollateral, TxTotalCollateral era
txTotalCollateral) of
    (rc :: TxReturnCollateral CtxTx era
rc@TxReturnCollateral{}, tc :: TxTotalCollateral era
tc@TxTotalCollateral{}) ->
      (TxReturnCollateral CtxTx era
rc, TxTotalCollateral era
tc)
    (rc :: TxReturnCollateral CtxTx era
rc@TxReturnCollateral{}, TxTotalCollateral era
TxTotalCollateralNone) ->
      (TxReturnCollateral CtxTx era
rc, TxTotalCollateral era
forall era. TxTotalCollateral era
TxTotalCollateralNone)
    (TxReturnCollateral CtxTx era
TxReturnCollateralNone, tc :: TxTotalCollateral era
tc@TxTotalCollateral{}) ->
      (TxReturnCollateral CtxTx era
forall ctx era. TxReturnCollateral ctx era
TxReturnCollateralNone, TxTotalCollateral era
tc)
    (TxReturnCollateral CtxTx era
TxReturnCollateralNone, TxTotalCollateral era
TxTotalCollateralNone)
      | Integer
returnCollateralAmount Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 ->
          (TxReturnCollateral CtxTx era
forall ctx era. TxReturnCollateral ctx era
TxReturnCollateralNone, TxTotalCollateral era
forall era. TxTotalCollateral era
TxTotalCollateralNone)
      | Bool
otherwise ->
          ( BabbageEraOnwards era
-> TxOut CtxTx era -> TxReturnCollateral CtxTx era
forall era ctx.
BabbageEraOnwards era
-> TxOut ctx era -> TxReturnCollateral ctx era
TxReturnCollateral
              BabbageEraOnwards era
w
              ( AddressInEra era
-> TxOutValue era
-> TxOutDatum CtxTx era
-> ReferenceScript era
-> TxOut CtxTx era
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
TxOut
                  AddressInEra era
cAddr
                  (ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
forall era.
(Eq (Value (ShelleyLedgerEra era)),
 Show (Value (ShelleyLedgerEra era))) =>
ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
TxOutValueShelleyBased ShelleyBasedEra era
sbe Value (ShelleyLedgerEra era)
MaryValue StandardCrypto
returnCollateral)
                  TxOutDatum CtxTx era
forall ctx era. TxOutDatum ctx era
TxOutDatumNone
                  ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone
              )
          , TxTotalCollateral era
totalCollateral
          )

calculateCreatedUTOValue
  :: ShelleyBasedEra era -> TxBodyContent build era -> Value
calculateCreatedUTOValue :: forall era build.
ShelleyBasedEra era -> TxBodyContent build era -> Value
calculateCreatedUTOValue ShelleyBasedEra era
sbe TxBodyContent build era
txbodycontent =
  [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat [ShelleyBasedEra era -> Value (ShelleyLedgerEra era) -> Value
forall era.
ShelleyBasedEra era -> Value (ShelleyLedgerEra era) -> Value
fromLedgerValue ShelleyBasedEra era
sbe Value (ShelleyLedgerEra era)
v | (TxOut AddressInEra era
_ (TxOutValueShelleyBased ShelleyBasedEra era
_ Value (ShelleyLedgerEra era)
v) TxOutDatum CtxTx era
_ ReferenceScript era
_) <- TxBodyContent build era -> [TxOut CtxTx era]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts TxBodyContent build era
txbodycontent]

calculateChangeValue
  :: ShelleyBasedEra era -> Value -> TxBodyContent build era -> Value
calculateChangeValue :: forall era build.
ShelleyBasedEra era -> Value -> TxBodyContent build era -> Value
calculateChangeValue ShelleyBasedEra era
sbe Value
incoming TxBodyContent build era
txbodycontent =
  let outgoing :: Value
outgoing = ShelleyBasedEra era -> TxBodyContent build era -> Value
forall era build.
ShelleyBasedEra era -> TxBodyContent build era -> Value
calculateCreatedUTOValue ShelleyBasedEra era
sbe TxBodyContent build era
txbodycontent
      minted :: Value
minted = case TxBodyContent build era -> TxMintValue build era
forall build era. TxBodyContent build era -> TxMintValue build era
txMintValue TxBodyContent build era
txbodycontent of
        TxMintValue build era
TxMintNone -> Value
forall a. Monoid a => a
mempty
        TxMintValue MaryEraOnwards era
_ Value
v BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
_ -> Value
v
   in [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat [Value
incoming, Value
minted, Value -> Value
negateValue Value
outgoing]

-- | 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 :: ShelleyBasedEra era -> TxBodyContent BuildTx era -> Coin -> UTxO era
createFakeUTxO :: forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Coin -> UTxO era
createFakeUTxO ShelleyBasedEra era
sbe TxBodyContent BuildTx 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]) -> 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, BuildTxWith BuildTx (Witness WitCtxTxIn era)
_) <- TxBodyContent BuildTx era -> TxIns BuildTx era
forall build era. TxBodyContent build era -> TxIns build era
txIns TxBodyContent BuildTx era
txbodycontent]
      singleTxOut :: [TxOut CtxUTxO era]
singleTxOut =
        [TxOut CtxUTxO era]
-> ((TxOut CtxTx era, [TxOut CtxTx era]) -> [TxOut CtxUTxO era])
-> Maybe (TxOut CtxTx era, [TxOut CtxTx era])
-> [TxOut CtxUTxO era]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (TxOut CtxUTxO era -> [TxOut CtxUTxO era]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (TxOut CtxUTxO era -> [TxOut CtxUTxO era])
-> ((TxOut CtxTx era, [TxOut CtxTx era]) -> TxOut CtxUTxO era)
-> (TxOut CtxTx era, [TxOut CtxTx era])
-> [TxOut CtxUTxO era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era
-> Coin -> TxOut CtxUTxO era -> TxOut CtxUTxO era
forall era.
ShelleyBasedEra era
-> Coin -> TxOut CtxUTxO era -> TxOut CtxUTxO era
updateTxOut ShelleyBasedEra era
sbe Coin
totalAdaInUTxO (TxOut CtxUTxO era -> TxOut CtxUTxO era)
-> ((TxOut CtxTx era, [TxOut CtxTx era]) -> TxOut CtxUTxO era)
-> (TxOut CtxTx era, [TxOut CtxTx era])
-> TxOut CtxUTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxTx era -> TxOut CtxUTxO era
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
toCtxUTxOTxOut (TxOut CtxTx era -> TxOut CtxUTxO era)
-> ((TxOut CtxTx era, [TxOut CtxTx era]) -> TxOut CtxTx era)
-> (TxOut CtxTx era, [TxOut CtxTx era])
-> TxOut CtxUTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut CtxTx era, [TxOut CtxTx era]) -> TxOut CtxTx era
forall a b. (a, b) -> a
fst) (Maybe (TxOut CtxTx era, [TxOut CtxTx era]) -> [TxOut CtxUTxO era])
-> Maybe (TxOut CtxTx era, [TxOut CtxTx era])
-> [TxOut CtxUTxO 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 BuildTx era -> [TxOut CtxTx era]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts TxBodyContent BuildTx 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 CtxUTxO era) -> UTxO era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO (Map TxIn (TxOut CtxUTxO era) -> UTxO era)
-> Map TxIn (TxOut CtxUTxO era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ [Item (Map TxIn (TxOut CtxUTxO era))]
-> Map TxIn (TxOut CtxUTxO era)
forall l. IsList l => [Item l] -> l
fromList ([Item (Map TxIn (TxOut CtxUTxO era))]
 -> Map TxIn (TxOut CtxUTxO era))
-> [Item (Map TxIn (TxOut CtxUTxO era))]
-> Map TxIn (TxOut CtxUTxO era)
forall a b. (a -> b) -> a -> b
$ [TxIn] -> [TxOut CtxUTxO era] -> [(TxIn, TxOut CtxUTxO era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIn]
singleTxIn [TxOut CtxUTxO era]
singleTxOut

updateTxOut :: ShelleyBasedEra era -> Coin -> TxOut CtxUTxO era -> TxOut CtxUTxO era
updateTxOut :: forall era.
ShelleyBasedEra era
-> Coin -> TxOut CtxUTxO era -> TxOut CtxUTxO era
updateTxOut ShelleyBasedEra era
sbe Coin
updatedValue TxOut CtxUTxO era
txout =
  let ledgerout :: TxOut (ShelleyLedgerEra era)
ledgerout = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => TxOut (ShelleyLedgerEra era))
-> TxOut (ShelleyLedgerEra era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => TxOut (ShelleyLedgerEra era))
 -> TxOut (ShelleyLedgerEra era))
-> (ShelleyBasedEraConstraints era => TxOut (ShelleyLedgerEra era))
-> TxOut (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> TxOut CtxUTxO era -> TxOut (ShelleyLedgerEra era)
forall era ledgerera.
(HasCallStack, ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era -> TxOut CtxUTxO era -> TxOut ledgerera
toShelleyTxOut ShelleyBasedEra era
sbe TxOut CtxUTxO era
txout TxOut (ShelleyLedgerEra era)
-> (TxOut (ShelleyLedgerEra era) -> TxOut (ShelleyLedgerEra era))
-> TxOut (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxOut (ShelleyLedgerEra era)
-> Identity (TxOut (ShelleyLedgerEra era))
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut (ShelleyLedgerEra era)) Coin
L.coinTxOutL ((Coin -> Identity Coin)
 -> TxOut (ShelleyLedgerEra era)
 -> Identity (TxOut (ShelleyLedgerEra era)))
-> Coin
-> TxOut (ShelleyLedgerEra era)
-> TxOut (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
updatedValue
   in ShelleyBasedEra era
-> TxOut (ShelleyLedgerEra era) -> TxOut CtxUTxO era
forall era ctx.
ShelleyBasedEra era
-> TxOut (ShelleyLedgerEra era) -> TxOut ctx era
fromShelleyTxOut ShelleyBasedEra era
sbe TxOut (ShelleyLedgerEra era)
ledgerout

-- 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
  :: ShelleyBasedEra era
  -> TxBodyContent BuildTx era
  -> AddressInEra era
  -> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
maybeDummyTotalCollAndCollReturnOutput :: forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
maybeDummyTotalCollAndCollReturnOutput ShelleyBasedEra era
sbe TxBodyContent{TxInsCollateral era
txInsCollateral :: forall build era. TxBodyContent build era -> TxInsCollateral era
txInsCollateral :: TxInsCollateral era
txInsCollateral, TxReturnCollateral CtxTx era
txReturnCollateral :: forall build era.
TxBodyContent build era -> TxReturnCollateral CtxTx era
txReturnCollateral :: TxReturnCollateral CtxTx era
txReturnCollateral, TxTotalCollateral era
txTotalCollateral :: forall build era. TxBodyContent build era -> TxTotalCollateral era
txTotalCollateral :: TxTotalCollateral era
txTotalCollateral} AddressInEra era
cAddr =
  case TxInsCollateral era
txInsCollateral of
    TxInsCollateral era
TxInsCollateralNone -> (TxReturnCollateral CtxTx era
forall ctx era. TxReturnCollateral ctx era
TxReturnCollateralNone, TxTotalCollateral era
forall era. TxTotalCollateral era
TxTotalCollateralNone)
    TxInsCollateral{} ->
      ShelleyBasedEra era
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
-> (BabbageEraOnwards era
    -> (TxReturnCollateral CtxTx era, TxTotalCollateral era))
-> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
forall (eon :: * -> *) era a.
Eon eon =>
ShelleyBasedEra era -> a -> (eon era -> a) -> a
forShelleyBasedEraInEon
        ShelleyBasedEra era
sbe
        (TxReturnCollateral CtxTx era
forall ctx era. TxReturnCollateral ctx era
TxReturnCollateralNone, TxTotalCollateral era
forall era. TxTotalCollateral era
TxTotalCollateralNone)
        ( \BabbageEraOnwards era
w ->
            let dummyRetCol :: TxReturnCollateral CtxTx era
dummyRetCol =
                  BabbageEraOnwards era
-> TxOut CtxTx era -> TxReturnCollateral CtxTx era
forall era ctx.
BabbageEraOnwards era
-> TxOut ctx era -> TxReturnCollateral ctx era
TxReturnCollateral
                    BabbageEraOnwards era
w
                    ( AddressInEra era
-> TxOutValue era
-> TxOutDatum CtxTx era
-> ReferenceScript era
-> TxOut CtxTx era
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
TxOut
                        AddressInEra era
cAddr
                        (ShelleyBasedEra era -> Coin -> TxOutValue era
forall era. ShelleyBasedEra era -> Coin -> TxOutValue era
lovelaceToTxOutValue ShelleyBasedEra era
sbe (Coin -> TxOutValue era) -> Coin -> TxOutValue 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)
                        TxOutDatum CtxTx era
forall ctx era. TxOutDatum ctx era
TxOutDatumNone
                        ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone
                    )
                dummyTotCol :: TxTotalCollateral era
dummyTotCol = BabbageEraOnwards era -> Coin -> TxTotalCollateral era
forall era. BabbageEraOnwards era -> Coin -> TxTotalCollateral era
TxTotalCollateral BabbageEraOnwards era
w (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 (TxReturnCollateral CtxTx era
txReturnCollateral, TxTotalCollateral era
txTotalCollateral) of
                  (rc :: TxReturnCollateral CtxTx era
rc@TxReturnCollateral{}, tc :: TxTotalCollateral era
tc@TxTotalCollateral{}) -> (TxReturnCollateral CtxTx era
rc, TxTotalCollateral era
tc)
                  (rc :: TxReturnCollateral CtxTx era
rc@TxReturnCollateral{}, TxTotalCollateral era
TxTotalCollateralNone) -> (TxReturnCollateral CtxTx era
rc, TxTotalCollateral era
dummyTotCol)
                  (TxReturnCollateral CtxTx era
TxReturnCollateralNone, tc :: TxTotalCollateral era
tc@TxTotalCollateral{}) -> (TxReturnCollateral CtxTx era
dummyRetCol, TxTotalCollateral era
tc)
                  (TxReturnCollateral CtxTx era
TxReturnCollateralNone, TxTotalCollateral era
TxTotalCollateralNone) -> (TxReturnCollateral CtxTx era
dummyRetCol, TxTotalCollateral era
dummyTotCol)
        )

substituteExecutionUnits
  :: forall era
   . Map ScriptWitnessIndex ExecutionUnits
  -> TxBodyContent BuildTx era
  -> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
substituteExecutionUnits :: forall era.
Map ScriptWitnessIndex ExecutionUnits
-> TxBodyContent BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
substituteExecutionUnits
  Map ScriptWitnessIndex ExecutionUnits
exUnitsMap
  txbodycontent :: TxBodyContent BuildTx era
txbodycontent@( TxBodyContent
                    TxIns BuildTx era
txIns
                    TxInsCollateral era
_
                    TxInsReference era
_
                    [TxOut CtxTx era]
_
                    TxTotalCollateral era
_
                    TxReturnCollateral CtxTx era
_
                    TxFee era
_
                    TxValidityLowerBound era
_
                    TxValidityUpperBound era
_
                    TxMetadataInEra era
_
                    TxAuxScripts era
_
                    TxExtraKeyWitnesses era
_
                    BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))
_
                    TxWithdrawals BuildTx era
txWithdrawals
                    TxCertificates BuildTx era
txCertificates
                    TxUpdateProposal era
_
                    TxMintValue BuildTx era
txMintValue
                    TxScriptValidity era
_
                    Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
txProposalProcedures
                    Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
txVotingProcedures
                    Maybe (Featured ConwayEraOnwards era (Maybe Coin))
_
                    Maybe (Featured ConwayEraOnwards era Coin)
_
                  ) = do
    TxIns BuildTx era
mappedTxIns <- TxIns BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxIns BuildTx era)
mapScriptWitnessesTxIns TxIns BuildTx era
txIns
    TxWithdrawals BuildTx era
mappedWithdrawals <- TxWithdrawals BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxWithdrawals BuildTx era)
mapScriptWitnessesWithdrawals TxWithdrawals BuildTx era
txWithdrawals
    TxMintValue BuildTx era
mappedMintedVals <- TxMintValue BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era)
mapScriptWitnessesMinting TxMintValue BuildTx era
txMintValue
    TxCertificates BuildTx era
mappedTxCertificates <- TxCertificates BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxCertificates BuildTx era)
mapScriptWitnessesCertificates TxCertificates BuildTx era
txCertificates
    Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
mappedVotes <- Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era)))
forall build.
Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxVotingProcedures build era)))
mapScriptWitnessesVotes Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
txVotingProcedures
    Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
mappedProposals <- Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era)))
forall build.
Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxProposalProcedures build era)))
mapScriptWitnessesProposals Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
txProposalProcedures

    TxBodyContent BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
forall a b. b -> Either a b
Right (TxBodyContent BuildTx era
 -> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era))
-> TxBodyContent BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
forall a b. (a -> b) -> a -> b
$
      TxBodyContent BuildTx era
txbodycontent
        TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxIns BuildTx era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall build era.
TxIns build era
-> TxBodyContent build era -> TxBodyContent build era
setTxIns TxIns BuildTx era
mappedTxIns
        TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxMintValue BuildTx era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall build era.
TxMintValue build era
-> TxBodyContent build era -> TxBodyContent build era
setTxMintValue TxMintValue BuildTx era
mappedMintedVals
        TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxCertificates BuildTx era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall build era.
TxCertificates build era
-> TxBodyContent build era -> TxBodyContent build era
setTxCertificates TxCertificates BuildTx era
mappedTxCertificates
        TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxWithdrawals BuildTx era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall build era.
TxWithdrawals build era
-> TxBodyContent build era -> TxBodyContent build era
setTxWithdrawals TxWithdrawals BuildTx era
mappedWithdrawals
        TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures build era))
-> TxBodyContent build era -> TxBodyContent build era
setTxVotingProcedures Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
mappedVotes
        TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures build era))
-> TxBodyContent build era -> TxBodyContent build era
setTxProposalProcedures Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
mappedProposals
   where
    substituteExecUnits
      :: ScriptWitnessIndex
      -> ScriptWitness witctx era
      -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
    substituteExecUnits :: forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
substituteExecUnits ScriptWitnessIndex
_ wit :: ScriptWitness witctx era
wit@SimpleScriptWitness{} = ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
forall a b. b -> Either a b
Right ScriptWitness witctx era
wit
    substituteExecUnits ScriptWitnessIndex
idx (PlutusScriptWitness ScriptLanguageInEra lang era
langInEra PlutusScriptVersion lang
version PlutusScriptOrReferenceInput lang
script ScriptDatum witctx
datum ScriptRedeemer
redeemer ExecutionUnits
_) =
      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 era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
forall a b. a -> Either a b
Left (TxBodyErrorAutoBalance era
 -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era))
-> TxBodyErrorAutoBalance era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$ ScriptWitnessIndex
-> Map ScriptWitnessIndex ExecutionUnits
-> TxBodyErrorAutoBalance era
forall era.
ScriptWitnessIndex
-> Map ScriptWitnessIndex ExecutionUnits
-> TxBodyErrorAutoBalance era
TxBodyErrorScriptWitnessIndexMissingFromExecUnitsMap ScriptWitnessIndex
idx Map ScriptWitnessIndex ExecutionUnits
exUnitsMap
        Just ExecutionUnits
exunits ->
          ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
forall a b. b -> Either a b
Right (ScriptWitness witctx era
 -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era))
-> ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
            ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> ScriptRedeemer
-> ExecutionUnits
-> ScriptWitness witctx era
forall lang era witctx.
ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> ScriptRedeemer
-> ExecutionUnits
-> ScriptWitness witctx era
PlutusScriptWitness
              ScriptLanguageInEra lang era
langInEra
              PlutusScriptVersion lang
version
              PlutusScriptOrReferenceInput lang
script
              ScriptDatum witctx
datum
              ScriptRedeemer
redeemer
              ExecutionUnits
exunits

    mapScriptWitnessesTxIns
      :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
      -> Either (TxBodyErrorAutoBalance era) [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
    mapScriptWitnessesTxIns :: TxIns BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxIns BuildTx era)
mapScriptWitnessesTxIns TxIns BuildTx era
txins =
      let mappedScriptWitnesses
            :: [ ( TxIn
                 , Either (TxBodyErrorAutoBalance era) (BuildTxWith BuildTx (Witness WitCtxTxIn era))
                 )
               ]
          mappedScriptWitnesses :: [(TxIn,
  Either
    (TxBodyErrorAutoBalance era)
    (BuildTxWith BuildTx (Witness WitCtxTxIn era)))]
mappedScriptWitnesses =
            [ (TxIn
txin, Witness WitCtxTxIn era
-> BuildTxWith BuildTx (Witness WitCtxTxIn era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn era
 -> BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> Either (TxBodyErrorAutoBalance era) (Witness WitCtxTxIn era)
-> Either
     (TxBodyErrorAutoBalance era)
     (BuildTxWith BuildTx (Witness WitCtxTxIn era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (TxBodyErrorAutoBalance era) (Witness WitCtxTxIn era)
wit')
            | -- The tx ins are indexed in the map order by txid
            (Word32
ix, (TxIn
txin, BuildTxWith Witness WitCtxTxIn era
wit)) <- [Word32]
-> TxIns BuildTx era
-> [(Word32, (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] (TxIns BuildTx era -> TxIns BuildTx era
forall v. [(TxIn, v)] -> [(TxIn, v)]
orderTxIns TxIns BuildTx era
txins)
            , let wit' :: Either (TxBodyErrorAutoBalance era) (Witness WitCtxTxIn era)
wit' = case Witness WitCtxTxIn era
wit of
                    KeyWitness{} -> Witness WitCtxTxIn era
-> Either (TxBodyErrorAutoBalance era) (Witness WitCtxTxIn era)
forall a b. b -> Either a b
Right Witness WitCtxTxIn era
wit
                    ScriptWitness ScriptWitnessInCtx WitCtxTxIn
ctx ScriptWitness WitCtxTxIn era
witness -> ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn era -> Witness WitCtxTxIn era
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
ctx (ScriptWitness WitCtxTxIn era -> Witness WitCtxTxIn era)
-> Either
     (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxTxIn era)
-> Either (TxBodyErrorAutoBalance era) (Witness WitCtxTxIn era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxTxIn era)
witness'
                     where
                      witness' :: Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxTxIn era)
witness' = ScriptWitnessIndex
-> ScriptWitness WitCtxTxIn era
-> Either
     (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxTxIn era)
forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
substituteExecUnits (Word32 -> ScriptWitnessIndex
ScriptWitnessIndexTxIn Word32
ix) ScriptWitness WitCtxTxIn era
witness
            ]
       in ((TxIn,
  Either
    (TxBodyErrorAutoBalance era)
    (BuildTxWith BuildTx (Witness WitCtxTxIn era)))
 -> Either
      (TxBodyErrorAutoBalance era)
      (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)))
-> [(TxIn,
     Either
       (TxBodyErrorAutoBalance era)
       (BuildTxWith BuildTx (Witness WitCtxTxIn era)))]
-> Either (TxBodyErrorAutoBalance era) (TxIns BuildTx 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 era)
  (BuildTxWith BuildTx (Witness WitCtxTxIn era))
eWitness) ->
                case Either
  (TxBodyErrorAutoBalance era)
  (BuildTxWith BuildTx (Witness WitCtxTxIn era))
eWitness of
                  Left TxBodyErrorAutoBalance era
e -> TxBodyErrorAutoBalance era
-> Either
     (TxBodyErrorAutoBalance era)
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
forall a b. a -> Either a b
Left TxBodyErrorAutoBalance era
e
                  Right BuildTxWith BuildTx (Witness WitCtxTxIn era)
wit -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> Either
     (TxBodyErrorAutoBalance era)
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
forall a b. b -> Either a b
Right (TxIn
txIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)
wit)
            )
            [(TxIn,
  Either
    (TxBodyErrorAutoBalance era)
    (BuildTxWith BuildTx (Witness WitCtxTxIn era)))]
mappedScriptWitnesses

    mapScriptWitnessesWithdrawals
      :: TxWithdrawals BuildTx era
      -> Either (TxBodyErrorAutoBalance era) (TxWithdrawals BuildTx era)
    mapScriptWitnessesWithdrawals :: TxWithdrawals BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxWithdrawals BuildTx era)
mapScriptWitnessesWithdrawals TxWithdrawals BuildTx era
TxWithdrawalsNone = TxWithdrawals BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxWithdrawals BuildTx era)
forall a b. b -> Either a b
Right TxWithdrawals BuildTx era
forall build era. TxWithdrawals build era
TxWithdrawalsNone
    mapScriptWitnessesWithdrawals (TxWithdrawals ShelleyBasedEra era
supported [(StakeAddress, Coin,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
withdrawals) =
      let mappedWithdrawals
            :: [ ( StakeAddress
                 , L.Coin
                 , Either (TxBodyErrorAutoBalance era) (BuildTxWith BuildTx (Witness WitCtxStake era))
                 )
               ]
          mappedWithdrawals :: [(StakeAddress, Coin,
  Either
    (TxBodyErrorAutoBalance era)
    (BuildTxWith BuildTx (Witness WitCtxStake era)))]
mappedWithdrawals =
            [ (StakeAddress
addr, Coin
withdrawal, Witness WitCtxStake era
-> BuildTxWith BuildTx (Witness WitCtxStake era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxStake era
 -> BuildTxWith BuildTx (Witness WitCtxStake era))
-> Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era)
-> Either
     (TxBodyErrorAutoBalance era)
     (BuildTxWith BuildTx (Witness WitCtxStake era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era)
mappedWitness)
            | -- The withdrawals are indexed in the map order by stake credential
            (Word32
ix, (StakeAddress
addr, Coin
withdrawal, BuildTxWith Witness WitCtxStake era
wit)) <- [Word32]
-> [(StakeAddress, Coin,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
-> [(Word32,
     (StakeAddress, Coin,
      BuildTxWith BuildTx (Witness WitCtxStake era)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] ([(StakeAddress, Coin,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
-> [(StakeAddress, Coin,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall x v. [(StakeAddress, x, v)] -> [(StakeAddress, x, v)]
orderStakeAddrs [(StakeAddress, Coin,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
withdrawals)
            , let mappedWitness :: Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era)
mappedWitness = (ScriptWitness WitCtxStake era
 -> Either
      (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era))
-> Witness WitCtxStake era
-> Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era)
forall witctx.
(ScriptWitness witctx era
 -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era))
-> Witness witctx era
-> Either (TxBodyErrorAutoBalance era) (Witness witctx era)
adjustWitness (ScriptWitnessIndex
-> ScriptWitness WitCtxStake era
-> Either
     (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era)
forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
substituteExecUnits (Word32 -> ScriptWitnessIndex
ScriptWitnessIndexWithdrawal Word32
ix)) Witness WitCtxStake era
wit
            ]
       in ShelleyBasedEra era
-> [(StakeAddress, Coin,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
-> TxWithdrawals BuildTx era
forall era build.
ShelleyBasedEra era
-> [(StakeAddress, Coin,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
TxWithdrawals ShelleyBasedEra era
supported
            ([(StakeAddress, Coin,
   BuildTxWith BuildTx (Witness WitCtxStake era))]
 -> TxWithdrawals BuildTx era)
-> Either
     (TxBodyErrorAutoBalance era)
     [(StakeAddress, Coin,
       BuildTxWith BuildTx (Witness WitCtxStake era))]
-> Either (TxBodyErrorAutoBalance era) (TxWithdrawals BuildTx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((StakeAddress, Coin,
  Either
    (TxBodyErrorAutoBalance era)
    (BuildTxWith BuildTx (Witness WitCtxStake era)))
 -> Either
      (TxBodyErrorAutoBalance era)
      (StakeAddress, Coin,
       BuildTxWith BuildTx (Witness WitCtxStake era)))
-> [(StakeAddress, Coin,
     Either
       (TxBodyErrorAutoBalance era)
       (BuildTxWith BuildTx (Witness WitCtxStake era)))]
-> Either
     (TxBodyErrorAutoBalance era)
     [(StakeAddress, Coin,
       BuildTxWith BuildTx (Witness WitCtxStake 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 era)
  (BuildTxWith BuildTx (Witness WitCtxStake era))
eWitness) ->
                  case Either
  (TxBodyErrorAutoBalance era)
  (BuildTxWith BuildTx (Witness WitCtxStake era))
eWitness of
                    Left TxBodyErrorAutoBalance era
e -> TxBodyErrorAutoBalance era
-> Either
     (TxBodyErrorAutoBalance era)
     (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake era))
forall a b. a -> Either a b
Left TxBodyErrorAutoBalance era
e
                    Right BuildTxWith BuildTx (Witness WitCtxStake era)
wit -> (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake era))
-> Either
     (TxBodyErrorAutoBalance era)
     (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake era))
forall a b. b -> Either a b
Right (StakeAddress
sAddr, Coin
ll, BuildTxWith BuildTx (Witness WitCtxStake era)
wit)
              )
              [(StakeAddress, Coin,
  Either
    (TxBodyErrorAutoBalance era)
    (BuildTxWith BuildTx (Witness WitCtxStake era)))]
mappedWithdrawals
     where
      adjustWitness
        :: (ScriptWitness witctx era -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era))
        -> Witness witctx era
        -> Either (TxBodyErrorAutoBalance era) (Witness witctx era)
      adjustWitness :: forall witctx.
(ScriptWitness witctx era
 -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era))
-> Witness witctx era
-> Either (TxBodyErrorAutoBalance era) (Witness witctx era)
adjustWitness ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
_ (KeyWitness KeyWitnessInCtx witctx
ctx) = Witness witctx era
-> Either (TxBodyErrorAutoBalance era) (Witness witctx era)
forall a b. b -> Either a b
Right (Witness witctx era
 -> Either (TxBodyErrorAutoBalance era) (Witness witctx era))
-> Witness witctx era
-> Either (TxBodyErrorAutoBalance era) (Witness witctx era)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx witctx -> Witness witctx era
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx witctx
ctx
      adjustWitness ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
g (ScriptWitness ScriptWitnessInCtx witctx
ctx ScriptWitness witctx era
witness') = ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx witctx
ctx (ScriptWitness witctx era -> Witness witctx era)
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
-> Either (TxBodyErrorAutoBalance era) (Witness witctx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
g ScriptWitness witctx era
witness'

    mapScriptWitnessesCertificates
      :: TxCertificates BuildTx era
      -> Either (TxBodyErrorAutoBalance era) (TxCertificates BuildTx era)
    mapScriptWitnessesCertificates :: TxCertificates BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxCertificates BuildTx era)
mapScriptWitnessesCertificates TxCertificates BuildTx era
TxCertificatesNone = TxCertificates BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxCertificates BuildTx era)
forall a b. b -> Either a b
Right TxCertificates BuildTx era
forall build era. TxCertificates build era
TxCertificatesNone
    mapScriptWitnessesCertificates
      ( TxCertificates
          ShelleyBasedEra era
supported
          [Certificate era]
certs
          (BuildTxWith [(StakeCredential, Witness WitCtxStake era)]
witnesses)
        ) =
        let mappedScriptWitnesses
              :: [(StakeCredential, Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era))]
            mappedScriptWitnesses :: [(StakeCredential,
  Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era))]
mappedScriptWitnesses =
              [ (StakeCredential
stakecred, ScriptWitnessInCtx WitCtxStake
-> ScriptWitness WitCtxStake era -> Witness WitCtxStake era
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxStake
ctx (ScriptWitness WitCtxStake era -> Witness WitCtxStake era)
-> Either
     (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era)
-> Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era)
witness')
              | -- The certs are indexed in list order
              (Word32
ix, Certificate era
cert) <- [Word32] -> [Certificate era] -> [(Word32, Certificate era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] [Certificate era]
certs
              , StakeCredential
stakecred <- Maybe StakeCredential -> [StakeCredential]
forall a. Maybe a -> [a]
maybeToList (Certificate era -> Maybe StakeCredential
forall era. Certificate era -> Maybe StakeCredential
selectStakeCredentialWitness Certificate era
cert)
              , ScriptWitness ScriptWitnessInCtx WitCtxStake
ctx ScriptWitness WitCtxStake era
witness <-
                  Maybe (Witness WitCtxStake era) -> [Witness WitCtxStake era]
forall a. Maybe a -> [a]
maybeToList (StakeCredential
-> [(StakeCredential, Witness WitCtxStake era)]
-> Maybe (Witness WitCtxStake era)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup StakeCredential
stakecred [(StakeCredential, Witness WitCtxStake era)]
witnesses)
              , let witness' :: Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era)
witness' = ScriptWitnessIndex
-> ScriptWitness WitCtxStake era
-> Either
     (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era)
forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
substituteExecUnits (Word32 -> ScriptWitnessIndex
ScriptWitnessIndexCertificate Word32
ix) ScriptWitness WitCtxStake era
witness
              ]
         in ShelleyBasedEra era
-> [Certificate era]
-> BuildTxWith BuildTx [(StakeCredential, Witness WitCtxStake era)]
-> TxCertificates BuildTx era
forall era build.
ShelleyBasedEra era
-> [Certificate era]
-> BuildTxWith build [(StakeCredential, Witness WitCtxStake era)]
-> TxCertificates build era
TxCertificates ShelleyBasedEra era
supported [Certificate era]
certs (BuildTxWith BuildTx [(StakeCredential, Witness WitCtxStake era)]
 -> TxCertificates BuildTx era)
-> ([(StakeCredential, Witness WitCtxStake era)]
    -> BuildTxWith
         BuildTx [(StakeCredential, Witness WitCtxStake era)])
-> [(StakeCredential, Witness WitCtxStake era)]
-> TxCertificates BuildTx era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(StakeCredential, Witness WitCtxStake era)]
-> BuildTxWith BuildTx [(StakeCredential, Witness WitCtxStake era)]
forall a. a -> BuildTxWith BuildTx a
BuildTxWith
              ([(StakeCredential, Witness WitCtxStake era)]
 -> TxCertificates BuildTx era)
-> Either
     (TxBodyErrorAutoBalance era)
     [(StakeCredential, Witness WitCtxStake era)]
-> Either (TxBodyErrorAutoBalance era) (TxCertificates BuildTx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((StakeCredential,
  Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era))
 -> Either
      (TxBodyErrorAutoBalance era)
      (StakeCredential, Witness WitCtxStake era))
-> [(StakeCredential,
     Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era))]
-> Either
     (TxBodyErrorAutoBalance era)
     [(StakeCredential, Witness WitCtxStake 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
                ( \(StakeCredential
sCred, Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era)
eScriptWitness) ->
                    case Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era)
eScriptWitness of
                      Left TxBodyErrorAutoBalance era
e -> TxBodyErrorAutoBalance era
-> Either
     (TxBodyErrorAutoBalance era)
     (StakeCredential, Witness WitCtxStake era)
forall a b. a -> Either a b
Left TxBodyErrorAutoBalance era
e
                      Right Witness WitCtxStake era
wit -> (StakeCredential, Witness WitCtxStake era)
-> Either
     (TxBodyErrorAutoBalance era)
     (StakeCredential, Witness WitCtxStake era)
forall a b. b -> Either a b
Right (StakeCredential
sCred, Witness WitCtxStake era
wit)
                )
                [(StakeCredential,
  Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era))]
mappedScriptWitnesses

    mapScriptWitnessesVotes
      :: Maybe (Featured ConwayEraOnwards era (TxVotingProcedures build era))
      -> Either
          (TxBodyErrorAutoBalance era)
          (Maybe (Featured ConwayEraOnwards era (TxVotingProcedures build era)))
    mapScriptWitnessesVotes :: forall build.
Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxVotingProcedures build era)))
mapScriptWitnessesVotes Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures build era))
Nothing = Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxVotingProcedures build era)))
forall a. a -> Either (TxBodyErrorAutoBalance era) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures build era))
forall a. Maybe a
Nothing
    mapScriptWitnessesVotes (Just (Featured ConwayEraOnwards era
_ TxVotingProcedures build era
TxVotingProceduresNone)) = Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxVotingProcedures build era)))
forall a. a -> Either (TxBodyErrorAutoBalance era) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures build era))
forall a. Maybe a
Nothing
    mapScriptWitnessesVotes (Just (Featured ConwayEraOnwards era
_ (TxVotingProcedures VotingProcedures (ShelleyLedgerEra era)
_ BuildTxWith
  build
  (Map
     (Voter (EraCrypto (ShelleyLedgerEra era)))
     (ScriptWitness WitCtxStake era))
ViewTx))) = Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxVotingProcedures build era)))
forall a. a -> Either (TxBodyErrorAutoBalance era) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures build era))
forall a. Maybe a
Nothing
    mapScriptWitnessesVotes (Just (Featured ConwayEraOnwards era
era (TxVotingProcedures VotingProcedures (ShelleyLedgerEra era)
vProcedures (BuildTxWith Map
  (Voter (EraCrypto (ShelleyLedgerEra era)))
  (ScriptWitness WitCtxStake era)
sWitMap)))) = do
      let eSubstitutedExecutionUnits :: [(Voter (EraCrypto (ShelleyLedgerEra era)),
  Either
    (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era))]
eSubstitutedExecutionUnits =
            [ (Voter (EraCrypto (ShelleyLedgerEra era))
vote, Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era)
updatedWitness)
            | let allVoteMap :: Map
  (Voter (EraCrypto (ShelleyLedgerEra era)))
  (Map
     (GovActionId (EraCrypto (ShelleyLedgerEra era)))
     (VotingProcedure (ShelleyLedgerEra era)))
allVoteMap = VotingProcedures (ShelleyLedgerEra era)
-> Map
     (Voter (EraCrypto (ShelleyLedgerEra era)))
     (Map
        (GovActionId (EraCrypto (ShelleyLedgerEra era)))
        (VotingProcedure (ShelleyLedgerEra era)))
forall era.
VotingProcedures era
-> Map
     (Voter (EraCrypto era))
     (Map (GovActionId (EraCrypto era)) (VotingProcedure era))
L.unVotingProcedures VotingProcedures (ShelleyLedgerEra era)
vProcedures
            , (Voter (EraCrypto (ShelleyLedgerEra era))
vote, ScriptWitness WitCtxStake era
scriptWitness) <- Map
  (Voter (EraCrypto (ShelleyLedgerEra era)))
  (ScriptWitness WitCtxStake era)
-> [Item
      (Map
         (Voter (EraCrypto (ShelleyLedgerEra era)))
         (ScriptWitness WitCtxStake era))]
forall l. IsList l => l -> [Item l]
toList Map
  (Voter (EraCrypto (ShelleyLedgerEra era)))
  (ScriptWitness WitCtxStake 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 (EraCrypto (ShelleyLedgerEra era))
-> Map
     (Voter (EraCrypto (ShelleyLedgerEra era)))
     (Map
        (GovActionId (EraCrypto (ShelleyLedgerEra era)))
        (VotingProcedure (ShelleyLedgerEra era)))
-> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex Voter (EraCrypto (ShelleyLedgerEra era))
vote Map
  (Voter (EraCrypto (ShelleyLedgerEra era)))
  (Map
     (GovActionId (EraCrypto (ShelleyLedgerEra era)))
     (VotingProcedure (ShelleyLedgerEra era)))
allVoteMap
            , let updatedWitness :: Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era)
updatedWitness = ScriptWitnessIndex
-> ScriptWitness WitCtxStake era
-> Either
     (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era)
forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
substituteExecUnits (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) ScriptWitness WitCtxStake era
scriptWitness
            ]

      [(Voter (EraCrypto (ShelleyLedgerEra era)),
  ScriptWitness WitCtxStake era)]
substitutedExecutionUnits <- [(Voter (EraCrypto (ShelleyLedgerEra era)),
  Either
    (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era))]
-> Either
     (TxBodyErrorAutoBalance era)
     [(Voter (EraCrypto (ShelleyLedgerEra era)),
       ScriptWitness WitCtxStake era)]
forall a era ctx.
[(a, Either (TxBodyErrorAutoBalance era) (ScriptWitness ctx era))]
-> Either (TxBodyErrorAutoBalance era) [(a, ScriptWitness ctx era)]
traverseScriptWitnesses [(Voter (EraCrypto (ShelleyLedgerEra era)),
  Either
    (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era))]
eSubstitutedExecutionUnits

      Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxVotingProcedures build era)))
forall a. a -> Either (TxBodyErrorAutoBalance era) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   (Featured ConwayEraOnwards era (TxVotingProcedures build era))
 -> Either
      (TxBodyErrorAutoBalance era)
      (Maybe
         (Featured ConwayEraOnwards era (TxVotingProcedures build era))))
-> Maybe
     (Featured ConwayEraOnwards era (TxVotingProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxVotingProcedures build era)))
forall a b. (a -> b) -> a -> b
$
        Featured ConwayEraOnwards era (TxVotingProcedures build era)
-> Maybe
     (Featured ConwayEraOnwards era (TxVotingProcedures build era))
forall a. a -> Maybe a
Just
          (ConwayEraOnwards era
-> TxVotingProcedures build era
-> Featured ConwayEraOnwards era (TxVotingProcedures build era)
forall (eon :: * -> *) era a. eon era -> a -> Featured eon era a
Featured ConwayEraOnwards era
era (VotingProcedures (ShelleyLedgerEra era)
-> BuildTxWith
     build
     (Map
        (Voter (EraCrypto (ShelleyLedgerEra era)))
        (ScriptWitness WitCtxStake era))
-> TxVotingProcedures build era
forall era build.
VotingProcedures (ShelleyLedgerEra era)
-> BuildTxWith
     build
     (Map
        (Voter (EraCrypto (ShelleyLedgerEra era)))
        (ScriptWitness WitCtxStake era))
-> TxVotingProcedures build era
TxVotingProcedures VotingProcedures (ShelleyLedgerEra era)
vProcedures (Map
  (Voter (EraCrypto (ShelleyLedgerEra era)))
  (ScriptWitness WitCtxStake era)
-> BuildTxWith
     BuildTx
     (Map
        (Voter (EraCrypto (ShelleyLedgerEra era)))
        (ScriptWitness WitCtxStake era))
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Map
   (Voter (EraCrypto (ShelleyLedgerEra era)))
   (ScriptWitness WitCtxStake era)
 -> BuildTxWith
      BuildTx
      (Map
         (Voter (EraCrypto (ShelleyLedgerEra era)))
         (ScriptWitness WitCtxStake era)))
-> Map
     (Voter (EraCrypto (ShelleyLedgerEra era)))
     (ScriptWitness WitCtxStake era)
-> BuildTxWith
     BuildTx
     (Map
        (Voter (EraCrypto (ShelleyLedgerEra era)))
        (ScriptWitness WitCtxStake era))
forall a b. (a -> b) -> a -> b
$ [Item
   (Map
      (Voter (EraCrypto (ShelleyLedgerEra era)))
      (ScriptWitness WitCtxStake era))]
-> Map
     (Voter (EraCrypto (ShelleyLedgerEra era)))
     (ScriptWitness WitCtxStake era)
forall l. IsList l => [Item l] -> l
fromList [(Voter (EraCrypto (ShelleyLedgerEra era)),
  ScriptWitness WitCtxStake era)]
[Item
   (Map
      (Voter (EraCrypto (ShelleyLedgerEra era)))
      (ScriptWitness WitCtxStake era))]
substitutedExecutionUnits)))

    mapScriptWitnessesProposals
      :: Maybe (Featured ConwayEraOnwards era (TxProposalProcedures build era))
      -> Either
          (TxBodyErrorAutoBalance era)
          (Maybe (Featured ConwayEraOnwards era (TxProposalProcedures build era)))
    mapScriptWitnessesProposals :: forall build.
Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxProposalProcedures build era)))
mapScriptWitnessesProposals Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures build era))
Nothing = Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxProposalProcedures build era)))
forall a. a -> Either (TxBodyErrorAutoBalance era) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures build era))
forall a. Maybe a
Nothing
    mapScriptWitnessesProposals (Just (Featured ConwayEraOnwards era
_ TxProposalProcedures build era
TxProposalProceduresNone)) = Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxProposalProcedures build era)))
forall a. a -> Either (TxBodyErrorAutoBalance era) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures build era))
forall a. Maybe a
Nothing
    mapScriptWitnessesProposals (Just (Featured ConwayEraOnwards era
_ (TxProposalProcedures OSet (ProposalProcedure (ShelleyLedgerEra era))
_ BuildTxWith
  build
  (Map
     (ProposalProcedure (ShelleyLedgerEra era))
     (ScriptWitness WitCtxStake era))
ViewTx))) = Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxProposalProcedures build era)))
forall a. a -> Either (TxBodyErrorAutoBalance era) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures build era))
forall a. Maybe a
Nothing
    mapScriptWitnessesProposals (Just (Featured ConwayEraOnwards era
era txpp :: TxProposalProcedures build era
txpp@(TxProposalProcedures OSet (ProposalProcedure (ShelleyLedgerEra era))
osetProposalProcedures (BuildTxWith Map
  (ProposalProcedure (ShelleyLedgerEra era))
  (ScriptWitness WitCtxStake era)
sWitMap)))) = do
      let allProposalsList :: [Item (OSet (ProposalProcedure (ShelleyLedgerEra era)))]
allProposalsList = OSet (ProposalProcedure (ShelleyLedgerEra era))
-> [Item (OSet (ProposalProcedure (ShelleyLedgerEra era)))]
forall l. IsList l => l -> [Item l]
toList (OSet (ProposalProcedure (ShelleyLedgerEra era))
 -> [Item (OSet (ProposalProcedure (ShelleyLedgerEra era)))])
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
-> [Item (OSet (ProposalProcedure (ShelleyLedgerEra era)))]
forall a b. (a -> b) -> a -> b
$ TxProposalProcedures build era
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
forall build era.
TxProposalProcedures build era
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
convProposalProcedures TxProposalProcedures build era
txpp
          eSubstitutedExecutionUnits :: [(ProposalProcedure (ShelleyLedgerEra era),
  Either
    (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era))]
eSubstitutedExecutionUnits =
            [ (ProposalProcedure (ShelleyLedgerEra era)
proposal, Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era)
updatedWitness)
            | (ProposalProcedure (ShelleyLedgerEra era)
proposal, ScriptWitness WitCtxStake era
scriptWitness) <- Map
  (ProposalProcedure (ShelleyLedgerEra era))
  (ScriptWitness WitCtxStake era)
-> [Item
      (Map
         (ProposalProcedure (ShelleyLedgerEra era))
         (ScriptWitness WitCtxStake era))]
forall l. IsList l => l -> [Item l]
toList Map
  (ProposalProcedure (ShelleyLedgerEra era))
  (ScriptWitness WitCtxStake 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
$ ProposalProcedure (ShelleyLedgerEra era)
-> [ProposalProcedure (ShelleyLedgerEra era)] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex ProposalProcedure (ShelleyLedgerEra era)
proposal [Item (OSet (ProposalProcedure (ShelleyLedgerEra era)))]
[ProposalProcedure (ShelleyLedgerEra era)]
allProposalsList
            , let updatedWitness :: Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era)
updatedWitness = ScriptWitnessIndex
-> ScriptWitness WitCtxStake era
-> Either
     (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era)
forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
substituteExecUnits (Word32 -> ScriptWitnessIndex
ScriptWitnessIndexProposing (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) ScriptWitness WitCtxStake era
scriptWitness
            ]

      [(ProposalProcedure (ShelleyLedgerEra era),
  ScriptWitness WitCtxStake era)]
substitutedExecutionUnits <- [(ProposalProcedure (ShelleyLedgerEra era),
  Either
    (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era))]
-> Either
     (TxBodyErrorAutoBalance era)
     [(ProposalProcedure (ShelleyLedgerEra era),
       ScriptWitness WitCtxStake era)]
forall a era ctx.
[(a, Either (TxBodyErrorAutoBalance era) (ScriptWitness ctx era))]
-> Either (TxBodyErrorAutoBalance era) [(a, ScriptWitness ctx era)]
traverseScriptWitnesses [(ProposalProcedure (ShelleyLedgerEra era),
  Either
    (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxStake era))]
eSubstitutedExecutionUnits

      Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxProposalProcedures build era)))
forall a. a -> Either (TxBodyErrorAutoBalance era) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   (Featured ConwayEraOnwards era (TxProposalProcedures build era))
 -> Either
      (TxBodyErrorAutoBalance era)
      (Maybe
         (Featured ConwayEraOnwards era (TxProposalProcedures build era))))
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures build era))
-> Either
     (TxBodyErrorAutoBalance era)
     (Maybe
        (Featured ConwayEraOnwards era (TxProposalProcedures build era)))
forall a b. (a -> b) -> a -> b
$
        Featured ConwayEraOnwards era (TxProposalProcedures build era)
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures build era))
forall a. a -> Maybe a
Just
          ( ConwayEraOnwards era
-> TxProposalProcedures build era
-> Featured ConwayEraOnwards era (TxProposalProcedures build era)
forall (eon :: * -> *) era a. eon era -> a -> Featured eon era a
Featured
              ConwayEraOnwards era
era
              (OSet (ProposalProcedure (ShelleyLedgerEra era))
-> BuildTxWith
     build
     (Map
        (ProposalProcedure (ShelleyLedgerEra era))
        (ScriptWitness WitCtxStake era))
-> TxProposalProcedures build era
forall era build.
EraPParams (ShelleyLedgerEra era) =>
OSet (ProposalProcedure (ShelleyLedgerEra era))
-> BuildTxWith
     build
     (Map
        (ProposalProcedure (ShelleyLedgerEra era))
        (ScriptWitness WitCtxStake era))
-> TxProposalProcedures build era
TxProposalProcedures OSet (ProposalProcedure (ShelleyLedgerEra era))
osetProposalProcedures (Map
  (ProposalProcedure (ShelleyLedgerEra era))
  (ScriptWitness WitCtxStake era)
-> BuildTxWith
     BuildTx
     (Map
        (ProposalProcedure (ShelleyLedgerEra era))
        (ScriptWitness WitCtxStake era))
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Map
   (ProposalProcedure (ShelleyLedgerEra era))
   (ScriptWitness WitCtxStake era)
 -> BuildTxWith
      BuildTx
      (Map
         (ProposalProcedure (ShelleyLedgerEra era))
         (ScriptWitness WitCtxStake era)))
-> Map
     (ProposalProcedure (ShelleyLedgerEra era))
     (ScriptWitness WitCtxStake era)
-> BuildTxWith
     BuildTx
     (Map
        (ProposalProcedure (ShelleyLedgerEra era))
        (ScriptWitness WitCtxStake era))
forall a b. (a -> b) -> a -> b
$ [Item
   (Map
      (ProposalProcedure (ShelleyLedgerEra era))
      (ScriptWitness WitCtxStake era))]
-> Map
     (ProposalProcedure (ShelleyLedgerEra era))
     (ScriptWitness WitCtxStake era)
forall l. IsList l => [Item l] -> l
fromList [(ProposalProcedure (ShelleyLedgerEra era),
  ScriptWitness WitCtxStake era)]
[Item
   (Map
      (ProposalProcedure (ShelleyLedgerEra era))
      (ScriptWitness WitCtxStake era))]
substitutedExecutionUnits))
          )

    mapScriptWitnessesMinting
      :: TxMintValue BuildTx era
      -> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era)
    mapScriptWitnessesMinting :: TxMintValue BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era)
mapScriptWitnessesMinting TxMintValue BuildTx era
TxMintNone = TxMintValue BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era)
forall a b. b -> Either a b
Right TxMintValue BuildTx era
forall build era. TxMintValue build era
TxMintNone
    mapScriptWitnessesMinting
      ( TxMintValue
          MaryEraOnwards era
supported
          Value
value
          (BuildTxWith Map PolicyId (ScriptWitness WitCtxMint era)
witnesses)
        ) =
        -- TxMintValue supported value $ BuildTxWith $ fromList
        let mappedScriptWitnesses
              :: [(PolicyId, Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxMint era))]
            mappedScriptWitnesses :: [(PolicyId,
  Either
    (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxMint era))]
mappedScriptWitnesses =
              [ (PolicyId
policyid, Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxMint era)
witness')
              | -- The minting policies are indexed in policy id order in the value
              let ValueNestedRep [ValueNestedBundle]
bundle = Value -> ValueNestedRep
valueToNestedRep Value
value
              , (Word32
ix, ValueNestedBundle PolicyId
policyid Map AssetName Quantity
_) <- [Word32] -> [ValueNestedBundle] -> [(Word32, ValueNestedBundle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] [ValueNestedBundle]
bundle
              , ScriptWitness WitCtxMint era
witness <- Maybe (ScriptWitness WitCtxMint era)
-> [ScriptWitness WitCtxMint era]
forall a. Maybe a -> [a]
maybeToList (PolicyId
-> Map PolicyId (ScriptWitness WitCtxMint era)
-> Maybe (ScriptWitness WitCtxMint era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PolicyId
policyid Map PolicyId (ScriptWitness WitCtxMint era)
witnesses)
              , let witness' :: Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxMint era)
witness' = ScriptWitnessIndex
-> ScriptWitness WitCtxMint era
-> Either
     (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxMint era)
forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era
-> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)
substituteExecUnits (Word32 -> ScriptWitnessIndex
ScriptWitnessIndexMint Word32
ix) ScriptWitness WitCtxMint era
witness
              ]
         in do
              [(PolicyId, ScriptWitness WitCtxMint era)]
final <- [(PolicyId,
  Either
    (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxMint era))]
-> Either
     (TxBodyErrorAutoBalance era)
     [(PolicyId, ScriptWitness WitCtxMint era)]
forall a era ctx.
[(a, Either (TxBodyErrorAutoBalance era) (ScriptWitness ctx era))]
-> Either (TxBodyErrorAutoBalance era) [(a, ScriptWitness ctx era)]
traverseScriptWitnesses [(PolicyId,
  Either
    (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxMint era))]
mappedScriptWitnesses
              TxMintValue BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era)
forall a b. b -> Either a b
Right (TxMintValue BuildTx era
 -> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era))
-> (Map PolicyId (ScriptWitness WitCtxMint era)
    -> TxMintValue BuildTx era)
-> Map PolicyId (ScriptWitness WitCtxMint era)
-> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaryEraOnwards era
-> Value
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue BuildTx era
forall era build.
MaryEraOnwards era
-> Value
-> BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue build era
TxMintValue MaryEraOnwards era
supported Value
value (BuildTxWith BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
 -> TxMintValue BuildTx era)
-> (Map PolicyId (ScriptWitness WitCtxMint era)
    -> BuildTxWith
         BuildTx (Map PolicyId (ScriptWitness WitCtxMint era)))
-> Map PolicyId (ScriptWitness WitCtxMint era)
-> TxMintValue BuildTx era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PolicyId (ScriptWitness WitCtxMint era)
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Map PolicyId (ScriptWitness WitCtxMint era)
 -> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era))
-> Map PolicyId (ScriptWitness WitCtxMint era)
-> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era)
forall a b. (a -> b) -> a -> b
$
                [Item (Map PolicyId (ScriptWitness WitCtxMint era))]
-> Map PolicyId (ScriptWitness WitCtxMint era)
forall l. IsList l => [Item l] -> l
fromList [(PolicyId, ScriptWitness WitCtxMint era)]
[Item (Map PolicyId (ScriptWitness WitCtxMint era))]
final

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

calculateMinimumUTxO
  :: ShelleyBasedEra era
  -> TxOut CtxTx era
  -> Ledger.PParams (ShelleyLedgerEra era)
  -> L.Coin
calculateMinimumUTxO :: forall era.
ShelleyBasedEra era
-> TxOut CtxTx era -> PParams (ShelleyLedgerEra era) -> Coin
calculateMinimumUTxO ShelleyBasedEra era
sbe TxOut CtxTx era
txout PParams (ShelleyLedgerEra era)
pp =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Coin) -> Coin
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Coin) -> Coin)
-> (ShelleyBasedEraConstraints era => Coin) -> Coin
forall a b. (a -> b) -> a -> b
$
    let txOutWithMinCoin :: TxOut (ShelleyLedgerEra era)
txOutWithMinCoin = PParams (ShelleyLedgerEra era)
-> TxOut (ShelleyLedgerEra era) -> TxOut (ShelleyLedgerEra era)
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
L.setMinCoinTxOut PParams (ShelleyLedgerEra era)
pp (ShelleyBasedEra era
-> TxOut CtxTx era -> TxOut (ShelleyLedgerEra era)
forall ctx era ledgerera.
(HasCallStack, ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era -> TxOut ctx era -> TxOut ledgerera
toShelleyTxOutAny ShelleyBasedEra era
sbe TxOut CtxTx era
txout)
     in TxOut (ShelleyLedgerEra era)
txOutWithMinCoin TxOut (ShelleyLedgerEra era)
-> Getting Coin (TxOut (ShelleyLedgerEra era)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut (ShelleyLedgerEra era)) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut (ShelleyLedgerEra era)) Coin
L.coinTxOutL