{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.CLI.EraBased.Transaction.Run
  ( partitionSomeWitnesses
  , runTransactionCmds
  , runTransactionBuildCmd
  , runTransactionBuildRawCmd
  , runTransactionSignCmd
  , runTransactionSubmitCmd
  , runTransactionCalculateMinFeeCmd
  , runTransactionCalculateMinValueCmd
  , runTransactionPolicyIdCmd
  , runTransactionHashScriptDataCmd
  , runTransactionTxIdCmd
  , runTransactionWitnessCmd
  , runTransactionSignWitnessCmd
  )
where

import Cardano.Api hiding
  ( Certificate
  , mkTxCertificates
  , txId
  , validateTxIns
  , validateTxInsCollateral
  )
import Cardano.Api qualified as Api
import Cardano.Api.Byron qualified as Byron
import Cardano.Api.Experimental (obtainCommonConstraints)
import Cardano.Api.Experimental qualified as Exp
import Cardano.Api.Ledger qualified as L
import Cardano.Api.Network qualified as Consensus
import Cardano.Api.Network qualified as Net.Tx

import Cardano.Binary qualified as CBOR
import Cardano.CLI.Compatible.Exception
import Cardano.CLI.Compatible.Transaction.TxOut
import Cardano.CLI.EraBased.Genesis.Internal.Common (readProtocolParameters)
import Cardano.CLI.EraBased.Script.Certificate.Read
import Cardano.CLI.EraBased.Script.Mint.Read
import Cardano.CLI.EraBased.Script.Mint.Type
import Cardano.CLI.EraBased.Script.Proposal.Read
import Cardano.CLI.EraBased.Script.Proposal.Type (ProposalScriptWitness (..))
import Cardano.CLI.EraBased.Script.Read.Common
import Cardano.CLI.EraBased.Script.Spend.Read
import Cardano.CLI.EraBased.Script.Spend.Type (SpendScriptWitness (..))
import Cardano.CLI.EraBased.Script.Vote.Read
import Cardano.CLI.EraBased.Script.Vote.Type
import Cardano.CLI.EraBased.Script.Withdrawal.Read
import Cardano.CLI.EraBased.Script.Withdrawal.Type (WithdrawalScriptWitness (..))
import Cardano.CLI.EraBased.Transaction.Command
import Cardano.CLI.EraBased.Transaction.Command qualified as Cmd
import Cardano.CLI.EraBased.Transaction.Internal.HashCheck
  ( checkCertificateHashes
  , checkProposalHashes
  , checkVotingProcedureHashes
  )
import Cardano.CLI.Json.Encode qualified as Json
import Cardano.CLI.Orphan ()
import Cardano.CLI.Read
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.NodeEraMismatchError
import Cardano.CLI.Type.Error.ProtocolParamsError
import Cardano.CLI.Type.Error.TxCmdError
import Cardano.CLI.Type.Error.TxValidationError
import Cardano.CLI.Type.Output (renderScriptCostsWithScriptHashesMap)
import Cardano.Ledger.Api (allInputsTxBodyF, bodyTxL)
import Cardano.Prelude (putLByteString)

import RIO hiding (toList)

import Data.Aeson ((.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.ByteString qualified as Data.Bytestring
import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Data ((:~:) (..))
import Data.Foldable qualified as Foldable
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.Type.Equality (TestEquality (..))
import Data.Universe (Some)
import GHC.Exts (IsList (..))
import System.IO qualified as IO
import Vary qualified

runTransactionCmds :: Exp.IsEra era => Cmd.TransactionCmds era -> CIO e ()
runTransactionCmds :: forall era e. IsEra era => TransactionCmds era -> CIO e ()
runTransactionCmds = \case
  Cmd.TransactionBuildCmd TransactionBuildCmdArgs era
args ->
    TransactionBuildCmdArgs era -> CIO e ()
forall era e. IsEra era => TransactionBuildCmdArgs era -> CIO e ()
runTransactionBuildCmd TransactionBuildCmdArgs era
args
  Cmd.TransactionBuildEstimateCmd TransactionBuildEstimateCmdArgs era
args -> TransactionBuildEstimateCmdArgs era -> CIO e ()
forall era e.
IsEra era =>
TransactionBuildEstimateCmdArgs era -> CIO e ()
runTransactionBuildEstimateCmd TransactionBuildEstimateCmdArgs era
args
  Cmd.TransactionBuildRawCmd TransactionBuildRawCmdArgs era
args ->
    TransactionBuildRawCmdArgs era -> CIO e ()
forall era e. TransactionBuildRawCmdArgs era -> CIO e ()
runTransactionBuildRawCmd TransactionBuildRawCmdArgs era
args
  Cmd.TransactionSignCmd TransactionSignCmdArgs
args -> ExceptT TxCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT TxCmdError IO () -> RIO e ())
-> ExceptT TxCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ TransactionSignCmdArgs -> ExceptT TxCmdError IO ()
runTransactionSignCmd TransactionSignCmdArgs
args
  Cmd.TransactionSubmitCmd TransactionSubmitCmdArgs
args -> ExceptT TxCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT TxCmdError IO () -> RIO e ())
-> ExceptT TxCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ TransactionSubmitCmdArgs -> ExceptT TxCmdError IO ()
runTransactionSubmitCmd TransactionSubmitCmdArgs
args
  Cmd.TransactionCalculateMinFeeCmd TransactionCalculateMinFeeCmdArgs
args ->
    TransactionCalculateMinFeeCmdArgs -> CIO e ()
forall e. TransactionCalculateMinFeeCmdArgs -> CIO e ()
runTransactionCalculateMinFeeCmd TransactionCalculateMinFeeCmdArgs
args
  Cmd.TransactionCalculateMinValueCmd TransactionCalculateMinValueCmdArgs era
args ->
    TransactionCalculateMinValueCmdArgs era -> CIO e ()
forall era e. TransactionCalculateMinValueCmdArgs era -> CIO e ()
runTransactionCalculateMinValueCmd TransactionCalculateMinValueCmdArgs era
args
  Cmd.TransactionCalculatePlutusScriptCostCmd TransactionCalculatePlutusScriptCostCmdArgs era
args -> ExceptT TxCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT TxCmdError IO () -> RIO e ())
-> ExceptT TxCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ TransactionCalculatePlutusScriptCostCmdArgs era
-> ExceptT TxCmdError IO ()
forall era.
TransactionCalculatePlutusScriptCostCmdArgs era
-> ExceptT TxCmdError IO ()
runTransactionCalculatePlutusScriptCostCmd TransactionCalculatePlutusScriptCostCmdArgs era
args
  Cmd.TransactionHashScriptDataCmd TransactionHashScriptDataCmdArgs
args -> ExceptT TxCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT TxCmdError IO () -> RIO e ())
-> ExceptT TxCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ TransactionHashScriptDataCmdArgs -> ExceptT TxCmdError IO ()
runTransactionHashScriptDataCmd TransactionHashScriptDataCmdArgs
args
  Cmd.TransactionTxIdCmd TransactionTxIdCmdArgs
args -> ExceptT TxCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT TxCmdError IO () -> RIO e ())
-> ExceptT TxCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ TransactionTxIdCmdArgs -> ExceptT TxCmdError IO ()
runTransactionTxIdCmd TransactionTxIdCmdArgs
args
  Cmd.TransactionPolicyIdCmd TransactionPolicyIdCmdArgs
args ->
    TransactionPolicyIdCmdArgs -> CIO e ()
forall e. TransactionPolicyIdCmdArgs -> CIO e ()
runTransactionPolicyIdCmd TransactionPolicyIdCmdArgs
args
  Cmd.TransactionWitnessCmd TransactionWitnessCmdArgs
args -> ExceptT TxCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT TxCmdError IO () -> RIO e ())
-> ExceptT TxCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ TransactionWitnessCmdArgs -> ExceptT TxCmdError IO ()
runTransactionWitnessCmd TransactionWitnessCmdArgs
args
  Cmd.TransactionSignWitnessCmd TransactionSignWitnessCmdArgs
args -> ExceptT TxCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT TxCmdError IO () -> RIO e ())
-> ExceptT TxCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ TransactionSignWitnessCmdArgs -> ExceptT TxCmdError IO ()
runTransactionSignWitnessCmd TransactionSignWitnessCmdArgs
args

-- ----------------------------------------------------------------------------
-- Building transactions
--

runTransactionBuildCmd
  :: Exp.IsEra era
  => Cmd.TransactionBuildCmdArgs era
  -> CIO e ()
runTransactionBuildCmd :: forall era e. IsEra era => TransactionBuildCmdArgs era -> CIO e ()
runTransactionBuildCmd
  Cmd.TransactionBuildCmdArgs
    { Era era
currentEra :: Era era
currentEra :: forall era. TransactionBuildCmdArgs era -> Era era
currentEra
    , nodeConnInfo :: forall era. TransactionBuildCmdArgs era -> LocalNodeConnectInfo
nodeConnInfo =
      nodeConnInfo :: LocalNodeConnectInfo
nodeConnInfo@LocalNodeConnectInfo
        { localNodeNetworkId :: LocalNodeConnectInfo -> NetworkId
localNodeNetworkId = NetworkId
networkId
        , localNodeSocketPath :: LocalNodeConnectInfo -> SocketPath
localNodeSocketPath = SocketPath
nodeSocketPath
        }
    , mScriptValidity :: forall era. TransactionBuildCmdArgs era -> Maybe ScriptValidity
mScriptValidity = Maybe ScriptValidity
mScriptValidity
    , mOverrideWitnesses :: forall era. TransactionBuildCmdArgs era -> Maybe Word
mOverrideWitnesses = Maybe Word
mOverrideWitnesses
    , [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txins :: [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txins :: forall era.
TransactionBuildCmdArgs era
-> [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txins
    , [TxIn]
readOnlyReferenceInputs :: [TxIn]
readOnlyReferenceInputs :: forall era. TransactionBuildCmdArgs era -> [TxIn]
readOnlyReferenceInputs
    , requiredSigners :: forall era. TransactionBuildCmdArgs era -> [RequiredSigner]
requiredSigners = [RequiredSigner]
reqSigners
    , [TxIn]
txinsc :: [TxIn]
txinsc :: forall era. TransactionBuildCmdArgs era -> [TxIn]
txinsc
    , mReturnCollateral :: forall era.
TransactionBuildCmdArgs era -> Maybe TxOutShelleyBasedEra
mReturnCollateral = Maybe TxOutShelleyBasedEra
mReturnColl
    , Maybe Lovelace
mTotalCollateral :: Maybe Lovelace
mTotalCollateral :: forall era. TransactionBuildCmdArgs era -> Maybe Lovelace
mTotalCollateral
    , [TxOutAnyEra]
txouts :: [TxOutAnyEra]
txouts :: forall era. TransactionBuildCmdArgs era -> [TxOutAnyEra]
txouts
    , TxOutChangeAddress
changeAddresses :: TxOutChangeAddress
changeAddresses :: forall era. TransactionBuildCmdArgs era -> TxOutChangeAddress
changeAddresses
    , Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets :: Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets :: forall era.
TransactionBuildCmdArgs era
-> Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets
    , Maybe SlotNo
mValidityLowerBound :: Maybe SlotNo
mValidityLowerBound :: forall era. TransactionBuildCmdArgs era -> Maybe SlotNo
mValidityLowerBound
    , TxValidityUpperBound era
mValidityUpperBound :: TxValidityUpperBound era
mValidityUpperBound :: forall era. TransactionBuildCmdArgs era -> TxValidityUpperBound era
mValidityUpperBound
    , [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates :: [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates :: forall era.
TransactionBuildCmdArgs era
-> [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates
    , [(StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals :: [(StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals :: forall era.
TransactionBuildCmdArgs era
-> [(StakeAddress, Lovelace,
     Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals
    , TxMetadataJsonSchema
metadataSchema :: TxMetadataJsonSchema
metadataSchema :: forall era. TransactionBuildCmdArgs era -> TxMetadataJsonSchema
metadataSchema
    , [ScriptFile]
scriptFiles :: [ScriptFile]
scriptFiles :: forall era. TransactionBuildCmdArgs era -> [ScriptFile]
scriptFiles
    , [MetadataFile]
metadataFiles :: [MetadataFile]
metadataFiles :: forall era. TransactionBuildCmdArgs era -> [MetadataFile]
metadataFiles
    , Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
mUpdateProposalFile :: Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
mUpdateProposalFile :: forall era.
TransactionBuildCmdArgs era
-> Maybe
     (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
mUpdateProposalFile
    , [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles :: [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles :: forall era.
TransactionBuildCmdArgs era
-> [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles
    , [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles :: [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles :: forall era.
TransactionBuildCmdArgs era
-> [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles
    , Maybe TxTreasuryDonation
treasuryDonation :: Maybe TxTreasuryDonation
treasuryDonation :: forall era. TransactionBuildCmdArgs era -> Maybe TxTreasuryDonation
treasuryDonation -- Maybe TxTreasuryDonation
    , TxCborFormat
isCborOutCanonical :: TxCborFormat
isCborOutCanonical :: forall era. TransactionBuildCmdArgs era -> TxCborFormat
isCborOutCanonical
    , TxBuildOutputOptions
buildOutputOptions :: TxBuildOutputOptions
buildOutputOptions :: forall era. TransactionBuildCmdArgs era -> TxBuildOutputOptions
buildOutputOptions
    } = do
    let eon :: ShelleyBasedEra era
eon = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
currentEra
        era' :: CardanoEra era
era' = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
eon

    [(TxIn, Maybe (SpendScriptWitness era))]
txinsAndMaybeScriptWits <-
      [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, Maybe (SpendScriptWitness era))]
forall era e.
IsEra era =>
[(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, Maybe (SpendScriptWitness era))]
readSpendScriptWitnesses [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txins

    let spendingScriptWitnesses :: [ScriptWitness WitCtxTxIn era]
spendingScriptWitnesses = ((TxIn, Maybe (SpendScriptWitness era))
 -> Maybe (ScriptWitness WitCtxTxIn era))
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [ScriptWitness WitCtxTxIn era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((SpendScriptWitness era -> ScriptWitness WitCtxTxIn era)
-> Maybe (SpendScriptWitness era)
-> Maybe (ScriptWitness WitCtxTxIn era)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SpendScriptWitness era -> ScriptWitness WitCtxTxIn era
forall era. SpendScriptWitness era -> ScriptWitness WitCtxTxIn era
sswScriptWitness (Maybe (SpendScriptWitness era)
 -> Maybe (ScriptWitness WitCtxTxIn era))
-> ((TxIn, Maybe (SpendScriptWitness era))
    -> Maybe (SpendScriptWitness era))
-> (TxIn, Maybe (SpendScriptWitness era))
-> Maybe (ScriptWitness WitCtxTxIn era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, Maybe (SpendScriptWitness era))
-> Maybe (SpendScriptWitness era)
forall a b. (a, b) -> b
snd) [(TxIn, Maybe (SpendScriptWitness era))]
txinsAndMaybeScriptWits

    [(CertificateFile, AnyWitness (LedgerEra era))]
certFilesAndMaybeScriptWits <-
      [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> CIO e [(CertificateFile, AnyWitness (LedgerEra era))]
forall era e.
IsEra era =>
[(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> CIO e [(CertificateFile, AnyWitness (LedgerEra era))]
readCertificateScriptWitnesses [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates

    -- TODO: Conway Era - How can we make this more composable?
    [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits <-
      [RIO e (Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> RIO
     e [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ (,AnyWitness (LedgerEra era)
mSwit)
            (Certificate (LedgerEra era)
 -> (Certificate (LedgerEra era), AnyWitness (LedgerEra era)))
-> RIO e (Certificate (LedgerEra era))
-> RIO e (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (Certificate era -> Certificate (LedgerEra era))
-> RIO e (Certificate era) -> RIO e (Certificate (LedgerEra era))
forall a b. (a -> b) -> RIO e a -> RIO e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Era era -> Certificate era -> Certificate (LedgerEra era)
forall era.
Era era -> Certificate era -> Certificate (LedgerEra era)
Exp.convertToNewCertificate Era era
forall era. IsEra era => Era era
Exp.useEra) (RIO e (Certificate era) -> RIO e (Certificate (LedgerEra era)))
-> RIO e (Certificate era) -> RIO e (Certificate (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
                    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError TextEnvelopeError) (IO (Either (FileError TextEnvelopeError) (Certificate era))
 -> RIO e (Certificate era))
-> IO (Either (FileError TextEnvelopeError) (Certificate era))
-> RIO e (Certificate era)
forall a b. (a -> b) -> a -> b
$
                      ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    IO (Either (FileError TextEnvelopeError) (Certificate era)))
-> IO (Either (FileError TextEnvelopeError) (Certificate era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
eon ((ShelleyBasedEraConstraints era =>
  IO (Either (FileError TextEnvelopeError) (Certificate era)))
 -> IO (Either (FileError TextEnvelopeError) (Certificate era)))
-> (ShelleyBasedEraConstraints era =>
    IO (Either (FileError TextEnvelopeError) (Certificate era)))
-> IO (Either (FileError TextEnvelopeError) (Certificate era))
forall a b. (a -> b) -> a -> b
$
                        File Any 'In
-> IO (Either (FileError TextEnvelopeError) (Certificate era))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
certFile)
                )
        | (CertificateFile FilePath
certFile, AnyWitness (LedgerEra era)
mSwit) <- [(CertificateFile, AnyWitness (LedgerEra era))]
certFilesAndMaybeScriptWits
        ]

    [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> ((Certificate (LedgerEra era), AnyWitness (LedgerEra era))
    -> RIO e ())
-> RIO e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits (ExceptT TxCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT TxCmdError IO () -> RIO e ())
-> ((Certificate (LedgerEra era), AnyWitness (LedgerEra era))
    -> ExceptT TxCmdError IO ())
-> (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Certificate (LedgerEra era) -> ExceptT TxCmdError IO ()
forall era.
IsEra era =>
Certificate (LedgerEra era) -> ExceptT TxCmdError IO ()
checkCertificateHashes (Certificate (LedgerEra era) -> ExceptT TxCmdError IO ())
-> ((Certificate (LedgerEra era), AnyWitness (LedgerEra era))
    -> Certificate (LedgerEra era))
-> (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
-> ExceptT TxCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a, b) -> a
fst)

    [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawalsAndMaybeScriptWits <-
      ((StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))
 -> RIO
      e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era)))
-> [(StakeAddress, Lovelace,
     Maybe (ScriptRequirements 'WithdrawalItem))]
-> RIO
     e [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> RIO
     e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO
     e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
forall era e.
IsEra era =>
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO
     e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
readWithdrawalScriptWitness [(StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals
    TxMetadataInEra era
txMetadata <-
      Era era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> CIO e (TxMetadataInEra era)
forall era e.
Era era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> CIO e (TxMetadataInEra era)
readTxMetadata Era era
currentEra TxMetadataJsonSchema
metadataSchema [MetadataFile]
metadataFiles
    let (MultiAsset
mintedMultiAsset, [ScriptRequirements 'MintItem]
sWitFiles) = (MultiAsset, [ScriptRequirements 'MintItem])
-> Maybe (MultiAsset, [ScriptRequirements 'MintItem])
-> (MultiAsset, [ScriptRequirements 'MintItem])
forall a. a -> Maybe a -> a
fromMaybe (MultiAsset, [ScriptRequirements 'MintItem])
forall a. Monoid a => a
mempty Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets
    [MintScriptWitnessWithPolicyId era]
mintingWitnesses <-
      (ScriptRequirements 'MintItem
 -> RIO e (MintScriptWitnessWithPolicyId era))
-> [ScriptRequirements 'MintItem]
-> RIO e [MintScriptWitnessWithPolicyId era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ScriptRequirements 'MintItem
-> RIO e (MintScriptWitnessWithPolicyId era)
ScriptRequirements 'MintItem
-> CIO e (MintScriptWitnessWithPolicyId era)
forall era e.
IsEra era =>
ScriptRequirements 'MintItem
-> CIO e (MintScriptWitnessWithPolicyId era)
readMintScriptWitness [ScriptRequirements 'MintItem]
sWitFiles
    [ScriptInAnyLang]
scripts <-
      (ScriptFile -> RIO e ScriptInAnyLang)
-> [ScriptFile] -> RIO e [ScriptInAnyLang]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FilePath -> RIO e ScriptInAnyLang
forall (m :: * -> *). MonadIO m => FilePath -> m ScriptInAnyLang
readFileScriptInAnyLang (FilePath -> RIO e ScriptInAnyLang)
-> (ScriptFile -> FilePath) -> ScriptFile -> RIO e ScriptInAnyLang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptFile -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile) [ScriptFile]
scriptFiles
    TxAuxScripts era
txAuxScripts <-
      Either TxAuxScriptsValidationError (TxAuxScripts era)
-> RIO e (TxAuxScripts era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either TxAuxScriptsValidationError (TxAuxScripts era)
 -> RIO e (TxAuxScripts era))
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
-> RIO e (TxAuxScripts era)
forall a b. (a -> b) -> a -> b
$ [ScriptInAnyLang]
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
forall era.
IsEra era =>
[ScriptInAnyLang]
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
validateTxAuxScripts [ScriptInAnyLang]
scripts

    TxUpdateProposal era
mProp <- case Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
mUpdateProposalFile of
      Just (Featured ShelleyToBabbageEra era
w (Just UpdateProposalFile
updateProposalFile)) ->
        ShelleyToBabbageEra era
-> UpdateProposalFile
-> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
forall era.
ShelleyToBabbageEra era
-> UpdateProposalFile
-> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
readTxUpdateProposal ShelleyToBabbageEra era
w UpdateProposalFile
updateProposalFile ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
-> (ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
    -> RIO e (TxUpdateProposal era))
-> RIO e (TxUpdateProposal era)
forall a b. a -> (a -> b) -> b
& ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
-> RIO e (TxUpdateProposal era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli
      Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
_ -> TxUpdateProposal era -> RIO e (TxUpdateProposal era)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxUpdateProposal era
forall era. TxUpdateProposal era
TxUpdateProposalNone

    [Hash PaymentKey]
requiredSigners <-
      (RequiredSigner -> RIO e (Hash PaymentKey))
-> [RequiredSigner] -> RIO e [Hash PaymentKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO (Either RequiredSignerError (Hash PaymentKey))
-> RIO e (Hash PaymentKey)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either RequiredSignerError (Hash PaymentKey))
 -> RIO e (Hash PaymentKey))
-> (RequiredSigner
    -> IO (Either RequiredSignerError (Hash PaymentKey)))
-> RequiredSigner
-> RIO e (Hash PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequiredSigner -> IO (Either RequiredSignerError (Hash PaymentKey))
readRequiredSigner) [RequiredSigner]
reqSigners
    Maybe (TxOut CtxTx era)
mReturnCollateral <- Maybe TxOutShelleyBasedEra
-> (TxOutShelleyBasedEra -> RIO e (TxOut CtxTx era))
-> RIO e (Maybe (TxOut CtxTx era))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe TxOutShelleyBasedEra
mReturnColl TxOutShelleyBasedEra -> RIO e (TxOut CtxTx era)
TxOutShelleyBasedEra -> CIO e (TxOut CtxTx era)
forall era e.
IsEra era =>
TxOutShelleyBasedEra -> CIO e (TxOut CtxTx era)
toTxOutInShelleyBasedEra

    [TxOut CtxTx era]
txOuts <- (TxOutAnyEra -> RIO e (TxOut CtxTx era))
-> [TxOutAnyEra] -> RIO e [TxOut CtxTx era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ShelleyBasedEra era -> TxOutAnyEra -> CIO e (TxOut CtxTx era)
forall era e.
ShelleyBasedEra era -> TxOutAnyEra -> CIO e (TxOut CtxTx era)
toTxOutInAnyEra ShelleyBasedEra era
eon) [TxOutAnyEra]
txouts

    -- Conway related
    [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProceduresAndMaybeScriptWits <-
      RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> (ConwayEraOnwards era
    -> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))])
-> CardanoEra era
-> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall a era.
a -> (ConwayEraOnwards era -> a) -> CardanoEra era -> a
forall (eon :: * -> *) a era.
Eon eon =>
a -> (eon era -> a) -> CardanoEra era -> a
inEonForEra
        ([(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall a. Monoid a => a
mempty)
        (ConwayEraOnwards era
-> [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall era e.
ConwayEraOnwards era
-> [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
`readVotingProceduresFiles` [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles)
        CardanoEra era
era'

    [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> ((VotingProcedures era, Maybe (VoteScriptWitness era))
    -> RIO e ())
-> RIO e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProceduresAndMaybeScriptWits (ExceptT TxCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT TxCmdError IO () -> RIO e ())
-> ((VotingProcedures era, Maybe (VoteScriptWitness era))
    -> ExceptT TxCmdError IO ())
-> (VotingProcedures era, Maybe (VoteScriptWitness era))
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingProcedures era -> ExceptT TxCmdError IO ()
forall era.
IsEra era =>
VotingProcedures era -> ExceptT TxCmdError IO ()
checkVotingProcedureHashes (VotingProcedures era -> ExceptT TxCmdError IO ())
-> ((VotingProcedures era, Maybe (VoteScriptWitness era))
    -> VotingProcedures era)
-> (VotingProcedures era, Maybe (VoteScriptWitness era))
-> ExceptT TxCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VotingProcedures era, Maybe (VoteScriptWitness era))
-> VotingProcedures era
forall a b. (a, b) -> a
fst)

    [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals <-
      [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
-> CIO e [(Proposal era, Maybe (ProposalScriptWitness era))]
forall era e.
IsEra era =>
[(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
-> CIO e [(Proposal era, Maybe (ProposalScriptWitness era))]
readTxGovernanceActions [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles

    [(Proposal era, Maybe (ProposalScriptWitness era))]
-> ((Proposal era, Maybe (ProposalScriptWitness era)) -> RIO e ())
-> RIO e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals (ExceptT TxCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT TxCmdError IO () -> RIO e ())
-> ((Proposal era, Maybe (ProposalScriptWitness era))
    -> ExceptT TxCmdError IO ())
-> (Proposal era, Maybe (ProposalScriptWitness era))
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proposal era -> ExceptT TxCmdError IO ()
forall era. IsEra era => Proposal era -> ExceptT TxCmdError IO ()
checkProposalHashes (Proposal era -> ExceptT TxCmdError IO ())
-> ((Proposal era, Maybe (ProposalScriptWitness era))
    -> Proposal era)
-> (Proposal era, Maybe (ProposalScriptWitness era))
-> ExceptT TxCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proposal era, Maybe (ProposalScriptWitness era)) -> Proposal era
forall a b. (a, b) -> a
fst)

    -- Extract return addresses from proposals and check that the return address in each proposal is registered

    let returnAddrHashes :: Set StakeCredential
returnAddrHashes =
          [Item (Set StakeCredential)] -> Set StakeCredential
forall l. IsList l => [Item l] -> l
fromList
            [ Item (Set StakeCredential)
StakeCredential
stakeCred
            | (Proposal era
proposal, Maybe (ProposalScriptWitness era)
_) <- [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals
            , let (Lovelace
_, StakeCredential
stakeCred, GovernanceAction era
_) = ShelleyBasedEra era
-> Proposal era
-> (Lovelace, StakeCredential, GovernanceAction era)
forall era.
ShelleyBasedEra era
-> Proposal era
-> (Lovelace, StakeCredential, GovernanceAction era)
fromProposalProcedure ShelleyBasedEra era
eon Proposal era
proposal
            ]
        treasuryWithdrawalAddresses :: Set StakeCredential
treasuryWithdrawalAddresses =
          [Item (Set StakeCredential)] -> Set StakeCredential
forall l. IsList l => [Item l] -> l
fromList
            [ Item (Set StakeCredential)
StakeCredential
stakeCred
            | (Proposal era
proposal, Maybe (ProposalScriptWitness era)
_) <- [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals
            , let (Lovelace
_, StakeCredential
_, GovernanceAction era
govAction) = ShelleyBasedEra era
-> Proposal era
-> (Lovelace, StakeCredential, GovernanceAction era)
forall era.
ShelleyBasedEra era
-> Proposal era
-> (Lovelace, StakeCredential, GovernanceAction era)
fromProposalProcedure ShelleyBasedEra era
eon Proposal era
proposal
            , TreasuryWithdrawal [(Network, StakeCredential, Lovelace)]
withdrawalsList StrictMaybe ScriptHash
_ <- [GovernanceAction era
govAction] -- Match on TreasuryWithdrawal action
            , (Network
_, StakeCredential
stakeCred, Lovelace
_) <- [(Network, StakeCredential, Lovelace)]
withdrawalsList -- Extract fund-receiving stake credentials
            ]
        allAddrHashes :: Set StakeCredential
allAddrHashes = Set StakeCredential -> Set StakeCredential -> Set StakeCredential
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set StakeCredential
returnAddrHashes Set StakeCredential
treasuryWithdrawalAddresses

    (Map StakeAddress Lovelace
balances, Map StakeAddress PoolId
_) <-
      IO
  (Either
     AcquiringFailure
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId))))
-> RIO
     e
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
-> IO
     (Either
        AcquiringFailure
        (Either
           UnsupportedNtcVersionError
           (Either
              EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId))))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr
            LocalNodeConnectInfo
nodeConnInfo
            Target ChainPoint
forall point. Target point
Consensus.VolatileTip
            (ShelleyBasedEra era
-> Set StakeCredential
-> NetworkId
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
forall era block point r.
ShelleyBasedEra era
-> Set StakeCredential
-> NetworkId
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
queryStakeAddresses ShelleyBasedEra era
eon Set StakeCredential
allAddrHashes NetworkId
networkId)
        )
        RIO
  e
  (Either
     UnsupportedNtcVersionError
     (Either
        EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
-> (RIO
      e
      (Either
         UnsupportedNtcVersionError
         (Either
            EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
    -> RIO
         e
         (Either
            EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
-> RIO
     e
     (Either
        EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId))
forall a b. a -> (a -> b) -> b
& RIO
  e
  (Either
     UnsupportedNtcVersionError
     (Either
        EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
-> RIO
     e
     (Either
        EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId))
CIO
  e
  (Either
     UnsupportedNtcVersionError
     (Either
        EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
-> CIO
     e
     (Either
        EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId))
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli
        RIO
  e
  (Either
     EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId))
-> (RIO
      e
      (Either
         EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId))
    -> RIO e (Map StakeAddress Lovelace, Map StakeAddress PoolId))
-> RIO e (Map StakeAddress Lovelace, Map StakeAddress PoolId)
forall a b. a -> (a -> b) -> b
& RIO
  e
  (Either
     EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId))
-> RIO e (Map StakeAddress Lovelace, Map StakeAddress PoolId)
CIO
  e
  (Either
     EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId))
-> CIO e (Map StakeAddress Lovelace, Map StakeAddress PoolId)
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

    let unregisteredAddresses :: Set StakeCredential
unregisteredAddresses =
          (StakeCredential -> Bool)
-> Set StakeCredential -> Set StakeCredential
forall a. (a -> Bool) -> Set a -> Set a
Set.filter
            (\StakeCredential
stakeCred -> StakeAddress -> Map StakeAddress Lovelace -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember (NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
networkId StakeCredential
stakeCred) Map StakeAddress Lovelace
balances)
            Set StakeCredential
allAddrHashes

    Bool -> RIO e () -> RIO e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set StakeCredential -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set StakeCredential
unregisteredAddresses) (RIO e () -> RIO e ()) -> RIO e () -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      TxCmdError -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError (TxCmdError -> RIO e ()) -> TxCmdError -> RIO e ()
forall a b. (a -> b) -> a -> b
$
        Set StakeCredential -> TxCmdError
TxCmdUnregisteredStakeAddress Set StakeCredential
unregisteredAddresses

    -- the same collateral input can be used for several plutus scripts
    let filteredTxinsc :: [TxIn]
filteredTxinsc = [TxIn] -> [TxIn]
forall a. Ord a => [a] -> [a]
nubOrd [TxIn]
txinsc

    let allReferenceInputs :: [TxIn]
allReferenceInputs =
          [ScriptWitness WitCtxTxIn era]
-> [ScriptWitness WitCtxMint era]
-> [AnyWitness (LedgerEra era)]
-> [WithdrawalScriptWitness era]
-> [VoteScriptWitness era]
-> [ProposalScriptWitness era]
-> [TxIn]
-> [TxIn]
forall era.
[ScriptWitness WitCtxTxIn era]
-> [ScriptWitness WitCtxMint era]
-> [AnyWitness (LedgerEra era)]
-> [WithdrawalScriptWitness era]
-> [VoteScriptWitness era]
-> [ProposalScriptWitness era]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
            [ScriptWitness WitCtxTxIn era]
spendingScriptWitnesses
            ((MintScriptWitnessWithPolicyId era -> ScriptWitness WitCtxMint era)
-> [MintScriptWitnessWithPolicyId era]
-> [ScriptWitness WitCtxMint era]
forall a b. (a -> b) -> [a] -> [b]
map MintScriptWitnessWithPolicyId era -> ScriptWitness WitCtxMint era
forall era.
MintScriptWitnessWithPolicyId era -> ScriptWitness WitCtxMint era
mswScriptWitness [MintScriptWitnessWithPolicyId era]
mintingWitnesses)
            (((Certificate (LedgerEra era), AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits)
            (((StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
 -> Maybe (WithdrawalScriptWitness era))
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [WithdrawalScriptWitness era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(StakeAddress
_, Lovelace
_, Maybe (WithdrawalScriptWitness era)
mSwit) -> Maybe (WithdrawalScriptWitness era)
mSwit) [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawalsAndMaybeScriptWits)
            (((VotingProcedures era, Maybe (VoteScriptWitness era))
 -> Maybe (VoteScriptWitness era))
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [VoteScriptWitness era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (VotingProcedures era, Maybe (VoteScriptWitness era))
-> Maybe (VoteScriptWitness era)
forall a b. (a, b) -> b
snd [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProceduresAndMaybeScriptWits)
            (((Proposal era, Maybe (ProposalScriptWitness era))
 -> Maybe (ProposalScriptWitness era))
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> [ProposalScriptWitness era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Proposal era, Maybe (ProposalScriptWitness era))
-> Maybe (ProposalScriptWitness era)
forall a b. (a, b) -> b
snd [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals)
            [TxIn]
readOnlyReferenceInputs

    let inputsThatRequireWitnessing :: [TxIn]
inputsThatRequireWitnessing = [TxIn
input | (TxIn
input, Maybe (ScriptRequirements 'TxInItem)
_) <- [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txins]
        allTxInputs :: [TxIn]
allTxInputs = [TxIn]
inputsThatRequireWitnessing [TxIn] -> [TxIn] -> [TxIn]
forall a. [a] -> [a] -> [a]
++ [TxIn]
allReferenceInputs [TxIn] -> [TxIn] -> [TxIn]
forall a. [a] -> [a] -> [a]
++ [TxIn]
filteredTxinsc

    AnyCardanoEra CardanoEra era
nodeEra <-
      IO
  (Either
     AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
-> RIO e (Either UnsupportedNtcVersionError AnyCardanoEra)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError AnyCardanoEra)
-> IO
     (Either
        AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
forall point. Target point
Consensus.VolatileTip LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
queryCurrentEra)
        RIO e (Either UnsupportedNtcVersionError AnyCardanoEra)
-> (RIO e (Either UnsupportedNtcVersionError AnyCardanoEra)
    -> RIO e AnyCardanoEra)
-> RIO e AnyCardanoEra
forall a b. a -> (a -> b) -> b
& RIO e (Either UnsupportedNtcVersionError AnyCardanoEra)
-> RIO e AnyCardanoEra
CIO e (Either UnsupportedNtcVersionError AnyCardanoEra)
-> CIO e AnyCardanoEra
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

    (UTxO era
txEraUtxo, LedgerProtocolParameters era
_, EraHistory
eraHistory, SystemStart
systemStart, Set PoolId
_, Map StakeCredential Lovelace
_, Map (Credential 'DRepRole) (CompactForm Lovelace)
_, Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
featuredCurrentTreasuryValueM) <-
      IO
  (Either
     AcquiringFailure
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
-> RIO
     e
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> IO
     (Either
        AcquiringFailure
        (Either
           QueryConvenienceError
           (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
            Set PoolId, Map StakeCredential Lovelace,
            Map (Credential 'DRepRole) (CompactForm Lovelace),
            Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr
            LocalNodeConnectInfo
nodeConnInfo
            Target ChainPoint
forall point. Target point
Consensus.VolatileTip
            (CardanoEra era
-> [TxIn]
-> [Certificate era]
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
forall era block point r.
CardanoEra era
-> [TxIn]
-> [Certificate era]
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
queryStateForBalancedTx CardanoEra era
nodeEra [TxIn]
allTxInputs [])
        )
        RIO
  e
  (Either
     QueryConvenienceError
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Lovelace,
      Map (Credential 'DRepRole) (CompactForm Lovelace),
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> (RIO
      e
      (Either
         QueryConvenienceError
         (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
          Set PoolId, Map StakeCredential Lovelace,
          Map (Credential 'DRepRole) (CompactForm Lovelace),
          Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
    -> RIO
         e
         (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
          Set PoolId, Map StakeCredential Lovelace,
          Map (Credential 'DRepRole) (CompactForm Lovelace),
          Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> RIO
     e
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Lovelace,
      Map (Credential 'DRepRole) (CompactForm Lovelace),
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall a b. a -> (a -> b) -> b
& RIO
  e
  (Either
     QueryConvenienceError
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Lovelace,
      Map (Credential 'DRepRole) (CompactForm Lovelace),
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> RIO
     e
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Lovelace,
      Map (Credential 'DRepRole) (CompactForm Lovelace),
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
CIO
  e
  (Either
     QueryConvenienceError
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Lovelace,
      Map (Credential 'DRepRole) (CompactForm Lovelace),
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> CIO
     e
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Lovelace,
      Map (Credential 'DRepRole) (CompactForm Lovelace),
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

    let currentTreasuryValueAndDonation :: Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
currentTreasuryValueAndDonation =
          case (Maybe TxTreasuryDonation
treasuryDonation, Featured ConwayEraOnwards era TxCurrentTreasuryValue
-> TxCurrentTreasuryValue
forall (eon :: * -> *) era a. Featured eon era a -> a
unFeatured (Featured ConwayEraOnwards era TxCurrentTreasuryValue
 -> TxCurrentTreasuryValue)
-> Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
-> Maybe TxCurrentTreasuryValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
featuredCurrentTreasuryValueM) of
            (Maybe TxTreasuryDonation
Nothing, Maybe TxCurrentTreasuryValue
_) -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
forall a. Maybe a
Nothing -- We shouldn't specify the treasury value when no donation is being done
            (Just TxTreasuryDonation
_td, Maybe TxCurrentTreasuryValue
Nothing) -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
forall a. Maybe a
Nothing -- TODO: Current treasury value couldn't be obtained but is required: we should fail suggesting that the node's version is too old
            (Just TxTreasuryDonation
td, Just TxCurrentTreasuryValue
ctv) -> (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
forall a. a -> Maybe a
Just (TxCurrentTreasuryValue
ctv, TxTreasuryDonation
td)

    -- We need to construct the txBodycontent outside of runTxBuild
    BalancedTxBody TxBodyContent BuildTx era
txBodyContent TxBody era
balancedTxBody TxOut CtxTx era
_ Lovelace
_ <-
      ExceptT TxCmdError IO (BalancedTxBody era)
-> RIO e (BalancedTxBody era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT TxCmdError IO (BalancedTxBody era)
 -> RIO e (BalancedTxBody era))
-> ExceptT TxCmdError IO (BalancedTxBody era)
-> RIO e (BalancedTxBody era)
forall a b. (a -> b) -> a -> b
$
        SocketPath
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> TxOutChangeAddress
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> Maybe SlotNo
-> TxValidityUpperBound era
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> Maybe Word
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> ExceptT TxCmdError IO (BalancedTxBody era)
forall era.
IsEra era =>
SocketPath
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> TxOutChangeAddress
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> Maybe SlotNo
-> TxValidityUpperBound era
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> Maybe Word
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> ExceptT TxCmdError IO (BalancedTxBody era)
runTxBuild
          SocketPath
nodeSocketPath
          NetworkId
networkId
          Maybe ScriptValidity
mScriptValidity
          [(TxIn, Maybe (SpendScriptWitness era))]
txinsAndMaybeScriptWits
          [TxIn]
readOnlyReferenceInputs
          [TxIn]
filteredTxinsc
          Maybe (TxOut CtxTx era)
mReturnCollateral
          Maybe Lovelace
mTotalCollateral
          [TxOut CtxTx era]
txOuts
          TxOutChangeAddress
changeAddresses
          (MultiAsset
mintedMultiAsset, [MintScriptWitnessWithPolicyId era]
mintingWitnesses)
          Maybe SlotNo
mValidityLowerBound
          TxValidityUpperBound era
mValidityUpperBound
          [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
          [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawalsAndMaybeScriptWits
          [Hash PaymentKey]
requiredSigners
          TxAuxScripts era
txAuxScripts
          TxMetadataInEra era
txMetadata
          TxUpdateProposal era
mProp
          Maybe Word
mOverrideWitnesses
          [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProceduresAndMaybeScriptWits
          [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals
          Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
currentTreasuryValueAndDonation

    -- TODO: Calculating the script cost should live as a different command.
    -- Why? Because then we can simply read a txbody and figure out
    -- the script cost vs having to build the tx body each time
    case TxBuildOutputOptions
buildOutputOptions of
      OutputScriptCostOnly File () 'Out
fp -> do
        -- Warn that the parameter is deprecated to stderr
        IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$
          Handle -> FilePath -> IO ()
IO.hPutStrLn
            Handle
IO.stderr
            ( FilePath
"Warning: The `--calculate-plutus-script-cost` parameter is deprecated and will be "
                FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"removed in a future version. Please use the `calculate-script-cost` command instead."
            )

        let BuildTxWith Maybe (LedgerProtocolParameters era)
mTxProtocolParams = TxBodyContent BuildTx era
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))
forall build era.
TxBodyContent build era
-> BuildTxWith build (Maybe (LedgerProtocolParameters era))
txProtocolParams TxBodyContent BuildTx era
txBodyContent

        LedgerProtocolParameters era
pparams <-
          Maybe (LedgerProtocolParameters era)
mTxProtocolParams Maybe (LedgerProtocolParameters era)
-> (Maybe (LedgerProtocolParameters era)
    -> RIO e (LedgerProtocolParameters era))
-> RIO e (LedgerProtocolParameters era)
forall a b. a -> (a -> b) -> b
& TxCmdError
-> Maybe (LedgerProtocolParameters era)
-> CIO e (LedgerProtocolParameters era)
forall err a e.
(Show err, Typeable err, Error err) =>
err -> Maybe a -> CIO e a
fromMaybeCli TxCmdError
TxCmdProtocolParametersNotPresentInTxBody
        Prices
executionUnitPrices <-
          CardanoEra era -> LedgerProtocolParameters era -> Maybe Prices
forall era.
CardanoEra era -> LedgerProtocolParameters era -> Maybe Prices
getExecutionUnitPrices CardanoEra era
era' LedgerProtocolParameters era
pparams
            Maybe Prices -> (Maybe Prices -> RIO e Prices) -> RIO e Prices
forall a b. a -> (a -> b) -> b
& TxCmdError -> Maybe Prices -> CIO e Prices
forall err a e.
(Show err, Typeable err, Error err) =>
err -> Maybe a -> CIO e a
fromMaybeCli TxCmdError
TxCmdPParamExecutionUnitsNotAvailable

        era :~: era
Refl <-
          CardanoEra era -> CardanoEra era -> Maybe (era :~: era)
forall a b. CardanoEra a -> CardanoEra b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality CardanoEra era
era' CardanoEra era
nodeEra
            Maybe (era :~: era)
-> (Maybe (era :~: era) -> RIO e (era :~: era))
-> RIO e (era :~: era)
forall a b. a -> (a -> b) -> b
& NodeEraMismatchError -> Maybe (era :~: era) -> CIO e (era :~: era)
forall err a e.
(Show err, Typeable err, Error err) =>
err -> Maybe a -> CIO e a
fromMaybeCli (CardanoEra era -> CardanoEra era -> NodeEraMismatchError
forall era nodeEra.
CardanoEra era -> CardanoEra nodeEra -> NodeEraMismatchError
NodeEraMismatchError CardanoEra era
era' CardanoEra era
nodeEra)

        let scriptExecUnitsMap :: Map
  ScriptWitnessIndex
  (Either
     ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
scriptExecUnitsMap =
              CardanoEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> TxBody era
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
forall era.
CardanoEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> TxBody era
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
evaluateTransactionExecutionUnits
                CardanoEra era
era'
                SystemStart
systemStart
                (EraHistory -> LedgerEpochInfo
toLedgerEpochInfo EraHistory
eraHistory)
                LedgerProtocolParameters era
pparams
                UTxO era
UTxO era
txEraUtxo
                TxBody era
balancedTxBody

        Map ScriptWitnessIndex ScriptHash
scriptHashes <-
          forall (eon :: * -> *) a era.
(Eon eon, Monoid a) =>
CardanoEra era -> (eon era -> a) -> a
monoidForEraInEon @AlonzoEraOnwards
            CardanoEra era
era'
            (\AlonzoEraOnwards era
aeo -> Map ScriptWitnessIndex ScriptHash
-> Maybe (Map ScriptWitnessIndex ScriptHash)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ScriptWitnessIndex ScriptHash
 -> Maybe (Map ScriptWitnessIndex ScriptHash))
-> Map ScriptWitnessIndex ScriptHash
-> Maybe (Map ScriptWitnessIndex ScriptHash)
forall a b. (a -> b) -> a -> b
$ AlonzoEraOnwards era
-> Tx era -> UTxO era -> Map ScriptWitnessIndex ScriptHash
forall era.
AlonzoEraOnwards era
-> Tx era -> UTxO era -> Map ScriptWitnessIndex ScriptHash
collectPlutusScriptHashes AlonzoEraOnwards era
aeo ([KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody era
balancedTxBody) UTxO era
UTxO era
txEraUtxo)
            Maybe (Map ScriptWitnessIndex ScriptHash)
-> (Maybe (Map ScriptWitnessIndex ScriptHash)
    -> RIO e (Map ScriptWitnessIndex ScriptHash))
-> RIO e (Map ScriptWitnessIndex ScriptHash)
forall a b. a -> (a -> b) -> b
& TxCmdError
-> Maybe (Map ScriptWitnessIndex ScriptHash)
-> CIO e (Map ScriptWitnessIndex ScriptHash)
forall err a e.
(Show err, Typeable err, Error err) =>
err -> Maybe a -> CIO e a
fromMaybeCli (CardanoEra era -> TxCmdError
forall era. CardanoEra era -> TxCmdError
TxCmdAlonzoEraOnwardsRequired CardanoEra era
era')

        [ScriptCostOutput]
scriptCostOutput <-
          Either PlutusScriptCostError [ScriptCostOutput]
-> RIO e [ScriptCostOutput]
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either PlutusScriptCostError [ScriptCostOutput]
 -> RIO e [ScriptCostOutput])
-> Either PlutusScriptCostError [ScriptCostOutput]
-> RIO e [ScriptCostOutput]
forall a b. (a -> b) -> a -> b
$
            Prices
-> Map ScriptWitnessIndex ScriptHash
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
-> Either PlutusScriptCostError [ScriptCostOutput]
renderScriptCostsWithScriptHashesMap
              Prices
executionUnitPrices
              Map ScriptWitnessIndex ScriptHash
scriptHashes
              Map
  ScriptWitnessIndex
  (Either
     ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
scriptExecUnitsMap
        IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
LBS.writeFile (File () 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File () 'Out
fp) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [ScriptCostOutput] -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty [ScriptCostOutput]
scriptCostOutput
      OutputTxBodyOnly TxBodyFile 'Out
fpath -> IO (Either (FileError ()) ()) -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
        let noWitTx :: Tx era
noWitTx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody era
balancedTxBody
        if TxCborFormat
isCborOutCanonical TxCborFormat -> TxCborFormat -> Bool
forall a. Eq a => a -> a -> Bool
== TxCborFormat
TxCborCanonical
          then ShelleyBasedEra era
-> TxBodyFile 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCanonical ShelleyBasedEra era
eon TxBodyFile 'Out
fpath Tx era
noWitTx
          else ShelleyBasedEra era
-> TxBodyFile 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelope ShelleyBasedEra era
eon TxBodyFile 'Out
fpath Tx era
noWitTx

runTransactionBuildEstimateCmd
  :: forall era e
   . Exp.IsEra era
  => Cmd.TransactionBuildEstimateCmdArgs era
  -> CIO e ()
runTransactionBuildEstimateCmd :: forall era e.
IsEra era =>
TransactionBuildEstimateCmdArgs era -> CIO e ()
runTransactionBuildEstimateCmd -- TODO change type
  Cmd.TransactionBuildEstimateCmdArgs
    { Era era
currentEra :: Era era
currentEra :: forall era. TransactionBuildEstimateCmdArgs era -> Era era
currentEra
    , Maybe ScriptValidity
mScriptValidity :: Maybe ScriptValidity
mScriptValidity :: forall era.
TransactionBuildEstimateCmdArgs era -> Maybe ScriptValidity
mScriptValidity
    , Int
shelleyWitnesses :: Int
shelleyWitnesses :: forall era. TransactionBuildEstimateCmdArgs era -> Int
shelleyWitnesses
    , Maybe Int
mByronWitnesses :: Maybe Int
mByronWitnesses :: forall era. TransactionBuildEstimateCmdArgs era -> Maybe Int
mByronWitnesses
    , ProtocolParamsFile
protocolParamsFile :: ProtocolParamsFile
protocolParamsFile :: forall era.
TransactionBuildEstimateCmdArgs era -> ProtocolParamsFile
protocolParamsFile
    , Value
totalUTxOValue :: Value
totalUTxOValue :: forall era. TransactionBuildEstimateCmdArgs era -> Value
totalUTxOValue
    , [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txins :: [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txins :: forall era.
TransactionBuildEstimateCmdArgs era
-> [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txins
    , readOnlyReferenceInputs :: forall era. TransactionBuildEstimateCmdArgs era -> [TxIn]
readOnlyReferenceInputs = [TxIn]
readOnlyRefIns
    , requiredSigners :: forall era. TransactionBuildEstimateCmdArgs era -> [RequiredSigner]
requiredSigners = [RequiredSigner]
reqSigners
    , txinsc :: forall era. TransactionBuildEstimateCmdArgs era -> [TxIn]
txinsc = [TxIn]
txInsCollateral
    , mReturnCollateral :: forall era.
TransactionBuildEstimateCmdArgs era -> Maybe TxOutShelleyBasedEra
mReturnCollateral = Maybe TxOutShelleyBasedEra
mReturnColl
    , [TxOutAnyEra]
txouts :: [TxOutAnyEra]
txouts :: forall era. TransactionBuildEstimateCmdArgs era -> [TxOutAnyEra]
txouts
    , changeAddress :: forall era.
TransactionBuildEstimateCmdArgs era -> TxOutChangeAddress
changeAddress = TxOutChangeAddress AddressAny
changeAddr
    , Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets :: Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets :: forall era.
TransactionBuildEstimateCmdArgs era
-> Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets
    , Maybe SlotNo
mValidityLowerBound :: Maybe SlotNo
mValidityLowerBound :: forall era. TransactionBuildEstimateCmdArgs era -> Maybe SlotNo
mValidityLowerBound
    , TxValidityUpperBound era
mValidityUpperBound :: TxValidityUpperBound era
mValidityUpperBound :: forall era.
TransactionBuildEstimateCmdArgs era -> TxValidityUpperBound era
mValidityUpperBound
    , [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates :: [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates :: forall era.
TransactionBuildEstimateCmdArgs era
-> [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates
    , [(StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals :: [(StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals :: forall era.
TransactionBuildEstimateCmdArgs era
-> [(StakeAddress, Lovelace,
     Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals
    , TxMetadataJsonSchema
metadataSchema :: TxMetadataJsonSchema
metadataSchema :: forall era.
TransactionBuildEstimateCmdArgs era -> TxMetadataJsonSchema
metadataSchema
    , [ScriptFile]
scriptFiles :: [ScriptFile]
scriptFiles :: forall era. TransactionBuildEstimateCmdArgs era -> [ScriptFile]
scriptFiles
    , [MetadataFile]
metadataFiles :: [MetadataFile]
metadataFiles :: forall era. TransactionBuildEstimateCmdArgs era -> [MetadataFile]
metadataFiles
    , [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles :: [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles :: forall era.
TransactionBuildEstimateCmdArgs era
-> [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles
    , [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles :: [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles :: forall era.
TransactionBuildEstimateCmdArgs era
-> [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles
    , Maybe Lovelace
plutusCollateral :: Maybe Lovelace
plutusCollateral :: forall era. TransactionBuildEstimateCmdArgs era -> Maybe Lovelace
plutusCollateral
    , Maybe ReferenceScriptSize
totalReferenceScriptSize :: Maybe ReferenceScriptSize
totalReferenceScriptSize :: forall era.
TransactionBuildEstimateCmdArgs era -> Maybe ReferenceScriptSize
totalReferenceScriptSize
    , Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
currentTreasuryValueAndDonation :: Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
currentTreasuryValueAndDonation :: forall era.
TransactionBuildEstimateCmdArgs era
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
currentTreasuryValueAndDonation
    , TxCborFormat
isCborOutCanonical :: TxCborFormat
isCborOutCanonical :: forall era. TransactionBuildEstimateCmdArgs era -> TxCborFormat
isCborOutCanonical
    , TxBodyFile 'Out
txBodyOutFile :: TxBodyFile 'Out
txBodyOutFile :: forall era. TransactionBuildEstimateCmdArgs era -> TxBodyFile 'Out
txBodyOutFile
    } = do
    let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
currentEra
        meo :: MaryEraOnwards era
meo = BabbageEraOnwards era -> MaryEraOnwards era
forall era. BabbageEraOnwards era -> MaryEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
currentEra :: BabbageEraOnwards era)

    PParams (LedgerEra era)
ledgerPParams <-
      ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
-> RIO e (PParams (LedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
 -> RIO e (PParams (LedgerEra era)))
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
-> RIO e (PParams (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
        forall era.
IsEra era =>
ProtocolParamsFile
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
readProtocolParameters @era ProtocolParamsFile
protocolParamsFile

    [(TxIn, Maybe (SpendScriptWitness era))]
txInsAndMaybeScriptWits <-
      [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, Maybe (SpendScriptWitness era))]
forall era e.
IsEra era =>
[(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, Maybe (SpendScriptWitness era))]
readSpendScriptWitnesses [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txins

    [(CertificateFile, AnyWitness (LedgerEra era))]
certFilesAndMaybeScriptWits <-
      forall era e.
IsEra era =>
[(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> CIO e [(CertificateFile, AnyWitness (LedgerEra era))]
readCertificateScriptWitnesses @era [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates

    [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawalsAndMaybeScriptWits <-
      ((StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))
 -> RIO
      e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era)))
-> [(StakeAddress, Lovelace,
     Maybe (ScriptRequirements 'WithdrawalItem))]
-> RIO
     e [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> RIO
     e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO
     e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
forall era e.
IsEra era =>
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO
     e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
readWithdrawalScriptWitness [(StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals
    TxMetadataInEra era
txMetadata <-
      Era era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> CIO e (TxMetadataInEra era)
forall era e.
Era era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> CIO e (TxMetadataInEra era)
readTxMetadata Era era
currentEra TxMetadataJsonSchema
metadataSchema [MetadataFile]
metadataFiles

    let (MultiAsset
mas, [ScriptRequirements 'MintItem]
sWitFiles) = (MultiAsset, [ScriptRequirements 'MintItem])
-> Maybe (MultiAsset, [ScriptRequirements 'MintItem])
-> (MultiAsset, [ScriptRequirements 'MintItem])
forall a. a -> Maybe a -> a
fromMaybe (MultiAsset, [ScriptRequirements 'MintItem])
forall a. Monoid a => a
mempty Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets
    (MultiAsset, [MintScriptWitnessWithPolicyId era])
valuesWithScriptWits <-
      (MultiAsset
mas,) ([MintScriptWitnessWithPolicyId era]
 -> (MultiAsset, [MintScriptWitnessWithPolicyId era]))
-> RIO e [MintScriptWitnessWithPolicyId era]
-> RIO e (MultiAsset, [MintScriptWitnessWithPolicyId era])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ScriptRequirements 'MintItem
 -> RIO e (MintScriptWitnessWithPolicyId era))
-> [ScriptRequirements 'MintItem]
-> RIO e [MintScriptWitnessWithPolicyId era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ScriptRequirements 'MintItem
-> RIO e (MintScriptWitnessWithPolicyId era)
ScriptRequirements 'MintItem
-> CIO e (MintScriptWitnessWithPolicyId era)
forall era e.
IsEra era =>
ScriptRequirements 'MintItem
-> CIO e (MintScriptWitnessWithPolicyId era)
readMintScriptWitness [ScriptRequirements 'MintItem]
sWitFiles

    [ScriptInAnyLang]
scripts <-
      (ScriptFile -> RIO e ScriptInAnyLang)
-> [ScriptFile] -> RIO e [ScriptInAnyLang]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FilePath -> RIO e ScriptInAnyLang
forall (m :: * -> *). MonadIO m => FilePath -> m ScriptInAnyLang
readFileScriptInAnyLang (FilePath -> RIO e ScriptInAnyLang)
-> (ScriptFile -> FilePath) -> ScriptFile -> RIO e ScriptInAnyLang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptFile -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile) [ScriptFile]
scriptFiles
    TxAuxScripts era
txAuxScripts <-
      Either TxAuxScriptsValidationError (TxAuxScripts era)
-> RIO e (TxAuxScripts era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either TxAuxScriptsValidationError (TxAuxScripts era)
 -> RIO e (TxAuxScripts era))
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
-> RIO e (TxAuxScripts era)
forall a b. (a -> b) -> a -> b
$ [ScriptInAnyLang]
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
forall era.
IsEra era =>
[ScriptInAnyLang]
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
validateTxAuxScripts [ScriptInAnyLang]
scripts

    [Hash PaymentKey]
requiredSigners <-
      (RequiredSigner -> RIO e (Hash PaymentKey))
-> [RequiredSigner] -> RIO e [Hash PaymentKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO (Either RequiredSignerError (Hash PaymentKey))
-> RIO e (Hash PaymentKey)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either RequiredSignerError (Hash PaymentKey))
 -> RIO e (Hash PaymentKey))
-> (RequiredSigner
    -> IO (Either RequiredSignerError (Hash PaymentKey)))
-> RequiredSigner
-> RIO e (Hash PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequiredSigner -> IO (Either RequiredSignerError (Hash PaymentKey))
readRequiredSigner) [RequiredSigner]
reqSigners

    Maybe (TxOut CtxTx era)
mReturnCollateral <- (TxOutShelleyBasedEra -> RIO e (TxOut CtxTx era))
-> Maybe TxOutShelleyBasedEra -> RIO e (Maybe (TxOut CtxTx era))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM TxOutShelleyBasedEra -> RIO e (TxOut CtxTx era)
TxOutShelleyBasedEra -> CIO e (TxOut CtxTx era)
forall era e.
IsEra era =>
TxOutShelleyBasedEra -> CIO e (TxOut CtxTx era)
toTxOutInShelleyBasedEra Maybe TxOutShelleyBasedEra
mReturnColl

    [TxOut CtxTx era]
txOuts <- (TxOutAnyEra -> RIO e (TxOut CtxTx era))
-> [TxOutAnyEra] -> RIO e [TxOut CtxTx era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ShelleyBasedEra era -> TxOutAnyEra -> CIO e (TxOut CtxTx era)
forall era e.
ShelleyBasedEra era -> TxOutAnyEra -> CIO e (TxOut CtxTx era)
toTxOutInAnyEra ShelleyBasedEra era
sbe) [TxOutAnyEra]
txouts

    -- the same collateral input can be used for several plutus scripts
    let filteredTxinsc :: [TxIn]
filteredTxinsc = [TxIn] -> [TxIn]
forall a. Ord a => [a] -> [a]
nubOrd [TxIn]
txInsCollateral

    -- Conway related
    [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProceduresAndMaybeScriptWits <-
      RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> (ConwayEraOnwards era
    -> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))])
-> ShelleyBasedEra era
-> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall (eon :: * -> *) a era.
Eon eon =>
a -> (eon era -> a) -> ShelleyBasedEra era -> a
inEonForShelleyBasedEra
        ([(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall a. Monoid a => a
mempty)
        ( \ConwayEraOnwards era
w ->
            ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))])
-> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))])
 -> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))])
-> (ConwayEraOnwardsConstraints era =>
    RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))])
-> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall a b. (a -> b) -> a -> b
$
              ConwayEraOnwards era
-> [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall era e.
ConwayEraOnwards era
-> [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
readVotingProceduresFiles ConwayEraOnwards era
w [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles
        )
        ShelleyBasedEra era
sbe

    [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals <- [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
-> CIO e [(Proposal era, Maybe (ProposalScriptWitness era))]
forall era e.
IsEra era =>
[(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
-> CIO e [(Proposal era, Maybe (ProposalScriptWitness era))]
readTxGovernanceActions [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles

    [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits <-
      [RIO e (Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> RIO
     e [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([RIO e (Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
 -> RIO
      e [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))])
-> [RIO
      e (Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> RIO
     e [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
forall a b. (a -> b) -> a -> b
$
        [ (,AnyWitness (LedgerEra era)
mSwit)
            (Certificate (LedgerEra era)
 -> (Certificate (LedgerEra era), AnyWitness (LedgerEra era)))
-> RIO e (Certificate (LedgerEra era))
-> RIO e (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (Certificate era -> Certificate (LedgerEra era))
-> RIO e (Certificate era) -> RIO e (Certificate (LedgerEra era))
forall a b. (a -> b) -> RIO e a -> RIO e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Era era -> Certificate era -> Certificate (LedgerEra era)
forall era.
Era era -> Certificate era -> Certificate (LedgerEra era)
Exp.convertToNewCertificate Era era
forall era. IsEra era => Era era
Exp.useEra) (RIO e (Certificate era) -> RIO e (Certificate (LedgerEra era)))
-> RIO e (Certificate era) -> RIO e (Certificate (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
                    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => RIO e (Certificate era))
-> RIO e (Certificate era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => RIO e (Certificate era))
 -> RIO e (Certificate era))
-> (ShelleyBasedEraConstraints era => RIO e (Certificate era))
-> RIO e (Certificate era)
forall a b. (a -> b) -> a -> b
$
                      IO (Either (FileError TextEnvelopeError) (Certificate era))
-> RIO e (Certificate era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError TextEnvelopeError) (Certificate era))
 -> RIO e (Certificate era))
-> IO (Either (FileError TextEnvelopeError) (Certificate era))
-> RIO e (Certificate era)
forall a b. (a -> b) -> a -> b
$
                        File Any 'In
-> IO (Either (FileError TextEnvelopeError) (Certificate era))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
certFile)
                )
        | (CertificateFile FilePath
certFile, AnyWitness (LedgerEra era)
mSwit :: Exp.AnyWitness (Exp.LedgerEra era)) <-
            [(CertificateFile, AnyWitness (LedgerEra era))]
certFilesAndMaybeScriptWits
        ]

    TxBodyContent BuildTx era
txBodyContent <-
      Either TxCmdError (TxBodyContent BuildTx era)
-> RIO e (TxBodyContent BuildTx era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either TxCmdError (TxBodyContent BuildTx era)
 -> RIO e (TxBodyContent BuildTx era))
-> Either TxCmdError (TxBodyContent BuildTx era)
-> RIO e (TxBodyContent BuildTx era)
forall a b. (a -> b) -> a -> b
$
        Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent BuildTx era)
forall era.
IsEra era =>
Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent BuildTx era)
constructTxBodyContent
          Maybe ScriptValidity
mScriptValidity
          (PParams (LedgerEra era) -> Maybe (PParams (LedgerEra era))
forall a. a -> Maybe a
Just PParams (LedgerEra era)
ledgerPParams)
          [(TxIn, Maybe (SpendScriptWitness era))]
txInsAndMaybeScriptWits
          [TxIn]
readOnlyRefIns
          [TxIn]
filteredTxinsc
          Maybe (TxOut CtxTx era)
mReturnCollateral
          Maybe Lovelace
forall a. Maybe a
Nothing -- TODO: Remove total collateral parameter from estimateBalancedTxBody
          [TxOut CtxTx era]
txOuts
          Maybe SlotNo
mValidityLowerBound
          TxValidityUpperBound era
mValidityUpperBound
          (MultiAsset, [MintScriptWitnessWithPolicyId era])
valuesWithScriptWits
          [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
          [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawalsAndMaybeScriptWits
          [Hash PaymentKey]
requiredSigners
          Lovelace
0
          TxAuxScripts era
txAuxScripts
          TxMetadataInEra era
txMetadata
          TxUpdateProposal era
forall era. TxUpdateProposal era
TxUpdateProposalNone
          [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProceduresAndMaybeScriptWits
          [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals
          Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
currentTreasuryValueAndDonation
    let stakeCredentialsToDeregisterMap :: Map StakeCredential Lovelace
stakeCredentialsToDeregisterMap = [Item (Map StakeCredential Lovelace)]
-> Map StakeCredential Lovelace
forall l. IsList l => [Item l] -> l
fromList ([Item (Map StakeCredential Lovelace)]
 -> Map StakeCredential Lovelace)
-> [Item (Map StakeCredential Lovelace)]
-> Map StakeCredential Lovelace
forall a b. (a -> b) -> a -> b
$ [Maybe (StakeCredential, Lovelace)]
-> [(StakeCredential, Lovelace)]
forall a. [Maybe a] -> [a]
catMaybes [Certificate (LedgerEra era) -> Maybe (StakeCredential, Lovelace)
forall era.
IsEra era =>
Certificate (LedgerEra era) -> Maybe (StakeCredential, Lovelace)
getStakeDeregistrationInfo Certificate (LedgerEra era)
cert | (Certificate (LedgerEra era)
cert, AnyWitness (LedgerEra era)
_) <- [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits]
        drepsToDeregisterMap :: Map (Credential 'DRepRole) Lovelace
drepsToDeregisterMap =
          [Item (Map (Credential 'DRepRole) Lovelace)]
-> Map (Credential 'DRepRole) Lovelace
forall l. IsList l => [Item l] -> l
fromList ([Item (Map (Credential 'DRepRole) Lovelace)]
 -> Map (Credential 'DRepRole) Lovelace)
-> [Item (Map (Credential 'DRepRole) Lovelace)]
-> Map (Credential 'DRepRole) Lovelace
forall a b. (a -> b) -> a -> b
$
            [Maybe (Credential 'DRepRole, Lovelace)]
-> [(Credential 'DRepRole, Lovelace)]
forall a. [Maybe a] -> [a]
catMaybes [Era era
-> Certificate (LedgerEra era)
-> Maybe (Credential 'DRepRole, Lovelace)
forall era.
Era era
-> Certificate (LedgerEra era)
-> Maybe (Credential 'DRepRole, Lovelace)
getDRepDeregistrationInfo Era era
forall era. IsEra era => Era era
Exp.useEra Certificate (LedgerEra era)
cert | (Certificate (LedgerEra era)
cert, AnyWitness (LedgerEra era)
_) <- [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits]
        poolsToDeregister :: Set PoolId
poolsToDeregister =
          [Item (Set PoolId)] -> Set PoolId
forall l. IsList l => [Item l] -> l
fromList ([Item (Set PoolId)] -> Set PoolId)
-> [Item (Set PoolId)] -> Set PoolId
forall a b. (a -> b) -> a -> b
$
            [Maybe PoolId] -> [PoolId]
forall a. [Maybe a] -> [a]
catMaybes [Era era -> Certificate (LedgerEra era) -> Maybe PoolId
forall era. Era era -> Certificate (LedgerEra era) -> Maybe PoolId
getPoolDeregistrationInfo Era era
forall era. IsEra era => Era era
Exp.useEra Certificate (LedgerEra era)
cert | (Certificate (LedgerEra era)
cert, AnyWitness (LedgerEra era)
_) <- [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits]
        totCol :: Lovelace
totCol = Lovelace -> Maybe Lovelace -> Lovelace
forall a. a -> Maybe a -> a
fromMaybe Lovelace
0 Maybe Lovelace
plutusCollateral
        pScriptExecUnits :: Map ScriptWitnessIndex ExecutionUnits
pScriptExecUnits =
          [Item (Map ScriptWitnessIndex ExecutionUnits)]
-> Map ScriptWitnessIndex ExecutionUnits
forall l. IsList l => [Item l] -> l
fromList
            [ (ScriptWitnessIndex
sWitIndex, ExecutionUnits
execUnits)
            | (ScriptWitnessIndex
sWitIndex, AnyScriptWitness (PlutusScriptWitness ScriptLanguageInEra lang era
_ PlutusScriptVersion lang
_ PlutusScriptOrReferenceInput lang
_ ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
execUnits)) <-
                ShelleyBasedEra era
-> TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
collectTxBodyScriptWitnesses ShelleyBasedEra era
sbe TxBodyContent BuildTx era
txBodyContent
            ]

    BalancedTxBody TxBodyContent BuildTx era
_ TxBody era
balancedTxBody TxOut CtxTx era
_ Lovelace
_ <-
      Either TxCmdError (BalancedTxBody era)
-> RIO e (BalancedTxBody era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either TxCmdError (BalancedTxBody era)
 -> RIO e (BalancedTxBody era))
-> Either TxCmdError (BalancedTxBody era)
-> RIO e (BalancedTxBody era)
forall a b. (a -> b) -> a -> b
$
        (TxFeeEstimationError era -> TxCmdError)
-> Either (TxFeeEstimationError era) (BalancedTxBody era)
-> Either TxCmdError (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 -> TxCmdError
forall era. TxFeeEstimationError era -> TxCmdError
TxCmdFeeEstimationError (Either (TxFeeEstimationError era) (BalancedTxBody era)
 -> Either TxCmdError (BalancedTxBody era))
-> Either (TxFeeEstimationError era) (BalancedTxBody era)
-> Either TxCmdError (BalancedTxBody era)
forall a b. (a -> b) -> a -> b
$
          MaryEraOnwards era
-> TxBodyContent BuildTx era
-> PParams (ShelleyLedgerEra era)
-> Set PoolId
-> Map StakeCredential Lovelace
-> Map (Credential 'DRepRole) Lovelace
-> Map ScriptWitnessIndex ExecutionUnits
-> Lovelace
-> Int
-> Int
-> Int
-> AddressInEra era
-> Value
-> Either (TxFeeEstimationError era) (BalancedTxBody era)
forall era.
HasCallStack =>
MaryEraOnwards era
-> TxBodyContent BuildTx era
-> PParams (ShelleyLedgerEra era)
-> Set PoolId
-> Map StakeCredential Lovelace
-> Map (Credential 'DRepRole) Lovelace
-> Map ScriptWitnessIndex ExecutionUnits
-> Lovelace
-> Int
-> Int
-> Int
-> AddressInEra era
-> Value
-> Either (TxFeeEstimationError era) (BalancedTxBody era)
estimateBalancedTxBody
            MaryEraOnwards era
meo
            TxBodyContent BuildTx era
txBodyContent
            (Era era
-> PParams (LedgerEra era) -> PParams (ShelleyLedgerEra era)
forall era.
Era era
-> PParams (LedgerEra era) -> PParams (ShelleyLedgerEra era)
toShelleyLedgerPParamsShim Era era
currentEra PParams (LedgerEra era)
ledgerPParams)
            Set PoolId
poolsToDeregister
            Map StakeCredential Lovelace
stakeCredentialsToDeregisterMap
            Map (Credential 'DRepRole) Lovelace
drepsToDeregisterMap
            Map ScriptWitnessIndex ExecutionUnits
pScriptExecUnits
            Lovelace
totCol
            Int
shelleyWitnesses
            (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mByronWitnesses)
            (Int
-> (ReferenceScriptSize -> Int) -> Maybe ReferenceScriptSize -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ReferenceScriptSize -> Int
unReferenceScriptSize Maybe ReferenceScriptSize
totalReferenceScriptSize)
            (ShelleyBasedEra era -> AddressAny -> AddressInEra era
forall era. ShelleyBasedEra era -> AddressAny -> AddressInEra era
anyAddressInShelleyBasedEra ShelleyBasedEra era
sbe AddressAny
changeAddr)
            Value
totalUTxOValue

    let noWitTx :: Tx era
noWitTx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody era
balancedTxBody
    IO (Either (FileError ()) ()) -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      CardanoEra era
-> (CardanoEraConstraints era => IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
CardanoEra era -> (CardanoEraConstraints era => a) -> a
cardanoEraConstraints (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
sbe) ((CardanoEraConstraints era => IO (Either (FileError ()) ()))
 -> IO (Either (FileError ()) ()))
-> (CardanoEraConstraints era => IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
        if TxCborFormat
isCborOutCanonical TxCborFormat -> TxCborFormat -> Bool
forall a. Eq a => a -> a -> Bool
== TxCborFormat
TxCborCanonical
          then ShelleyBasedEra era
-> TxBodyFile 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCanonical ShelleyBasedEra era
sbe TxBodyFile 'Out
txBodyOutFile Tx era
noWitTx
          else ShelleyBasedEra era
-> TxBodyFile 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelope ShelleyBasedEra era
sbe TxBodyFile 'Out
txBodyOutFile Tx era
noWitTx

-- TODO: Update type in cardano-api to be more generic then delete this
toShelleyLedgerPParamsShim
  :: Exp.Era era -> L.PParams (Exp.LedgerEra era) -> L.PParams (ShelleyLedgerEra era)
toShelleyLedgerPParamsShim :: forall era.
Era era
-> PParams (LedgerEra era) -> PParams (ShelleyLedgerEra era)
toShelleyLedgerPParamsShim Era era
Exp.ConwayEra PParams (LedgerEra era)
pp = PParams (ShelleyLedgerEra era)
PParams (LedgerEra era)
pp
toShelleyLedgerPParamsShim Era era
Exp.DijkstraEra PParams (LedgerEra era)
pp = PParams (ShelleyLedgerEra era)
PParams (LedgerEra era)
pp

fromShelleyLedgerPParamsShim
  :: Exp.Era era -> L.PParams (ShelleyLedgerEra era) -> L.PParams (Exp.LedgerEra era)
fromShelleyLedgerPParamsShim :: forall era.
Era era
-> PParams (ShelleyLedgerEra era) -> PParams (LedgerEra era)
fromShelleyLedgerPParamsShim Era era
Exp.ConwayEra PParams (ShelleyLedgerEra era)
pp = PParams (ShelleyLedgerEra era)
PParams (LedgerEra era)
pp
fromShelleyLedgerPParamsShim Era era
Exp.DijkstraEra PParams (ShelleyLedgerEra era)
pp = PParams (ShelleyLedgerEra era)
PParams (LedgerEra era)
pp

getPoolDeregistrationInfo
  :: Exp.Era era
  -> Exp.Certificate (Exp.LedgerEra era)
  -> Maybe PoolId
getPoolDeregistrationInfo :: forall era. Era era -> Certificate (LedgerEra era) -> Maybe PoolId
getPoolDeregistrationInfo Era era
era (Exp.Certificate TxCert (LedgerEra era)
cert) =
  KeyHash 'StakePool -> PoolId
StakePoolKeyHash (KeyHash 'StakePool -> PoolId)
-> ((KeyHash 'StakePool, EpochNo) -> KeyHash 'StakePool)
-> (KeyHash 'StakePool, EpochNo)
-> PoolId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHash 'StakePool, EpochNo) -> KeyHash 'StakePool
forall a b. (a, b) -> a
fst
    ((KeyHash 'StakePool, EpochNo) -> PoolId)
-> Maybe (KeyHash 'StakePool, EpochNo) -> Maybe PoolId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Era era
-> (EraCommonConstraints era =>
    TxCert (LedgerEra era) -> Maybe (KeyHash 'StakePool, EpochNo))
-> TxCert (LedgerEra era)
-> Maybe (KeyHash 'StakePool, EpochNo)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era EraCommonConstraints era =>
TxCert (LedgerEra era) -> Maybe (KeyHash 'StakePool, EpochNo)
TxCert (LedgerEra era) -> Maybe (KeyHash 'StakePool, EpochNo)
forall era.
EraTxCert era =>
TxCert era -> Maybe (KeyHash 'StakePool, EpochNo)
L.getRetirePoolTxCert TxCert (LedgerEra era)
cert :: Maybe (L.KeyHash L.StakePool, EpochNo))

getDRepDeregistrationInfo
  :: Exp.Era era
  -> Exp.Certificate (Exp.LedgerEra era)
  -> Maybe (L.Credential L.DRepRole, Lovelace)
getDRepDeregistrationInfo :: forall era.
Era era
-> Certificate (LedgerEra era)
-> Maybe (Credential 'DRepRole, Lovelace)
getDRepDeregistrationInfo Era era
e (Exp.Certificate TxCert (LedgerEra era)
cert) =
  Era era
-> (EraCommonConstraints era =>
    Maybe (Credential 'DRepRole, Lovelace))
-> Maybe (Credential 'DRepRole, Lovelace)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
e ((EraCommonConstraints era =>
  Maybe (Credential 'DRepRole, Lovelace))
 -> Maybe (Credential 'DRepRole, Lovelace))
-> (EraCommonConstraints era =>
    Maybe (Credential 'DRepRole, Lovelace))
-> Maybe (Credential 'DRepRole, Lovelace)
forall a b. (a -> b) -> a -> b
$ TxCert (LedgerEra era) -> Maybe (Credential 'DRepRole, Lovelace)
forall era.
ConwayEraTxCert era =>
TxCert era -> Maybe (Credential 'DRepRole, Lovelace)
L.getUnRegDRepTxCert TxCert (LedgerEra era)
cert

getStakeDeregistrationInfo
  :: forall era
   . Exp.IsEra era
  => Exp.Certificate (Exp.LedgerEra era)
  -> Maybe (StakeCredential, Lovelace)
getStakeDeregistrationInfo :: forall era.
IsEra era =>
Certificate (LedgerEra era) -> Maybe (StakeCredential, Lovelace)
getStakeDeregistrationInfo (Exp.Certificate TxCert (LedgerEra era)
cert) =
  Era era
-> TxCert (LedgerEra era) -> Maybe (StakeCredential, Lovelace)
forall era.
Era era
-> TxCert (LedgerEra era) -> Maybe (StakeCredential, Lovelace)
getConwayDeregistrationInfo Era era
forall era. IsEra era => Era era
Exp.useEra TxCert (LedgerEra era)
cert

getConwayDeregistrationInfo
  :: forall era
   . Exp.Era era
  -> L.TxCert (Exp.LedgerEra era)
  -> Maybe (StakeCredential, Lovelace)
getConwayDeregistrationInfo :: forall era.
Era era
-> TxCert (LedgerEra era) -> Maybe (StakeCredential, Lovelace)
getConwayDeregistrationInfo Era era
e TxCert (LedgerEra era)
cert = do
  (StakeCredential
stakeCred, Lovelace
depositRefund) <- Era era
-> (EraCommonConstraints era => Maybe (StakeCredential, Lovelace))
-> Maybe (StakeCredential, Lovelace)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
e ((EraCommonConstraints era => Maybe (StakeCredential, Lovelace))
 -> Maybe (StakeCredential, Lovelace))
-> (EraCommonConstraints era => Maybe (StakeCredential, Lovelace))
-> Maybe (StakeCredential, Lovelace)
forall a b. (a -> b) -> a -> b
$ TxCert (LedgerEra era) -> Maybe (StakeCredential, Lovelace)
forall era.
ConwayEraTxCert era =>
TxCert era -> Maybe (StakeCredential, Lovelace)
L.getUnRegDepositTxCert TxCert (LedgerEra era)
cert
  (StakeCredential, Lovelace) -> Maybe (StakeCredential, Lovelace)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeCredential -> StakeCredential
fromShelleyStakeCredential StakeCredential
stakeCred, Lovelace
depositRefund)

getExecutionUnitPrices :: CardanoEra era -> LedgerProtocolParameters era -> Maybe L.Prices
getExecutionUnitPrices :: forall era.
CardanoEra era -> LedgerProtocolParameters era -> Maybe Prices
getExecutionUnitPrices CardanoEra era
cEra (LedgerProtocolParameters PParams (ShelleyLedgerEra era)
pp) =
  CardanoEra era -> (AlonzoEraOnwards era -> Prices) -> Maybe Prices
forall (eon :: * -> *) era a.
Eon eon =>
CardanoEra era -> (eon era -> a) -> Maybe a
forEraInEonMaybe CardanoEra era
cEra ((AlonzoEraOnwards era -> Prices) -> Maybe Prices)
-> (AlonzoEraOnwards era -> Prices) -> Maybe Prices
forall a b. (a -> b) -> a -> b
$ \AlonzoEraOnwards era
aeo ->
    AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era => Prices) -> Prices
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeo ((AlonzoEraOnwardsConstraints era => Prices) -> Prices)
-> (AlonzoEraOnwardsConstraints era => Prices) -> Prices
forall a b. (a -> b) -> a -> b
$
      PParams (ShelleyLedgerEra era)
pp PParams (ShelleyLedgerEra era)
-> Getting Prices (PParams (ShelleyLedgerEra era)) Prices -> Prices
forall s a. s -> Getting a s a -> a
^. Getting Prices (PParams (ShelleyLedgerEra era)) Prices
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams (ShelleyLedgerEra era)) Prices
L.ppPricesL

runTransactionBuildRawCmd
  :: forall era e
   . Cmd.TransactionBuildRawCmdArgs era
  -> CIO e ()
runTransactionBuildRawCmd :: forall era e. TransactionBuildRawCmdArgs era -> CIO e ()
runTransactionBuildRawCmd
  Cmd.TransactionBuildRawCmdArgs
    { Era era
eon :: Era era
eon :: forall era. TransactionBuildRawCmdArgs era -> Era era
eon
    , Maybe ScriptValidity
mScriptValidity :: Maybe ScriptValidity
mScriptValidity :: forall era. TransactionBuildRawCmdArgs era -> Maybe ScriptValidity
mScriptValidity
    , [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txIns :: [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txIns :: forall era.
TransactionBuildRawCmdArgs era
-> [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txIns
    , [TxIn]
readOnlyRefIns :: [TxIn]
readOnlyRefIns :: forall era. TransactionBuildRawCmdArgs era -> [TxIn]
readOnlyRefIns
    , [TxIn]
txInsCollateral :: [TxIn]
txInsCollateral :: forall era. TransactionBuildRawCmdArgs era -> [TxIn]
txInsCollateral
    , mReturnCollateral :: forall era.
TransactionBuildRawCmdArgs era -> Maybe TxOutShelleyBasedEra
mReturnCollateral = Maybe TxOutShelleyBasedEra
mReturnColl
    , Maybe Lovelace
mTotalCollateral :: Maybe Lovelace
mTotalCollateral :: forall era. TransactionBuildRawCmdArgs era -> Maybe Lovelace
mTotalCollateral
    , requiredSigners :: forall era. TransactionBuildRawCmdArgs era -> [RequiredSigner]
requiredSigners = [RequiredSigner]
reqSigners
    , [TxOutAnyEra]
txouts :: [TxOutAnyEra]
txouts :: forall era. TransactionBuildRawCmdArgs era -> [TxOutAnyEra]
txouts
    , Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets :: Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets :: forall era.
TransactionBuildRawCmdArgs era
-> Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets
    , Maybe SlotNo
mValidityLowerBound :: Maybe SlotNo
mValidityLowerBound :: forall era. TransactionBuildRawCmdArgs era -> Maybe SlotNo
mValidityLowerBound
    , TxValidityUpperBound era
mValidityUpperBound :: TxValidityUpperBound era
mValidityUpperBound :: forall era.
TransactionBuildRawCmdArgs era -> TxValidityUpperBound era
mValidityUpperBound
    , Lovelace
fee :: Lovelace
fee :: forall era. TransactionBuildRawCmdArgs era -> Lovelace
fee
    , [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates :: [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates :: forall era.
TransactionBuildRawCmdArgs era
-> [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates
    , [(StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals :: [(StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals :: forall era.
TransactionBuildRawCmdArgs era
-> [(StakeAddress, Lovelace,
     Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals
    , TxMetadataJsonSchema
metadataSchema :: TxMetadataJsonSchema
metadataSchema :: forall era. TransactionBuildRawCmdArgs era -> TxMetadataJsonSchema
metadataSchema
    , [ScriptFile]
scriptFiles :: [ScriptFile]
scriptFiles :: forall era. TransactionBuildRawCmdArgs era -> [ScriptFile]
scriptFiles
    , [MetadataFile]
metadataFiles :: [MetadataFile]
metadataFiles :: forall era. TransactionBuildRawCmdArgs era -> [MetadataFile]
metadataFiles
    , Maybe ProtocolParamsFile
mProtocolParamsFile :: Maybe ProtocolParamsFile
mProtocolParamsFile :: forall era.
TransactionBuildRawCmdArgs era -> Maybe ProtocolParamsFile
mProtocolParamsFile
    , Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
mUpdateProprosalFile :: Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
mUpdateProprosalFile :: forall era.
TransactionBuildRawCmdArgs era
-> Maybe
     (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
mUpdateProprosalFile
    , [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles :: [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles :: forall era.
TransactionBuildRawCmdArgs era
-> [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles
    , [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles :: [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles :: forall era.
TransactionBuildRawCmdArgs era
-> [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles
    , Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
currentTreasuryValueAndDonation :: Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
currentTreasuryValueAndDonation :: forall era.
TransactionBuildRawCmdArgs era
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
currentTreasuryValueAndDonation
    , TxCborFormat
isCborOutCanonical :: TxCborFormat
isCborOutCanonical :: forall era. TransactionBuildRawCmdArgs era -> TxCborFormat
isCborOutCanonical
    , TxBodyFile 'Out
txBodyOutFile :: TxBodyFile 'Out
txBodyOutFile :: forall era. TransactionBuildRawCmdArgs era -> TxBodyFile 'Out
txBodyOutFile
    } = Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
eon ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    [(TxIn, Maybe (SpendScriptWitness era))]
txInsAndMaybeScriptWits <-
      [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, Maybe (SpendScriptWitness era))]
forall era e.
IsEra era =>
[(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, Maybe (SpendScriptWitness era))]
readSpendScriptWitnesses [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txIns

    [(CertificateFile, AnyWitness (LedgerEra era))]
certFilesAndMaybeScriptWits :: [(CertificateFile, Exp.AnyWitness (Exp.LedgerEra era))] <-
      [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> CIO e [(CertificateFile, AnyWitness (LedgerEra era))]
forall era e.
IsEra era =>
[(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> CIO e [(CertificateFile, AnyWitness (LedgerEra era))]
readCertificateScriptWitnesses [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates

    [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawalsAndMaybeScriptWits <-
      ((StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))
 -> RIO
      e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era)))
-> [(StakeAddress, Lovelace,
     Maybe (ScriptRequirements 'WithdrawalItem))]
-> RIO
     e [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> RIO
     e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO
     e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
forall era e.
IsEra era =>
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO
     e (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
readWithdrawalScriptWitness [(StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))]
withdrawals
    TxMetadataInEra era
txMetadata <-
      Era era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> CIO e (TxMetadataInEra era)
forall era e.
Era era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> CIO e (TxMetadataInEra era)
readTxMetadata (Era era -> Era era
forall era. Era era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra) TxMetadataJsonSchema
metadataSchema [MetadataFile]
metadataFiles

    let (MultiAsset
mas, [ScriptRequirements 'MintItem]
sWitFiles) = (MultiAsset, [ScriptRequirements 'MintItem])
-> Maybe (MultiAsset, [ScriptRequirements 'MintItem])
-> (MultiAsset, [ScriptRequirements 'MintItem])
forall a. a -> Maybe a -> a
fromMaybe (MultiAsset, [ScriptRequirements 'MintItem])
forall a. Monoid a => a
mempty Maybe (MultiAsset, [ScriptRequirements 'MintItem])
mMintedAssets
    (MultiAsset, [MintScriptWitnessWithPolicyId era])
valuesWithScriptWits <-
      (MultiAsset
mas,)
        ([MintScriptWitnessWithPolicyId era]
 -> (MultiAsset, [MintScriptWitnessWithPolicyId era]))
-> RIO e [MintScriptWitnessWithPolicyId era]
-> RIO e (MultiAsset, [MintScriptWitnessWithPolicyId era])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ScriptRequirements 'MintItem
 -> RIO e (MintScriptWitnessWithPolicyId era))
-> [ScriptRequirements 'MintItem]
-> RIO e [MintScriptWitnessWithPolicyId era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ScriptRequirements 'MintItem
-> RIO e (MintScriptWitnessWithPolicyId era)
ScriptRequirements 'MintItem
-> CIO e (MintScriptWitnessWithPolicyId era)
forall era e.
IsEra era =>
ScriptRequirements 'MintItem
-> CIO e (MintScriptWitnessWithPolicyId era)
readMintScriptWitness [ScriptRequirements 'MintItem]
sWitFiles

    [ScriptInAnyLang]
scripts <-
      (ScriptFile -> RIO e ScriptInAnyLang)
-> [ScriptFile] -> RIO e [ScriptInAnyLang]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FilePath -> RIO e ScriptInAnyLang
forall (m :: * -> *). MonadIO m => FilePath -> m ScriptInAnyLang
readFileScriptInAnyLang (FilePath -> RIO e ScriptInAnyLang)
-> (ScriptFile -> FilePath) -> ScriptFile -> RIO e ScriptInAnyLang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptFile -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile) [ScriptFile]
scriptFiles
    TxAuxScripts era
txAuxScripts <-
      Either TxAuxScriptsValidationError (TxAuxScripts era)
-> RIO e (TxAuxScripts era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either TxAuxScriptsValidationError (TxAuxScripts era)
 -> RIO e (TxAuxScripts era))
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
-> RIO e (TxAuxScripts era)
forall a b. (a -> b) -> a -> b
$
        [ScriptInAnyLang]
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
forall era.
IsEra era =>
[ScriptInAnyLang]
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
validateTxAuxScripts [ScriptInAnyLang]
scripts

    Maybe (PParams (LedgerEra era))
pparams <- Maybe ProtocolParamsFile
-> (ProtocolParamsFile -> RIO e (PParams (LedgerEra era)))
-> RIO e (Maybe (PParams (LedgerEra era)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe ProtocolParamsFile
mProtocolParamsFile ((ProtocolParamsFile -> RIO e (PParams (LedgerEra era)))
 -> RIO e (Maybe (PParams (LedgerEra era))))
-> (ProtocolParamsFile -> RIO e (PParams (LedgerEra era)))
-> RIO e (Maybe (PParams (LedgerEra era)))
forall a b. (a -> b) -> a -> b
$ \ProtocolParamsFile
ppf ->
      ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
-> RIO e (PParams (LedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ProtocolParamsFile
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
forall era.
IsEra era =>
ProtocolParamsFile
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
readProtocolParameters ProtocolParamsFile
ppf)

    let mLedgerPParams :: Maybe (LedgerProtocolParameters era)
mLedgerPParams = PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
PParams (LedgerEra era) -> LedgerProtocolParameters era
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters (PParams (LedgerEra era) -> LedgerProtocolParameters era)
-> Maybe (PParams (LedgerEra era))
-> Maybe (LedgerProtocolParameters era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PParams (LedgerEra era))
pparams

    TxUpdateProposal era
txUpdateProposal <- case Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
mUpdateProprosalFile of
      Just (Featured ShelleyToBabbageEra era
w (Just UpdateProposalFile
updateProposalFile)) ->
        ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
-> RIO e (TxUpdateProposal era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
 -> RIO e (TxUpdateProposal era))
-> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
-> RIO e (TxUpdateProposal era)
forall a b. (a -> b) -> a -> b
$ ShelleyToBabbageEra era
-> UpdateProposalFile
-> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
forall era.
ShelleyToBabbageEra era
-> UpdateProposalFile
-> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
readTxUpdateProposal ShelleyToBabbageEra era
w UpdateProposalFile
updateProposalFile
      Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
_ -> TxUpdateProposal era -> RIO e (TxUpdateProposal era)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxUpdateProposal era
forall era. TxUpdateProposal era
TxUpdateProposalNone

    [Hash PaymentKey]
requiredSigners <-
      (RequiredSigner -> RIO e (Hash PaymentKey))
-> [RequiredSigner] -> RIO e [Hash PaymentKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO (Either RequiredSignerError (Hash PaymentKey))
-> RIO e (Hash PaymentKey)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either RequiredSignerError (Hash PaymentKey))
 -> RIO e (Hash PaymentKey))
-> (RequiredSigner
    -> IO (Either RequiredSignerError (Hash PaymentKey)))
-> RequiredSigner
-> RIO e (Hash PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequiredSigner -> IO (Either RequiredSignerError (Hash PaymentKey))
readRequiredSigner) [RequiredSigner]
reqSigners

    Maybe (TxOut CtxTx era)
mReturnCollateral <- (TxOutShelleyBasedEra -> RIO e (TxOut CtxTx era))
-> Maybe TxOutShelleyBasedEra -> RIO e (Maybe (TxOut CtxTx era))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM TxOutShelleyBasedEra -> RIO e (TxOut CtxTx era)
TxOutShelleyBasedEra -> CIO e (TxOut CtxTx era)
forall era e.
IsEra era =>
TxOutShelleyBasedEra -> CIO e (TxOut CtxTx era)
toTxOutInShelleyBasedEra Maybe TxOutShelleyBasedEra
mReturnColl

    [TxOut CtxTx era]
txOuts <- (TxOutAnyEra -> RIO e (TxOut CtxTx era))
-> [TxOutAnyEra] -> RIO e [TxOut CtxTx era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ShelleyBasedEra era -> TxOutAnyEra -> CIO e (TxOut CtxTx era)
forall era e.
ShelleyBasedEra era -> TxOutAnyEra -> CIO e (TxOut CtxTx era)
toTxOutInAnyEra (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra)) [TxOutAnyEra]
txouts

    -- the same collateral input can be used for several plutus scripts
    let filteredTxinsc :: [Item (Set TxIn)]
filteredTxinsc = forall l. IsList l => l -> [Item l]
toList @(Set _) (Set TxIn -> [Item (Set TxIn)]) -> Set TxIn -> [Item (Set TxIn)]
forall a b. (a -> b) -> a -> b
$ [Item (Set TxIn)] -> Set TxIn
forall l. IsList l => [Item l] -> l
fromList [Item (Set TxIn)]
[TxIn]
txInsCollateral

    -- Conway related
    [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProceduresAndMaybeScriptWits <-
      ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))])
-> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints (Era era -> ConwayEraOnwards era
forall era. Era era -> ConwayEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> ConwayEraOnwards era)
-> Era era -> ConwayEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
Exp.useEra @era) ((ConwayEraOnwardsConstraints era =>
  RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))])
 -> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))])
-> (ConwayEraOnwardsConstraints era =>
    RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))])
-> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall a b. (a -> b) -> a -> b
$
        ConwayEraOnwards era
-> [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall era e.
ConwayEraOnwards era
-> [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
readVotingProceduresFiles (Era era -> ConwayEraOnwards era
forall era. Era era -> ConwayEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra) [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles

    [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals <-
      forall era e.
IsEra era =>
[(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
-> CIO e [(Proposal era, Maybe (ProposalScriptWitness era))]
readTxGovernanceActions @era [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposalFiles

    [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits <-
      [RIO e (Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> RIO
     e [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ (,AnyWitness (LedgerEra era)
mSwit)
            (Certificate (LedgerEra era)
 -> (Certificate (LedgerEra era), AnyWitness (LedgerEra era)))
-> RIO e (Certificate (LedgerEra era))
-> RIO e (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Certificate era -> Certificate (LedgerEra era))
-> RIO e (Certificate era) -> RIO e (Certificate (LedgerEra era))
forall a b. (a -> b) -> RIO e a -> RIO e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              (Era era -> Certificate era -> Certificate (LedgerEra era)
forall era.
Era era -> Certificate era -> Certificate (LedgerEra era)
Exp.convertToNewCertificate Era era
forall era. IsEra era => Era era
Exp.useEra)
              ( IO (Either (FileError TextEnvelopeError) (Certificate era))
-> RIO e (Certificate era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError TextEnvelopeError) (Certificate era))
 -> RIO e (Certificate era))
-> IO (Either (FileError TextEnvelopeError) (Certificate era))
-> RIO e (Certificate era)
forall a b. (a -> b) -> a -> b
$
                  File Any 'In
-> IO (Either (FileError TextEnvelopeError) (Certificate era))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
certFile)
              )
        | (CertificateFile FilePath
certFile, AnyWitness (LedgerEra era)
mSwit) <- [(CertificateFile, AnyWitness (LedgerEra era))]
certFilesAndMaybeScriptWits
        ]
    TxBody era
txBody <-
      Either TxCmdError (TxBody era) -> RIO e (TxBody era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either TxCmdError (TxBody era) -> RIO e (TxBody era))
-> Either TxCmdError (TxBody era) -> RIO e (TxBody era)
forall a b. (a -> b) -> a -> b
$
        Maybe ScriptValidity
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> Lovelace
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> Maybe (LedgerProtocolParameters era)
-> TxUpdateProposal era
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBody era)
forall era.
IsEra era =>
Maybe ScriptValidity
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> Lovelace
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> Maybe (LedgerProtocolParameters era)
-> TxUpdateProposal era
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBody era)
runTxBuildRaw
          Maybe ScriptValidity
mScriptValidity
          [(TxIn, Maybe (SpendScriptWitness era))]
txInsAndMaybeScriptWits
          [TxIn]
readOnlyRefIns
          [Item (Set TxIn)]
[TxIn]
filteredTxinsc
          Maybe (TxOut CtxTx era)
mReturnCollateral
          Maybe Lovelace
mTotalCollateral
          [TxOut CtxTx era]
txOuts
          Maybe SlotNo
mValidityLowerBound
          TxValidityUpperBound era
mValidityUpperBound
          Lovelace
fee
          (MultiAsset, [MintScriptWitnessWithPolicyId era])
valuesWithScriptWits
          [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
          [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawalsAndMaybeScriptWits
          [Hash PaymentKey]
requiredSigners
          TxAuxScripts era
txAuxScripts
          TxMetadataInEra era
txMetadata
          Maybe (LedgerProtocolParameters era)
mLedgerPParams
          TxUpdateProposal era
txUpdateProposal
          [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProceduresAndMaybeScriptWits
          [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals
          Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
currentTreasuryValueAndDonation

    let noWitTx :: Tx era
noWitTx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody era
txBody
    IO (Either (FileError ()) ()) -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      if TxCborFormat
isCborOutCanonical TxCborFormat -> TxCborFormat -> Bool
forall a. Eq a => a -> a -> Bool
== TxCborFormat
TxCborCanonical
        then ShelleyBasedEra era
-> TxBodyFile 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCanonical (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra) TxBodyFile 'Out
txBodyOutFile Tx era
noWitTx
        else ShelleyBasedEra era
-> TxBodyFile 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelope (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra) TxBodyFile 'Out
txBodyOutFile Tx era
noWitTx

runTxBuildRaw
  :: Exp.IsEra era
  => Maybe ScriptValidity
  -- ^ Mark script as expected to pass or fail validation
  -> [(TxIn, Maybe (SpendScriptWitness era))]
  -- ^ TxIn with potential script witness
  -> [TxIn]
  -- ^ Read only reference inputs
  -> [TxIn]
  -- ^ TxIn for collateral
  -> Maybe (TxOut CtxTx era)
  -- ^ Return collateral
  -> Maybe Lovelace
  -- ^ Total collateral
  -> [TxOut CtxTx era]
  -> Maybe SlotNo
  -- ^ Tx lower bound
  -> TxValidityUpperBound era
  -- ^ Tx upper bound
  -> Lovelace
  -- ^ Tx fee
  -> (L.MultiAsset, [MintScriptWitnessWithPolicyId era])
  -- ^ Multi-Asset minted value(s)
  -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
  -> [Hash PaymentKey]
  -- ^ Required signers
  -> TxAuxScripts era
  -> TxMetadataInEra era
  -> Maybe (LedgerProtocolParameters era)
  -> TxUpdateProposal era
  -> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
  -> [(Proposal era, Maybe (ProposalScriptWitness era))]
  -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
  -> Either TxCmdError (TxBody era)
runTxBuildRaw :: forall era.
IsEra era =>
Maybe ScriptValidity
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> Lovelace
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> Maybe (LedgerProtocolParameters era)
-> TxUpdateProposal era
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBody era)
runTxBuildRaw
  Maybe ScriptValidity
mScriptValidity
  [(TxIn, Maybe (SpendScriptWitness era))]
inputsAndMaybeScriptWits
  [TxIn]
readOnlyRefIns
  [TxIn]
txinsc
  Maybe (TxOut CtxTx era)
mReturnCollateral
  Maybe Lovelace
mTotCollateral
  [TxOut CtxTx era]
txouts
  Maybe SlotNo
mLowerBound
  TxValidityUpperBound era
mUpperBound
  Lovelace
fee
  (MultiAsset, [MintScriptWitnessWithPolicyId era])
valuesWithScriptWits
  [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeSriptWits
  [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawals
  [Hash PaymentKey]
reqSigners
  TxAuxScripts era
txAuxScripts
  TxMetadataInEra era
txMetadata
  Maybe (LedgerProtocolParameters era)
mpparams
  TxUpdateProposal era
txUpdateProposal
  [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProcedures
  [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals
  Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation = do
    let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra
    -- pp =
    TxBodyContent BuildTx era
txBodyContent <-
      Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent BuildTx era)
forall era.
IsEra era =>
Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent BuildTx era)
constructTxBodyContent
        Maybe ScriptValidity
mScriptValidity
        (Era era
-> PParams (ShelleyLedgerEra era) -> PParams (LedgerEra era)
forall era.
Era era
-> PParams (ShelleyLedgerEra era) -> PParams (LedgerEra era)
fromShelleyLedgerPParamsShim Era era
forall era. IsEra era => Era era
Exp.useEra (PParams (ShelleyLedgerEra era) -> PParams (LedgerEra era))
-> (LedgerProtocolParameters era -> PParams (ShelleyLedgerEra era))
-> LedgerProtocolParameters era
-> PParams (LedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerProtocolParameters era -> PParams (ShelleyLedgerEra era)
forall era.
LedgerProtocolParameters era -> PParams (ShelleyLedgerEra era)
unLedgerProtocolParameters (LedgerProtocolParameters era -> PParams (LedgerEra era))
-> Maybe (LedgerProtocolParameters era)
-> Maybe (PParams (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LedgerProtocolParameters era)
mpparams)
        [(TxIn, Maybe (SpendScriptWitness era))]
inputsAndMaybeScriptWits
        [TxIn]
readOnlyRefIns
        [TxIn]
txinsc
        Maybe (TxOut CtxTx era)
mReturnCollateral
        Maybe Lovelace
mTotCollateral
        [TxOut CtxTx era]
txouts
        Maybe SlotNo
mLowerBound
        TxValidityUpperBound era
mUpperBound
        (MultiAsset, [MintScriptWitnessWithPolicyId era])
valuesWithScriptWits
        [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeSriptWits
        [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawals
        [Hash PaymentKey]
reqSigners
        Lovelace
fee
        TxAuxScripts era
txAuxScripts
        TxMetadataInEra era
txMetadata
        TxUpdateProposal era
txUpdateProposal
        [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProcedures
        [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals
        Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation

    (TxBodyError -> TxCmdError)
-> Either TxBodyError (TxBody era)
-> Either TxCmdError (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 -> TxCmdError
TxCmdTxBodyError (Either TxBodyError (TxBody era) -> Either TxCmdError (TxBody era))
-> Either TxBodyError (TxBody era)
-> Either TxCmdError (TxBody era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
forall era.
HasCallStack =>
ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
createTransactionBody ShelleyBasedEra era
sbe TxBodyContent BuildTx era
txBodyContent

constructTxBodyContent
  :: forall era
   . Exp.IsEra era
  => Maybe ScriptValidity
  -> Maybe (L.PParams (Exp.LedgerEra era))
  -> [(TxIn, Maybe (SpendScriptWitness era))]
  -- ^ TxIn with potential script witness
  -> [TxIn]
  -- ^ Read only reference inputs
  -> [TxIn]
  -- ^ TxIn for collateral
  -> Maybe (TxOut CtxTx era)
  -- ^ Return collateral
  -> Maybe Lovelace
  -- ^ Total collateral
  -> [TxOut CtxTx era]
  -- ^ Normal outputs
  -> Maybe SlotNo
  -- ^ Tx lower bound
  -> TxValidityUpperBound era
  -- ^ Tx upper bound
  -> (L.MultiAsset, [MintScriptWitnessWithPolicyId era])
  -- ^ Multi-Asset value(s)
  -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
  -- ^ Withdrawals
  -> [Hash PaymentKey]
  -- ^ Required signers
  -> Lovelace
  -- ^ Tx fee
  -> TxAuxScripts era
  -> TxMetadataInEra era
  -> TxUpdateProposal era
  -> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
  -> [(Proposal era, Maybe (ProposalScriptWitness era))]
  -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
  -- ^ The current treasury value and the donation. This is a stop gap as the
  -- semantics of the donation and treasury value depend on the script languages
  -- being used.
  -> Either TxCmdError (TxBodyContent BuildTx era)
constructTxBodyContent :: forall era.
IsEra era =>
Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent BuildTx era)
constructTxBodyContent
  Maybe ScriptValidity
mScriptValidity
  Maybe (PParams (LedgerEra era))
mPparams
  [(TxIn, Maybe (SpendScriptWitness era))]
inputsAndMaybeScriptWits
  [TxIn]
readOnlyRefIns
  [TxIn]
txinsc
  Maybe (TxOut CtxTx era)
mReturnCollateral
  Maybe Lovelace
mTotCollateral
  [TxOut CtxTx era]
txouts
  Maybe SlotNo
mLowerBound
  TxValidityUpperBound era
mUpperBound
  (MultiAsset, [MintScriptWitnessWithPolicyId era])
valuesWithScriptWits
  [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
  [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawals
  [Hash PaymentKey]
reqSigners
  Lovelace
fee
  TxAuxScripts era
txAuxScripts
  TxMetadataInEra era
txMetadata
  TxUpdateProposal era
txUpdateProposal
  [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProcedures
  [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals
  Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation =
    do
      let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> ShelleyBasedEra era) -> Era era -> ShelleyBasedEra era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
Exp.useEra @era
      let allReferenceInputs :: [TxIn]
allReferenceInputs =
            [ScriptWitness WitCtxTxIn era]
-> [ScriptWitness WitCtxMint era]
-> [AnyWitness (LedgerEra era)]
-> [WithdrawalScriptWitness era]
-> [VoteScriptWitness era]
-> [ProposalScriptWitness era]
-> [TxIn]
-> [TxIn]
forall era.
[ScriptWitness WitCtxTxIn era]
-> [ScriptWitness WitCtxMint era]
-> [AnyWitness (LedgerEra era)]
-> [WithdrawalScriptWitness era]
-> [VoteScriptWitness era]
-> [ProposalScriptWitness era]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
              ((SpendScriptWitness era -> ScriptWitness WitCtxTxIn era)
-> [SpendScriptWitness era] -> [ScriptWitness WitCtxTxIn era]
forall a b. (a -> b) -> [a] -> [b]
map SpendScriptWitness era -> ScriptWitness WitCtxTxIn era
forall era. SpendScriptWitness era -> ScriptWitness WitCtxTxIn era
sswScriptWitness ([SpendScriptWitness era] -> [ScriptWitness WitCtxTxIn era])
-> [SpendScriptWitness era] -> [ScriptWitness WitCtxTxIn era]
forall a b. (a -> b) -> a -> b
$ ((TxIn, Maybe (SpendScriptWitness era))
 -> Maybe (SpendScriptWitness era))
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [SpendScriptWitness era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TxIn, Maybe (SpendScriptWitness era))
-> Maybe (SpendScriptWitness era)
forall a b. (a, b) -> b
snd [(TxIn, Maybe (SpendScriptWitness era))]
inputsAndMaybeScriptWits)
              ((MintScriptWitnessWithPolicyId era -> ScriptWitness WitCtxMint era)
-> [MintScriptWitnessWithPolicyId era]
-> [ScriptWitness WitCtxMint era]
forall a b. (a -> b) -> [a] -> [b]
map MintScriptWitnessWithPolicyId era -> ScriptWitness WitCtxMint era
forall era.
MintScriptWitnessWithPolicyId era -> ScriptWitness WitCtxMint era
mswScriptWitness ([MintScriptWitnessWithPolicyId era]
 -> [ScriptWitness WitCtxMint era])
-> [MintScriptWitnessWithPolicyId era]
-> [ScriptWitness WitCtxMint era]
forall a b. (a -> b) -> a -> b
$ (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [MintScriptWitnessWithPolicyId era]
forall a b. (a, b) -> b
snd (MultiAsset, [MintScriptWitnessWithPolicyId era])
valuesWithScriptWits)
              (((Certificate (LedgerEra era), AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits)
              (((StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
 -> Maybe (WithdrawalScriptWitness era))
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [WithdrawalScriptWitness era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(StakeAddress
_, Lovelace
_, Maybe (WithdrawalScriptWitness era)
mSwit) -> Maybe (WithdrawalScriptWitness era)
mSwit) [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawals)
              (((VotingProcedures era, Maybe (VoteScriptWitness era))
 -> Maybe (VoteScriptWitness era))
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [VoteScriptWitness era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (VotingProcedures era, Maybe (VoteScriptWitness era))
-> Maybe (VoteScriptWitness era)
forall a b. (a, b) -> b
snd [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProcedures)
              (((Proposal era, Maybe (ProposalScriptWitness era))
 -> Maybe (ProposalScriptWitness era))
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> [ProposalScriptWitness era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Proposal era, Maybe (ProposalScriptWitness era))
-> Maybe (ProposalScriptWitness era)
forall a b. (a, b) -> b
snd [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals)
              [TxIn]
readOnlyRefIns

      let validatedCollateralTxIns :: TxInsCollateral era
validatedCollateralTxIns = forall era. IsEra era => [TxIn] -> TxInsCollateral era
validateTxInsCollateral @era [TxIn]
txinsc
      -- TODO The last argument of validateTxInsReference is a datum set from reference inputs
      -- Should we allow providing of datum from CLI?
      let validatedRefInputs :: TxInsReference BuildTx era
validatedRefInputs = forall build era.
(Applicative (BuildTxWith build), IsEra era) =>
[TxIn] -> Set ScriptRedeemer -> TxInsReference build era
validateTxInsReference @BuildTx @era [TxIn]
allReferenceInputs Set ScriptRedeemer
forall a. Monoid a => a
mempty
          validatedTotCollateral :: TxTotalCollateral era
validatedTotCollateral = forall era. IsEra era => Maybe Lovelace -> TxTotalCollateral era
validateTxTotalCollateral @era Maybe Lovelace
mTotCollateral
          validatedRetCol :: TxReturnCollateral CtxTx era
validatedRetCol = forall era.
IsEra era =>
Maybe (TxOut CtxTx era) -> TxReturnCollateral CtxTx era
validateTxReturnCollateral @era Maybe (TxOut CtxTx era)
mReturnCollateral
      let txFee :: TxFee era
txFee = ShelleyBasedEra era -> Lovelace -> TxFee era
forall era. ShelleyBasedEra era -> Lovelace -> TxFee era
TxFeeExplicit ShelleyBasedEra era
sbe Lovelace
fee
          validatedLowerBound :: TxValidityLowerBound era
validatedLowerBound = forall era. IsEra era => Maybe SlotNo -> TxValidityLowerBound era
validateTxValidityLowerBound @era Maybe SlotNo
mLowerBound
          validatedReqSigners :: TxExtraKeyWitnesses era
validatedReqSigners = forall era.
IsEra era =>
[Hash PaymentKey] -> TxExtraKeyWitnesses era
validateRequiredSigners @era [Hash PaymentKey]
reqSigners
          validatedTxScriptValidity :: TxScriptValidity era
validatedTxScriptValidity = forall era.
IsEra era =>
Maybe ScriptValidity -> TxScriptValidity era
validateTxScriptValidity @era Maybe ScriptValidity
mScriptValidity

      TxMintValue BuildTx era
validatedMintValue <- (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> Either TxCmdError (TxMintValue BuildTx era)
forall era.
IsEra era =>
(MultiAsset, [MintScriptWitnessWithPolicyId era])
-> Either TxCmdError (TxMintValue BuildTx era)
createTxMintValue (MultiAsset, [MintScriptWitnessWithPolicyId era])
valuesWithScriptWits
      TxVotingProcedures BuildTx era
validatedVotingProcedures :: TxVotingProcedures BuildTx era <-
        (VotesMergingConflict era -> TxCmdError)
-> Either
     (VotesMergingConflict era) (TxVotingProcedures BuildTx era)
-> Either TxCmdError (TxVotingProcedures 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 (TxGovDuplicateVotes era -> TxCmdError
forall era. TxGovDuplicateVotes era -> TxCmdError
TxCmdTxGovDuplicateVotes (TxGovDuplicateVotes era -> TxCmdError)
-> (VotesMergingConflict era -> TxGovDuplicateVotes era)
-> VotesMergingConflict era
-> TxCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotesMergingConflict era -> TxGovDuplicateVotes era
forall era. VotesMergingConflict era -> TxGovDuplicateVotes era
TxGovDuplicateVotes) (Either (VotesMergingConflict era) (TxVotingProcedures BuildTx era)
 -> Either TxCmdError (TxVotingProcedures BuildTx era))
-> Either
     (VotesMergingConflict era) (TxVotingProcedures BuildTx era)
-> Either TxCmdError (TxVotingProcedures BuildTx era)
forall a b. (a -> b) -> a -> b
$
          [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
-> Either
     (VotesMergingConflict era) (TxVotingProcedures BuildTx era)
forall build era.
Applicative (BuildTxWith build) =>
[(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
-> Either (VotesMergingConflict era) (TxVotingProcedures build era)
mkTxVotingProcedures [(VotingProcedures era
v, VoteScriptWitness era -> ScriptWitness WitCtxStake era
forall era. VoteScriptWitness era -> ScriptWitness WitCtxStake era
vswScriptWitness (VoteScriptWitness era -> ScriptWitness WitCtxStake era)
-> Maybe (VoteScriptWitness era)
-> Maybe (ScriptWitness WitCtxStake era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (VoteScriptWitness era)
mSwit) | (VotingProcedures era
v, Maybe (VoteScriptWitness era)
mSwit) <- [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProcedures]
      let txProposals :: Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
txProposals = ShelleyBasedEra era
-> (ConwayEraOnwards era
    -> Featured
         ConwayEraOnwards era (TxProposalProcedures BuildTx era))
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
forall (eon :: * -> *) era a.
Eon eon =>
ShelleyBasedEra era -> (eon era -> a) -> Maybe a
forShelleyBasedEraInEonMaybe ShelleyBasedEra era
sbe ((ConwayEraOnwards era
  -> Featured
       ConwayEraOnwards era (TxProposalProcedures BuildTx era))
 -> Maybe
      (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era)))
-> (ConwayEraOnwards era
    -> Featured
         ConwayEraOnwards era (TxProposalProcedures BuildTx era))
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
forall a b. (a -> b) -> a -> b
$ \ConwayEraOnwards era
w -> do
            let txp :: TxProposalProcedures BuildTx era
                txp :: TxProposalProcedures BuildTx era
txp =
                  ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    TxProposalProcedures BuildTx era)
-> TxProposalProcedures BuildTx era
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  TxProposalProcedures BuildTx era)
 -> TxProposalProcedures BuildTx era)
-> (ConwayEraOnwardsConstraints era =>
    TxProposalProcedures BuildTx era)
-> TxProposalProcedures BuildTx era
forall a b. (a -> b) -> a -> b
$
                    [(ProposalProcedure (ShelleyLedgerEra era),
  Maybe (ScriptWitness WitCtxStake era))]
-> TxProposalProcedures BuildTx era
forall era build.
(Applicative (BuildTxWith build), IsShelleyBasedEra era) =>
[(ProposalProcedure (ShelleyLedgerEra era),
  Maybe (ScriptWitness WitCtxStake era))]
-> TxProposalProcedures build era
mkTxProposalProcedures ([(ProposalProcedure (ShelleyLedgerEra era),
   Maybe (ScriptWitness WitCtxStake era))]
 -> TxProposalProcedures BuildTx era)
-> [(ProposalProcedure (ShelleyLedgerEra era),
     Maybe (ScriptWitness WitCtxStake era))]
-> TxProposalProcedures BuildTx era
forall a b. (a -> b) -> a -> b
$
                      [(ProposalProcedure (ShelleyLedgerEra era)
prop, ProposalScriptWitness era -> ScriptWitness WitCtxStake era
forall era.
ProposalScriptWitness era -> ScriptWitness WitCtxStake era
pswScriptWitness (ProposalScriptWitness era -> ScriptWitness WitCtxStake era)
-> Maybe (ProposalScriptWitness era)
-> Maybe (ScriptWitness WitCtxStake era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ProposalScriptWitness era)
mSwit) | (Proposal ProposalProcedure (ShelleyLedgerEra era)
prop, Maybe (ProposalScriptWitness era)
mSwit) <- [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals]
            ConwayEraOnwards era
-> TxProposalProcedures BuildTx era
-> Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era)
forall (eon :: * -> *) era a. eon era -> a -> Featured eon era a
Featured ConwayEraOnwards era
w TxProposalProcedures BuildTx era
txp

      let validatedCurrentTreasuryValue :: Maybe (Featured ConwayEraOnwards era (Maybe Lovelace))
validatedCurrentTreasuryValue = forall era.
IsEra era =>
Maybe TxCurrentTreasuryValue
-> Maybe (Featured ConwayEraOnwards era (Maybe Lovelace))
validateTxCurrentTreasuryValue @era ((TxCurrentTreasuryValue, TxTreasuryDonation)
-> TxCurrentTreasuryValue
forall a b. (a, b) -> a
fst ((TxCurrentTreasuryValue, TxTreasuryDonation)
 -> TxCurrentTreasuryValue)
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Maybe TxCurrentTreasuryValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation)
          validatedTreasuryDonation :: Maybe (Featured ConwayEraOnwards era Lovelace)
validatedTreasuryDonation = forall era.
IsEra era =>
Maybe TxTreasuryDonation
-> Maybe (Featured ConwayEraOnwards era Lovelace)
validateTxTreasuryDonation @era ((TxCurrentTreasuryValue, TxTreasuryDonation) -> TxTreasuryDonation
forall a b. (a, b) -> b
snd ((TxCurrentTreasuryValue, TxTreasuryDonation)
 -> TxTreasuryDonation)
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Maybe TxTreasuryDonation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation)
      TxBodyContent BuildTx era
-> Either TxCmdError (TxBodyContent BuildTx era)
forall a. a -> Either TxCmdError a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxBodyContent BuildTx era
 -> Either TxCmdError (TxBodyContent BuildTx era))
-> TxBodyContent BuildTx era
-> Either TxCmdError (TxBodyContent BuildTx era)
forall a b. (a -> b) -> a -> b
$
        ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints
          ShelleyBasedEra era
sbe
          ( ShelleyBasedEra era -> TxBodyContent BuildTx era
forall era. ShelleyBasedEra era -> TxBodyContent BuildTx era
defaultTxBodyContent ShelleyBasedEra era
sbe
              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 ([(TxIn, Maybe (SpendScriptWitness era))] -> TxIns BuildTx era
forall era.
[(TxIn, Maybe (SpendScriptWitness era))]
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns [(TxIn, Maybe (SpendScriptWitness era))]
inputsAndMaybeScriptWits)
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxInsCollateral era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
TxInsCollateral era
-> TxBodyContent build era -> TxBodyContent build era
setTxInsCollateral TxInsCollateral era
validatedCollateralTxIns
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxInsReference BuildTx era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall build era.
TxInsReference build era
-> TxBodyContent build era -> TxBodyContent build era
setTxInsReference TxInsReference BuildTx era
validatedRefInputs
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& [TxOut CtxTx era]
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
[TxOut CtxTx era]
-> TxBodyContent build era -> TxBodyContent build era
setTxOuts [TxOut CtxTx era]
txouts
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxTotalCollateral era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
TxTotalCollateral era
-> TxBodyContent build era -> TxBodyContent build era
setTxTotalCollateral TxTotalCollateral era
validatedTotCollateral
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxReturnCollateral CtxTx era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
TxReturnCollateral CtxTx era
-> TxBodyContent build era -> TxBodyContent build era
setTxReturnCollateral TxReturnCollateral CtxTx era
validatedRetCol
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxFee era -> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
TxFee era -> TxBodyContent build era -> TxBodyContent build era
setTxFee TxFee era
txFee
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxValidityLowerBound era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
TxValidityLowerBound era
-> TxBodyContent build era -> TxBodyContent build era
setTxValidityLowerBound TxValidityLowerBound era
validatedLowerBound
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxValidityUpperBound era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
TxValidityUpperBound era
-> TxBodyContent build era -> TxBodyContent build era
setTxValidityUpperBound TxValidityUpperBound era
mUpperBound
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxMetadataInEra era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
TxMetadataInEra era
-> TxBodyContent build era -> TxBodyContent build era
setTxMetadata TxMetadataInEra era
txMetadata
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxAuxScripts era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
TxAuxScripts era
-> TxBodyContent build era -> TxBodyContent build era
setTxAuxScripts TxAuxScripts era
txAuxScripts
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxExtraKeyWitnesses era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
TxExtraKeyWitnesses era
-> TxBodyContent build era -> TxBodyContent build era
setTxExtraKeyWits TxExtraKeyWitnesses era
validatedReqSigners
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall build era.
BuildTxWith build (Maybe (LedgerProtocolParameters era))
-> TxBodyContent build era -> TxBodyContent build era
setTxProtocolParams
                (Maybe (LedgerProtocolParameters era)
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Maybe (LedgerProtocolParameters era)
 -> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era)))
-> Maybe (LedgerProtocolParameters era)
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))
forall a b. (a -> b) -> a -> b
$ PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters (PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era)
-> (PParams (LedgerEra era) -> PParams (ShelleyLedgerEra era))
-> PParams (LedgerEra era)
-> LedgerProtocolParameters era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Era era
-> PParams (LedgerEra era) -> PParams (ShelleyLedgerEra era)
forall era.
Era era
-> PParams (LedgerEra era) -> PParams (ShelleyLedgerEra era)
toShelleyLedgerPParamsShim Era era
forall era. IsEra era => Era era
Exp.useEra (PParams (LedgerEra era) -> LedgerProtocolParameters era)
-> Maybe (PParams (LedgerEra era))
-> Maybe (LedgerProtocolParameters era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PParams (LedgerEra era))
mPparams)
              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 (ShelleyBasedEra era
-> [(StakeAddress, Lovelace,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
-> TxWithdrawals BuildTx era
forall era build.
ShelleyBasedEra era
-> [(StakeAddress, Lovelace,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
TxWithdrawals ShelleyBasedEra era
sbe ([(StakeAddress, Lovelace,
   BuildTxWith BuildTx (Witness WitCtxStake era))]
 -> TxWithdrawals BuildTx era)
-> [(StakeAddress, Lovelace,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
-> TxWithdrawals BuildTx era
forall a b. (a -> b) -> a -> b
$ ((StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
 -> (StakeAddress, Lovelace,
     BuildTxWith BuildTx (Witness WitCtxStake era)))
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [(StakeAddress, Lovelace,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall a b. (a -> b) -> [a] -> [b]
map (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
-> (StakeAddress, Lovelace,
    BuildTxWith BuildTx (Witness WitCtxStake era))
convertWithdrawals [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawals)
              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 ([(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> TxCertificates BuildTx era
forall era.
IsEra era =>
[(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> TxCertificates BuildTx era
Exp.mkTxCertificates [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits)
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxUpdateProposal era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
TxUpdateProposal era
-> TxBodyContent build era -> TxBodyContent build era
setTxUpdateProposal TxUpdateProposal era
txUpdateProposal
              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
validatedMintValue
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& TxScriptValidity era
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
TxScriptValidity era
-> TxBodyContent build era -> TxBodyContent build era
setTxScriptValidity TxScriptValidity era
validatedTxScriptValidity
              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 (TxVotingProcedures BuildTx era
-> Maybe
     (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
forall (eon :: * -> *) era a.
(IsCardanoEra era, Eon eon) =>
a -> Maybe (Featured eon era a)
mkFeatured TxVotingProcedures BuildTx era
validatedVotingProcedures)
              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))
txProposals
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& Maybe (Featured ConwayEraOnwards era (Maybe Lovelace))
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
Maybe (Featured ConwayEraOnwards era (Maybe Lovelace))
-> TxBodyContent build era -> TxBodyContent build era
setTxCurrentTreasuryValue Maybe (Featured ConwayEraOnwards era (Maybe Lovelace))
validatedCurrentTreasuryValue
              TxBodyContent BuildTx era
-> (TxBodyContent BuildTx era -> TxBodyContent BuildTx era)
-> TxBodyContent BuildTx era
forall a b. a -> (a -> b) -> b
& Maybe (Featured ConwayEraOnwards era Lovelace)
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
forall era build.
Maybe (Featured ConwayEraOnwards era Lovelace)
-> TxBodyContent build era -> TxBodyContent build era
setTxTreasuryDonation Maybe (Featured ConwayEraOnwards era Lovelace)
validatedTreasuryDonation
          )
   where
    convertWithdrawals
      :: (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
      -> (StakeAddress, Lovelace, BuildTxWith BuildTx (Witness WitCtxStake era))
    convertWithdrawals :: (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
-> (StakeAddress, Lovelace,
    BuildTxWith BuildTx (Witness WitCtxStake era))
convertWithdrawals (StakeAddress
sAddr, Lovelace
ll, Maybe (WithdrawalScriptWitness era)
mScriptWitnessFiles) =
      case Maybe (WithdrawalScriptWitness era)
mScriptWitnessFiles of
        Just WithdrawalScriptWitness era
sWit -> (StakeAddress
sAddr, Lovelace
ll, Witness WitCtxStake era
-> BuildTxWith BuildTx (Witness WitCtxStake era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxStake era
 -> BuildTxWith BuildTx (Witness WitCtxStake era))
-> Witness WitCtxStake era
-> BuildTxWith BuildTx (Witness WitCtxStake era)
forall a b. (a -> b) -> a -> b
$ ScriptWitnessInCtx WitCtxStake
-> ScriptWitness WitCtxStake era -> Witness WitCtxStake era
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxStake
ScriptWitnessForStakeAddr (ScriptWitness WitCtxStake era -> Witness WitCtxStake era)
-> ScriptWitness WitCtxStake era -> Witness WitCtxStake era
forall a b. (a -> b) -> a -> b
$ WithdrawalScriptWitness era -> ScriptWitness WitCtxStake era
forall era.
WithdrawalScriptWitness era -> ScriptWitness WitCtxStake era
wswScriptWitness WithdrawalScriptWitness era
sWit)
        Maybe (WithdrawalScriptWitness era)
Nothing -> (StakeAddress
sAddr, Lovelace
ll, Witness WitCtxStake era
-> BuildTxWith BuildTx (Witness WitCtxStake era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxStake era
 -> BuildTxWith BuildTx (Witness WitCtxStake era))
-> Witness WitCtxStake era
-> BuildTxWith BuildTx (Witness WitCtxStake era)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxStake -> Witness WitCtxStake era
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxStake
KeyWitnessForStakeAddr)

runTxBuild
  :: forall era
   . Exp.IsEra era
  => SocketPath
  -> NetworkId
  -> Maybe ScriptValidity
  -- ^ Mark script as expected to pass or fail validation
  -> [(TxIn, Maybe (SpendScriptWitness era))]
  -- ^ Read only reference inputs
  -> [TxIn]
  -- ^ TxIn with potential script witness
  -> [TxIn]
  -- ^ TxIn for collateral
  -> Maybe (TxOut CtxTx era)
  -- ^ Return collateral
  -> Maybe Lovelace
  -- ^ Total collateral
  -> [TxOut CtxTx era]
  -- ^ Normal outputs
  -> TxOutChangeAddress
  -- ^ A change output
  -> (L.MultiAsset, [MintScriptWitnessWithPolicyId era])
  -- ^ Multi-Asset value(s)
  -> Maybe SlotNo
  -- ^ Tx lower bound
  -> TxValidityUpperBound era
  -- ^ Tx upper bound
  -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
  -> [Hash PaymentKey]
  -- ^ Required signers
  -> TxAuxScripts era
  -> TxMetadataInEra era
  -> TxUpdateProposal era
  -> Maybe Word
  -> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
  -> [(Proposal era, Maybe (ProposalScriptWitness era))]
  -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
  -- ^ The current treasury value and the donation.
  -> ExceptT TxCmdError IO (BalancedTxBody era)
runTxBuild :: forall era.
IsEra era =>
SocketPath
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> TxOutChangeAddress
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> Maybe SlotNo
-> TxValidityUpperBound era
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> Maybe Word
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> ExceptT TxCmdError IO (BalancedTxBody era)
runTxBuild
  SocketPath
socketPath
  NetworkId
networkId
  Maybe ScriptValidity
mScriptValidity
  [(TxIn, Maybe (SpendScriptWitness era))]
inputsAndMaybeScriptWits
  [TxIn]
readOnlyRefIns
  [TxIn]
txinsc
  Maybe (TxOut CtxTx era)
mReturnCollateral
  Maybe Lovelace
mTotCollateral
  [TxOut CtxTx era]
txouts
  (TxOutChangeAddress AddressAny
changeAddr)
  (MultiAsset, [MintScriptWitnessWithPolicyId era])
mintValueWithScriptWits
  Maybe SlotNo
mLowerBound
  TxValidityUpperBound era
mUpperBound
  [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
  [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawals
  [Hash PaymentKey]
reqSigners
  TxAuxScripts era
txAuxScripts
  TxMetadataInEra era
txMetadata
  TxUpdateProposal era
txUpdateProposal
  Maybe Word
mOverrideWits
  [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProcedures
  [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals
  Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation = do
    let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (forall era. IsEra era => Era era
Exp.useEra @era)
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    ExceptT TxCmdError IO (BalancedTxBody era))
-> ExceptT TxCmdError IO (BalancedTxBody era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  ExceptT TxCmdError IO (BalancedTxBody era))
 -> ExceptT TxCmdError IO (BalancedTxBody era))
-> (ShelleyBasedEraConstraints era =>
    ExceptT TxCmdError IO (BalancedTxBody era))
-> ExceptT TxCmdError IO (BalancedTxBody era)
forall a b. (a -> b) -> a -> b
$ do
      -- TODO: All functions should be parameterized by ShelleyBasedEra
      -- as it's not possible to call this function with ByronEra
      let era :: CardanoEra era
era = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
sbe
          inputsThatRequireWitnessing :: [TxIn]
inputsThatRequireWitnessing = [TxIn
input | (TxIn
input, Maybe (SpendScriptWitness era)
_) <- [(TxIn, Maybe (SpendScriptWitness era))]
inputsAndMaybeScriptWits]

      let allReferenceInputs :: [TxIn]
allReferenceInputs =
            [ScriptWitness WitCtxTxIn era]
-> [ScriptWitness WitCtxMint era]
-> [AnyWitness (LedgerEra era)]
-> [WithdrawalScriptWitness era]
-> [VoteScriptWitness era]
-> [ProposalScriptWitness era]
-> [TxIn]
-> [TxIn]
forall era.
[ScriptWitness WitCtxTxIn era]
-> [ScriptWitness WitCtxMint era]
-> [AnyWitness (LedgerEra era)]
-> [WithdrawalScriptWitness era]
-> [VoteScriptWitness era]
-> [ProposalScriptWitness era]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
              ((SpendScriptWitness era -> ScriptWitness WitCtxTxIn era)
-> [SpendScriptWitness era] -> [ScriptWitness WitCtxTxIn era]
forall a b. (a -> b) -> [a] -> [b]
map SpendScriptWitness era -> ScriptWitness WitCtxTxIn era
forall era. SpendScriptWitness era -> ScriptWitness WitCtxTxIn era
sswScriptWitness ([SpendScriptWitness era] -> [ScriptWitness WitCtxTxIn era])
-> [SpendScriptWitness era] -> [ScriptWitness WitCtxTxIn era]
forall a b. (a -> b) -> a -> b
$ ((TxIn, Maybe (SpendScriptWitness era))
 -> Maybe (SpendScriptWitness era))
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [SpendScriptWitness era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TxIn, Maybe (SpendScriptWitness era))
-> Maybe (SpendScriptWitness era)
forall a b. (a, b) -> b
snd [(TxIn, Maybe (SpendScriptWitness era))]
inputsAndMaybeScriptWits)
              ((MintScriptWitnessWithPolicyId era -> ScriptWitness WitCtxMint era)
-> [MintScriptWitnessWithPolicyId era]
-> [ScriptWitness WitCtxMint era]
forall a b. (a -> b) -> [a] -> [b]
map MintScriptWitnessWithPolicyId era -> ScriptWitness WitCtxMint era
forall era.
MintScriptWitnessWithPolicyId era -> ScriptWitness WitCtxMint era
mswScriptWitness ([MintScriptWitnessWithPolicyId era]
 -> [ScriptWitness WitCtxMint era])
-> [MintScriptWitnessWithPolicyId era]
-> [ScriptWitness WitCtxMint era]
forall a b. (a -> b) -> a -> b
$ (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [MintScriptWitnessWithPolicyId era]
forall a b. (a, b) -> b
snd (MultiAsset, [MintScriptWitnessWithPolicyId era])
mintValueWithScriptWits)
              (((Certificate (LedgerEra era), AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits)
              (((StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))
 -> Maybe (WithdrawalScriptWitness era))
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [WithdrawalScriptWitness era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(StakeAddress
_, Lovelace
_, Maybe (WithdrawalScriptWitness era)
mSwit) -> Maybe (WithdrawalScriptWitness era)
mSwit) [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawals)
              (((VotingProcedures era, Maybe (VoteScriptWitness era))
 -> Maybe (VoteScriptWitness era))
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [VoteScriptWitness era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (VotingProcedures era, Maybe (VoteScriptWitness era))
-> Maybe (VoteScriptWitness era)
forall a b. (a, b) -> b
snd [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProcedures)
              (((Proposal era, Maybe (ProposalScriptWitness era))
 -> Maybe (ProposalScriptWitness era))
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> [ProposalScriptWitness era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Proposal era, Maybe (ProposalScriptWitness era))
-> Maybe (ProposalScriptWitness era)
forall a b. (a, b) -> b
snd [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals)
              [TxIn]
readOnlyRefIns

      let allTxInputs :: [TxIn]
allTxInputs = [TxIn]
inputsThatRequireWitnessing [TxIn] -> [TxIn] -> [TxIn]
forall a. [a] -> [a] -> [a]
++ [TxIn]
allReferenceInputs [TxIn] -> [TxIn] -> [TxIn]
forall a. [a] -> [a] -> [a]
++ [TxIn]
txinsc
          localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo =
            LocalNodeConnectInfo
              { localConsensusModeParams :: ConsensusModeParams
localConsensusModeParams = EpochSlots -> ConsensusModeParams
CardanoModeParams (EpochSlots -> ConsensusModeParams)
-> EpochSlots -> ConsensusModeParams
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochSlots
EpochSlots Word64
21600
              , localNodeNetworkId :: NetworkId
localNodeNetworkId = NetworkId
networkId
              , localNodeSocketPath :: SocketPath
localNodeSocketPath = SocketPath
socketPath
              }

      AnyCardanoEra CardanoEra era
nodeEra <-
        IO
  (Either
     AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
-> ExceptT
     TxCmdError
     IO
     (Either
        AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TxCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError AnyCardanoEra)
-> IO
     (Either
        AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
forall point. Target point
Consensus.VolatileTip LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
queryCurrentEra)
          ExceptT
  TxCmdError
  IO
  (Either
     AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
-> (ExceptT
      TxCmdError
      IO
      (Either
         AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
    -> ExceptT
         TxCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra))
-> ExceptT
     TxCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra)
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      TxCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra))
-> ExceptT
     TxCmdError
     IO
     (Either
        AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
-> ExceptT
     TxCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError
-> ExceptT
     TxCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError
 -> ExceptT
      TxCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra))
-> (AcquiringFailure -> TxCmdError)
-> AcquiringFailure
-> ExceptT
     TxCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConvenienceError -> TxCmdError
TxCmdQueryConvenienceError (QueryConvenienceError -> TxCmdError)
-> (AcquiringFailure -> QueryConvenienceError)
-> AcquiringFailure
-> TxCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryConvenienceError
AcqFailure)
          ExceptT
  TxCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra)
-> (ExceptT
      TxCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra)
    -> ExceptT TxCmdError IO AnyCardanoEra)
-> ExceptT TxCmdError IO AnyCardanoEra
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError -> ExceptT TxCmdError IO AnyCardanoEra)
-> ExceptT
     TxCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra)
-> ExceptT TxCmdError IO AnyCardanoEra
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError -> ExceptT TxCmdError IO AnyCardanoEra
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError -> ExceptT TxCmdError IO AnyCardanoEra)
-> (UnsupportedNtcVersionError -> TxCmdError)
-> UnsupportedNtcVersionError
-> ExceptT TxCmdError IO AnyCardanoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConvenienceError -> TxCmdError
TxCmdQueryConvenienceError (QueryConvenienceError -> TxCmdError)
-> (UnsupportedNtcVersionError -> QueryConvenienceError)
-> UnsupportedNtcVersionError
-> TxCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion)

      era :~: era
Refl <-
        CardanoEra era -> CardanoEra era -> Maybe (era :~: era)
forall a b. CardanoEra a -> CardanoEra b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality CardanoEra era
era CardanoEra era
nodeEra
          Maybe (era :~: era)
-> (Maybe (era :~: era) -> ExceptT TxCmdError IO (era :~: era))
-> ExceptT TxCmdError IO (era :~: era)
forall a b. a -> (a -> b) -> b
& TxCmdError
-> Maybe (era :~: era) -> ExceptT TxCmdError IO (era :~: era)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (NodeEraMismatchError -> TxCmdError
TxCmdTxNodeEraMismatchError (NodeEraMismatchError -> TxCmdError)
-> NodeEraMismatchError -> TxCmdError
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEra era -> NodeEraMismatchError
forall era nodeEra.
CardanoEra era -> CardanoEra nodeEra -> NodeEraMismatchError
NodeEraMismatchError CardanoEra era
era CardanoEra era
nodeEra)

      let certsToQuery :: [Certificate era]
certsToQuery = (Certificate (LedgerEra era) -> Certificate era)
-> [Certificate (LedgerEra era)] -> [Certificate era]
forall a b. (a -> b) -> [a] -> [b]
map (Era era -> Certificate (LedgerEra era) -> Certificate era
forall era.
Era era -> Certificate (LedgerEra era) -> Certificate era
Exp.convertToOldApiCertificate Era era
forall era. IsEra era => Era era
Exp.useEra) ([Certificate (LedgerEra era)] -> [Certificate era])
-> [Certificate (LedgerEra era)] -> [Certificate era]
forall a b. (a -> b) -> a -> b
$ (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a, b) -> a
fst ((Certificate (LedgerEra era), AnyWitness (LedgerEra era))
 -> Certificate (LedgerEra era))
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [Certificate (LedgerEra era)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
      (UTxO era
txEraUtxo, LedgerProtocolParameters era
pparams, EraHistory
eraHistory, SystemStart
systemStart, Set PoolId
stakePools, Map StakeCredential Lovelace
stakeDelegDeposits, Map (Credential 'DRepRole) (CompactForm Lovelace)
drepDelegDeposits, Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
_) <-
        IO
  (Either
     AcquiringFailure
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
-> ExceptT
     TxCmdError
     IO
     (Either
        AcquiringFailure
        (Either
           QueryConvenienceError
           (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
            Set PoolId, Map StakeCredential Lovelace,
            Map (Credential 'DRepRole) (CompactForm Lovelace),
            Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TxCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
          ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> IO
     (Either
        AcquiringFailure
        (Either
           QueryConvenienceError
           (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
            Set PoolId, Map StakeCredential Lovelace,
            Map (Credential 'DRepRole) (CompactForm Lovelace),
            Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
forall point. Target point
Consensus.VolatileTip (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      QueryConvenienceError
      (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
       Set PoolId, Map StakeCredential Lovelace,
       Map (Credential 'DRepRole) (CompactForm Lovelace),
       Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
 -> IO
      (Either
         AcquiringFailure
         (Either
            QueryConvenienceError
            (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
             Set PoolId, Map StakeCredential Lovelace,
             Map (Credential 'DRepRole) (CompactForm Lovelace),
             Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> IO
     (Either
        AcquiringFailure
        (Either
           QueryConvenienceError
           (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
            Set PoolId, Map StakeCredential Lovelace,
            Map (Credential 'DRepRole) (CompactForm Lovelace),
            Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
forall a b. (a -> b) -> a -> b
$
              CardanoEra era
-> [TxIn]
-> [Certificate era]
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
forall era block point r.
CardanoEra era
-> [TxIn]
-> [Certificate era]
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
queryStateForBalancedTx CardanoEra era
nodeEra [TxIn]
allTxInputs [Certificate era]
certsToQuery
          )
          ExceptT
  TxCmdError
  IO
  (Either
     AcquiringFailure
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
-> (ExceptT
      TxCmdError
      IO
      (Either
         AcquiringFailure
         (Either
            QueryConvenienceError
            (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
             Set PoolId, Map StakeCredential Lovelace,
             Map (Credential 'DRepRole) (CompactForm Lovelace),
             Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
    -> ExceptT
         TxCmdError
         IO
         (Either
            QueryConvenienceError
            (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
             Set PoolId, Map StakeCredential Lovelace,
             Map (Credential 'DRepRole) (CompactForm Lovelace),
             Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
-> ExceptT
     TxCmdError
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      TxCmdError
      IO
      (Either
         QueryConvenienceError
         (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
          Set PoolId, Map StakeCredential Lovelace,
          Map (Credential 'DRepRole) (CompactForm Lovelace),
          Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
-> ExceptT
     TxCmdError
     IO
     (Either
        AcquiringFailure
        (Either
           QueryConvenienceError
           (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
            Set PoolId, Map StakeCredential Lovelace,
            Map (Credential 'DRepRole) (CompactForm Lovelace),
            Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
-> ExceptT
     TxCmdError
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError
-> ExceptT
     TxCmdError
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError
 -> ExceptT
      TxCmdError
      IO
      (Either
         QueryConvenienceError
         (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
          Set PoolId, Map StakeCredential Lovelace,
          Map (Credential 'DRepRole) (CompactForm Lovelace),
          Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
-> (AcquiringFailure -> TxCmdError)
-> AcquiringFailure
-> ExceptT
     TxCmdError
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConvenienceError -> TxCmdError
TxCmdQueryConvenienceError (QueryConvenienceError -> TxCmdError)
-> (AcquiringFailure -> QueryConvenienceError)
-> AcquiringFailure
-> TxCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryConvenienceError
AcqFailure)
          ExceptT
  TxCmdError
  IO
  (Either
     QueryConvenienceError
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Lovelace,
      Map (Credential 'DRepRole) (CompactForm Lovelace),
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> (ExceptT
      TxCmdError
      IO
      (Either
         QueryConvenienceError
         (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
          Set PoolId, Map StakeCredential Lovelace,
          Map (Credential 'DRepRole) (CompactForm Lovelace),
          Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
    -> ExceptT
         TxCmdError
         IO
         (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
          Set PoolId, Map StakeCredential Lovelace,
          Map (Credential 'DRepRole) (CompactForm Lovelace),
          Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> ExceptT
     TxCmdError
     IO
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Lovelace,
      Map (Credential 'DRepRole) (CompactForm Lovelace),
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall a b. a -> (a -> b) -> b
& (QueryConvenienceError
 -> ExceptT
      TxCmdError
      IO
      (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
       Set PoolId, Map StakeCredential Lovelace,
       Map (Credential 'DRepRole) (CompactForm Lovelace),
       Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> ExceptT
     TxCmdError
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Lovelace,
         Map (Credential 'DRepRole) (CompactForm Lovelace),
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> ExceptT
     TxCmdError
     IO
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Lovelace,
      Map (Credential 'DRepRole) (CompactForm Lovelace),
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError
-> ExceptT
     TxCmdError
     IO
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Lovelace,
      Map (Credential 'DRepRole) (CompactForm Lovelace),
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError
 -> ExceptT
      TxCmdError
      IO
      (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
       Set PoolId, Map StakeCredential Lovelace,
       Map (Credential 'DRepRole) (CompactForm Lovelace),
       Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> (QueryConvenienceError -> TxCmdError)
-> QueryConvenienceError
-> ExceptT
     TxCmdError
     IO
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Lovelace,
      Map (Credential 'DRepRole) (CompactForm Lovelace),
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConvenienceError -> TxCmdError
TxCmdQueryConvenienceError)

      TxBodyContent BuildTx era
txBodyContent <-
        Either TxCmdError (TxBodyContent BuildTx era)
-> ExceptT TxCmdError IO (TxBodyContent BuildTx era)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TxCmdError (TxBodyContent BuildTx era)
 -> ExceptT TxCmdError IO (TxBodyContent BuildTx era))
-> Either TxCmdError (TxBodyContent BuildTx era)
-> ExceptT TxCmdError IO (TxBodyContent BuildTx era)
forall a b. (a -> b) -> a -> b
$
          Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent BuildTx era)
forall era.
IsEra era =>
Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [MintScriptWitnessWithPolicyId era])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent BuildTx era)
constructTxBodyContent
            Maybe ScriptValidity
mScriptValidity
            (PParams (LedgerEra era) -> Maybe (PParams (LedgerEra era))
forall a. a -> Maybe a
Just (PParams (LedgerEra era) -> Maybe (PParams (LedgerEra era)))
-> PParams (LedgerEra era) -> Maybe (PParams (LedgerEra era))
forall a b. (a -> b) -> a -> b
$ Era era
-> PParams (ShelleyLedgerEra era) -> PParams (LedgerEra era)
forall era.
Era era
-> PParams (ShelleyLedgerEra era) -> PParams (LedgerEra era)
fromShelleyLedgerPParamsShim Era era
forall era. IsEra era => Era era
Exp.useEra (PParams (ShelleyLedgerEra era) -> PParams (LedgerEra era))
-> PParams (ShelleyLedgerEra era) -> PParams (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ LedgerProtocolParameters era -> PParams (ShelleyLedgerEra era)
forall era.
LedgerProtocolParameters era -> PParams (ShelleyLedgerEra era)
unLedgerProtocolParameters LedgerProtocolParameters era
pparams)
            [(TxIn, Maybe (SpendScriptWitness era))]
inputsAndMaybeScriptWits
            [TxIn]
readOnlyRefIns
            [TxIn]
txinsc
            Maybe (TxOut CtxTx era)
mReturnCollateral
            Maybe Lovelace
mTotCollateral
            [TxOut CtxTx era]
txouts
            Maybe SlotNo
mLowerBound
            TxValidityUpperBound era
mUpperBound
            (MultiAsset, [MintScriptWitnessWithPolicyId era])
mintValueWithScriptWits
            [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
            [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))]
withdrawals
            [Hash PaymentKey]
reqSigners
            Lovelace
0
            TxAuxScripts era
txAuxScripts
            TxMetadataInEra era
txMetadata
            TxUpdateProposal era
txUpdateProposal
            [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votingProcedures
            [(Proposal era, Maybe (ProposalScriptWitness era))]
proposals
            Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation

      (TxInsExistError -> TxCmdError)
-> ExceptT TxInsExistError IO () -> ExceptT TxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT TxInsExistError -> TxCmdError
TxCmdTxInsDoNotExist
        (ExceptT TxInsExistError IO () -> ExceptT TxCmdError IO ())
-> (Either TxInsExistError () -> ExceptT TxInsExistError IO ())
-> Either TxInsExistError ()
-> ExceptT TxCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TxInsExistError () -> ExceptT TxInsExistError IO ()
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
        (Either TxInsExistError () -> ExceptT TxCmdError IO ())
-> Either TxInsExistError () -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ [TxIn] -> UTxO era -> Either TxInsExistError ()
forall era. [TxIn] -> UTxO era -> Either TxInsExistError ()
txInsExistInUTxO [TxIn]
allTxInputs UTxO era
txEraUtxo
      (ScriptLockedTxInsError -> TxCmdError)
-> ExceptT ScriptLockedTxInsError IO () -> ExceptT TxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptLockedTxInsError -> TxCmdError
TxCmdQueryNotScriptLocked
        (ExceptT ScriptLockedTxInsError IO () -> ExceptT TxCmdError IO ())
-> (Either ScriptLockedTxInsError ()
    -> ExceptT ScriptLockedTxInsError IO ())
-> Either ScriptLockedTxInsError ()
-> ExceptT TxCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ScriptLockedTxInsError ()
-> ExceptT ScriptLockedTxInsError IO ()
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
        (Either ScriptLockedTxInsError () -> ExceptT TxCmdError IO ())
-> Either ScriptLockedTxInsError () -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ [TxIn] -> UTxO era -> Either ScriptLockedTxInsError ()
forall era. [TxIn] -> UTxO era -> Either ScriptLockedTxInsError ()
notScriptLockedTxIns [TxIn]
txinsc UTxO era
txEraUtxo

      AddressInEra era
cAddr <-
        Either FilePath (AddressInEra era)
-> ExceptT TxCmdError IO (Either FilePath (AddressInEra era))
forall a. a -> ExceptT TxCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CardanoEra era -> AddressAny -> Either FilePath (AddressInEra era)
forall era.
CardanoEra era -> AddressAny -> Either FilePath (AddressInEra era)
anyAddressInEra CardanoEra era
era AddressAny
changeAddr)
          ExceptT TxCmdError IO (Either FilePath (AddressInEra era))
-> (ExceptT TxCmdError IO (Either FilePath (AddressInEra era))
    -> ExceptT TxCmdError IO (AddressInEra era))
-> ExceptT TxCmdError IO (AddressInEra era)
forall a b. a -> (a -> b) -> b
& (FilePath -> ExceptT TxCmdError IO (AddressInEra era))
-> ExceptT TxCmdError IO (Either FilePath (AddressInEra era))
-> ExceptT TxCmdError IO (AddressInEra era)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (FilePath -> FilePath -> ExceptT TxCmdError IO (AddressInEra era)
forall a. HasCallStack => FilePath -> a
error (FilePath -> FilePath -> ExceptT TxCmdError IO (AddressInEra era))
-> FilePath -> FilePath -> ExceptT TxCmdError IO (AddressInEra era)
forall a b. (a -> b) -> a -> b
$ FilePath
"runTxBuild: Byron address used: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> AddressAny -> FilePath
forall a. Show a => a -> FilePath
show AddressAny
changeAddr) -- should this throw instead?
      balancedTxBody :: BalancedTxBody era
balancedTxBody@(BalancedTxBody TxBodyContent BuildTx era
_ TxBody era
_ TxOut CtxTx era
_ Lovelace
fee) <-
        (TxBodyErrorAutoBalance era -> TxCmdError)
-> ExceptT (TxBodyErrorAutoBalance era) IO (BalancedTxBody era)
-> ExceptT TxCmdError IO (BalancedTxBody era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (AnyTxBodyErrorAutoBalance -> TxCmdError
TxCmdBalanceTxBody (AnyTxBodyErrorAutoBalance -> TxCmdError)
-> (TxBodyErrorAutoBalance era -> AnyTxBodyErrorAutoBalance)
-> TxBodyErrorAutoBalance era
-> TxCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBodyErrorAutoBalance era -> AnyTxBodyErrorAutoBalance
forall era. TxBodyErrorAutoBalance era -> AnyTxBodyErrorAutoBalance
AnyTxBodyErrorAutoBalance)
          (ExceptT (TxBodyErrorAutoBalance era) IO (BalancedTxBody era)
 -> ExceptT TxCmdError IO (BalancedTxBody era))
-> (Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
    -> ExceptT (TxBodyErrorAutoBalance era) IO (BalancedTxBody era))
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
-> ExceptT TxCmdError IO (BalancedTxBody era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
-> ExceptT (TxBodyErrorAutoBalance era) IO (BalancedTxBody era)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
          (Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
 -> ExceptT TxCmdError IO (BalancedTxBody era))
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
-> ExceptT TxCmdError IO (BalancedTxBody era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> Set PoolId
-> Map StakeCredential Lovelace
-> Map (Credential 'DRepRole) Lovelace
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
forall era.
HasCallStack =>
ShelleyBasedEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> Set PoolId
-> Map StakeCredential Lovelace
-> Map (Credential 'DRepRole) Lovelace
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
makeTransactionBodyAutoBalance
            ShelleyBasedEra era
sbe
            SystemStart
systemStart
            (EraHistory -> LedgerEpochInfo
toLedgerEpochInfo EraHistory
eraHistory)
            LedgerProtocolParameters era
LedgerProtocolParameters era
pparams
            Set PoolId
stakePools
            Map StakeCredential Lovelace
stakeDelegDeposits
            ((CompactForm Lovelace -> Lovelace)
-> Map (Credential 'DRepRole) (CompactForm Lovelace)
-> Map (Credential 'DRepRole) Lovelace
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map CompactForm Lovelace -> Lovelace
forall a. Compactible a => CompactForm a -> a
L.fromCompact Map (Credential 'DRepRole) (CompactForm Lovelace)
drepDelegDeposits)
            UTxO era
UTxO era
txEraUtxo
            TxBodyContent BuildTx era
txBodyContent
            AddressInEra era
cAddr
            Maybe Word
mOverrideWits

      IO () -> ExceptT TxCmdError IO ()
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT TxCmdError IO ())
-> (Doc AnsiStyle -> IO ())
-> Doc AnsiStyle
-> ExceptT TxCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
putStrLn (FilePath -> IO ())
-> (Doc AnsiStyle -> FilePath) -> Doc AnsiStyle -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> FilePath
docToString (Doc AnsiStyle -> ExceptT TxCmdError IO ())
-> Doc AnsiStyle -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Estimated transaction fee:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lovelace -> Doc AnsiStyle
forall ann. Lovelace -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Lovelace
fee

      BalancedTxBody era -> ExceptT TxCmdError IO (BalancedTxBody era)
forall a. a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BalancedTxBody era
balancedTxBody

-- ----------------------------------------------------------------------------
-- Transaction body validation and conversion
--

validateTxIns
  :: [(TxIn, Maybe (SpendScriptWitness era))]
  -> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns :: forall era.
[(TxIn, Maybe (SpendScriptWitness era))]
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns = ((TxIn, Maybe (SpendScriptWitness era))
 -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)))
-> [(TxIn, Maybe (SpendScriptWitness era))]
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, Maybe (SpendScriptWitness era))
-> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
forall era.
(TxIn, Maybe (SpendScriptWitness era))
-> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
convertTxIn
 where
  convertTxIn
    :: (TxIn, Maybe (SpendScriptWitness era))
    -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
  convertTxIn :: forall era.
(TxIn, Maybe (SpendScriptWitness era))
-> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
convertTxIn (TxIn
txin, Maybe (SpendScriptWitness era)
mScriptWitness) =
    case Maybe (SpendScriptWitness era)
mScriptWitness of
      Just SpendScriptWitness era
sWit ->
        (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))
-> Witness WitCtxTxIn era
-> BuildTxWith BuildTx (Witness WitCtxTxIn era)
forall a b. (a -> b) -> a -> b
$ ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn era -> Witness WitCtxTxIn era
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
ScriptWitnessForSpending (ScriptWitness WitCtxTxIn era -> Witness WitCtxTxIn era)
-> ScriptWitness WitCtxTxIn era -> Witness WitCtxTxIn era
forall a b. (a -> b) -> a -> b
$ SpendScriptWitness era -> ScriptWitness WitCtxTxIn era
forall era. SpendScriptWitness era -> ScriptWitness WitCtxTxIn era
sswScriptWitness SpendScriptWitness era
sWit)
      Maybe (SpendScriptWitness era)
Nothing ->
        (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))
-> Witness WitCtxTxIn era
-> BuildTxWith BuildTx (Witness WitCtxTxIn era)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn era
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxTxIn
KeyWitnessForSpending)

validateTxInsCollateral
  :: Exp.IsEra era
  => [TxIn]
  -> TxInsCollateral era
validateTxInsCollateral :: forall era. IsEra era => [TxIn] -> TxInsCollateral era
validateTxInsCollateral [] = TxInsCollateral era
forall era. TxInsCollateral era
TxInsCollateralNone
validateTxInsCollateral [TxIn]
txins =
  AlonzoEraOnwards era -> [TxIn] -> TxInsCollateral era
forall era. AlonzoEraOnwards era -> [TxIn] -> TxInsCollateral era
TxInsCollateral (Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra) [TxIn]
txins

validateTxInsReference
  :: (Applicative (BuildTxWith build), Exp.IsEra era)
  => [TxIn]
  -> Set HashableScriptData
  -> TxInsReference build era
validateTxInsReference :: forall build era.
(Applicative (BuildTxWith build), IsEra era) =>
[TxIn] -> Set ScriptRedeemer -> TxInsReference build era
validateTxInsReference [] Set ScriptRedeemer
_ = TxInsReference build era
forall build era. TxInsReference build era
TxInsReferenceNone
validateTxInsReference [TxIn]
allRefIns Set ScriptRedeemer
datumSet = BabbageEraOnwards era
-> [TxIn] -> TxInsReferenceDatums build -> TxInsReference build era
forall era build.
BabbageEraOnwards era
-> [TxIn] -> TxInsReferenceDatums build -> TxInsReference build era
TxInsReference (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra) [TxIn]
allRefIns (Set ScriptRedeemer -> TxInsReferenceDatums build
forall a. a -> BuildTxWith build a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set ScriptRedeemer
datumSet)

getAllReferenceInputs
  :: [ScriptWitness WitCtxTxIn era]
  -> [ScriptWitness WitCtxMint era]
  -> [Exp.AnyWitness (Exp.LedgerEra era)]
  -- \^ Certificate witnesses
  -> [WithdrawalScriptWitness era]
  -> [VoteScriptWitness era]
  -> [ProposalScriptWitness era]
  -> [TxIn]
  -- \^ Read only reference inputs
  -> [TxIn]
getAllReferenceInputs :: forall era.
[ScriptWitness WitCtxTxIn era]
-> [ScriptWitness WitCtxMint era]
-> [AnyWitness (LedgerEra era)]
-> [WithdrawalScriptWitness era]
-> [VoteScriptWitness era]
-> [ProposalScriptWitness era]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
  [ScriptWitness WitCtxTxIn era]
spendingWitnesses
  [ScriptWitness WitCtxMint era]
mintWitnesses
  [AnyWitness (LedgerEra era)]
certScriptWitnesses
  [WithdrawalScriptWitness era]
withdrawals
  [VoteScriptWitness era]
votingProceduresAndMaybeScriptWits
  [ProposalScriptWitness era]
propProceduresAnMaybeScriptWits
  [TxIn]
readOnlyRefIns = do
    let txinsWitByRefInputs :: [Maybe TxIn]
txinsWitByRefInputs = (ScriptWitness WitCtxTxIn era -> Maybe TxIn)
-> [ScriptWitness WitCtxTxIn era] -> [Maybe TxIn]
forall a b. (a -> b) -> [a] -> [b]
map ScriptWitness WitCtxTxIn era -> Maybe TxIn
forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getScriptWitnessReferenceInput [ScriptWitness WitCtxTxIn era]
spendingWitnesses
        mintingRefInputs :: [Maybe TxIn]
mintingRefInputs = (ScriptWitness WitCtxMint era -> Maybe TxIn)
-> [ScriptWitness WitCtxMint era] -> [Maybe TxIn]
forall a b. (a -> b) -> [a] -> [b]
map ScriptWitness WitCtxMint era -> Maybe TxIn
forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getScriptWitnessReferenceInput [ScriptWitness WitCtxMint era]
mintWitnesses
        certsWitByRefInputs :: [Maybe TxIn]
certsWitByRefInputs = (AnyWitness (LedgerEra era) -> Maybe TxIn)
-> [AnyWitness (LedgerEra era)] -> [Maybe TxIn]
forall a b. (a -> b) -> [a] -> [b]
map AnyWitness (LedgerEra era) -> Maybe TxIn
forall era. AnyWitness era -> Maybe TxIn
getAnyWitnessReferenceInput [AnyWitness (LedgerEra era)]
certScriptWitnesses
        withdrawalsWitByRefInputs :: [Maybe TxIn]
withdrawalsWitByRefInputs = (WithdrawalScriptWitness era -> Maybe TxIn)
-> [WithdrawalScriptWitness era] -> [Maybe TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (ScriptWitness WitCtxStake era -> Maybe TxIn
forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getScriptWitnessReferenceInput (ScriptWitness WitCtxStake era -> Maybe TxIn)
-> (WithdrawalScriptWitness era -> ScriptWitness WitCtxStake era)
-> WithdrawalScriptWitness era
-> Maybe TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithdrawalScriptWitness era -> ScriptWitness WitCtxStake era
forall era.
WithdrawalScriptWitness era -> ScriptWitness WitCtxStake era
wswScriptWitness) [WithdrawalScriptWitness era]
withdrawals
        votesWitByRefInputs :: [Maybe TxIn]
votesWitByRefInputs = (VoteScriptWitness era -> Maybe TxIn)
-> [VoteScriptWitness era] -> [Maybe TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (ScriptWitness WitCtxStake era -> Maybe TxIn
forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getScriptWitnessReferenceInput (ScriptWitness WitCtxStake era -> Maybe TxIn)
-> (VoteScriptWitness era -> ScriptWitness WitCtxStake era)
-> VoteScriptWitness era
-> Maybe TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VoteScriptWitness era -> ScriptWitness WitCtxStake era
forall era. VoteScriptWitness era -> ScriptWitness WitCtxStake era
vswScriptWitness) [VoteScriptWitness era]
votingProceduresAndMaybeScriptWits
        propsWitByRefInputs :: [Maybe TxIn]
propsWitByRefInputs = (ProposalScriptWitness era -> Maybe TxIn)
-> [ProposalScriptWitness era] -> [Maybe TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (ScriptWitness WitCtxStake era -> Maybe TxIn
forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getScriptWitnessReferenceInput (ScriptWitness WitCtxStake era -> Maybe TxIn)
-> (ProposalScriptWitness era -> ScriptWitness WitCtxStake era)
-> ProposalScriptWitness era
-> Maybe TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposalScriptWitness era -> ScriptWitness WitCtxStake era
forall era.
ProposalScriptWitness era -> ScriptWitness WitCtxStake era
pswScriptWitness) [ProposalScriptWitness era]
propProceduresAnMaybeScriptWits

    ([Maybe TxIn] -> [TxIn]) -> [[Maybe TxIn]] -> [TxIn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
      [Maybe TxIn] -> [TxIn]
forall a. [Maybe a] -> [a]
catMaybes
      [ [Maybe TxIn]
txinsWitByRefInputs
      , [Maybe TxIn]
mintingRefInputs
      , [Maybe TxIn]
certsWitByRefInputs
      , [Maybe TxIn]
withdrawalsWitByRefInputs
      , [Maybe TxIn]
votesWitByRefInputs
      , [Maybe TxIn]
propsWitByRefInputs
      , (TxIn -> Maybe TxIn) -> [TxIn] -> [Maybe TxIn]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> Maybe TxIn
forall a. a -> Maybe a
Just [TxIn]
readOnlyRefIns
      ]

getAnyWitnessReferenceInput :: Exp.AnyWitness era -> Maybe TxIn
getAnyWitnessReferenceInput :: forall era. AnyWitness era -> Maybe TxIn
getAnyWitnessReferenceInput AnyWitness era
Exp.AnyKeyWitnessPlaceholder = Maybe TxIn
forall a. Maybe a
Nothing
getAnyWitnessReferenceInput Exp.AnySimpleScriptWitness{} = Maybe TxIn
forall a. Maybe a
Nothing
getAnyWitnessReferenceInput (Exp.AnyPlutusScriptWitness (Exp.PlutusScriptWitness SLanguage lang
_ (Exp.PReferenceScript TxIn
ref) PlutusScriptDatum lang purpose
_ ScriptRedeemer
_ ExecutionUnits
_)) = TxIn -> Maybe TxIn
forall a. a -> Maybe a
Just TxIn
ref
getAnyWitnessReferenceInput (Exp.AnyPlutusScriptWitness (Exp.PlutusScriptWitness SLanguage lang
_ (Exp.PScript{}) PlutusScriptDatum lang purpose
_ ScriptRedeemer
_ ExecutionUnits
_)) = Maybe TxIn
forall a. Maybe a
Nothing

toTxOutInShelleyBasedEra
  :: Exp.IsEra era
  => TxOutShelleyBasedEra
  -> CIO e (TxOut CtxTx era)
toTxOutInShelleyBasedEra :: forall era e.
IsEra era =>
TxOutShelleyBasedEra -> CIO e (TxOut CtxTx era)
toTxOutInShelleyBasedEra (TxOutShelleyBasedEra Address ShelleyAddr
addr' Value
val' TxOutDatumAnyEra
mDatumHash ReferenceScriptAnyEra
refScriptFp) = do
  let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra
      addr :: AddressInEra era
addr = ShelleyBasedEra era -> Address ShelleyAddr -> AddressInEra era
forall era.
ShelleyBasedEra era -> Address ShelleyAddr -> AddressInEra era
shelleyAddressInEra ShelleyBasedEra era
sbe Address ShelleyAddr
addr'
  ShelleyBasedEra era
-> AddressInEra era
-> Value
-> TxOutDatumAnyEra
-> ReferenceScriptAnyEra
-> CIO e (TxOut CtxTx era)
forall era e.
ShelleyBasedEra era
-> AddressInEra era
-> Value
-> TxOutDatumAnyEra
-> ReferenceScriptAnyEra
-> CIO e (TxOut CtxTx era)
mkTxOut ShelleyBasedEra era
sbe AddressInEra era
addr Value
val' TxOutDatumAnyEra
mDatumHash ReferenceScriptAnyEra
refScriptFp

-- TODO: Currently we specify the policyId with the '--mint' option on the cli
-- and we added a separate '--policy-id' parser that parses the policy id for the
-- given reference input (since we don't have the script in this case). To avoid asking
-- for the policy id twice (in the build command) we can potentially query the UTxO and
-- access the script (and therefore the policy id).
createTxMintValue
  :: forall era
   . Exp.IsEra era
  => (L.MultiAsset, [MintScriptWitnessWithPolicyId era])
  -> Either TxCmdError (TxMintValue BuildTx era)
createTxMintValue :: forall era.
IsEra era =>
(MultiAsset, [MintScriptWitnessWithPolicyId era])
-> Either TxCmdError (TxMintValue BuildTx era)
createTxMintValue (MultiAsset
val, [MintScriptWitnessWithPolicyId era]
scriptWitnesses) =
  if MultiAsset
forall a. Monoid a => a
mempty MultiAsset -> MultiAsset -> Bool
forall a. Eq a => a -> a -> Bool
== MultiAsset
val Bool -> Bool -> Bool
&& [MintScriptWitnessWithPolicyId era] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [MintScriptWitnessWithPolicyId era]
scriptWitnesses
    then TxMintValue BuildTx era
-> Either TxCmdError (TxMintValue BuildTx era)
forall a. a -> Either TxCmdError a
forall (m :: * -> *) a. Monad m => a -> m a
return TxMintValue BuildTx era
forall build era. TxMintValue build era
TxMintNone
    else do
      let policiesWithAssets :: Map PolicyId PolicyAssets
          policiesWithAssets :: Map PolicyId PolicyAssets
policiesWithAssets = MultiAsset -> Map PolicyId PolicyAssets
multiAssetToPolicyAssets MultiAsset
val
          -- The set of policy ids for which we need witnesses:
          witnessesNeededSet :: Set PolicyId
          witnessesNeededSet :: Set PolicyId
witnessesNeededSet = Map PolicyId PolicyAssets -> Set PolicyId
forall k a. Map k a -> Set k
Map.keysSet Map PolicyId PolicyAssets
policiesWithAssets

          witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
          witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
witnessesProvidedMap = [Item (Map PolicyId (ScriptWitness WitCtxMint era))]
-> Map PolicyId (ScriptWitness WitCtxMint era)
forall l. IsList l => [Item l] -> l
fromList ([Item (Map PolicyId (ScriptWitness WitCtxMint era))]
 -> Map PolicyId (ScriptWitness WitCtxMint era))
-> [Item (Map PolicyId (ScriptWitness WitCtxMint era))]
-> Map PolicyId (ScriptWitness WitCtxMint era)
forall a b. (a -> b) -> a -> b
$ [(PolicyId
polid, ScriptWitness WitCtxMint era
sWit) | MintScriptWitnessWithPolicyId PolicyId
polid ScriptWitness WitCtxMint era
sWit <- [MintScriptWitnessWithPolicyId era]
scriptWitnesses]

          witnessesProvidedSet :: Set PolicyId
          witnessesProvidedSet :: Set PolicyId
witnessesProvidedSet = Map PolicyId (ScriptWitness WitCtxMint era) -> Set PolicyId
forall k a. Map k a -> Set k
Map.keysSet Map PolicyId (ScriptWitness WitCtxMint era)
witnessesProvidedMap
      -- Check not too many, nor too few:
      Set PolicyId -> Set PolicyId -> Either TxCmdError ()
validateAllWitnessesProvided Set PolicyId
witnessesNeededSet Set PolicyId
witnessesProvidedSet
      Set PolicyId -> Set PolicyId -> Either TxCmdError ()
validateNoUnnecessaryWitnesses Set PolicyId
witnessesNeededSet Set PolicyId
witnessesProvidedSet
      TxMintValue BuildTx era
-> Either TxCmdError (TxMintValue BuildTx era)
forall a. a -> Either TxCmdError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxMintValue BuildTx era
 -> Either TxCmdError (TxMintValue BuildTx era))
-> TxMintValue BuildTx era
-> Either TxCmdError (TxMintValue BuildTx era)
forall a b. (a -> b) -> a -> b
$
        MaryEraOnwards era
-> Map
     PolicyId
     (PolicyAssets, BuildTxWith BuildTx (ScriptWitness WitCtxMint era))
-> TxMintValue BuildTx era
forall era build.
MaryEraOnwards era
-> Map
     PolicyId
     (PolicyAssets, BuildTxWith build (ScriptWitness WitCtxMint era))
-> TxMintValue build era
TxMintValue (Era era -> MaryEraOnwards era
forall era. Era era -> MaryEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra) (Map
   PolicyId
   (PolicyAssets, BuildTxWith BuildTx (ScriptWitness WitCtxMint era))
 -> TxMintValue BuildTx era)
-> Map
     PolicyId
     (PolicyAssets, BuildTxWith BuildTx (ScriptWitness WitCtxMint era))
-> TxMintValue BuildTx era
forall a b. (a -> b) -> a -> b
$
          (PolicyAssets
 -> ScriptWitness WitCtxMint era
 -> (PolicyAssets,
     BuildTxWith BuildTx (ScriptWitness WitCtxMint era)))
-> Map PolicyId PolicyAssets
-> Map PolicyId (ScriptWitness WitCtxMint era)
-> Map
     PolicyId
     (PolicyAssets, BuildTxWith BuildTx (ScriptWitness WitCtxMint era))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
            (\PolicyAssets
assets ScriptWitness WitCtxMint era
wit -> (PolicyAssets
assets, ScriptWitness WitCtxMint era
-> BuildTxWith BuildTx (ScriptWitness WitCtxMint era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith ScriptWitness WitCtxMint era
wit))
            Map PolicyId PolicyAssets
policiesWithAssets
            Map PolicyId (ScriptWitness WitCtxMint era)
witnessesProvidedMap
 where
  validateAllWitnessesProvided :: Set PolicyId -> Set PolicyId -> Either TxCmdError ()
validateAllWitnessesProvided Set PolicyId
witnessesNeeded Set PolicyId
witnessesProvided
    | [PolicyId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PolicyId]
witnessesMissing = () -> Either TxCmdError ()
forall a. a -> Either TxCmdError a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = TxCmdError -> Either TxCmdError ()
forall a b. a -> Either a b
Left ([PolicyId] -> [PolicyId] -> TxCmdError
TxCmdPolicyIdsMissing [PolicyId]
witnessesMissing (Set PolicyId -> [Item (Set PolicyId)]
forall l. IsList l => l -> [Item l]
toList Set PolicyId
witnessesProvided))
   where
    witnessesMissing :: [PolicyId]
witnessesMissing = Set PolicyId -> [PolicyId]
forall a. Set a -> [a]
Set.elems (Set PolicyId
witnessesNeeded Set PolicyId -> Set PolicyId -> Set PolicyId
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PolicyId
witnessesProvided)

  validateNoUnnecessaryWitnesses :: Set PolicyId -> Set PolicyId -> Either TxCmdError ()
validateNoUnnecessaryWitnesses Set PolicyId
witnessesNeeded Set PolicyId
witnessesProvided
    | [PolicyId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PolicyId]
witnessesExtra = () -> Either TxCmdError ()
forall a. a -> Either TxCmdError a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = TxCmdError -> Either TxCmdError ()
forall a b. a -> Either a b
Left ([PolicyId] -> TxCmdError
TxCmdPolicyIdsExcess [PolicyId]
witnessesExtra)
   where
    witnessesExtra :: [PolicyId]
witnessesExtra = Set PolicyId -> [PolicyId]
forall a. Set a -> [a]
Set.elems (Set PolicyId
witnessesProvided Set PolicyId -> Set PolicyId -> Set PolicyId
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PolicyId
witnessesNeeded)

-- ----------------------------------------------------------------------------
-- Transaction signing
--

runTransactionSignCmd
  :: ()
  => Cmd.TransactionSignCmdArgs
  -> ExceptT TxCmdError IO ()
runTransactionSignCmd :: TransactionSignCmdArgs -> ExceptT TxCmdError IO ()
runTransactionSignCmd
  Cmd.TransactionSignCmdArgs
    { txOrTxBodyFile :: TransactionSignCmdArgs -> InputTxBodyOrTxFile
txOrTxBodyFile = InputTxBodyOrTxFile
txOrTxBody
    , [WitnessSigningData]
witnessSigningData :: [WitnessSigningData]
witnessSigningData :: TransactionSignCmdArgs -> [WitnessSigningData]
witnessSigningData
    , Maybe NetworkId
mNetworkId :: Maybe NetworkId
mNetworkId :: TransactionSignCmdArgs -> Maybe NetworkId
mNetworkId
    , TxCborFormat
isCborOutCanonical :: TxCborFormat
isCborOutCanonical :: TransactionSignCmdArgs -> TxCborFormat
isCborOutCanonical
    , TxFile 'Out
outTxFile :: TxFile 'Out
outTxFile :: TransactionSignCmdArgs -> TxFile 'Out
outTxFile
    } = do
    [SomeSigningWitness]
sks <- [WitnessSigningData]
-> (WitnessSigningData -> ExceptT TxCmdError IO SomeSigningWitness)
-> ExceptT TxCmdError IO [SomeSigningWitness]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [WitnessSigningData]
witnessSigningData ((WitnessSigningData -> ExceptT TxCmdError IO SomeSigningWitness)
 -> ExceptT TxCmdError IO [SomeSigningWitness])
-> (WitnessSigningData -> ExceptT TxCmdError IO SomeSigningWitness)
-> ExceptT TxCmdError IO [SomeSigningWitness]
forall a b. (a -> b) -> a -> b
$ \WitnessSigningData
d ->
      IO (Either ReadWitnessSigningDataError SomeSigningWitness)
-> ExceptT
     TxCmdError
     IO
     (Either ReadWitnessSigningDataError SomeSigningWitness)
forall (m :: * -> *) a. Monad m => m a -> ExceptT TxCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WitnessSigningData
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
readWitnessSigningData WitnessSigningData
d)
        ExceptT
  TxCmdError
  IO
  (Either ReadWitnessSigningDataError SomeSigningWitness)
-> (ExceptT
      TxCmdError
      IO
      (Either ReadWitnessSigningDataError SomeSigningWitness)
    -> ExceptT TxCmdError IO SomeSigningWitness)
-> ExceptT TxCmdError IO SomeSigningWitness
forall a b. a -> (a -> b) -> b
& (ReadWitnessSigningDataError
 -> ExceptT TxCmdError IO SomeSigningWitness)
-> ExceptT
     TxCmdError
     IO
     (Either ReadWitnessSigningDataError SomeSigningWitness)
-> ExceptT TxCmdError IO SomeSigningWitness
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError -> ExceptT TxCmdError IO SomeSigningWitness
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError -> ExceptT TxCmdError IO SomeSigningWitness)
-> (ReadWitnessSigningDataError -> TxCmdError)
-> ReadWitnessSigningDataError
-> ExceptT TxCmdError IO SomeSigningWitness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadWitnessSigningDataError -> TxCmdError
TxCmdReadWitnessSigningDataError)

    let ([ShelleyBootstrapWitnessSigningKeyData]
sksByron, [ShelleyWitnessSigningKey]
sksShelley) = [ByronOrShelleyWitness]
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
partitionSomeWitnesses ([ByronOrShelleyWitness]
 -> ([ShelleyBootstrapWitnessSigningKeyData],
     [ShelleyWitnessSigningKey]))
-> [ByronOrShelleyWitness]
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
forall a b. (a -> b) -> a -> b
$ (SomeSigningWitness -> ByronOrShelleyWitness)
-> [SomeSigningWitness] -> [ByronOrShelleyWitness]
forall a b. (a -> b) -> [a] -> [b]
map SomeSigningWitness -> ByronOrShelleyWitness
categoriseSomeSigningWitness [SomeSigningWitness]
sks

    case InputTxBodyOrTxFile
txOrTxBody of
      InputTxFile (File FilePath
inputTxFilePath) -> do
        FileOrPipe
inputTxFile <- IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe)
-> IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
inputTxFilePath
        InAnyShelleyBasedEra Tx
anyTx <- IO (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> ExceptT
     TxCmdError
     IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TxCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
readFileTx FileOrPipe
inputTxFile) ExceptT
  TxCmdError
  IO
  (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> (ExceptT
      TxCmdError
      IO
      (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
    -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall a b. a -> (a -> b) -> b
& (FileError TextEnvelopeError
 -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> ExceptT
     TxCmdError
     IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> (FileError TextEnvelopeError -> TxCmdError)
-> FileError TextEnvelopeError
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> TxCmdError
TxCmdTextEnvError)

        InAnyShelleyBasedEra ShelleyBasedEra era
sbe tx :: Tx era
tx@(ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
ledgerTx) <- InAnyShelleyBasedEra Tx
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall a. a -> ExceptT TxCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InAnyShelleyBasedEra Tx
anyTx

        let (TxBody era
apiTxBody, [KeyWitness era]
existingTxKeyWits) = Tx era -> (TxBody era, [KeyWitness era])
forall era. Tx era -> (TxBody era, [KeyWitness era])
getTxBodyAndWitnesses Tx era
tx

        [KeyWitness era]
byronWitnesses <-
          (BootstrapWitnessError -> TxCmdError)
-> ExceptT BootstrapWitnessError IO [KeyWitness era]
-> ExceptT TxCmdError IO [KeyWitness era]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT BootstrapWitnessError -> TxCmdError
TxCmdBootstrapWitnessError (ExceptT BootstrapWitnessError IO [KeyWitness era]
 -> ExceptT TxCmdError IO [KeyWitness era])
-> (Either BootstrapWitnessError [KeyWitness era]
    -> ExceptT BootstrapWitnessError IO [KeyWitness era])
-> Either BootstrapWitnessError [KeyWitness era]
-> ExceptT TxCmdError IO [KeyWitness era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either BootstrapWitnessError [KeyWitness era]
-> ExceptT BootstrapWitnessError IO [KeyWitness era]
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either BootstrapWitnessError [KeyWitness era]
 -> ExceptT TxCmdError IO [KeyWitness era])
-> Either BootstrapWitnessError [KeyWitness era]
-> ExceptT TxCmdError IO [KeyWitness era]
forall a b. (a -> b) -> a -> b
$
            [ShelleyBootstrapWitnessSigningKeyData]
-> (ShelleyBootstrapWitnessSigningKeyData
    -> Either BootstrapWitnessError (KeyWitness era))
-> Either BootstrapWitnessError [KeyWitness era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ShelleyBootstrapWitnessSigningKeyData]
sksByron ((ShelleyBootstrapWitnessSigningKeyData
  -> Either BootstrapWitnessError (KeyWitness era))
 -> Either BootstrapWitnessError [KeyWitness era])
-> (ShelleyBootstrapWitnessSigningKeyData
    -> Either BootstrapWitnessError (KeyWitness era))
-> Either BootstrapWitnessError [KeyWitness era]
forall a b. (a -> b) -> a -> b
$
              ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    ShelleyBootstrapWitnessSigningKeyData
    -> Either BootstrapWitnessError (KeyWitness era))
-> ShelleyBootstrapWitnessSigningKeyData
-> Either BootstrapWitnessError (KeyWitness era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  ShelleyBootstrapWitnessSigningKeyData
  -> Either BootstrapWitnessError (KeyWitness era))
 -> ShelleyBootstrapWitnessSigningKeyData
 -> Either BootstrapWitnessError (KeyWitness era))
-> (ShelleyBasedEraConstraints era =>
    ShelleyBootstrapWitnessSigningKeyData
    -> Either BootstrapWitnessError (KeyWitness era))
-> ShelleyBootstrapWitnessSigningKeyData
-> Either BootstrapWitnessError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$
                ShelleyBasedEra era
-> Maybe NetworkId
-> TxBody (ShelleyLedgerEra era)
-> ShelleyBootstrapWitnessSigningKeyData
-> Either BootstrapWitnessError (KeyWitness era)
forall era.
ShelleyBasedEra era
-> Maybe NetworkId
-> TxBody (ShelleyLedgerEra era)
-> ShelleyBootstrapWitnessSigningKeyData
-> Either BootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness ShelleyBasedEra era
sbe Maybe NetworkId
mNetworkId (Tx (ShelleyLedgerEra era)
ledgerTx Tx (ShelleyLedgerEra era)
-> Getting
     (TxBody (ShelleyLedgerEra era))
     (Tx (ShelleyLedgerEra era))
     (TxBody (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody (ShelleyLedgerEra era))
  (Tx (ShelleyLedgerEra era))
  (TxBody (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (ShelleyLedgerEra era)) (TxBody (ShelleyLedgerEra era))
L.bodyTxL)

        let newShelleyKeyWits :: [KeyWitness era]
newShelleyKeyWits = (ShelleyWitnessSigningKey -> KeyWitness era)
-> [ShelleyWitnessSigningKey] -> [KeyWitness era]
forall a b. (a -> b) -> [a] -> [b]
map (ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
forall era.
ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
makeShelleyKeyWitness ShelleyBasedEra era
sbe TxBody era
apiTxBody) [ShelleyWitnessSigningKey]
sksShelley
            allKeyWits :: [KeyWitness era]
allKeyWits = [KeyWitness era]
existingTxKeyWits [KeyWitness era] -> [KeyWitness era] -> [KeyWitness era]
forall a. [a] -> [a] -> [a]
++ [KeyWitness era]
newShelleyKeyWits [KeyWitness era] -> [KeyWitness era] -> [KeyWitness era]
forall a. [a] -> [a] -> [a]
++ [KeyWitness era]
byronWitnesses
            signedTx :: Tx era
signedTx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness era]
allKeyWits TxBody era
apiTxBody

        (FileError () -> TxCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT TxCmdError IO ()
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError () -> TxCmdError
TxCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT TxCmdError IO ())
-> ExceptT (FileError ()) IO () -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$
          IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall e (t :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIOTransError e t m =>
IO (Either e a) -> t m a
hoistIOEither (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
            if TxCborFormat
isCborOutCanonical TxCborFormat -> TxCborFormat -> Bool
forall a. Eq a => a -> a -> Bool
== TxCborFormat
TxCborCanonical
              then ShelleyBasedEra era
-> TxFile 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCanonical ShelleyBasedEra era
sbe TxFile 'Out
outTxFile Tx era
signedTx
              else ShelleyBasedEra era
-> TxFile 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelope ShelleyBasedEra era
sbe TxFile 'Out
outTxFile Tx era
signedTx
      InputTxBodyFile (File FilePath
txbodyFilePath) -> do
        FileOrPipe
txbodyFile <- IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe)
-> IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txbodyFilePath
        IncompleteTxBody
unwitnessed <-
          (FileError TextEnvelopeError -> TxCmdError)
-> ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody
-> ExceptT TxCmdError IO IncompleteTxBody
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> TxCmdError
TxCmdTextEnvError (ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody
 -> ExceptT TxCmdError IO IncompleteTxBody)
-> (IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
    -> ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody)
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> ExceptT TxCmdError IO IncompleteTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
 -> ExceptT TxCmdError IO IncompleteTxBody)
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> ExceptT TxCmdError IO IncompleteTxBody
forall a b. (a -> b) -> a -> b
$
            FileOrPipe
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
readFileTxBody FileOrPipe
txbodyFile

        case IncompleteTxBody
unwitnessed of
          IncompleteTxBody InAnyShelleyBasedEra TxBody
anyTxBody -> do
            InAnyShelleyBasedEra ShelleyBasedEra era
sbe txbody :: TxBody era
txbody@(ShelleyTxBody ShelleyBasedEra era
_ TxBody (ShelleyLedgerEra era)
ledgerTxBody [Script (ShelleyLedgerEra era)]
_ TxBodyScriptData era
_ Maybe (TxAuxData (ShelleyLedgerEra era))
_ TxScriptValidity era
_) <- InAnyShelleyBasedEra TxBody
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra TxBody)
forall a. a -> ExceptT TxCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InAnyShelleyBasedEra TxBody
anyTxBody

            -- Byron witnesses require the network ID. This can either be provided
            -- directly or derived from a provided Byron address.
            [KeyWitness era]
byronWitnesses <-
              (BootstrapWitnessError -> TxCmdError)
-> ExceptT BootstrapWitnessError IO [KeyWitness era]
-> ExceptT TxCmdError IO [KeyWitness era]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT BootstrapWitnessError -> TxCmdError
TxCmdBootstrapWitnessError (ExceptT BootstrapWitnessError IO [KeyWitness era]
 -> ExceptT TxCmdError IO [KeyWitness era])
-> (Either BootstrapWitnessError [KeyWitness era]
    -> ExceptT BootstrapWitnessError IO [KeyWitness era])
-> Either BootstrapWitnessError [KeyWitness era]
-> ExceptT TxCmdError IO [KeyWitness era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either BootstrapWitnessError [KeyWitness era]
-> ExceptT BootstrapWitnessError IO [KeyWitness era]
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either BootstrapWitnessError [KeyWitness era]
 -> ExceptT TxCmdError IO [KeyWitness era])
-> Either BootstrapWitnessError [KeyWitness era]
-> ExceptT TxCmdError IO [KeyWitness era]
forall a b. (a -> b) -> a -> b
$
                [ShelleyBootstrapWitnessSigningKeyData]
-> (ShelleyBootstrapWitnessSigningKeyData
    -> Either BootstrapWitnessError (KeyWitness era))
-> Either BootstrapWitnessError [KeyWitness era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ShelleyBootstrapWitnessSigningKeyData]
sksByron ((ShelleyBootstrapWitnessSigningKeyData
  -> Either BootstrapWitnessError (KeyWitness era))
 -> Either BootstrapWitnessError [KeyWitness era])
-> (ShelleyBootstrapWitnessSigningKeyData
    -> Either BootstrapWitnessError (KeyWitness era))
-> Either BootstrapWitnessError [KeyWitness era]
forall a b. (a -> b) -> a -> b
$
                  ShelleyBasedEra era
-> Maybe NetworkId
-> TxBody (ShelleyLedgerEra era)
-> ShelleyBootstrapWitnessSigningKeyData
-> Either BootstrapWitnessError (KeyWitness era)
forall era.
ShelleyBasedEra era
-> Maybe NetworkId
-> TxBody (ShelleyLedgerEra era)
-> ShelleyBootstrapWitnessSigningKeyData
-> Either BootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness ShelleyBasedEra era
sbe Maybe NetworkId
mNetworkId TxBody (ShelleyLedgerEra era)
ledgerTxBody

            let shelleyKeyWitnesses :: [KeyWitness era]
shelleyKeyWitnesses = (ShelleyWitnessSigningKey -> KeyWitness era)
-> [ShelleyWitnessSigningKey] -> [KeyWitness era]
forall a b. (a -> b) -> [a] -> [b]
map (ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
forall era.
ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
makeShelleyKeyWitness ShelleyBasedEra era
sbe TxBody era
txbody) [ShelleyWitnessSigningKey]
sksShelley
                tx :: Tx era
tx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction ([KeyWitness era]
byronWitnesses [KeyWitness era] -> [KeyWitness era] -> [KeyWitness era]
forall a. [a] -> [a] -> [a]
++ [KeyWitness era]
shelleyKeyWitnesses) TxBody era
txbody

            (FileError () -> TxCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT TxCmdError IO ()
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError () -> TxCmdError
TxCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT TxCmdError IO ())
-> ExceptT (FileError ()) IO () -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$
              IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall e (t :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIOTransError e t m =>
IO (Either e a) -> t m a
hoistIOEither (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
                if TxCborFormat
isCborOutCanonical TxCborFormat -> TxCborFormat -> Bool
forall a. Eq a => a -> a -> Bool
== TxCborFormat
TxCborCanonical
                  then ShelleyBasedEra era
-> TxFile 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCanonical ShelleyBasedEra era
sbe TxFile 'Out
outTxFile Tx era
tx
                  else ShelleyBasedEra era
-> TxFile 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelope ShelleyBasedEra era
sbe TxFile 'Out
outTxFile Tx era
tx

-- ----------------------------------------------------------------------------
-- Transaction submission
--

runTransactionSubmitCmd
  :: ()
  => Cmd.TransactionSubmitCmdArgs
  -> ExceptT TxCmdError IO ()
runTransactionSubmitCmd :: TransactionSubmitCmdArgs -> ExceptT TxCmdError IO ()
runTransactionSubmitCmd
  Cmd.TransactionSubmitCmdArgs
    { LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
nodeConnInfo :: TransactionSubmitCmdArgs -> LocalNodeConnectInfo
nodeConnInfo
    , FilePath
txFile :: FilePath
txFile :: TransactionSubmitCmdArgs -> FilePath
txFile
    } = do
    FileOrPipe
txFileOrPipe <- IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe)
-> IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txFile
    InAnyShelleyBasedEra ShelleyBasedEra era
era Tx era
tx <-
      IO (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> ExceptT
     TxCmdError
     IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TxCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
readFileTx FileOrPipe
txFileOrPipe) ExceptT
  TxCmdError
  IO
  (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> (ExceptT
      TxCmdError
      IO
      (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
    -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall a b. a -> (a -> b) -> b
& (FileError TextEnvelopeError
 -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> ExceptT
     TxCmdError
     IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> (FileError TextEnvelopeError -> TxCmdError)
-> FileError TextEnvelopeError
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> TxCmdError
TxCmdTextEnvError)
    let txInMode :: TxInMode
txInMode = ShelleyBasedEra era -> Tx era -> TxInMode
forall era. ShelleyBasedEra era -> Tx era -> TxInMode
TxInMode ShelleyBasedEra era
era Tx era
tx
    SubmitResult TxValidationErrorInCardanoMode
res <- IO (SubmitResult TxValidationErrorInCardanoMode)
-> ExceptT
     TxCmdError IO (SubmitResult TxValidationErrorInCardanoMode)
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SubmitResult TxValidationErrorInCardanoMode)
 -> ExceptT
      TxCmdError IO (SubmitResult TxValidationErrorInCardanoMode))
-> IO (SubmitResult TxValidationErrorInCardanoMode)
-> ExceptT
     TxCmdError IO (SubmitResult TxValidationErrorInCardanoMode)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> TxInMode -> IO (SubmitResult TxValidationErrorInCardanoMode)
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo
-> TxInMode -> m (SubmitResult TxValidationErrorInCardanoMode)
submitTxToNodeLocal LocalNodeConnectInfo
nodeConnInfo TxInMode
txInMode
    case SubmitResult TxValidationErrorInCardanoMode
res of
      SubmitResult TxValidationErrorInCardanoMode
Net.Tx.SubmitSuccess -> do
        IO () -> ExceptT TxCmdError IO ()
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT TxCmdError IO ())
-> IO () -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
Text.hPutStrLn Handle
IO.stderr Text
"Transaction successfully submitted. Transaction hash is:"
        IO () -> ExceptT TxCmdError IO ()
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT TxCmdError IO ())
-> IO () -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ TxSubmissionResult -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (TxSubmissionResult -> ByteString)
-> TxSubmissionResult -> ByteString
forall a b. (a -> b) -> a -> b
$ TxId -> TxSubmissionResult
TxSubmissionResult (TxId -> TxSubmissionResult) -> TxId -> TxSubmissionResult
forall a b. (a -> b) -> a -> b
$ TxBody era -> TxId
forall era. TxBody era -> TxId
getTxId (TxBody era -> TxId) -> TxBody era -> TxId
forall a b. (a -> b) -> a -> b
$ Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx
      Net.Tx.SubmitFail TxValidationErrorInCardanoMode
reason ->
        case TxValidationErrorInCardanoMode
reason of
          TxValidationErrorInCardanoMode TxValidationError era
err -> TxCmdError -> ExceptT TxCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError -> ExceptT TxCmdError IO ())
-> (FilePath -> TxCmdError) -> FilePath -> ExceptT TxCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TxCmdError
TxCmdTxSubmitError (Text -> TxCmdError)
-> (FilePath -> Text) -> FilePath -> TxCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack (FilePath -> ExceptT TxCmdError IO ())
-> FilePath -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ TxValidationError era -> FilePath
forall a. Show a => a -> FilePath
show TxValidationError era
err
          TxValidationEraMismatch EraMismatch
mismatchErr -> TxCmdError -> ExceptT TxCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError -> ExceptT TxCmdError IO ())
-> TxCmdError -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ EraMismatch -> TxCmdError
TxCmdTxSubmitErrorEraMismatch EraMismatch
mismatchErr

-- ----------------------------------------------------------------------------
-- Transaction fee calculation
--

runTransactionCalculateMinFeeCmd
  :: ()
  => Cmd.TransactionCalculateMinFeeCmdArgs
  -> CIO e ()
runTransactionCalculateMinFeeCmd :: forall e. TransactionCalculateMinFeeCmdArgs -> CIO e ()
runTransactionCalculateMinFeeCmd
  Cmd.TransactionCalculateMinFeeCmdArgs
    { txBodyFile :: TransactionCalculateMinFeeCmdArgs -> File (TxBody ()) 'In
txBodyFile = File FilePath
txbodyFilePath
    , protocolParamsFile :: TransactionCalculateMinFeeCmdArgs -> ProtocolParamsFile
protocolParamsFile = ProtocolParamsFile
protocolParamsFile
    , txShelleyWitnessCount :: TransactionCalculateMinFeeCmdArgs -> TxShelleyWitnessCount
txShelleyWitnessCount = TxShelleyWitnessCount Int
nShelleyKeyWitnesses
    , txByronWitnessCount :: TransactionCalculateMinFeeCmdArgs -> TxByronWitnessCount
txByronWitnessCount = TxByronWitnessCount Int
nByronKeyWitnesses
    , referenceScriptSize :: TransactionCalculateMinFeeCmdArgs -> ReferenceScriptSize
referenceScriptSize = ReferenceScriptSize Int
sReferenceScript
    , Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: TransactionCalculateMinFeeCmdArgs
-> Vary '[FormatJson, FormatText, FormatYaml]
outputFormat
    , Maybe (File () 'Out)
outFile :: Maybe (File () 'Out)
outFile :: TransactionCalculateMinFeeCmdArgs -> Maybe (File () 'Out)
outFile
    } = do
    FileOrPipe
txbodyFile <- IO FileOrPipe -> RIO e FileOrPipe
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> RIO e FileOrPipe)
-> IO FileOrPipe -> RIO e FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txbodyFilePath
    IncompleteTxBody
unwitnessed <-
      IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> RIO e IncompleteTxBody
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
 -> RIO e IncompleteTxBody)
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> RIO e IncompleteTxBody
forall a b. (a -> b) -> a -> b
$
        FileOrPipe
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
readFileTxBody FileOrPipe
txbodyFile

    let nShelleyKeyWitW32 :: Word
nShelleyKeyWitW32 = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nShelleyKeyWitnesses

    InAnyShelleyBasedEra ShelleyBasedEra era
sbe TxBody era
txbody <- InAnyShelleyBasedEra TxBody -> RIO e (InAnyShelleyBasedEra TxBody)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InAnyShelleyBasedEra TxBody
 -> RIO e (InAnyShelleyBasedEra TxBody))
-> InAnyShelleyBasedEra TxBody
-> RIO e (InAnyShelleyBasedEra TxBody)
forall a b. (a -> b) -> a -> b
$ IncompleteTxBody -> InAnyShelleyBasedEra TxBody
unIncompleteTxBody IncompleteTxBody
unwitnessed

    Era era
era <- Either (DeprecatedEra era) (Era era) -> RIO e (Era era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either (DeprecatedEra era) (Era era) -> RIO e (Era era))
-> Either (DeprecatedEra era) (Era era) -> RIO e (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)
Exp.sbeToEra ShelleyBasedEra era
sbe
    PParams (ShelleyLedgerEra era)
lpparams <-
      forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli @ProtocolParamsError (ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era))
 -> RIO e (PParams (ShelleyLedgerEra era)))
-> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era))
-> RIO e (PParams (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
        Era era
-> (EraCommonConstraints era =>
    ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
-> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
 -> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
-> (EraCommonConstraints era =>
    ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
-> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
          ProtocolParamsFile
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
forall era.
IsEra era =>
ProtocolParamsFile
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
readProtocolParameters ProtocolParamsFile
protocolParamsFile

    let shelleyfee :: Lovelace
shelleyfee = ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> TxBody era
-> Word
-> Word
-> Int
-> Lovelace
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> TxBody era
-> Word
-> Word
-> Int
-> Lovelace
evaluateTransactionFee ShelleyBasedEra era
sbe PParams (ShelleyLedgerEra era)
lpparams TxBody era
txbody Word
nShelleyKeyWitW32 Word
0 Int
sReferenceScript

    let byronfee :: Lovelace
byronfee =
          ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Lovelace) -> Lovelace
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Lovelace) -> Lovelace)
-> (ShelleyBasedEraConstraints era => Lovelace) -> Lovelace
forall a b. (a -> b) -> a -> b
$
            Lovelace -> Int -> Lovelace
calculateByronWitnessFees (PParams (ShelleyLedgerEra era)
lpparams PParams (ShelleyLedgerEra era)
-> Getting Lovelace (PParams (ShelleyLedgerEra era)) Lovelace
-> Lovelace
forall s a. s -> Getting a s a -> a
^. Getting Lovelace (PParams (ShelleyLedgerEra era)) Lovelace
forall era. EraPParams era => Lens' (PParams era) Lovelace
Lens' (PParams (ShelleyLedgerEra era)) Lovelace
L.ppMinFeeAL) Int
nByronKeyWitnesses

    let fee :: Lovelace
fee = Lovelace
shelleyfee Lovelace -> Lovelace -> Lovelace
forall a. Num a => a -> a -> a
+ Lovelace
byronfee
        textToWrite :: Text
textToWrite = Doc AnsiStyle -> Text
docToText (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$ Lovelace -> Doc AnsiStyle
forall ann. Lovelace -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Lovelace
fee
        content :: Value
content = [Pair] -> Value
Aeson.object [Key
"fee" Key -> Lovelace -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Lovelace
fee]

    Vary '[FormatJson, FormatText, FormatYaml]
outputFormat
      Vary '[FormatJson, FormatText, FormatYaml]
-> (Vary '[FormatJson, FormatText, FormatYaml] -> RIO e ())
-> RIO e ()
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatText, FormatYaml] -> RIO e ())
-> Vary '[FormatJson, FormatText, FormatYaml] -> RIO e ()
forall a. a -> a
id
            ((Vary '[FormatJson, FormatText, FormatYaml] -> RIO e ())
 -> Vary '[FormatJson, FormatText, FormatYaml] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatJson, FormatText, FormatYaml] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatJson, FormatText, FormatYaml]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> RIO e ())
-> (Vary '[FormatText, FormatYaml] -> RIO e ())
-> Vary '[FormatJson, FormatText, FormatYaml]
-> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatJson
FormatJson -> case Maybe (File () 'Out)
outFile of
                  Maybe (File () 'Out)
Nothing ->
                    IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson Value
content
                  Just File () 'Out
file ->
                    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
                      File () 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File () 'Out
file (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
                        Value -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson Value
content
              )
            ((Vary '[FormatText, FormatYaml] -> RIO e ())
 -> Vary '[FormatJson, FormatText, FormatYaml] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatText, FormatYaml] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatJson, FormatText, FormatYaml]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatText -> RIO e ())
-> (Vary '[FormatYaml] -> RIO e ())
-> Vary '[FormatText, FormatYaml]
-> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatText
FormatText -> case Maybe (File () 'Out)
outFile of
                  Maybe (File () 'Out)
Nothing ->
                    IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn Text
textToWrite
                  Just File () 'Out
file ->
                    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ File () 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile File () 'Out
file Text
textToWrite
              )
            ((Vary '[FormatYaml] -> RIO e ())
 -> Vary '[FormatText, FormatYaml] -> RIO e ())
-> ((Vary '[] -> RIO e ()) -> Vary '[FormatYaml] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatText, FormatYaml]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> RIO e ())
-> (Vary '[] -> RIO e ()) -> Vary '[FormatYaml] -> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatYaml
FormatYaml -> case Maybe (File () 'Out)
outFile of
                  Maybe (File () 'Out)
Nothing ->
                    IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml Value
content
                  Just File () 'Out
file ->
                    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
                      File () 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File () 'Out
file (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
                        Value -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml Value
content
              )
            ((Vary '[] -> RIO e ())
 -> Vary '[FormatJson, FormatText, FormatYaml] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatJson, FormatText, FormatYaml]
-> RIO e ()
forall a b. (a -> b) -> a -> b
$ Vary '[] -> RIO e ()
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
        )

-- Extra logic to handle byron witnesses.
-- TODO: move this to Cardano.API.Fee.evaluateTransactionFee.
calculateByronWitnessFees
  :: ()
  => Lovelace
  -- ^ The tx fee per byte (from protocol parameters)
  -> Int
  -- ^ The number of Byron key witnesses
  -> Lovelace
calculateByronWitnessFees :: Lovelace -> Int -> Lovelace
calculateByronWitnessFees Lovelace
txFeePerByte Int
byronwitcount =
  Integer -> Lovelace
L.Coin (Integer -> Lovelace) -> Integer -> Lovelace
forall a b. (a -> b) -> a -> b
$
    Lovelace -> Integer
forall a. Integral a => a -> Integer
toInteger Lovelace
txFeePerByte
      Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
byronwitcount
      Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
sizeByronKeyWitnesses
 where
  sizeByronKeyWitnesses :: Int
sizeByronKeyWitnesses = Int
smallArray Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
keyObj Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sigObj Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ccodeObj Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
attrsObj

  smallArray :: Int
smallArray = Int
1

  keyObj :: Int
keyObj = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
keyLen
  keyLen :: Int
keyLen = Int
32

  sigObj :: Int
sigObj = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sigLen
  sigLen :: Int
sigLen = Int
64

  ccodeObj :: Int
ccodeObj = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ccodeLen
  ccodeLen :: Int
ccodeLen = Int
32

  attrsObj :: Int
attrsObj = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
Data.Bytestring.length ByteString
attributes

  -- We assume testnet network magic here to avoid having
  -- to thread the actual network ID into this function
  -- merely to calculate the fees of byron witnesses more accurately.
  -- This may slightly over-estimate min fees for byron witnesses
  -- in mainnet transaction by one Word32 per witness.
  attributes :: ByteString
attributes =
    Attributes AddrAttributes -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' (Attributes AddrAttributes -> ByteString)
-> Attributes AddrAttributes -> ByteString
forall a b. (a -> b) -> a -> b
$
      AddrAttributes -> Attributes AddrAttributes
forall h. h -> Attributes h
Byron.mkAttributes
        Byron.AddrAttributes
          { aaVKDerivationPath :: Maybe HDAddressPayload
Byron.aaVKDerivationPath = Maybe HDAddressPayload
forall a. Maybe a
Nothing
          , aaNetworkMagic :: NetworkMagic
Byron.aaNetworkMagic = Word32 -> NetworkMagic
Byron.NetworkTestnet Word32
forall a. Bounded a => a
maxBound
          }

-- ----------------------------------------------------------------------------
-- Transaction fee calculation
--

runTransactionCalculateMinValueCmd
  :: ()
  => Cmd.TransactionCalculateMinValueCmdArgs era
  -> CIO e ()
runTransactionCalculateMinValueCmd :: forall era e. TransactionCalculateMinValueCmdArgs era -> CIO e ()
runTransactionCalculateMinValueCmd
  Cmd.TransactionCalculateMinValueCmdArgs
    { Era era
era :: Era era
era :: forall era. TransactionCalculateMinValueCmdArgs era -> Era era
era
    , ProtocolParamsFile
protocolParamsFile :: ProtocolParamsFile
protocolParamsFile :: forall era.
TransactionCalculateMinValueCmdArgs era -> ProtocolParamsFile
protocolParamsFile
    , TxOutShelleyBasedEra
txOut :: TxOutShelleyBasedEra
txOut :: forall era.
TransactionCalculateMinValueCmdArgs era -> TxOutShelleyBasedEra
txOut
    } = do
    PParams (ShelleyLedgerEra era)
pp <-
      forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli @ProtocolParamsError
        (Era era
-> (EraCommonConstraints era =>
    ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
-> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
 -> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
-> (EraCommonConstraints era =>
    ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
-> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ ProtocolParamsFile
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
forall era.
IsEra era =>
ProtocolParamsFile
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
readProtocolParameters ProtocolParamsFile
protocolParamsFile)
    TxOut CtxTx era
out <- Era era
-> (EraCommonConstraints era => RIO e (TxOut CtxTx era))
-> RIO e (TxOut CtxTx era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => RIO e (TxOut CtxTx era))
 -> RIO e (TxOut CtxTx era))
-> (EraCommonConstraints era => RIO e (TxOut CtxTx era))
-> RIO e (TxOut CtxTx era)
forall a b. (a -> b) -> a -> b
$ TxOutShelleyBasedEra -> CIO e (TxOut CtxTx era)
forall era e.
IsEra era =>
TxOutShelleyBasedEra -> CIO e (TxOut CtxTx era)
toTxOutInShelleyBasedEra TxOutShelleyBasedEra
txOut

    let minValue :: Lovelace
minValue = ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era) -> TxOut CtxTx era -> Lovelace
forall era.
HasCallStack =>
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era) -> TxOut CtxTx era -> Lovelace
calculateMinimumUTxO (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era) PParams (ShelleyLedgerEra era)
pp TxOut CtxTx era
out
    IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> (Lovelace -> IO ()) -> Lovelace -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> IO ()
forall a. Show a => a -> IO ()
IO.print (Lovelace -> RIO e ()) -> Lovelace -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Lovelace
minValue

runTransactionCalculatePlutusScriptCostCmd
  :: Cmd.TransactionCalculatePlutusScriptCostCmdArgs era -> ExceptT TxCmdError IO ()
runTransactionCalculatePlutusScriptCostCmd :: forall era.
TransactionCalculatePlutusScriptCostCmdArgs era
-> ExceptT TxCmdError IO ()
runTransactionCalculatePlutusScriptCostCmd
  Cmd.TransactionCalculatePlutusScriptCostCmdArgs
    { NodeContextInfoSource era
nodeContextInfoSource :: NodeContextInfoSource era
nodeContextInfoSource :: forall era.
TransactionCalculatePlutusScriptCostCmdArgs era
-> NodeContextInfoSource era
nodeContextInfoSource
    , FilePath
txFileIn :: FilePath
txFileIn :: forall era.
TransactionCalculatePlutusScriptCostCmdArgs era -> FilePath
txFileIn
    , Maybe (File () 'Out)
outputFile :: Maybe (File () 'Out)
outputFile :: forall era.
TransactionCalculatePlutusScriptCostCmdArgs era
-> Maybe (File () 'Out)
outputFile
    } = do
    FileOrPipe
txFileOrPipeIn <- IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe)
-> IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txFileIn
    InAnyShelleyBasedEra ShelleyBasedEra era
txEra tx :: Tx era
tx@(ShelleyTx ShelleyBasedEra era
sbe Tx (ShelleyLedgerEra era)
ledgerTx) <-
      IO (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> ExceptT
     TxCmdError
     IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
readFileTx FileOrPipe
txFileOrPipeIn) ExceptT
  TxCmdError
  IO
  (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> (ExceptT
      TxCmdError
      IO
      (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
    -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall a b. a -> (a -> b) -> b
& (FileError TextEnvelopeError
 -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> ExceptT
     TxCmdError
     IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> (FileError TextEnvelopeError -> TxCmdError)
-> FileError TextEnvelopeError
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> TxCmdError
TxCmdTextEnvError)

    let relevantTxIns :: Set TxIn
        relevantTxIns :: Set TxIn
relevantTxIns = (TxIn -> TxIn) -> Set TxIn -> Set TxIn
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TxIn -> TxIn
fromShelleyTxIn (Set TxIn -> Set TxIn) -> Set TxIn -> Set TxIn
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Set TxIn) -> Set TxIn
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe (Tx (ShelleyLedgerEra era)
ledgerTx Tx (ShelleyLedgerEra era)
-> Getting (Set TxIn) (Tx (ShelleyLedgerEra era)) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. (TxBody (ShelleyLedgerEra era)
 -> Const (Set TxIn) (TxBody (ShelleyLedgerEra era)))
-> Tx (ShelleyLedgerEra era)
-> Const (Set TxIn) (Tx (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (ShelleyLedgerEra era)) (TxBody (ShelleyLedgerEra era))
bodyTxL ((TxBody (ShelleyLedgerEra era)
  -> Const (Set TxIn) (TxBody (ShelleyLedgerEra era)))
 -> Tx (ShelleyLedgerEra era)
 -> Const (Set TxIn) (Tx (ShelleyLedgerEra era)))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody (ShelleyLedgerEra era)
    -> Const (Set TxIn) (TxBody (ShelleyLedgerEra era)))
-> Getting (Set TxIn) (Tx (ShelleyLedgerEra era)) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody (ShelleyLedgerEra era)
-> Const (Set TxIn) (TxBody (ShelleyLedgerEra era))
forall era. EraTxBody era => SimpleGetter (TxBody era) (Set TxIn)
SimpleGetter (TxBody (ShelleyLedgerEra era)) (Set TxIn)
allInputsTxBodyF)

    (AnyCardanoEra CardanoEra era
nodeEra, SystemStart
systemStart, EraHistory
eraHistory, UTxO era
txEraUtxo, LedgerProtocolParameters era
pparams) <-
      case NodeContextInfoSource era
nodeContextInfoSource of
        NodeConnectionInfo LocalNodeConnectInfo
nodeConnInfo ->
          IO
  (Either
     AcquiringFailure
     (Either
        QueryConvenienceError
        (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
         LedgerProtocolParameters era)))
-> ExceptT
     TxCmdError
     IO
     (Either
        AcquiringFailure
        (Either
           QueryConvenienceError
           (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
            LedgerProtocolParameters era)))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TxCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
            ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        QueryConvenienceError
        (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
         LedgerProtocolParameters era))
-> IO
     (Either
        AcquiringFailure
        (Either
           QueryConvenienceError
           (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
            LedgerProtocolParameters era)))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
forall point. Target point
Consensus.VolatileTip (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      QueryConvenienceError
      (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
       LedgerProtocolParameters era))
 -> IO
      (Either
         AcquiringFailure
         (Either
            QueryConvenienceError
            (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
             LedgerProtocolParameters era))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        QueryConvenienceError
        (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
         LedgerProtocolParameters era))
-> IO
     (Either
        AcquiringFailure
        (Either
           QueryConvenienceError
           (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
            LedgerProtocolParameters era)))
forall a b. (a -> b) -> a -> b
$ do
                Either UnsupportedNtcVersionError AnyCardanoEra
eCurrentEra <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
queryCurrentEra
                Either UnsupportedNtcVersionError SystemStart
eSystemStart <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError SystemStart)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError SystemStart)
querySystemStart
                Either UnsupportedNtcVersionError EraHistory
eEraHistory <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError EraHistory)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError EraHistory)
queryEraHistory
                Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era))
eeUtxo <- ShelleyBasedEra era
-> QueryUTxOFilter
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
forall era block point r.
ShelleyBasedEra era
-> QueryUTxOFilter
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
queryUtxo ShelleyBasedEra era
txEra (Set TxIn -> QueryUTxOFilter
QueryUTxOByTxIn Set TxIn
relevantTxIns)
                Either
  UnsupportedNtcVersionError
  (Either EraMismatch (PParams (ShelleyLedgerEra era)))
ePp <- QueryInMode (Either EraMismatch (PParams (ShelleyLedgerEra era)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (PParams (ShelleyLedgerEra era))))
forall a block point r.
QueryInMode a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
queryExpr (QueryInMode (Either EraMismatch (PParams (ShelleyLedgerEra era)))
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (PParams (ShelleyLedgerEra era)))))
-> QueryInMode
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (PParams (ShelleyLedgerEra era))))
forall a b. (a -> b) -> a -> b
$ QueryInEra era (PParams (ShelleyLedgerEra era))
-> QueryInMode
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
forall era result1.
QueryInEra era result1 -> QueryInMode (Either EraMismatch result1)
QueryInEra (QueryInEra era (PParams (ShelleyLedgerEra era))
 -> QueryInMode
      (Either EraMismatch (PParams (ShelleyLedgerEra era))))
-> QueryInEra era (PParams (ShelleyLedgerEra era))
-> QueryInMode
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
-> QueryInEra era (PParams (ShelleyLedgerEra era))
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
forall era.
QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
Api.QueryProtocolParameters
                Either
  QueryConvenienceError
  (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
   LedgerProtocolParameters era)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        QueryConvenienceError
        (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
         LedgerProtocolParameters era))
forall a.
a -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   QueryConvenienceError
   (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
    LedgerProtocolParameters era)
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either
         QueryConvenienceError
         (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
          LedgerProtocolParameters era)))
-> Either
     QueryConvenienceError
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        QueryConvenienceError
        (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
         LedgerProtocolParameters era))
forall a b. (a -> b) -> a -> b
$ do
                  AnyCardanoEra
currentEra <- (UnsupportedNtcVersionError -> QueryConvenienceError)
-> Either UnsupportedNtcVersionError AnyCardanoEra
-> Either QueryConvenienceError AnyCardanoEra
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 UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion Either UnsupportedNtcVersionError AnyCardanoEra
eCurrentEra
                  SystemStart
systemStart <- (UnsupportedNtcVersionError -> QueryConvenienceError)
-> Either UnsupportedNtcVersionError SystemStart
-> Either QueryConvenienceError SystemStart
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 UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion Either UnsupportedNtcVersionError SystemStart
eSystemStart
                  EraHistory
eraHistory <- (UnsupportedNtcVersionError -> QueryConvenienceError)
-> Either UnsupportedNtcVersionError EraHistory
-> Either QueryConvenienceError EraHistory
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 UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion Either UnsupportedNtcVersionError EraHistory
eEraHistory
                  UTxO era
utxo <- (EraMismatch -> QueryConvenienceError)
-> Either EraMismatch (UTxO era)
-> Either QueryConvenienceError (UTxO 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 EraMismatch -> QueryConvenienceError
QueryEraMismatch (Either EraMismatch (UTxO era)
 -> Either QueryConvenienceError (UTxO era))
-> Either QueryConvenienceError (Either EraMismatch (UTxO era))
-> Either QueryConvenienceError (UTxO era)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (UnsupportedNtcVersionError -> QueryConvenienceError)
-> Either
     UnsupportedNtcVersionError (Either EraMismatch (UTxO era))
-> Either QueryConvenienceError (Either EraMismatch (UTxO 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 UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era))
eeUtxo
                  PParams (ShelleyLedgerEra era)
pp <- (EraMismatch -> QueryConvenienceError)
-> Either EraMismatch (PParams (ShelleyLedgerEra era))
-> Either QueryConvenienceError (PParams (ShelleyLedgerEra 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 EraMismatch -> QueryConvenienceError
QueryEraMismatch (Either EraMismatch (PParams (ShelleyLedgerEra era))
 -> Either QueryConvenienceError (PParams (ShelleyLedgerEra era)))
-> Either
     QueryConvenienceError
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
-> Either QueryConvenienceError (PParams (ShelleyLedgerEra era))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (UnsupportedNtcVersionError -> QueryConvenienceError)
-> Either
     UnsupportedNtcVersionError
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
-> Either
     QueryConvenienceError
     (Either EraMismatch (PParams (ShelleyLedgerEra 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 UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion Either
  UnsupportedNtcVersionError
  (Either EraMismatch (PParams (ShelleyLedgerEra era)))
ePp
                  (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
 LedgerProtocolParameters era)
-> Either
     QueryConvenienceError
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
forall a. a -> Either QueryConvenienceError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra
currentEra, SystemStart
systemStart, EraHistory
eraHistory, UTxO era
utxo, PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters PParams (ShelleyLedgerEra era)
pp)
            )
            ExceptT
  TxCmdError
  IO
  (Either
     AcquiringFailure
     (Either
        QueryConvenienceError
        (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
         LedgerProtocolParameters era)))
-> (ExceptT
      TxCmdError
      IO
      (Either
         AcquiringFailure
         (Either
            QueryConvenienceError
            (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
             LedgerProtocolParameters era)))
    -> ExceptT
         TxCmdError
         IO
         (Either
            QueryConvenienceError
            (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
             LedgerProtocolParameters era)))
-> ExceptT
     TxCmdError
     IO
     (Either
        QueryConvenienceError
        (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
         LedgerProtocolParameters era))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      TxCmdError
      IO
      (Either
         QueryConvenienceError
         (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
          LedgerProtocolParameters era)))
-> ExceptT
     TxCmdError
     IO
     (Either
        AcquiringFailure
        (Either
           QueryConvenienceError
           (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
            LedgerProtocolParameters era)))
-> ExceptT
     TxCmdError
     IO
     (Either
        QueryConvenienceError
        (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
         LedgerProtocolParameters era))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError
-> ExceptT
     TxCmdError
     IO
     (Either
        QueryConvenienceError
        (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
         LedgerProtocolParameters era))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError
 -> ExceptT
      TxCmdError
      IO
      (Either
         QueryConvenienceError
         (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
          LedgerProtocolParameters era)))
-> (AcquiringFailure -> TxCmdError)
-> AcquiringFailure
-> ExceptT
     TxCmdError
     IO
     (Either
        QueryConvenienceError
        (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
         LedgerProtocolParameters era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConvenienceError -> TxCmdError
TxCmdQueryConvenienceError (QueryConvenienceError -> TxCmdError)
-> (AcquiringFailure -> QueryConvenienceError)
-> AcquiringFailure
-> TxCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryConvenienceError
AcqFailure)
            ExceptT
  TxCmdError
  IO
  (Either
     QueryConvenienceError
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era))
-> (ExceptT
      TxCmdError
      IO
      (Either
         QueryConvenienceError
         (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
          LedgerProtocolParameters era))
    -> ExceptT
         TxCmdError
         IO
         (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
          LedgerProtocolParameters era))
-> ExceptT
     TxCmdError
     IO
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
forall a b. a -> (a -> b) -> b
& (QueryConvenienceError
 -> ExceptT
      TxCmdError
      IO
      (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
       LedgerProtocolParameters era))
-> ExceptT
     TxCmdError
     IO
     (Either
        QueryConvenienceError
        (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
         LedgerProtocolParameters era))
-> ExceptT
     TxCmdError
     IO
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError
-> ExceptT
     TxCmdError
     IO
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError
 -> ExceptT
      TxCmdError
      IO
      (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
       LedgerProtocolParameters era))
-> (QueryConvenienceError -> TxCmdError)
-> QueryConvenienceError
-> ExceptT
     TxCmdError
     IO
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConvenienceError -> TxCmdError
TxCmdQueryConvenienceError)
        ProvidedTransactionContextInfo
          ( TransactionContext
              { SystemStartOrGenesisFileSource
systemStartSource :: SystemStartOrGenesisFileSource
systemStartSource :: forall era.
TransactionContext era -> SystemStartOrGenesisFileSource
systemStartSource
              , MustExtendSafeZone
mustExtendSafeZone :: MustExtendSafeZone
mustExtendSafeZone :: forall era. TransactionContext era -> MustExtendSafeZone
mustExtendSafeZone
              , File EraHistory 'In
eraHistoryFile :: File EraHistory 'In
eraHistoryFile :: forall era. TransactionContext era -> File EraHistory 'In
eraHistoryFile
              , File (Some UTxO) 'In
utxoFile :: File (Some UTxO) 'In
utxoFile :: forall era. TransactionContext era -> File (Some UTxO) 'In
utxoFile
              , ProtocolParamsFile
protocolParamsFile :: ProtocolParamsFile
protocolParamsFile :: forall era. TransactionContext era -> ProtocolParamsFile
protocolParamsFile
              }
            ) -> do
            Era era
era <- Either TxCmdError (Era era) -> ExceptT TxCmdError IO (Era era)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TxCmdError (Era era) -> ExceptT TxCmdError IO (Era era))
-> Either TxCmdError (Era era) -> ExceptT TxCmdError IO (Era era)
forall a b. (a -> b) -> a -> b
$ (DeprecatedEra era -> TxCmdError)
-> Either (DeprecatedEra era) (Era era)
-> Either TxCmdError (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 -> TxCmdError
forall era. DeprecatedEra era -> TxCmdError
TxCmdDeprecatedEra (Either (DeprecatedEra era) (Era era)
 -> Either TxCmdError (Era era))
-> Either (DeprecatedEra era) (Era era)
-> Either TxCmdError (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)
Exp.sbeToEra ShelleyBasedEra era
sbe
            Era era
-> SystemStartOrGenesisFileSource
-> MustExtendSafeZone
-> File EraHistory 'In
-> File (Some UTxO) 'In
-> ProtocolParamsFile
-> ExceptT
     TxCmdError
     IO
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
forall era.
Era era
-> SystemStartOrGenesisFileSource
-> MustExtendSafeZone
-> File EraHistory 'In
-> File (Some UTxO) 'In
-> ProtocolParamsFile
-> ExceptT
     TxCmdError
     IO
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
buildTransactionContext
              Era era
era
              SystemStartOrGenesisFileSource
systemStartSource
              MustExtendSafeZone
mustExtendSafeZone
              File EraHistory 'In
eraHistoryFile
              File (Some UTxO) 'In
utxoFile
              ProtocolParamsFile
protocolParamsFile

    era :~: era
Refl <-
      CardanoEra era -> CardanoEra era -> Maybe (era :~: era)
forall a b. CardanoEra a -> CardanoEra b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality CardanoEra era
nodeEra (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ShelleyBasedEra era
txEra)
        Maybe (era :~: era)
-> (Maybe (era :~: era) -> ExceptT TxCmdError IO (era :~: era))
-> ExceptT TxCmdError IO (era :~: era)
forall a b. a -> (a -> b) -> b
& TxCmdError
-> Maybe (era :~: era) -> ExceptT TxCmdError IO (era :~: era)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe
          ( EraMismatch -> TxCmdError
TxCmdTxSubmitErrorEraMismatch (EraMismatch -> TxCmdError) -> EraMismatch -> TxCmdError
forall a b. (a -> b) -> a -> b
$
              EraMismatch{ledgerEraName :: Text
ledgerEraName = Doc AnsiStyle -> Text
docToText (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra era -> Doc ann
pretty CardanoEra era
nodeEra, otherEraName :: Text
otherEraName = Doc AnsiStyle -> Text
docToText (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
forall ann. ShelleyBasedEra era -> Doc ann
pretty ShelleyBasedEra era
txEra}
          )

    AlonzoEraOnwards era
aeo <- CardanoEra era -> Maybe (AlonzoEraOnwards era)
forall (eon :: * -> *) era.
Eon eon =>
CardanoEra era -> Maybe (eon era)
forEraMaybeEon CardanoEra era
nodeEra Maybe (AlonzoEraOnwards era)
-> (Maybe (AlonzoEraOnwards era)
    -> ExceptT TxCmdError IO (AlonzoEraOnwards era))
-> ExceptT TxCmdError IO (AlonzoEraOnwards era)
forall a b. a -> (a -> b) -> b
& TxCmdError
-> Maybe (AlonzoEraOnwards era)
-> ExceptT TxCmdError IO (AlonzoEraOnwards era)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (CardanoEra era -> TxCmdError
forall era. CardanoEra era -> TxCmdError
TxCmdAlonzoEraOnwardsRequired CardanoEra era
nodeEra)
    AlonzoEraOnwards era
-> SystemStart
-> EraHistory
-> LedgerProtocolParameters era
-> UTxO era
-> Tx era
-> ExceptT TxCmdError IO ()
forall era.
AlonzoEraOnwards era
-> SystemStart
-> EraHistory
-> LedgerProtocolParameters era
-> UTxO era
-> Tx era
-> ExceptT TxCmdError IO ()
calculatePlutusScriptsCosts AlonzoEraOnwards era
aeo SystemStart
systemStart EraHistory
eraHistory LedgerProtocolParameters era
LedgerProtocolParameters era
pparams UTxO era
UTxO era
txEraUtxo Tx era
Tx era
tx
   where
    calculatePlutusScriptsCosts
      :: AlonzoEraOnwards era
      -> SystemStart
      -> EraHistory
      -> LedgerProtocolParameters era
      -> UTxO era
      -> Tx era
      -> ExceptT TxCmdError IO ()
    calculatePlutusScriptsCosts :: forall era.
AlonzoEraOnwards era
-> SystemStart
-> EraHistory
-> LedgerProtocolParameters era
-> UTxO era
-> Tx era
-> ExceptT TxCmdError IO ()
calculatePlutusScriptsCosts AlonzoEraOnwards era
aeo SystemStart
systemStart EraHistory
eraHistory LedgerProtocolParameters era
pparams UTxO era
txEraUtxo Tx era
tx = do
      let era' :: CardanoEra era
era' = AlonzoEraOnwards era -> CardanoEra era
forall era. AlonzoEraOnwards era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra AlonzoEraOnwards era
aeo

      let scriptHashes :: Map ScriptWitnessIndex ScriptHash
scriptHashes = AlonzoEraOnwards era
-> Tx era -> UTxO era -> Map ScriptWitnessIndex ScriptHash
forall era.
AlonzoEraOnwards era
-> Tx era -> UTxO era -> Map ScriptWitnessIndex ScriptHash
collectPlutusScriptHashes AlonzoEraOnwards era
aeo Tx era
tx UTxO era
txEraUtxo

      Prices
executionUnitPrices <-
        Maybe Prices -> ExceptT TxCmdError IO (Maybe Prices)
forall a. a -> ExceptT TxCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CardanoEra era -> LedgerProtocolParameters era -> Maybe Prices
forall era.
CardanoEra era -> LedgerProtocolParameters era -> Maybe Prices
getExecutionUnitPrices CardanoEra era
era' LedgerProtocolParameters era
pparams) ExceptT TxCmdError IO (Maybe Prices)
-> (ExceptT TxCmdError IO (Maybe Prices)
    -> ExceptT TxCmdError IO Prices)
-> ExceptT TxCmdError IO Prices
forall a b. a -> (a -> b) -> b
& ExceptT TxCmdError IO Prices
-> ExceptT TxCmdError IO (Maybe Prices)
-> ExceptT TxCmdError IO Prices
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (TxCmdError -> ExceptT TxCmdError IO Prices
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left TxCmdError
TxCmdPParamExecutionUnitsNotAvailable)

      let scriptExecUnitsMap :: Map
  ScriptWitnessIndex
  (Either
     ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
scriptExecUnitsMap =
            CardanoEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> TxBody era
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
forall era.
CardanoEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> TxBody era
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
evaluateTransactionExecutionUnits
              CardanoEra era
era'
              SystemStart
systemStart
              (EraHistory -> LedgerEpochInfo
toLedgerEpochInfo EraHistory
eraHistory)
              LedgerProtocolParameters era
pparams
              UTxO era
txEraUtxo
              (Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx)

      [ScriptCostOutput]
scriptCostOutput <-
        (PlutusScriptCostError -> TxCmdError)
-> ExceptT PlutusScriptCostError IO [ScriptCostOutput]
-> ExceptT TxCmdError IO [ScriptCostOutput]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT PlutusScriptCostError -> TxCmdError
TxCmdPlutusScriptCostErr (ExceptT PlutusScriptCostError IO [ScriptCostOutput]
 -> ExceptT TxCmdError IO [ScriptCostOutput])
-> ExceptT PlutusScriptCostError IO [ScriptCostOutput]
-> ExceptT TxCmdError IO [ScriptCostOutput]
forall a b. (a -> b) -> a -> b
$
          Either PlutusScriptCostError [ScriptCostOutput]
-> ExceptT PlutusScriptCostError IO [ScriptCostOutput]
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either PlutusScriptCostError [ScriptCostOutput]
 -> ExceptT PlutusScriptCostError IO [ScriptCostOutput])
-> Either PlutusScriptCostError [ScriptCostOutput]
-> ExceptT PlutusScriptCostError IO [ScriptCostOutput]
forall a b. (a -> b) -> a -> b
$
            Prices
-> Map ScriptWitnessIndex ScriptHash
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
-> Either PlutusScriptCostError [ScriptCostOutput]
renderScriptCostsWithScriptHashesMap
              Prices
executionUnitPrices
              Map ScriptWitnessIndex ScriptHash
scriptHashes
              Map
  ScriptWitnessIndex
  (Either
     ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
scriptExecUnitsMap
      IO () -> ExceptT TxCmdError IO ()
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO () -> ExceptT TxCmdError IO ())
-> IO () -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ( case Maybe (File () 'Out)
outputFile of
              Just File () 'Out
file -> FilePath -> ByteString -> IO ()
LBS.writeFile (File () 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File () 'Out
file)
              Maybe (File () 'Out)
Nothing -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => ByteString -> m ()
putLByteString
          )
        (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [ScriptCostOutput] -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty [ScriptCostOutput]
scriptCostOutput

buildTransactionContext
  :: Exp.Era era
  -> SystemStartOrGenesisFileSource
  -> MustExtendSafeZone
  -> File EraHistory In
  -> File (Some UTxO) In
  -> ProtocolParamsFile
  -> ExceptT
       TxCmdError
       IO
       (AnyCardanoEra, SystemStart, EraHistory, UTxO era, LedgerProtocolParameters era)
buildTransactionContext :: forall era.
Era era
-> SystemStartOrGenesisFileSource
-> MustExtendSafeZone
-> File EraHistory 'In
-> File (Some UTxO) 'In
-> ProtocolParamsFile
-> ExceptT
     TxCmdError
     IO
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
buildTransactionContext Era era
era SystemStartOrGenesisFileSource
systemStartOrGenesisFileSource MustExtendSafeZone
mustUnsafeExtendSafeZone File EraHistory 'In
eraHistoryFile File (Some UTxO) 'In
utxoFile ProtocolParamsFile
protocolParamsFile =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    ExceptT
      TxCmdError
      IO
      (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
       LedgerProtocolParameters era))
-> ExceptT
     TxCmdError
     IO
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era) ((ShelleyBasedEraConstraints era =>
  ExceptT
    TxCmdError
    IO
    (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
     LedgerProtocolParameters era))
 -> ExceptT
      TxCmdError
      IO
      (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
       LedgerProtocolParameters era))
-> (ShelleyBasedEraConstraints era =>
    ExceptT
      TxCmdError
      IO
      (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
       LedgerProtocolParameters era))
-> ExceptT
     TxCmdError
     IO
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
forall a b. (a -> b) -> a -> b
$ do
    PParams (ShelleyLedgerEra era)
ledgerPParams <-
      (ProtocolParamsError -> TxCmdError)
-> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era))
-> ExceptT TxCmdError IO (PParams (ShelleyLedgerEra era))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ProtocolParamsError -> TxCmdError
TxCmdProtocolParamsError (ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era))
 -> ExceptT TxCmdError IO (PParams (ShelleyLedgerEra era)))
-> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era))
-> ExceptT TxCmdError IO (PParams (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
        Era era
-> (EraCommonConstraints era =>
    ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
-> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
 -> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
-> (EraCommonConstraints era =>
    ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era)))
-> ExceptT ProtocolParamsError IO (PParams (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
          ProtocolParamsFile
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
forall era.
IsEra era =>
ProtocolParamsFile
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
readProtocolParameters ProtocolParamsFile
protocolParamsFile
    EraHistory Interpreter xs
interpreter <-
      (FileError TextEnvelopeError -> ExceptT TxCmdError IO EraHistory)
-> ExceptT
     TxCmdError IO (Either (FileError TextEnvelopeError) EraHistory)
-> ExceptT TxCmdError IO EraHistory
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError -> ExceptT TxCmdError IO EraHistory
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError -> ExceptT TxCmdError IO EraHistory)
-> (FileError TextEnvelopeError -> TxCmdError)
-> FileError TextEnvelopeError
-> ExceptT TxCmdError IO EraHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> TxCmdError
TxCmdTextEnvError) (ExceptT
   TxCmdError IO (Either (FileError TextEnvelopeError) EraHistory)
 -> ExceptT TxCmdError IO EraHistory)
-> ExceptT
     TxCmdError IO (Either (FileError TextEnvelopeError) EraHistory)
-> ExceptT TxCmdError IO EraHistory
forall a b. (a -> b) -> a -> b
$
        IO (Either (FileError TextEnvelopeError) EraHistory)
-> ExceptT
     TxCmdError IO (Either (FileError TextEnvelopeError) EraHistory)
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (FileError TextEnvelopeError) EraHistory)
 -> ExceptT
      TxCmdError IO (Either (FileError TextEnvelopeError) EraHistory))
-> IO (Either (FileError TextEnvelopeError) EraHistory)
-> ExceptT
     TxCmdError IO (Either (FileError TextEnvelopeError) EraHistory)
forall a b. (a -> b) -> a -> b
$
          File EraHistory 'In
-> IO (Either (FileError TextEnvelopeError) EraHistory)
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope File EraHistory 'In
eraHistoryFile
    SystemStart
systemStart <- case SystemStartOrGenesisFileSource
systemStartOrGenesisFileSource of
      SystemStartLiteral SystemStart
systemStart -> SystemStart -> ExceptT TxCmdError IO SystemStart
forall a. a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SystemStart
systemStart
      SystemStartFromGenesisFile (GenesisFile FilePath
byronGenesisFile) -> do
        (GenesisData
byronGenesisData, GenesisHash
_) <- (GenesisDataError -> TxCmdError)
-> ExceptT GenesisDataError IO (GenesisData, GenesisHash)
-> ExceptT TxCmdError IO (GenesisData, GenesisHash)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT GenesisDataError -> TxCmdError
TxCmdGenesisDataError (ExceptT GenesisDataError IO (GenesisData, GenesisHash)
 -> ExceptT TxCmdError IO (GenesisData, GenesisHash))
-> ExceptT GenesisDataError IO (GenesisData, GenesisHash)
-> ExceptT TxCmdError IO (GenesisData, GenesisHash)
forall a b. (a -> b) -> a -> b
$ FilePath -> ExceptT GenesisDataError IO (GenesisData, GenesisHash)
forall (m :: * -> *).
(MonadError GenesisDataError m, MonadIO m) =>
FilePath -> m (GenesisData, GenesisHash)
Byron.readGenesisData FilePath
byronGenesisFile
        let systemStartUTCTime :: UTCTime
systemStartUTCTime = GenesisData -> UTCTime
Byron.gdStartTime GenesisData
byronGenesisData
        SystemStart -> ExceptT TxCmdError IO SystemStart
forall a. a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SystemStart -> ExceptT TxCmdError IO SystemStart)
-> SystemStart -> ExceptT TxCmdError IO SystemStart
forall a b. (a -> b) -> a -> b
$ UTCTime -> SystemStart
SystemStart UTCTime
systemStartUTCTime
    ByteString
utxosBytes <- (FileError JsonDecodeError -> TxCmdError)
-> ExceptT (FileError JsonDecodeError) IO ByteString
-> ExceptT TxCmdError IO ByteString
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError JsonDecodeError -> TxCmdError
TxCmdUtxoFileError (IO (Either (FileError JsonDecodeError) ByteString)
-> ExceptT (FileError JsonDecodeError) IO ByteString
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either (FileError JsonDecodeError) ByteString)
 -> ExceptT (FileError JsonDecodeError) IO ByteString)
-> IO (Either (FileError JsonDecodeError) ByteString)
-> ExceptT (FileError JsonDecodeError) IO ByteString
forall a b. (a -> b) -> a -> b
$ File (Some UTxO) 'In
-> IO (Either (FileError JsonDecodeError) ByteString)
forall (m :: * -> *) content e.
MonadIO m =>
File content 'In -> m (Either (FileError e) ByteString)
readByteStringFile File (Some UTxO) 'In
utxoFile)
    UTxO era
utxos <- Either TxCmdError (UTxO era) -> ExceptT TxCmdError IO (UTxO era)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either TxCmdError (UTxO era) -> ExceptT TxCmdError IO (UTxO era))
-> (Either FilePath (UTxO era) -> Either TxCmdError (UTxO era))
-> Either FilePath (UTxO era)
-> ExceptT TxCmdError IO (UTxO era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> TxCmdError)
-> Either FilePath (UTxO era) -> Either TxCmdError (UTxO 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 FilePath -> TxCmdError
TxCmdUtxoJsonError (Either FilePath (UTxO era) -> ExceptT TxCmdError IO (UTxO era))
-> Either FilePath (UTxO era) -> ExceptT TxCmdError IO (UTxO era)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath (UTxO era)
forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecodeStrict' ByteString
utxosBytes
    let eraHistory :: EraHistory
eraHistory = Interpreter xs -> EraHistory
forall (xs :: [*]).
(CardanoBlock StandardCrypto ~ HardForkBlock xs) =>
Interpreter xs -> EraHistory
EraHistory (Interpreter xs -> EraHistory) -> Interpreter xs -> EraHistory
forall a b. (a -> b) -> a -> b
$ case MustExtendSafeZone
mustUnsafeExtendSafeZone of
          MustExtendSafeZone
MustExtendSafeZone -> Interpreter xs -> Interpreter xs
forall (xs :: [*]). Interpreter xs -> Interpreter xs
unsafeExtendSafeZone Interpreter xs
interpreter
          MustExtendSafeZone
DoNotExtendSafeZone -> Interpreter xs
interpreter
    (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
 LedgerProtocolParameters era)
-> ExceptT
     TxCmdError
     IO
     (AnyCardanoEra, SystemStart, EraHistory, UTxO era,
      LedgerProtocolParameters era)
forall a. a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
      ( CardanoEra era -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra (Era era -> CardanoEra era
forall era. Era era -> CardanoEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era)
      , SystemStart
systemStart
      , EraHistory
eraHistory
      , UTxO era
utxos
      , PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters PParams (ShelleyLedgerEra era)
ledgerPParams
      )

runTransactionPolicyIdCmd
  :: Cmd.TransactionPolicyIdCmdArgs
  -> CIO e ()
runTransactionPolicyIdCmd :: forall e. TransactionPolicyIdCmdArgs -> CIO e ()
runTransactionPolicyIdCmd
  Cmd.TransactionPolicyIdCmdArgs
    { scriptFile :: TransactionPolicyIdCmdArgs -> ScriptFile
scriptFile = File FilePath
sFile
    } = do
    ScriptInAnyLang ScriptLanguage lang
_ Script lang
script <-
      FilePath -> RIO e ScriptInAnyLang
forall (m :: * -> *). MonadIO m => FilePath -> m ScriptInAnyLang
readFileScriptInAnyLang FilePath
sFile
    IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ())
-> (ScriptHash -> IO ()) -> ScriptHash -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
Text.putStrLn (Text -> IO ()) -> (ScriptHash -> Text) -> ScriptHash -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText (ScriptHash -> RIO e ()) -> ScriptHash -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
script

partitionSomeWitnesses
  :: [ByronOrShelleyWitness]
  -> ( [ShelleyBootstrapWitnessSigningKeyData]
     , [ShelleyWitnessSigningKey]
     )
partitionSomeWitnesses :: [ByronOrShelleyWitness]
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
partitionSomeWitnesses = ([ShelleyBootstrapWitnessSigningKeyData],
 [ShelleyWitnessSigningKey])
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
forall {a} {a}. ([a], [a]) -> ([a], [a])
reversePartitionedWits (([ShelleyBootstrapWitnessSigningKeyData],
  [ShelleyWitnessSigningKey])
 -> ([ShelleyBootstrapWitnessSigningKeyData],
     [ShelleyWitnessSigningKey]))
-> ([ByronOrShelleyWitness]
    -> ([ShelleyBootstrapWitnessSigningKeyData],
        [ShelleyWitnessSigningKey]))
-> [ByronOrShelleyWitness]
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([ShelleyBootstrapWitnessSigningKeyData],
  [ShelleyWitnessSigningKey])
 -> ByronOrShelleyWitness
 -> ([ShelleyBootstrapWitnessSigningKeyData],
     [ShelleyWitnessSigningKey]))
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
-> [ByronOrShelleyWitness]
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' ([ShelleyBootstrapWitnessSigningKeyData],
 [ShelleyWitnessSigningKey])
-> ByronOrShelleyWitness
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
go ([ShelleyBootstrapWitnessSigningKeyData],
 [ShelleyWitnessSigningKey])
forall a. Monoid a => a
mempty
 where
  reversePartitionedWits :: ([a], [a]) -> ([a], [a])
reversePartitionedWits ([a]
bw, [a]
skw) =
    ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
bw, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
skw)

  go :: ([ShelleyBootstrapWitnessSigningKeyData],
 [ShelleyWitnessSigningKey])
-> ByronOrShelleyWitness
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
go ([ShelleyBootstrapWitnessSigningKeyData]
byronAcc, [ShelleyWitnessSigningKey]
shelleyKeyAcc) ByronOrShelleyWitness
byronOrShelleyWit =
    case ByronOrShelleyWitness
byronOrShelleyWit of
      AByronWitness ShelleyBootstrapWitnessSigningKeyData
byronWit ->
        (ShelleyBootstrapWitnessSigningKeyData
byronWit ShelleyBootstrapWitnessSigningKeyData
-> [ShelleyBootstrapWitnessSigningKeyData]
-> [ShelleyBootstrapWitnessSigningKeyData]
forall a. a -> [a] -> [a]
: [ShelleyBootstrapWitnessSigningKeyData]
byronAcc, [ShelleyWitnessSigningKey]
shelleyKeyAcc)
      AShelleyKeyWitness ShelleyWitnessSigningKey
shelleyKeyWit ->
        ([ShelleyBootstrapWitnessSigningKeyData]
byronAcc, ShelleyWitnessSigningKey
shelleyKeyWit ShelleyWitnessSigningKey
-> [ShelleyWitnessSigningKey] -> [ShelleyWitnessSigningKey]
forall a. a -> [a] -> [a]
: [ShelleyWitnessSigningKey]
shelleyKeyAcc)

-- ----------------------------------------------------------------------------
-- Other misc small commands
--

runTransactionHashScriptDataCmd
  :: ()
  => Cmd.TransactionHashScriptDataCmdArgs
  -> ExceptT TxCmdError IO ()
runTransactionHashScriptDataCmd :: TransactionHashScriptDataCmdArgs -> ExceptT TxCmdError IO ()
runTransactionHashScriptDataCmd
  Cmd.TransactionHashScriptDataCmdArgs
    { ScriptDataOrFile
scriptDataOrFile :: ScriptDataOrFile
scriptDataOrFile :: TransactionHashScriptDataCmdArgs -> ScriptDataOrFile
scriptDataOrFile
    } = do
    ScriptRedeemer
d <- (ScriptDataError -> TxCmdError)
-> ExceptT ScriptDataError IO ScriptRedeemer
-> ExceptT TxCmdError IO ScriptRedeemer
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> TxCmdError
TxCmdScriptDataError (ExceptT ScriptDataError IO ScriptRedeemer
 -> ExceptT TxCmdError IO ScriptRedeemer)
-> ExceptT ScriptDataError IO ScriptRedeemer
-> ExceptT TxCmdError IO ScriptRedeemer
forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO ScriptRedeemer
forall (m :: * -> *).
MonadIO m =>
ScriptDataOrFile -> ExceptT ScriptDataError m ScriptRedeemer
readScriptDataOrFile ScriptDataOrFile
scriptDataOrFile
    IO () -> ExceptT TxCmdError IO ()
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT TxCmdError IO ())
-> IO () -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (ScriptRedeemer -> Hash ScriptData
hashScriptDataBytes ScriptRedeemer
d)

runTransactionTxIdCmd
  :: ()
  => Cmd.TransactionTxIdCmdArgs
  -> ExceptT TxCmdError IO ()
runTransactionTxIdCmd :: TransactionTxIdCmdArgs -> ExceptT TxCmdError IO ()
runTransactionTxIdCmd
  Cmd.TransactionTxIdCmdArgs
    { InputTxBodyOrTxFile
inputTxBodyOrTxFile :: InputTxBodyOrTxFile
inputTxBodyOrTxFile :: TransactionTxIdCmdArgs -> InputTxBodyOrTxFile
inputTxBodyOrTxFile
    , Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: TransactionTxIdCmdArgs
-> Vary '[FormatJson, FormatText, FormatYaml]
outputFormat
    } = do
    InAnyShelleyBasedEra ShelleyBasedEra era
_era TxBody era
txbody <-
      case InputTxBodyOrTxFile
inputTxBodyOrTxFile of
        InputTxBodyFile (File FilePath
txbodyFilePath) -> do
          FileOrPipe
txbodyFile <- IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe)
-> IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txbodyFilePath
          IncompleteTxBody
unwitnessed <-
            (FileError TextEnvelopeError -> TxCmdError)
-> ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody
-> ExceptT TxCmdError IO IncompleteTxBody
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> TxCmdError
TxCmdTextEnvError (ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody
 -> ExceptT TxCmdError IO IncompleteTxBody)
-> (IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
    -> ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody)
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> ExceptT TxCmdError IO IncompleteTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
 -> ExceptT TxCmdError IO IncompleteTxBody)
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> ExceptT TxCmdError IO IncompleteTxBody
forall a b. (a -> b) -> a -> b
$
              FileOrPipe
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
readFileTxBody FileOrPipe
txbodyFile
          InAnyShelleyBasedEra TxBody
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra TxBody)
forall a. a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InAnyShelleyBasedEra TxBody
 -> ExceptT TxCmdError IO (InAnyShelleyBasedEra TxBody))
-> InAnyShelleyBasedEra TxBody
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra TxBody)
forall a b. (a -> b) -> a -> b
$ IncompleteTxBody -> InAnyShelleyBasedEra TxBody
unIncompleteTxBody IncompleteTxBody
unwitnessed
        InputTxFile (File FilePath
txFilePath) -> do
          FileOrPipe
txFile <- IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe)
-> IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txFilePath
          InAnyShelleyBasedEra ShelleyBasedEra era
era Tx era
tx <- IO (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> ExceptT
     TxCmdError
     IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TxCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
readFileTx FileOrPipe
txFile) ExceptT
  TxCmdError
  IO
  (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> (ExceptT
      TxCmdError
      IO
      (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
    -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall a b. a -> (a -> b) -> b
& (FileError TextEnvelopeError
 -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> ExceptT
     TxCmdError
     IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError -> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx))
-> (FileError TextEnvelopeError -> TxCmdError)
-> FileError TextEnvelopeError
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra Tx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> TxCmdError
TxCmdTextEnvError)
          InAnyShelleyBasedEra TxBody
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra TxBody)
forall a. a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InAnyShelleyBasedEra TxBody
 -> ExceptT TxCmdError IO (InAnyShelleyBasedEra TxBody))
-> (TxBody era -> InAnyShelleyBasedEra TxBody)
-> TxBody era
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra TxBody)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> TxBody era -> InAnyShelleyBasedEra TxBody
forall era (thing :: * -> *).
Typeable era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra era
era (TxBody era -> ExceptT TxCmdError IO (InAnyShelleyBasedEra TxBody))
-> TxBody era
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra TxBody)
forall a b. (a -> b) -> a -> b
$ Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx

    let txId :: TxId
txId = TxBody era -> TxId
forall era. TxBody era -> TxId
getTxId TxBody era
txbody

    IO () -> ExceptT TxCmdError IO ()
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT TxCmdError IO ())
-> IO () -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      Vary '[FormatJson, FormatText, FormatYaml]
outputFormat
        Vary '[FormatJson, FormatText, FormatYaml]
-> (Vary '[FormatJson, FormatText, FormatYaml] -> IO ()) -> IO ()
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatText, FormatYaml] -> IO ())
-> Vary '[FormatJson, FormatText, FormatYaml] -> IO ()
forall a. a -> a
id
              ((Vary '[FormatJson, FormatText, FormatYaml] -> IO ())
 -> Vary '[FormatJson, FormatText, FormatYaml] -> IO ())
-> ((Vary '[] -> IO ())
    -> Vary '[FormatJson, FormatText, FormatYaml] -> IO ())
-> (Vary '[] -> IO ())
-> Vary '[FormatJson, FormatText, FormatYaml]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> IO ())
-> (Vary '[FormatText, FormatYaml] -> IO ())
-> Vary '[FormatJson, FormatText, FormatYaml]
-> IO ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ TxSubmissionResult -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson (TxSubmissionResult -> ByteString)
-> TxSubmissionResult -> ByteString
forall a b. (a -> b) -> a -> b
$ TxId -> TxSubmissionResult
TxSubmissionResult TxId
txId)
              ((Vary '[FormatText, FormatYaml] -> IO ())
 -> Vary '[FormatJson, FormatText, FormatYaml] -> IO ())
-> ((Vary '[] -> IO ()) -> Vary '[FormatText, FormatYaml] -> IO ())
-> (Vary '[] -> IO ())
-> Vary '[FormatJson, FormatText, FormatYaml]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatText -> IO ())
-> (Vary '[FormatYaml] -> IO ())
-> Vary '[FormatText, FormatYaml]
-> IO ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatText
FormatText -> ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ TxId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex TxId
txId)
              ((Vary '[FormatYaml] -> IO ())
 -> Vary '[FormatText, FormatYaml] -> IO ())
-> ((Vary '[] -> IO ()) -> Vary '[FormatYaml] -> IO ())
-> (Vary '[] -> IO ())
-> Vary '[FormatText, FormatYaml]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> IO ())
-> (Vary '[] -> IO ()) -> Vary '[FormatYaml] -> IO ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ TxSubmissionResult -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml (TxSubmissionResult -> ByteString)
-> TxSubmissionResult -> ByteString
forall a b. (a -> b) -> a -> b
$ TxId -> TxSubmissionResult
TxSubmissionResult TxId
txId)
              ((Vary '[] -> IO ())
 -> Vary '[FormatJson, FormatText, FormatYaml] -> IO ())
-> (Vary '[] -> IO ())
-> Vary '[FormatJson, FormatText, FormatYaml]
-> IO ()
forall a b. (a -> b) -> a -> b
$ Vary '[] -> IO ()
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
          )

-- ----------------------------------------------------------------------------
-- Witness commands
--

runTransactionWitnessCmd
  :: ()
  => Cmd.TransactionWitnessCmdArgs
  -> ExceptT TxCmdError IO ()
runTransactionWitnessCmd :: TransactionWitnessCmdArgs -> ExceptT TxCmdError IO ()
runTransactionWitnessCmd
  Cmd.TransactionWitnessCmdArgs
    { txBodyFile :: TransactionWitnessCmdArgs -> File (TxBody ()) 'In
txBodyFile = File FilePath
txbodyFilePath
    , WitnessSigningData
witnessSigningData :: WitnessSigningData
witnessSigningData :: TransactionWitnessCmdArgs -> WitnessSigningData
witnessSigningData
    , Maybe NetworkId
mNetworkId :: Maybe NetworkId
mNetworkId :: TransactionWitnessCmdArgs -> Maybe NetworkId
mNetworkId
    , File () 'Out
outFile :: File () 'Out
outFile :: TransactionWitnessCmdArgs -> File () 'Out
outFile
    } = do
    FileOrPipe
txbodyFile <- IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe)
-> IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txbodyFilePath
    IncompleteTxBody
unwitnessed <-
      (FileError TextEnvelopeError -> TxCmdError)
-> ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody
-> ExceptT TxCmdError IO IncompleteTxBody
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> TxCmdError
TxCmdTextEnvError (ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody
 -> ExceptT TxCmdError IO IncompleteTxBody)
-> (IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
    -> ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody)
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> ExceptT TxCmdError IO IncompleteTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> ExceptT (FileError TextEnvelopeError) IO IncompleteTxBody
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
 -> ExceptT TxCmdError IO IncompleteTxBody)
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> ExceptT TxCmdError IO IncompleteTxBody
forall a b. (a -> b) -> a -> b
$
        FileOrPipe
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
readFileTxBody FileOrPipe
txbodyFile
    case IncompleteTxBody
unwitnessed of
      IncompleteTxBody InAnyShelleyBasedEra TxBody
anyTxBody -> do
        InAnyShelleyBasedEra ShelleyBasedEra era
sbe txbody :: TxBody era
txbody@(ShelleyTxBody ShelleyBasedEra era
_ TxBody (ShelleyLedgerEra era)
ledgerTxBody [Script (ShelleyLedgerEra era)]
_ TxBodyScriptData era
_ Maybe (TxAuxData (ShelleyLedgerEra era))
_ TxScriptValidity era
_) <- InAnyShelleyBasedEra TxBody
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra TxBody)
forall a. a -> ExceptT TxCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InAnyShelleyBasedEra TxBody
anyTxBody
        SomeSigningWitness
someWit <-
          (ReadWitnessSigningDataError -> TxCmdError)
-> ExceptT ReadWitnessSigningDataError IO SomeSigningWitness
-> ExceptT TxCmdError IO SomeSigningWitness
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ReadWitnessSigningDataError -> TxCmdError
TxCmdReadWitnessSigningDataError
            (ExceptT ReadWitnessSigningDataError IO SomeSigningWitness
 -> ExceptT TxCmdError IO SomeSigningWitness)
-> (IO (Either ReadWitnessSigningDataError SomeSigningWitness)
    -> ExceptT ReadWitnessSigningDataError IO SomeSigningWitness)
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
-> ExceptT TxCmdError IO SomeSigningWitness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either ReadWitnessSigningDataError SomeSigningWitness)
-> ExceptT ReadWitnessSigningDataError IO SomeSigningWitness
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
            (IO (Either ReadWitnessSigningDataError SomeSigningWitness)
 -> ExceptT TxCmdError IO SomeSigningWitness)
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
-> ExceptT TxCmdError IO SomeSigningWitness
forall a b. (a -> b) -> a -> b
$ WitnessSigningData
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
readWitnessSigningData WitnessSigningData
witnessSigningData
        KeyWitness era
witness <-
          case SomeSigningWitness -> ByronOrShelleyWitness
categoriseSomeSigningWitness SomeSigningWitness
someWit of
            -- Byron witnesses require the network ID. This can either be provided
            -- directly or derived from a provided Byron address.
            AByronWitness ShelleyBootstrapWitnessSigningKeyData
bootstrapWitData ->
              (BootstrapWitnessError -> TxCmdError)
-> ExceptT BootstrapWitnessError IO (KeyWitness era)
-> ExceptT TxCmdError IO (KeyWitness era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT BootstrapWitnessError -> TxCmdError
TxCmdBootstrapWitnessError (ExceptT BootstrapWitnessError IO (KeyWitness era)
 -> ExceptT TxCmdError IO (KeyWitness era))
-> (Either BootstrapWitnessError (KeyWitness era)
    -> ExceptT BootstrapWitnessError IO (KeyWitness era))
-> Either BootstrapWitnessError (KeyWitness era)
-> ExceptT TxCmdError IO (KeyWitness era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either BootstrapWitnessError (KeyWitness era)
-> ExceptT BootstrapWitnessError IO (KeyWitness era)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either BootstrapWitnessError (KeyWitness era)
 -> ExceptT TxCmdError IO (KeyWitness era))
-> Either BootstrapWitnessError (KeyWitness era)
-> ExceptT TxCmdError IO (KeyWitness era)
forall a b. (a -> b) -> a -> b
$
                ShelleyBasedEra era
-> Maybe NetworkId
-> TxBody (ShelleyLedgerEra era)
-> ShelleyBootstrapWitnessSigningKeyData
-> Either BootstrapWitnessError (KeyWitness era)
forall era.
ShelleyBasedEra era
-> Maybe NetworkId
-> TxBody (ShelleyLedgerEra era)
-> ShelleyBootstrapWitnessSigningKeyData
-> Either BootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness ShelleyBasedEra era
sbe Maybe NetworkId
mNetworkId TxBody (ShelleyLedgerEra era)
ledgerTxBody ShelleyBootstrapWitnessSigningKeyData
bootstrapWitData
            AShelleyKeyWitness ShelleyWitnessSigningKey
skShelley ->
              KeyWitness era -> ExceptT TxCmdError IO (KeyWitness era)
forall a. a -> ExceptT TxCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyWitness era -> ExceptT TxCmdError IO (KeyWitness era))
-> KeyWitness era -> ExceptT TxCmdError IO (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
forall era.
ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
makeShelleyKeyWitness ShelleyBasedEra era
sbe TxBody era
txbody ShelleyWitnessSigningKey
skShelley

        (FileError () -> TxCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT TxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> TxCmdError
TxCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT TxCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT TxCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT TxCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$
          ShelleyBasedEra era
-> File () 'Out -> KeyWitness era -> IO (Either (FileError ()) ())
forall era.
ShelleyBasedEra era
-> File () 'Out -> KeyWitness era -> IO (Either (FileError ()) ())
writeTxWitnessFileTextEnvelope ShelleyBasedEra era
sbe File () 'Out
outFile KeyWitness era
witness

runTransactionSignWitnessCmd
  :: ()
  => Cmd.TransactionSignWitnessCmdArgs
  -> ExceptT TxCmdError IO ()
runTransactionSignWitnessCmd :: TransactionSignWitnessCmdArgs -> ExceptT TxCmdError IO ()
runTransactionSignWitnessCmd
  Cmd.TransactionSignWitnessCmdArgs
    { txBodyFile :: TransactionSignWitnessCmdArgs -> File (TxBody ()) 'In
txBodyFile = File FilePath
txbodyFilePath
    , [WitnessFile]
witnessFiles :: [WitnessFile]
witnessFiles :: TransactionSignWitnessCmdArgs -> [WitnessFile]
witnessFiles
    , File () 'Out
outFile :: File () 'Out
outFile :: TransactionSignWitnessCmdArgs -> File () 'Out
outFile
    , TxCborFormat
isCborOutCanonical :: TxCborFormat
isCborOutCanonical :: TransactionSignWitnessCmdArgs -> TxCborFormat
isCborOutCanonical
    } = do
    FileOrPipe
txbodyFile <- IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a. IO a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe)
-> IO FileOrPipe -> ExceptT TxCmdError IO FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txbodyFilePath
    -- unwitnessed body
    IncompleteTxBody (InAnyShelleyBasedEra ShelleyBasedEra era
era TxBody era
txbody) <-
      IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> ExceptT
     TxCmdError
     IO
     (Either (FileError TextEnvelopeError) IncompleteTxBody)
forall (m :: * -> *) a. Monad m => m a -> ExceptT TxCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FileOrPipe
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
readFileTxBody FileOrPipe
txbodyFile) ExceptT
  TxCmdError
  IO
  (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> (ExceptT
      TxCmdError
      IO
      (Either (FileError TextEnvelopeError) IncompleteTxBody)
    -> ExceptT TxCmdError IO IncompleteTxBody)
-> ExceptT TxCmdError IO IncompleteTxBody
forall a b. a -> (a -> b) -> b
& (FileError TextEnvelopeError
 -> ExceptT TxCmdError IO IncompleteTxBody)
-> ExceptT
     TxCmdError
     IO
     (Either (FileError TextEnvelopeError) IncompleteTxBody)
-> ExceptT TxCmdError IO IncompleteTxBody
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError -> ExceptT TxCmdError IO IncompleteTxBody
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError -> ExceptT TxCmdError IO IncompleteTxBody)
-> (FileError TextEnvelopeError -> TxCmdError)
-> FileError TextEnvelopeError
-> ExceptT TxCmdError IO IncompleteTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> TxCmdError
TxCmdTextEnvError)
    [KeyWitness era]
witnesses <-
      [ExceptT TxCmdError IO (KeyWitness era)]
-> ExceptT TxCmdError IO [KeyWitness era]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ do
            InAnyShelleyBasedEra ShelleyBasedEra era
era' KeyWitness era
witness <-
              IO
  (Either
     (FileError TextEnvelopeError) (InAnyShelleyBasedEra KeyWitness))
-> ExceptT
     TxCmdError
     IO
     (Either
        (FileError TextEnvelopeError) (InAnyShelleyBasedEra KeyWitness))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TxCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FilePath
-> IO
     (Either
        (FileError TextEnvelopeError) (InAnyShelleyBasedEra KeyWitness))
readFileTxKeyWitness FilePath
file)
                ExceptT
  TxCmdError
  IO
  (Either
     (FileError TextEnvelopeError) (InAnyShelleyBasedEra KeyWitness))
-> (ExceptT
      TxCmdError
      IO
      (Either
         (FileError TextEnvelopeError) (InAnyShelleyBasedEra KeyWitness))
    -> ExceptT TxCmdError IO (InAnyShelleyBasedEra KeyWitness))
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra KeyWitness)
forall a b. a -> (a -> b) -> b
& (FileError TextEnvelopeError
 -> ExceptT TxCmdError IO (InAnyShelleyBasedEra KeyWitness))
-> ExceptT
     TxCmdError
     IO
     (Either
        (FileError TextEnvelopeError) (InAnyShelleyBasedEra KeyWitness))
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra KeyWitness)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (TxCmdError
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra KeyWitness)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError
 -> ExceptT TxCmdError IO (InAnyShelleyBasedEra KeyWitness))
-> (FileError TextEnvelopeError -> TxCmdError)
-> FileError TextEnvelopeError
-> ExceptT TxCmdError IO (InAnyShelleyBasedEra KeyWitness)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> TxCmdError
TxCmdTextEnvError)

            case ShelleyBasedEra era -> ShelleyBasedEra era -> Maybe (era :~: era)
forall a b.
ShelleyBasedEra a -> ShelleyBasedEra b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality ShelleyBasedEra era
era ShelleyBasedEra era
era' of
              Maybe (era :~: era)
Nothing ->
                TxCmdError -> ExceptT TxCmdError IO (KeyWitness era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxCmdError -> ExceptT TxCmdError IO (KeyWitness era))
-> TxCmdError -> ExceptT TxCmdError IO (KeyWitness era)
forall a b. (a -> b) -> a -> b
$
                  AnyCardanoEra -> AnyCardanoEra -> WitnessFile -> TxCmdError
TxCmdWitnessEraMismatch
                    (CardanoEra era -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra (CardanoEra era -> AnyCardanoEra)
-> CardanoEra era -> AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
era)
                    (CardanoEra era -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra (CardanoEra era -> AnyCardanoEra)
-> CardanoEra era -> AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
era')
                    WitnessFile
witnessFile
              Just era :~: era
Refl -> KeyWitness era -> ExceptT TxCmdError IO (KeyWitness era)
forall a. a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return KeyWitness era
KeyWitness era
witness
        | witnessFile :: WitnessFile
witnessFile@(WitnessFile FilePath
file) <- [WitnessFile]
witnessFiles
        ]

    let tx :: Tx era
tx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness era]
witnesses TxBody era
txbody
    (FileError () -> TxCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT TxCmdError IO ()
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError () -> TxCmdError
TxCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT TxCmdError IO ())
-> ExceptT (FileError ()) IO () -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall e (t :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIOTransError e t m =>
IO (Either e a) -> t m a
hoistIOEither (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
        if TxCborFormat
isCborOutCanonical TxCborFormat -> TxCborFormat -> Bool
forall a. Eq a => a -> a -> Bool
== TxCborFormat
TxCborCanonical
          then ShelleyBasedEra era
-> File () 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCanonical ShelleyBasedEra era
era File () 'Out
outFile Tx era
tx
          else ShelleyBasedEra era
-> File () 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelope ShelleyBasedEra era
era File () 'Out
outFile Tx era
tx