{-# 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.Experimental.AnyScript qualified as Exp
import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp
import Cardano.Api.Experimental.Tx 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.Proposal.Read
import Cardano.CLI.EraBased.Script.Read.Common
import Cardano.CLI.EraBased.Script.Spend.Read
import Cardano.CLI.EraBased.Script.Vote.Read
import Cardano.CLI.EraBased.Script.Withdrawal.Read
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, AnyWitness (LedgerEra era))]
txinsAndMaybeScriptWits <-
      [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, AnyWitness (LedgerEra era))]
forall era e.
IsEra era =>
[(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, AnyWitness (LedgerEra era))]
readSpendScriptWitnesses [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txins

    let spendingScriptWitnesses :: [AnyWitness (LedgerEra era)]
spendingScriptWitnesses = ((TxIn, AnyWitness (LedgerEra era)) -> AnyWitness (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, AnyWitness (LedgerEra era)) -> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(TxIn, AnyWitness (LedgerEra 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
      :: [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))] <-
      [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
<$> ( 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 (LedgerEra era)))
 -> RIO e (Certificate (LedgerEra era)))
-> IO
     (Either
        (FileError TextEnvelopeError) (Certificate (LedgerEra era)))
-> RIO e (Certificate (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
                    Era era
-> (EraCommonConstraints era =>
    IO
      (Either
         (FileError TextEnvelopeError) (Certificate (LedgerEra era))))
-> IO
     (Either
        (FileError TextEnvelopeError) (Certificate (LedgerEra era)))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
currentEra ((EraCommonConstraints era =>
  IO
    (Either
       (FileError TextEnvelopeError) (Certificate (LedgerEra era))))
 -> IO
      (Either
         (FileError TextEnvelopeError) (Certificate (LedgerEra era))))
-> (EraCommonConstraints era =>
    IO
      (Either
         (FileError TextEnvelopeError) (Certificate (LedgerEra era))))
-> IO
     (Either
        (FileError TextEnvelopeError) (Certificate (LedgerEra era)))
forall a b. (a -> b) -> a -> b
$
                      File Any 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (Certificate (LedgerEra 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, AnyWitness (LedgerEra era))]
withdrawalsAndMaybeScriptWits <-
      ((StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))
 -> RIO e (StakeAddress, Lovelace, AnyWitness (LedgerEra era)))
-> [(StakeAddress, Lovelace,
     Maybe (ScriptRequirements 'WithdrawalItem))]
-> RIO e [(StakeAddress, Lovelace, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO e (StakeAddress, Lovelace, AnyWitness (LedgerEra era))
forall e era.
IsEra era =>
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO e (StakeAddress, Lovelace, AnyWitness (LedgerEra 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
    [(PolicyId, AnyWitness (LedgerEra era))]
mintingWitnesses <-
      (ScriptRequirements 'MintItem
 -> RIO e (PolicyId, AnyWitness (LedgerEra era)))
-> [ScriptRequirements 'MintItem]
-> RIO e [(PolicyId, AnyWitness (LedgerEra 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 (PolicyId, AnyWitness (LedgerEra era))
ScriptRequirements 'MintItem
-> CIO e (PolicyId, AnyWitness (LedgerEra era))
forall era e.
IsEra era =>
ScriptRequirements 'MintItem
-> CIO e (PolicyId, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))]
votingProceduresAndMaybeScriptWits :: [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] <-
      [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall era e.
IsEra era =>
[(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
readVotingProceduresFiles [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles

    [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> ((VotingProcedures era, AnyWitness (LedgerEra era)) -> RIO e ())
-> RIO e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(VotingProcedures era, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))
    -> ExceptT TxCmdError IO ())
-> (VotingProcedures era, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))
    -> VotingProcedures era)
-> (VotingProcedures era, AnyWitness (LedgerEra era))
-> ExceptT TxCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VotingProcedures era, AnyWitness (LedgerEra era))
-> VotingProcedures era
forall a b. (a, b) -> a
fst)

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

    [(Proposal era, AnyWitness (LedgerEra era))]
-> ((Proposal era, AnyWitness (LedgerEra era)) -> RIO e ())
-> RIO e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Proposal era, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))
    -> ExceptT TxCmdError IO ())
-> (Proposal era, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era)) -> Proposal era)
-> (Proposal era, AnyWitness (LedgerEra era))
-> ExceptT TxCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proposal era, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era)
_) <- [(Proposal era, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era)
_) <- [(Proposal era, AnyWitness (LedgerEra 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 =
          [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
forall era.
[AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
            [AnyWitness (LedgerEra era)]
spendingScriptWitnesses
            (((PolicyId, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(PolicyId, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (PolicyId, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(PolicyId, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (\(StakeAddress
_, Lovelace
_, AnyWitness (LedgerEra era)
wit) -> AnyWitness (LedgerEra era)
wit) [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawalsAndMaybeScriptWits)
            (((VotingProcedures era, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (VotingProcedures era, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProceduresAndMaybeScriptWits)
            (((Proposal era, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Proposal era, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(Proposal era, AnyWitness (LedgerEra 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 (ShelleyLedgerEra 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 (ShelleyLedgerEra 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 :: UnsignedTx era
balancedTxBody@(Exp.UnsignedTx Tx (LedgerEra era)
tx), TxBodyContent (LedgerEra era)
txBodyContent) <-
      ExceptT
  TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era))
-> RIO e (UnsignedTx era, TxBodyContent (LedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT
   TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era))
 -> RIO e (UnsignedTx era, TxBodyContent (LedgerEra era)))
-> ExceptT
     TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era))
-> RIO e (UnsignedTx era, TxBodyContent (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
        SocketPath
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> TxOutChangeAddress
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> Maybe SlotNo
-> TxValidityUpperBound era
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> Maybe Word
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> ExceptT
     TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era))
forall era.
(IsEra era, HasCallStack) =>
SocketPath
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> TxOutChangeAddress
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> Maybe SlotNo
-> TxValidityUpperBound era
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> Maybe Word
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> ExceptT
     TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era))
runTxBuild
          SocketPath
nodeSocketPath
          NetworkId
networkId
          Maybe ScriptValidity
mScriptValidity
          [(TxIn, AnyWitness (LedgerEra era))]
txinsAndMaybeScriptWits
          [TxIn]
allReferenceInputs
          [TxIn]
filteredTxinsc
          Maybe (TxOut CtxTx era)
mReturnCollateral
          Maybe Lovelace
mTotalCollateral
          [TxOut CtxTx era]
txOuts
          TxOutChangeAddress
changeAddresses
          (MultiAsset
mintedMultiAsset, [(PolicyId, AnyWitness (LedgerEra era))]
mintingWitnesses)
          Maybe SlotNo
mValidityLowerBound
          TxValidityUpperBound era
mValidityUpperBound
          [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
          [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawalsAndMaybeScriptWits
          [Hash PaymentKey]
requiredSigners
          TxAuxScripts era
txAuxScripts
          TxMetadataInEra era
txMetadata
          TxUpdateProposal era
mProp
          Maybe Word
mOverrideWitnesses
          [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProceduresAndMaybeScriptWits
          [(Proposal era, AnyWitness (LedgerEra 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 mTxProtocolParams :: Maybe (PParams (LedgerEra era))
mTxProtocolParams = TxBodyContent (LedgerEra era) -> Maybe (PParams (LedgerEra era))
forall era. TxBodyContent era -> Maybe (PParams era)
Exp.txProtocolParams TxBodyContent (LedgerEra era)
txBodyContent

        PParams (LedgerEra era)
pparams <-
          Maybe (PParams (LedgerEra era))
mTxProtocolParams Maybe (PParams (LedgerEra era))
-> (Maybe (PParams (LedgerEra era))
    -> RIO e (PParams (LedgerEra era)))
-> RIO e (PParams (LedgerEra era))
forall a b. a -> (a -> b) -> b
& TxCmdError
-> Maybe (PParams (LedgerEra era))
-> CIO e (PParams (LedgerEra era))
forall err a e.
(Show err, Typeable err, Error err) =>
err -> Maybe a -> CIO e a
fromMaybeCli TxCmdError
TxCmdProtocolParametersNotPresentInTxBody
        let Prices
executionUnitPrices :: L.Prices = Era era -> (EraCommonConstraints era => Prices) -> Prices
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) ((EraCommonConstraints era => Prices) -> Prices)
-> (EraCommonConstraints era => Prices) -> Prices
forall a b. (a -> b) -> a -> b
$ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Prices (PParams (LedgerEra era)) Prices -> Prices
forall s a. s -> Getting a s a -> a
^. Getting Prices (PParams (LedgerEra era)) Prices
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams (LedgerEra era)) Prices
L.ppPricesL

        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 ledgerUTxO :: UTxO (LedgerEra era)
ledgerUTxO =
              Era era
-> (EraCommonConstraints era => UTxO (LedgerEra era))
-> UTxO (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) ((EraCommonConstraints era => UTxO (LedgerEra era))
 -> UTxO (LedgerEra era))
-> (EraCommonConstraints era => UTxO (LedgerEra era))
-> UTxO (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
Api.toLedgerUTxO (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) UTxO era
UTxO era
txEraUtxo
            scriptExecUnitsMap :: Map
  ScriptWitnessIndex
  (Either
     ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
scriptExecUnitsMap =
              SystemStart
-> LedgerEpochInfo
-> PParams (LedgerEra era)
-> UTxO (LedgerEra era)
-> Tx (LedgerEra era)
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
forall era.
IsEra era =>
SystemStart
-> LedgerEpochInfo
-> PParams (LedgerEra era)
-> UTxO (LedgerEra era)
-> Tx (LedgerEra era)
-> Map
     ScriptWitnessIndex
     (Either
        ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
Exp.evaluateTransactionExecutionUnits
                SystemStart
systemStart
                (EraHistory -> LedgerEpochInfo
toLedgerEpochInfo EraHistory
eraHistory)
                PParams (LedgerEra era)
pparams
                (Era era
-> (EraCommonConstraints era => UTxO (LedgerEra era))
-> UTxO (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) UTxO (LedgerEra era)
EraCommonConstraints era => UTxO (LedgerEra era)
ledgerUTxO)
                Tx (LedgerEra era)
tx

        let scriptHashes :: Map ScriptWitnessIndex ScriptHash
scriptHashes = UnsignedTx era
-> UTxO (LedgerEra era) -> Map ScriptWitnessIndex ScriptHash
forall era.
IsEra era =>
UnsignedTx era
-> UTxO (LedgerEra era) -> Map ScriptWitnessIndex ScriptHash
Exp.collectPlutusScriptHashes UnsignedTx era
balancedTxBody UTxO (LedgerEra era)
ledgerUTxO

        [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 = ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx (ShelleyBasedEra era -> ShelleyBasedEra era
forall era. ShelleyBasedEra era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ShelleyBasedEra era
eon) (Tx (ShelleyLedgerEra era) -> Tx era)
-> Tx (ShelleyLedgerEra era) -> Tx era
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era => Tx (ShelleyLedgerEra era))
-> Tx (ShelleyLedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) Tx (ShelleyLedgerEra era)
Tx (LedgerEra era)
EraCommonConstraints era => Tx (ShelleyLedgerEra era)
tx

        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

    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, AnyWitness (LedgerEra era))]
txInsAndMaybeScriptWits <-
      [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, AnyWitness (LedgerEra era))]
forall era e.
IsEra era =>
[(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))]
withdrawalsAndMaybeScriptWits <-
      ((StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))
 -> RIO e (StakeAddress, Lovelace, AnyWitness (LedgerEra era)))
-> [(StakeAddress, Lovelace,
     Maybe (ScriptRequirements 'WithdrawalItem))]
-> RIO e [(StakeAddress, Lovelace, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO e (StakeAddress, Lovelace, AnyWitness (LedgerEra era))
forall e era.
IsEra era =>
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO e (StakeAddress, Lovelace, AnyWitness (LedgerEra 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, [(PolicyId, AnyWitness (LedgerEra era))])
valuesWithScriptWits <-
      (MultiAsset
mas,) ([(PolicyId, AnyWitness (LedgerEra era))]
 -> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))]))
-> RIO e [(PolicyId, AnyWitness (LedgerEra era))]
-> RIO e (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ScriptRequirements 'MintItem
 -> RIO e (PolicyId, AnyWitness (LedgerEra era)))
-> [ScriptRequirements 'MintItem]
-> RIO e [(PolicyId, AnyWitness (LedgerEra 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 (PolicyId, AnyWitness (LedgerEra era))
ScriptRequirements 'MintItem
-> CIO e (PolicyId, AnyWitness (LedgerEra era))
forall era e.
IsEra era =>
ScriptRequirements 'MintItem
-> CIO e (PolicyId, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))]
votingProceduresAndMaybeScriptWits <-
      RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> (ConwayEraOnwards era
    -> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
-> ShelleyBasedEra era
-> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall (eon :: * -> *) a era.
Eon eon =>
a -> (eon era -> a) -> ShelleyBasedEra era -> a
inEonForShelleyBasedEra
        ([(VotingProcedures era, AnyWitness (LedgerEra era))]
-> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall a. Monoid a => a
mempty)
        ( \ConwayEraOnwards era
w ->
            ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
-> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
 -> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
-> (ConwayEraOnwardsConstraints era =>
    RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
-> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall a b. (a -> b) -> a -> b
$
              [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall era e.
IsEra era =>
[(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
readVotingProceduresFiles [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles
        )
        ShelleyBasedEra era
sbe

    [(Proposal era, AnyWitness (LedgerEra era))]
proposals <- [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
-> CIO e [(Proposal era, AnyWitness (LedgerEra era))]
forall era e.
IsEra era =>
[(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
-> CIO e [(Proposal era, AnyWitness (LedgerEra 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
<$> ( Era era
-> (EraCommonConstraints era =>
    RIO e (Certificate (LedgerEra era)))
-> RIO e (Certificate (LedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
currentEra ((EraCommonConstraints era => RIO e (Certificate (LedgerEra era)))
 -> RIO e (Certificate (LedgerEra era)))
-> (EraCommonConstraints era =>
    RIO e (Certificate (LedgerEra era)))
-> RIO e (Certificate (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
                    IO
  (Either
     (FileError TextEnvelopeError) (Certificate (LedgerEra era)))
-> RIO e (Certificate (LedgerEra 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 (LedgerEra era)))
 -> RIO e (Certificate (LedgerEra era)))
-> IO
     (Either
        (FileError TextEnvelopeError) (Certificate (LedgerEra era)))
-> RIO e (Certificate (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
                      File Any 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (Certificate (LedgerEra 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 (LedgerEra era)
txBodyContent <-
      Either TxCmdError (TxBodyContent (LedgerEra era))
-> RIO e (TxBodyContent (LedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either TxCmdError (TxBodyContent (LedgerEra era))
 -> RIO e (TxBodyContent (LedgerEra era)))
-> Either TxCmdError (TxBodyContent (LedgerEra era))
-> RIO e (TxBodyContent (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
        Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent (LedgerEra era))
forall era.
IsEra era =>
Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent (LedgerEra era))
constructTxBodyContent
          Maybe ScriptValidity
mScriptValidity
          (PParams (LedgerEra era) -> Maybe (PParams (LedgerEra era))
forall a. a -> Maybe a
Just PParams (LedgerEra era)
ledgerPParams)
          [(TxIn, AnyWitness (LedgerEra 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, [(PolicyId, AnyWitness (LedgerEra era))])
valuesWithScriptWits
          [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
          [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawalsAndMaybeScriptWits
          [Hash PaymentKey]
requiredSigners
          Lovelace
0
          TxAuxScripts era
txAuxScripts
          TxMetadataInEra era
txMetadata
          [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProceduresAndMaybeScriptWits
          [(Proposal era, AnyWitness (LedgerEra 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 (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits
pScriptExecUnits =
          Era era
-> (EraCommonConstraints era =>
    Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits)
-> Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
currentEra ((EraCommonConstraints era =>
  Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits)
 -> Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits)
-> (EraCommonConstraints era =>
    Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits)
-> Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits
forall a b. (a -> b) -> a -> b
$
            [Item (Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits)]
-> Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits
forall l. IsList l => [Item l] -> l
fromList
              [ (Era era
-> (EraCommonConstraints era => PlutusPurpose AsIx (LedgerEra era))
-> PlutusPurpose AsIx (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
currentEra PlutusPurpose AsIx (LedgerEra era)
EraCommonConstraints era => PlutusPurpose AsIx (LedgerEra era)
index, AnyPlutusScriptWitness lang purpose (LedgerEra era)
-> ExecutionUnits
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> ExecutionUnits
Exp.getAnyPlutusScriptWitnessExecutionUnits AnyPlutusScriptWitness lang purpose (LedgerEra era)
psw)
              | (ScriptWitnessIndex
sWitIndex, Exp.AnyScriptWitnessPlutus AnyPlutusScriptWitness lang purpose (LedgerEra era)
psw) <-
                  TxBodyContent (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
forall era.
IsEra era =>
TxBodyContent (LedgerEra era)
-> [(ScriptWitnessIndex, AnyScriptWitness (LedgerEra era))]
Exp.collectTxBodyScriptWitnesses TxBodyContent (LedgerEra era)
txBodyContent
              , PlutusPurpose AsIx (LedgerEra era)
index <- Maybe (PlutusPurpose AsIx (LedgerEra era))
-> [PlutusPurpose AsIx (LedgerEra era)]
forall a. Maybe a -> [a]
maybeToList (Maybe (PlutusPurpose AsIx (LedgerEra era))
 -> [PlutusPurpose AsIx (LedgerEra era)])
-> Maybe (PlutusPurpose AsIx (LedgerEra era))
-> [PlutusPurpose AsIx (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ AlonzoEraOnwards era
-> ScriptWitnessIndex
-> Maybe (PlutusPurpose AsIx (ShelleyLedgerEra era))
forall era.
AlonzoEraOnwards era
-> ScriptWitnessIndex
-> Maybe (PlutusPurpose AsIx (ShelleyLedgerEra era))
Api.fromScriptWitnessIndex (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
currentEra) ScriptWitnessIndex
sWitIndex
              ]

    TxBodyContent (LedgerEra era)
balancedTxBody :: Exp.TxBodyContent (Exp.LedgerEra era) <-
      Either TxCmdError (TxBodyContent (LedgerEra era))
-> RIO e (TxBodyContent (LedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either TxCmdError (TxBodyContent (LedgerEra era))
 -> RIO e (TxBodyContent (LedgerEra era)))
-> Either TxCmdError (TxBodyContent (LedgerEra era))
-> RIO e (TxBodyContent (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
        (TxFeeEstimationError era -> TxCmdError)
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
-> Either TxCmdError (TxBodyContent (LedgerEra era))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxFeeEstimationError era -> TxCmdError
forall era. TxFeeEstimationError era -> TxCmdError
TxCmdFeeEstimationError (Either (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
 -> Either TxCmdError (TxBodyContent (LedgerEra era)))
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
-> Either TxCmdError (TxBodyContent (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
          Era era
-> TxBodyContent (LedgerEra era)
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Lovelace
-> Map (Credential 'DRepRole) Lovelace
-> Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits
-> Lovelace
-> Int
-> Int
-> Int
-> AddressInEra era
-> Value (LedgerEra era)
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
forall era.
HasCallStack =>
Era era
-> TxBodyContent (LedgerEra era)
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Lovelace
-> Map (Credential 'DRepRole) Lovelace
-> Map (PlutusPurpose AsIx (LedgerEra era)) ExecutionUnits
-> Lovelace
-> Int
-> Int
-> Int
-> AddressInEra era
-> Value (LedgerEra era)
-> Either
     (TxFeeEstimationError era) (TxBodyContent (LedgerEra era))
Exp.estimateBalancedTxBody
            Era era
currentEra
            TxBodyContent (LedgerEra era)
txBodyContent
            PParams (LedgerEra era)
ledgerPParams
            Set PoolId
poolsToDeregister
            Map StakeCredential Lovelace
stakeCredentialsToDeregisterMap
            Map (Credential 'DRepRole) Lovelace
drepsToDeregisterMap
            Map (PlutusPurpose AsIx (LedgerEra era)) 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)
            (Era era
-> (EraCommonConstraints era => Value (LedgerEra era))
-> Value (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
currentEra ((EraCommonConstraints era => Value (LedgerEra era))
 -> Value (LedgerEra era))
-> (EraCommonConstraints era => Value (LedgerEra era))
-> Value (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ MaryEraOnwards era -> Value -> Value (ShelleyLedgerEra era)
forall era.
MaryEraOnwards era -> Value -> Value (ShelleyLedgerEra era)
toLedgerValue (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
currentEra) Value
totalUTxOValue)

    let unsignedTx :: UnsignedTx era
unsignedTx = Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
forall era.
Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
Exp.makeUnsignedTx Era era
currentEra TxBodyContent (LedgerEra 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
$ ( 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
            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
currentEra)
        TxBodyFile 'Out
txBodyOutFile
      (Tx era -> IO (Either (FileError ()) ()))
-> Tx era -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ UnsignedTx era -> Tx era
forall era. IsEra era => UnsignedTx era -> Tx era
unsignedToToApiTx UnsignedTx era
unsignedTx

unsignedToToApiTx :: forall era. Exp.IsEra era => Exp.UnsignedTx era -> Api.Tx era
unsignedToToApiTx :: forall era. IsEra era => UnsignedTx era -> Tx era
unsignedToToApiTx (Exp.UnsignedTx Tx (LedgerEra era)
lTx) =
  ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx (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) (Tx (ShelleyLedgerEra era) -> Tx era)
-> Tx (ShelleyLedgerEra era) -> Tx era
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era => Tx (ShelleyLedgerEra era))
-> Tx (ShelleyLedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) Tx (ShelleyLedgerEra era)
Tx (LedgerEra era)
EraCommonConstraints era => Tx (ShelleyLedgerEra era)
lTx

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)

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, AnyWitness (LedgerEra era))]
txInsAndMaybeScriptWits <-
      [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, AnyWitness (LedgerEra era))]
forall era e.
IsEra era =>
[(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))]
withdrawalsAndMaybeScriptWits <-
      ((StakeAddress, Lovelace,
  Maybe (ScriptRequirements 'WithdrawalItem))
 -> RIO e (StakeAddress, Lovelace, AnyWitness (LedgerEra era)))
-> [(StakeAddress, Lovelace,
     Maybe (ScriptRequirements 'WithdrawalItem))]
-> RIO e [(StakeAddress, Lovelace, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO e (StakeAddress, Lovelace, AnyWitness (LedgerEra era))
forall e era.
IsEra era =>
(StakeAddress, Lovelace,
 Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO e (StakeAddress, Lovelace, AnyWitness (LedgerEra 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, [(PolicyId, AnyWitness (LedgerEra era))])
valuesWithScriptWits <-
      (MultiAsset
mas,)
        ([(PolicyId, AnyWitness (LedgerEra era))]
 -> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))]))
-> RIO e [(PolicyId, AnyWitness (LedgerEra era))]
-> RIO e (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ScriptRequirements 'MintItem
 -> RIO e (PolicyId, AnyWitness (LedgerEra era)))
-> [ScriptRequirements 'MintItem]
-> RIO e [(PolicyId, AnyWitness (LedgerEra 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 (PolicyId, AnyWitness (LedgerEra era))
ScriptRequirements 'MintItem
-> CIO e (PolicyId, AnyWitness (LedgerEra era))
forall era e.
IsEra era =>
ScriptRequirements 'MintItem
-> CIO e (PolicyId, AnyWitness (LedgerEra 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

    -- TODO: Remove me as update proposals are deprecated since Conway (replaced with proposals)
    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, AnyWitness (LedgerEra era))]
votingProceduresAndMaybeScriptWits <-
      ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
-> RIO e [(VotingProcedures era, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))])
 -> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
-> (ConwayEraOnwardsConstraints era =>
    RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
-> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall a b. (a -> b) -> a -> b
$
        [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall era e.
IsEra era =>
[(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
readVotingProceduresFiles [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
voteFiles

    [(Proposal era, AnyWitness (LedgerEra era))]
proposals <-
      forall era e.
IsEra era =>
[(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
-> CIO e [(Proposal era, AnyWitness (LedgerEra 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
<$> ( Era era
-> (EraCommonConstraints era =>
    RIO e (Certificate (LedgerEra era)))
-> RIO e (Certificate (LedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
eon ((EraCommonConstraints era => RIO e (Certificate (LedgerEra era)))
 -> RIO e (Certificate (LedgerEra era)))
-> (EraCommonConstraints era =>
    RIO e (Certificate (LedgerEra era)))
-> RIO e (Certificate (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
                    IO
  (Either
     (FileError TextEnvelopeError) (Certificate (LedgerEra era)))
-> RIO e (Certificate (LedgerEra 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 (LedgerEra era)))
 -> RIO e (Certificate (LedgerEra era)))
-> IO
     (Either
        (FileError TextEnvelopeError) (Certificate (LedgerEra era)))
-> RIO e (Certificate (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
                      File Any 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (Certificate (LedgerEra 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
        ]
    UnsignedTx era
txBody :: Exp.UnsignedTx era <-
      Either TxCmdError (UnsignedTx era) -> RIO e (UnsignedTx era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either TxCmdError (UnsignedTx era) -> RIO e (UnsignedTx era))
-> Either TxCmdError (UnsignedTx era) -> RIO e (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$
        Maybe ScriptValidity
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> Lovelace
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> Maybe (LedgerProtocolParameters era)
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (UnsignedTx era)
forall era.
IsEra era =>
Maybe ScriptValidity
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> Lovelace
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> Maybe (LedgerProtocolParameters era)
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (UnsignedTx era)
runTxBuildRaw
          Maybe ScriptValidity
mScriptValidity
          [(TxIn, AnyWitness (LedgerEra 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, [(PolicyId, AnyWitness (LedgerEra era))])
valuesWithScriptWits
          [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
          [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawalsAndMaybeScriptWits
          [Hash PaymentKey]
requiredSigners
          TxAuxScripts era
txAuxScripts
          TxMetadataInEra era
txMetadata
          Maybe (LedgerProtocolParameters era)
mLedgerPParams
          [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProceduresAndMaybeScriptWits
          [(Proposal era, AnyWitness (LedgerEra era))]
proposals
          Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
currentTreasuryValueAndDonation

    let Exp.UnsignedTx Tx (LedgerEra era)
lTx = UnsignedTx era
txBody
        noWitTx :: Tx era
noWitTx = ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx (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
eon) Tx (ShelleyLedgerEra era)
Tx (LedgerEra era)
lTx
    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, Exp.AnyWitness (Exp.LedgerEra 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, [(PolicyId, Exp.AnyWitness (Exp.LedgerEra era))])
  -- ^ Multi-Asset minted value(s)
  -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Lovelace, Exp.AnyWitness (Exp.LedgerEra era))]
  -> [Hash PaymentKey]
  -- ^ Required signers
  -> TxAuxScripts era
  -> TxMetadataInEra era
  -> Maybe (LedgerProtocolParameters era)
  -> [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))]
  -> [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))]
  -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
  -> Either TxCmdError (Exp.UnsignedTx era)
runTxBuildRaw :: forall era.
IsEra era =>
Maybe ScriptValidity
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> Lovelace
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> Maybe (LedgerProtocolParameters era)
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (UnsignedTx era)
runTxBuildRaw
  Maybe ScriptValidity
mScriptValidity
  [(TxIn, AnyWitness (LedgerEra 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, [(PolicyId, AnyWitness (LedgerEra era))])
valuesWithScriptWits
  [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeSriptWits
  [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawals
  [Hash PaymentKey]
reqSigners
  TxAuxScripts era
txAuxScripts
  TxMetadataInEra era
txMetadata
  Maybe (LedgerProtocolParameters era)
mpparams
  [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProcedures
  [(Proposal era, AnyWitness (LedgerEra era))]
proposals
  Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation = do
    TxBodyContent (LedgerEra era)
txBodyContent <-
      Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent (LedgerEra era))
forall era.
IsEra era =>
Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent (LedgerEra 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, AnyWitness (LedgerEra 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, [(PolicyId, AnyWitness (LedgerEra era))])
valuesWithScriptWits
        [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeSriptWits
        [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawals
        [Hash PaymentKey]
reqSigners
        Lovelace
fee
        TxAuxScripts era
txAuxScripts
        TxMetadataInEra era
txMetadata
        [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProcedures
        [(Proposal era, AnyWitness (LedgerEra era))]
proposals
        Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation

    UnsignedTx era -> Either TxCmdError (UnsignedTx era)
forall a. a -> Either TxCmdError a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnsignedTx era -> Either TxCmdError (UnsignedTx era))
-> UnsignedTx era -> Either TxCmdError (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$ Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
forall era.
Era era -> TxBodyContent (LedgerEra era) -> UnsignedTx era
Exp.makeUnsignedTx Era era
forall era. IsEra era => Era era
Exp.useEra TxBodyContent (LedgerEra era)
txBodyContent

constructTxBodyContent
  :: forall era
   . Exp.IsEra era
  => Maybe ScriptValidity
  -> Maybe (L.PParams (Exp.LedgerEra era))
  -> [(TxIn, Exp.AnyWitness (Exp.LedgerEra 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, [(PolicyId, Exp.AnyWitness (Exp.LedgerEra era))])
  -- ^ Multi-Asset value(s)
  -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Lovelace, Exp.AnyWitness (Exp.LedgerEra era))]
  -- ^ Withdrawals
  -> [Hash PaymentKey]
  -- ^ Required signers
  -> Lovelace
  -- ^ Tx fee
  -> TxAuxScripts era
  -> TxMetadataInEra era
  -> [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))]
  -> [(Proposal era, Exp.AnyWitness (Exp.LedgerEra 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 (Exp.TxBodyContent (Exp.LedgerEra era))
constructTxBodyContent :: forall era.
IsEra era =>
Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent (LedgerEra era))
constructTxBodyContent
  Maybe ScriptValidity
mScriptValidity
  Maybe (PParams (LedgerEra era))
mPparams
  [(TxIn, AnyWitness (LedgerEra era))]
inputsAndMaybeScriptWits
  [TxIn]
readOnlyRefIns
  [TxIn]
txinsc
  Maybe (TxOut CtxTx era)
mReturnCollateral
  Maybe Lovelace
mTotCollateral
  [TxOut CtxTx era]
txouts
  Maybe SlotNo
mLowerBound
  (TxValidityUpperBound ShelleyBasedEra era
_ Maybe SlotNo
mUpperBound)
  (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
valuesWithScriptWits
  [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
  [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawals
  [Hash PaymentKey]
reqSigners
  Lovelace
fee
  TxAuxScripts era
txAuxScripts
  TxMetadataInEra era
txMetadata
  [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProcedures
  [(Proposal era, AnyWitness (LedgerEra era))]
proposals
  Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation =
    do
      let allReferenceInputs :: [TxIn]
allReferenceInputs =
            [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
forall era.
[AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
              (((TxIn, AnyWitness (LedgerEra era)) -> AnyWitness (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, AnyWitness (LedgerEra era)) -> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(TxIn, AnyWitness (LedgerEra era))]
inputsAndMaybeScriptWits)
              (((PolicyId, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(PolicyId, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (PolicyId, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd ([(PolicyId, AnyWitness (LedgerEra era))]
 -> [AnyWitness (LedgerEra era)])
-> [(PolicyId, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(PolicyId, AnyWitness (LedgerEra era))]
forall a b. (a, b) -> b
snd (MultiAsset, [(PolicyId, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (\(StakeAddress
_, Lovelace
_, AnyWitness (LedgerEra era)
mSwit) -> AnyWitness (LedgerEra era)
mSwit) [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawals)
              (((VotingProcedures era, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (VotingProcedures era, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProcedures)
              (((Proposal era, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Proposal era, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(Proposal era, AnyWitness (LedgerEra era))]
proposals)
              [TxIn]
readOnlyRefIns
      -- TODO The last argument of validateTxInsReference is a datum set from reference inputs
      -- Should we allow providing of datum from CLI?
      -- TODO: Figure how to expose resolved datums
      let refInputs :: TxInsReference (LedgerEra era)
refInputs = [TxIn]
-> Set (Datum CtxTx (LedgerEra era))
-> TxInsReference (LedgerEra era)
forall era. [TxIn] -> Set (Datum CtxTx era) -> TxInsReference era
Exp.TxInsReference [TxIn]
allReferenceInputs Set (Datum CtxTx (LedgerEra era))
forall a. Set a
Set.empty
          expTxouts :: [TxOut CtxTx (LedgerEra era)]
expTxouts = (TxOut CtxTx era -> TxOut CtxTx (LedgerEra era))
-> [TxOut CtxTx era] -> [TxOut CtxTx (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map TxOut CtxTx era -> TxOut CtxTx (LedgerEra era)
forall era.
IsEra era =>
TxOut CtxTx era -> TxOut CtxTx (LedgerEra era)
Exp.fromLegacyTxOut [TxOut CtxTx era]
txouts
          auxScripts :: [SimpleScript (LedgerEra era)]
auxScripts = case TxAuxScripts era
txAuxScripts of
            TxAuxScripts era
TxAuxScriptsNone -> []
            -- TODO: Auxiliary scripts cannot be plutus scripts
            TxAuxScripts AllegraEraOnwards era
_ [ScriptInEra era]
scripts -> (ScriptInEra era -> Maybe (SimpleScript (LedgerEra era)))
-> [ScriptInEra era] -> [SimpleScript (LedgerEra era)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ScriptInEra era -> Maybe (SimpleScript (LedgerEra era))
forall era.
IsEra era =>
ScriptInEra era -> Maybe (SimpleScript (LedgerEra era))
scriptInEraToSimpleScript [ScriptInEra era]
scripts
          txRetCollateral :: Maybe (TxReturnCollateral (LedgerEra era))
txRetCollateral = case Maybe (TxOut CtxTx era)
mReturnCollateral of
            Just TxOut CtxTx era
rc ->
              let Exp.TxOut TxOut (LedgerEra era)
o Maybe (Datum CtxTx (LedgerEra era))
_ = TxOut CtxTx era -> TxOut CtxTx (LedgerEra era)
forall era.
IsEra era =>
TxOut CtxTx era -> TxOut CtxTx (LedgerEra era)
Exp.fromLegacyTxOut TxOut CtxTx era
rc
               in TxReturnCollateral (LedgerEra era)
-> Maybe (TxReturnCollateral (LedgerEra era))
forall a. a -> Maybe a
Just (TxReturnCollateral (LedgerEra era)
 -> Maybe (TxReturnCollateral (LedgerEra era)))
-> TxReturnCollateral (LedgerEra era)
-> Maybe (TxReturnCollateral (LedgerEra era))
forall a b. (a -> b) -> a -> b
$ TxOut (LedgerEra era) -> TxReturnCollateral (LedgerEra era)
forall era. TxOut era -> TxReturnCollateral era
Exp.TxReturnCollateral (TxOut (LedgerEra era)
o :: (L.TxOut (Exp.LedgerEra era)))
            Maybe (TxOut CtxTx era)
Nothing -> Maybe (TxReturnCollateral (LedgerEra era))
forall a. Maybe a
Nothing
          txTotCollateral :: Maybe TxTotalCollateral
txTotCollateral = Lovelace -> TxTotalCollateral
Exp.TxTotalCollateral (Lovelace -> TxTotalCollateral)
-> Maybe Lovelace -> Maybe TxTotalCollateral
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Lovelace
mTotCollateral :: Maybe L.Coin)
          expTxMetadata :: TxMetadata
expTxMetadata = case TxMetadataInEra era
txMetadata of
            TxMetadataInEra era
TxMetadataNone -> Map Word64 TxMetadataValue -> TxMetadata
TxMetadata Map Word64 TxMetadataValue
forall a. Monoid a => a
mempty
            TxMetadataInEra ShelleyBasedEra era
_ TxMetadata
mDat -> TxMetadata
mDat

      TxMintValue (LedgerEra era)
validatedMintValue <- (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> Either TxCmdError (TxMintValue (LedgerEra era))
forall era.
(MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> Either TxCmdError (TxMintValue (LedgerEra era))
createTxMintValue (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
valuesWithScriptWits
      let vProcedures :: [(VotingProcedures (LedgerEra era), AnyWitness (LedgerEra era))]
vProcedures = [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(VotingProcedures (LedgerEra era), AnyWitness (LedgerEra era))]
forall era.
IsEra era =>
[(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(VotingProcedures (LedgerEra era), AnyWitness (LedgerEra era))]
convertVotingProcedures [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProcedures
      TxVotingProcedures (LedgerEra era)
validatedVotingProcedures <-
        (VotesMergingConflict (LedgerEra era) -> TxCmdError)
-> Either
     (VotesMergingConflict (LedgerEra era))
     (TxVotingProcedures (LedgerEra era))
-> Either TxCmdError (TxVotingProcedures (LedgerEra era))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (TxGovDuplicateVotes (LedgerEra era) -> TxCmdError
forall era. TxGovDuplicateVotes era -> TxCmdError
TxCmdTxGovDuplicateVotes (TxGovDuplicateVotes (LedgerEra era) -> TxCmdError)
-> (VotesMergingConflict (LedgerEra era)
    -> TxGovDuplicateVotes (LedgerEra era))
-> VotesMergingConflict (LedgerEra era)
-> TxCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotesMergingConflict (LedgerEra era)
-> TxGovDuplicateVotes (LedgerEra era)
forall era. VotesMergingConflict era -> TxGovDuplicateVotes era
TxGovDuplicateVotes) (Either
   (VotesMergingConflict (LedgerEra era))
   (TxVotingProcedures (LedgerEra era))
 -> Either TxCmdError (TxVotingProcedures (LedgerEra era)))
-> Either
     (VotesMergingConflict (LedgerEra era))
     (TxVotingProcedures (LedgerEra era))
-> Either TxCmdError (TxVotingProcedures (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
          [(VotingProcedures (LedgerEra era), AnyWitness (LedgerEra era))]
-> Either
     (VotesMergingConflict (LedgerEra era))
     (TxVotingProcedures (LedgerEra era))
forall era.
[(VotingProcedures era, AnyWitness era)]
-> Either (VotesMergingConflict era) (TxVotingProcedures era)
Exp.mkTxVotingProcedures [(VotingProcedures (LedgerEra era), AnyWitness (LedgerEra era))]
vProcedures
      let txProposals :: [(ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era))]
txProposals = [(Era era
-> (EraCommonConstraints era => ProposalProcedure (LedgerEra era))
-> ProposalProcedure (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) ProposalProcedure (ShelleyLedgerEra era)
ProposalProcedure (LedgerEra era)
EraCommonConstraints era => ProposalProcedure (LedgerEra era)
p, AnyWitness (LedgerEra era)
w) | (Proposal ProposalProcedure (ShelleyLedgerEra era)
p, AnyWitness (LedgerEra era)
w) <- [(Proposal era, AnyWitness (LedgerEra era))]
proposals]
      let validatedTxProposals :: TxProposalProcedures (LedgerEra era)
validatedTxProposals =
            [(ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era))]
-> TxProposalProcedures (LedgerEra era)
forall era.
IsEra era =>
[(ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era))]
-> TxProposalProcedures (LedgerEra era)
Exp.mkTxProposalProcedures [(ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era))]
txProposals
      let validatedCurrentTreasuryValue :: Maybe Lovelace
validatedCurrentTreasuryValue = TxCurrentTreasuryValue -> Lovelace
unTxCurrentTreasuryValue (TxCurrentTreasuryValue -> Lovelace)
-> ((TxCurrentTreasuryValue, TxTreasuryDonation)
    -> TxCurrentTreasuryValue)
-> (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxCurrentTreasuryValue, TxTreasuryDonation)
-> TxCurrentTreasuryValue
forall a b. (a, b) -> a
fst ((TxCurrentTreasuryValue, TxTreasuryDonation) -> Lovelace)
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation
          validatedTreasuryDonation :: Maybe Lovelace
validatedTreasuryDonation = TxTreasuryDonation -> Lovelace
unTxTreasuryDonation (TxTreasuryDonation -> Lovelace)
-> ((TxCurrentTreasuryValue, TxTreasuryDonation)
    -> TxTreasuryDonation)
-> (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxCurrentTreasuryValue, TxTreasuryDonation) -> TxTreasuryDonation
forall a b. (a, b) -> b
snd ((TxCurrentTreasuryValue, TxTreasuryDonation) -> Lovelace)
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
mCurrentTreasuryValueAndDonation
      let validatedWithdrawals :: TxWithdrawals (LedgerEra era)
validatedWithdrawals = [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> TxWithdrawals (LedgerEra era)
forall era.
[(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> TxWithdrawals (LedgerEra era)
convertWithdrawals [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawals
      TxBodyContent (LedgerEra era)
-> Either TxCmdError (TxBodyContent (LedgerEra era))
forall a. a -> Either TxCmdError a
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( TxBodyContent (LedgerEra era)
forall era. TxBodyContent era
Exp.defaultTxBodyContent
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& [(TxIn, AnyWitness (LedgerEra era))]
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
[(TxIn, AnyWitness era)] -> TxBodyContent era -> TxBodyContent era
Exp.setTxIns [(TxIn, AnyWitness (LedgerEra era))]
inputsAndMaybeScriptWits
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& [TxIn]
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era. [TxIn] -> TxBodyContent era -> TxBodyContent era
Exp.setTxInsCollateral [TxIn]
txinsc
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& TxInsReference (LedgerEra era)
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
TxInsReference era -> TxBodyContent era -> TxBodyContent era
Exp.setTxInsReference TxInsReference (LedgerEra era)
refInputs
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& [TxOut CtxTx (LedgerEra era)]
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
[TxOut CtxTx era] -> TxBodyContent era -> TxBodyContent era
Exp.setTxOuts [TxOut CtxTx (LedgerEra era)]
expTxouts
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> (TxReturnCollateral (LedgerEra era)
    -> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> Maybe (TxReturnCollateral (LedgerEra era))
-> TxBodyContent (LedgerEra era)
-> TxBodyContent (LedgerEra era)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall a. a -> a
id TxReturnCollateral (LedgerEra era)
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
TxReturnCollateral era -> TxBodyContent era -> TxBodyContent era
Exp.setTxReturnCollateral Maybe (TxReturnCollateral (LedgerEra era))
txRetCollateral
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> (TxTotalCollateral
    -> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> Maybe TxTotalCollateral
-> TxBodyContent (LedgerEra era)
-> TxBodyContent (LedgerEra era)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall a. a -> a
id TxTotalCollateral
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
TxTotalCollateral -> TxBodyContent era -> TxBodyContent era
Exp.setTxTotalCollateral Maybe TxTotalCollateral
txTotCollateral
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& Lovelace
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era. Lovelace -> TxBodyContent era -> TxBodyContent era
Exp.setTxFee Lovelace
fee
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> (SlotNo
    -> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> Maybe SlotNo
-> TxBodyContent (LedgerEra era)
-> TxBodyContent (LedgerEra era)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall a. a -> a
id SlotNo
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era. SlotNo -> TxBodyContent era -> TxBodyContent era
Exp.setTxValidityLowerBound Maybe SlotNo
mLowerBound
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> (SlotNo
    -> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> Maybe SlotNo
-> TxBodyContent (LedgerEra era)
-> TxBodyContent (LedgerEra era)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall a. a -> a
id SlotNo
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era. SlotNo -> TxBodyContent era -> TxBodyContent era
Exp.setTxValidityUpperBound Maybe SlotNo
mUpperBound
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& TxMetadata
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era. TxMetadata -> TxBodyContent era -> TxBodyContent era
Exp.setTxMetadata TxMetadata
expTxMetadata
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& [SimpleScript (LedgerEra era)]
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
[SimpleScript era] -> TxBodyContent era -> TxBodyContent era
Exp.setTxAuxScripts [SimpleScript (LedgerEra era)]
auxScripts
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& TxWithdrawals (LedgerEra era)
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
TxWithdrawals era -> TxBodyContent era -> TxBodyContent era
Exp.setTxWithdrawals TxWithdrawals (LedgerEra era)
validatedWithdrawals
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& TxExtraKeyWitnesses
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
TxExtraKeyWitnesses -> TxBodyContent era -> TxBodyContent era
Exp.setTxExtraKeyWits ([Hash PaymentKey] -> TxExtraKeyWitnesses
Exp.TxExtraKeyWitnesses [Hash PaymentKey]
reqSigners)
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> (PParams (LedgerEra era)
    -> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> Maybe (PParams (LedgerEra era))
-> TxBodyContent (LedgerEra era)
-> TxBodyContent (LedgerEra era)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall a. a -> a
id (PParams (LedgerEra era)
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era. PParams era -> TxBodyContent era -> TxBodyContent era
Exp.setTxProtocolParams (PParams (LedgerEra era)
 -> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> (PParams (LedgerEra era) -> PParams (LedgerEra era))
-> PParams (LedgerEra era)
-> TxBodyContent (LedgerEra era)
-> TxBodyContent (LedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Era era
-> (EraCommonConstraints era => PParams (LedgerEra era))
-> PParams (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era)) Maybe (PParams (LedgerEra era))
mPparams
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& TxCertificates (LedgerEra era)
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
TxCertificates era -> TxBodyContent era -> TxBodyContent era
Exp.setTxCertificates
              (Era era
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> TxCertificates (LedgerEra era)
forall era.
Era era
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> TxCertificates (LedgerEra era)
Exp.mkTxCertificates Era era
forall era. IsEra era => Era era
Exp.useEra [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits)
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& TxMintValue (LedgerEra era)
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
TxMintValue era -> TxBodyContent era -> TxBodyContent era
Exp.setTxMintValue TxMintValue (LedgerEra era)
validatedMintValue
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& ScriptValidity
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
ScriptValidity -> TxBodyContent era -> TxBodyContent era
Exp.setTxScriptValidity (ScriptValidity -> Maybe ScriptValidity -> ScriptValidity
forall a. a -> Maybe a -> a
fromMaybe ScriptValidity
ScriptValid Maybe ScriptValidity
mScriptValidity)
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& TxVotingProcedures (LedgerEra era)
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
TxVotingProcedures era -> TxBodyContent era -> TxBodyContent era
Exp.setTxVotingProcedures TxVotingProcedures (LedgerEra era)
validatedVotingProcedures
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& TxProposalProcedures (LedgerEra era)
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era.
TxProposalProcedures era -> TxBodyContent era -> TxBodyContent era
Exp.setTxProposalProcedures TxProposalProcedures (LedgerEra era)
validatedTxProposals
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> (Lovelace
    -> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> Maybe Lovelace
-> TxBodyContent (LedgerEra era)
-> TxBodyContent (LedgerEra era)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall a. a -> a
id Lovelace
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era. Lovelace -> TxBodyContent era -> TxBodyContent era
Exp.setTxCurrentTreasuryValue Maybe Lovelace
validatedCurrentTreasuryValue
            TxBodyContent (LedgerEra era)
-> (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> (Lovelace
    -> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era))
-> Maybe Lovelace
-> TxBodyContent (LedgerEra era)
-> TxBodyContent (LedgerEra era)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall a. a -> a
id Lovelace
-> TxBodyContent (LedgerEra era) -> TxBodyContent (LedgerEra era)
forall era. Lovelace -> TxBodyContent era -> TxBodyContent era
Exp.setTxTreasuryDonation Maybe Lovelace
validatedTreasuryDonation
        )

convertWithdrawals
  :: [(StakeAddress, L.Coin, Exp.AnyWitness (Exp.LedgerEra era))]
  -> Exp.TxWithdrawals (Exp.LedgerEra era)
convertWithdrawals :: forall era.
[(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> TxWithdrawals (LedgerEra era)
convertWithdrawals = [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> TxWithdrawals (LedgerEra era)
forall era.
[(StakeAddress, Lovelace, AnyWitness era)] -> TxWithdrawals era
Exp.TxWithdrawals

convertVotingProcedures
  :: forall era
   . Exp.IsEra era
  => [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))]
  -> [(L.VotingProcedures (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))]
convertVotingProcedures :: forall era.
IsEra era =>
[(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(VotingProcedures (LedgerEra era), AnyWitness (LedgerEra era))]
convertVotingProcedures =
  ((VotingProcedures era, AnyWitness (LedgerEra era))
 -> (VotingProcedures (LedgerEra era), AnyWitness (LedgerEra era)))
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(VotingProcedures (LedgerEra era), AnyWitness (LedgerEra era))]
forall a b. (a -> b) -> [a] -> [b]
map
    ( \(VotingProcedures VotingProcedures (ShelleyLedgerEra era)
vp, AnyWitness (LedgerEra era)
wit) ->
        (Era era
-> (EraCommonConstraints era => VotingProcedures (LedgerEra era))
-> VotingProcedures (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) VotingProcedures (ShelleyLedgerEra era)
VotingProcedures (LedgerEra era)
EraCommonConstraints era => VotingProcedures (LedgerEra era)
vp, AnyWitness (LedgerEra era)
wit)
    )

scriptInEraToSimpleScript
  :: forall era. Exp.IsEra era => ScriptInEra era -> Maybe (Exp.SimpleScript (Exp.LedgerEra era))
scriptInEraToSimpleScript :: forall era.
IsEra era =>
ScriptInEra era -> Maybe (SimpleScript (LedgerEra era))
scriptInEraToSimpleScript ScriptInEra era
s =
  Era era
-> (EraCommonConstraints era =>
    Maybe (SimpleScript (LedgerEra era)))
-> Maybe (SimpleScript (LedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) ((EraCommonConstraints era => Maybe (SimpleScript (LedgerEra era)))
 -> Maybe (SimpleScript (LedgerEra era)))
-> (EraCommonConstraints era =>
    Maybe (SimpleScript (LedgerEra era)))
-> Maybe (SimpleScript (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
    Timelock (LedgerEra era) -> SimpleScript (LedgerEra era)
NativeScript (LedgerEra era) -> SimpleScript (LedgerEra era)
forall era. EraScript era => NativeScript era -> SimpleScript era
Exp.SimpleScript
      (Timelock (LedgerEra era) -> SimpleScript (LedgerEra era))
-> Maybe (Timelock (LedgerEra era))
-> Maybe (SimpleScript (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script (LedgerEra era) -> Maybe (NativeScript (LedgerEra era))
forall era. EraScript era => Script era -> Maybe (NativeScript era)
L.getNativeScript (Era era
-> (EraCommonConstraints era => Script (LedgerEra era))
-> Script (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) ((EraCommonConstraints era => Script (LedgerEra era))
 -> Script (LedgerEra era))
-> (EraCommonConstraints era => Script (LedgerEra era))
-> Script (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ ScriptInEra era -> Script (ShelleyLedgerEra era)
forall era. ScriptInEra era -> Script (ShelleyLedgerEra era)
toShelleyScript ScriptInEra era
s)

runTxBuild
  :: forall era
   . Exp.IsEra era
  => HasCallStack
  => SocketPath
  -> NetworkId
  -> Maybe ScriptValidity
  -- ^ Mark script as expected to pass or fail validation
  -> [(TxIn, Exp.AnyWitness (Exp.LedgerEra 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, [(PolicyId, Exp.AnyWitness (Exp.LedgerEra era))]) -- TODO: Double check why this is a list

  -- ^ 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, Exp.AnyWitness (Exp.LedgerEra era))]
  -> [Hash PaymentKey]
  -- ^ Required signers
  -> TxAuxScripts era
  -> TxMetadataInEra era
  -> TxUpdateProposal era
  -> Maybe Word
  -> [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))]
  -> [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))]
  -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
  -- ^ The current treasury value and the donation.
  -> ExceptT TxCmdError IO (Exp.UnsignedTx era, Exp.TxBodyContent (Exp.LedgerEra era))
runTxBuild :: forall era.
(IsEra era, HasCallStack) =>
SocketPath
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> TxOutChangeAddress
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> Maybe SlotNo
-> TxValidityUpperBound era
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> TxUpdateProposal era
-> Maybe Word
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> ExceptT
     TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era))
runTxBuild
  SocketPath
socketPath
  NetworkId
networkId
  Maybe ScriptValidity
mScriptValidity
  [(TxIn, AnyWitness (LedgerEra era))]
inputsAndMaybeScriptWits
  [TxIn]
readOnlyRefIns
  [TxIn]
txinsc
  Maybe (TxOut CtxTx era)
mReturnCollateral
  Maybe Lovelace
mTotCollateral
  [TxOut CtxTx era]
txouts
  (TxOutChangeAddress AddressAny
changeAddr)
  (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
mintValueWithScriptWits
  Maybe SlotNo
mLowerBound
  TxValidityUpperBound era
mUpperBound
  [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
  [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawals
  [Hash PaymentKey]
reqSigners
  TxAuxScripts era
txAuxScripts
  TxMetadataInEra era
txMetadata
  TxUpdateProposal era
_txUpdateProposal -- TODO: Remove this parameter
  Maybe Word
mOverrideWits
  [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProcedures
  [(Proposal era, AnyWitness (LedgerEra 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 (UnsignedTx era, TxBodyContent (LedgerEra era)))
-> ExceptT
     TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  ExceptT
    TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era)))
 -> ExceptT
      TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
    ExceptT
      TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era)))
-> ExceptT
     TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra 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, AnyWitness (LedgerEra era)
_) <- [(TxIn, AnyWitness (LedgerEra era))]
inputsAndMaybeScriptWits]
      let allReferenceInputs :: [TxIn]
allReferenceInputs =
            [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
forall era.
[AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
              (((TxIn, AnyWitness (LedgerEra era)) -> AnyWitness (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, AnyWitness (LedgerEra era)) -> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(TxIn, AnyWitness (LedgerEra era))]
inputsAndMaybeScriptWits)
              (((PolicyId, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(PolicyId, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (PolicyId, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd ([(PolicyId, AnyWitness (LedgerEra era))]
 -> [AnyWitness (LedgerEra era)])
-> [(PolicyId, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(PolicyId, AnyWitness (LedgerEra era))]
forall a b. (a, b) -> b
snd (MultiAsset, [(PolicyId, AnyWitness (LedgerEra 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, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (\(StakeAddress
_, Lovelace
_, AnyWitness (LedgerEra era)
wit) -> AnyWitness (LedgerEra era)
wit) [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawals)
              (((VotingProcedures era, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (VotingProcedures era, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProcedures)
              (((Proposal era, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Proposal era, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(Proposal era, AnyWitness (LedgerEra 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 (ShelleyLedgerEra era)]
certsToQuery = Era era
-> (EraCommonConstraints era =>
    [Certificate (ShelleyLedgerEra era)])
-> [Certificate (ShelleyLedgerEra era)]
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) ((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 (ShelleyLedgerEra 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 (ShelleyLedgerEra 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 (ShelleyLedgerEra era)]
[Certificate (ShelleyLedgerEra 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 (LedgerEra era)
txBodyContent <-
        Either TxCmdError (TxBodyContent (LedgerEra era))
-> ExceptT TxCmdError IO (TxBodyContent (LedgerEra era))
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TxCmdError (TxBodyContent (LedgerEra era))
 -> ExceptT TxCmdError IO (TxBodyContent (LedgerEra era)))
-> Either TxCmdError (TxBodyContent (LedgerEra era))
-> ExceptT TxCmdError IO (TxBodyContent (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
          Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent (LedgerEra era))
forall era.
IsEra era =>
Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
-> [Hash PaymentKey]
-> Lovelace
-> TxAuxScripts era
-> TxMetadataInEra era
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Either TxCmdError (TxBodyContent (LedgerEra 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, AnyWitness (LedgerEra 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, [(PolicyId, AnyWitness (LedgerEra era))])
mintValueWithScriptWits
            [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
            [(StakeAddress, Lovelace, AnyWitness (LedgerEra era))]
withdrawals
            [Hash PaymentKey]
reqSigners
            Lovelace
0
            TxAuxScripts era
txAuxScripts
            TxMetadataInEra era
txMetadata
            [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProcedures
            [(Proposal era, AnyWitness (LedgerEra 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
      let ledgerUTxO :: UTxO (ShelleyLedgerEra era)
ledgerUTxO = ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
Api.toLedgerUTxO (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) 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?
      r :: (UnsignedTx era, TxBodyContent (LedgerEra era))
r@(UnsignedTx era
unsignedTx, TxBodyContent (LedgerEra era)
_) <-
        (TxBodyErrorAutoBalance (LedgerEra era) -> TxCmdError)
-> ExceptT
     (TxBodyErrorAutoBalance (LedgerEra era))
     IO
     (UnsignedTx era, TxBodyContent (LedgerEra era))
-> ExceptT
     TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra 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 (LedgerEra era)
    -> AnyTxBodyErrorAutoBalance)
-> TxBodyErrorAutoBalance (LedgerEra era)
-> TxCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBodyErrorAutoBalance (LedgerEra era) -> AnyTxBodyErrorAutoBalance
forall era. TxBodyErrorAutoBalance era -> AnyTxBodyErrorAutoBalance
AnyTxBodyErrorAutoBalance)
          (ExceptT
   (TxBodyErrorAutoBalance (LedgerEra era))
   IO
   (UnsignedTx era, TxBodyContent (LedgerEra era))
 -> ExceptT
      TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era)))
-> (Either
      (TxBodyErrorAutoBalance (LedgerEra era))
      (UnsignedTx era, TxBodyContent (LedgerEra era))
    -> ExceptT
         (TxBodyErrorAutoBalance (LedgerEra era))
         IO
         (UnsignedTx era, TxBodyContent (LedgerEra era)))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (UnsignedTx era, TxBodyContent (LedgerEra era))
-> ExceptT
     TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either
  (TxBodyErrorAutoBalance (LedgerEra era))
  (UnsignedTx era, TxBodyContent (LedgerEra era))
-> ExceptT
     (TxBodyErrorAutoBalance (LedgerEra era))
     IO
     (UnsignedTx era, TxBodyContent (LedgerEra era))
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
          (Either
   (TxBodyErrorAutoBalance (LedgerEra era))
   (UnsignedTx era, TxBodyContent (LedgerEra era))
 -> ExceptT
      TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era)))
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (UnsignedTx era, TxBodyContent (LedgerEra era))
-> ExceptT
     TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era))
forall a b. (a -> b) -> a -> b
$ SystemStart
-> LedgerEpochInfo
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Lovelace
-> Map (Credential 'DRepRole) Lovelace
-> UTxO (LedgerEra era)
-> TxBodyContent (LedgerEra era)
-> AddressInEra era
-> Maybe Word
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (UnsignedTx era, TxBodyContent (LedgerEra era))
forall era.
(HasCallStack, IsEra era) =>
SystemStart
-> LedgerEpochInfo
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Lovelace
-> Map (Credential 'DRepRole) Lovelace
-> UTxO (LedgerEra era)
-> TxBodyContent (LedgerEra era)
-> AddressInEra era
-> Maybe Word
-> Either
     (TxBodyErrorAutoBalance (LedgerEra era))
     (UnsignedTx era, TxBodyContent (LedgerEra era))
Exp.makeTransactionBodyAutoBalance
            SystemStart
systemStart
            (EraHistory -> LedgerEpochInfo
toLedgerEpochInfo EraHistory
eraHistory)
            (Era era
-> (EraCommonConstraints era => PParams (LedgerEra era))
-> PParams (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) ((EraCommonConstraints era => PParams (LedgerEra era))
 -> PParams (LedgerEra era))
-> (EraCommonConstraints era => PParams (LedgerEra 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)
            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)
            (Era era
-> (EraCommonConstraints era => UTxO (LedgerEra era))
-> UTxO (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) UTxO (ShelleyLedgerEra era)
UTxO (LedgerEra era)
EraCommonConstraints era => UTxO (LedgerEra era)
ledgerUTxO)
            TxBodyContent (LedgerEra era)
txBodyContent
            AddressInEra era
cAddr
            Maybe Word
mOverrideWits
      -- Check to see if we lost any scripts during balancing
      [AnyIndexedPlutusScriptWitness (LedgerEra era)]
scriptWitnessesBeforeBalance <-
        (DecoderError -> TxCmdError)
-> ExceptT
     DecoderError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)]
-> ExceptT
     TxCmdError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT DecoderError -> TxCmdError
TxCmdCBORDecodeError (ExceptT
   DecoderError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)]
 -> ExceptT
      TxCmdError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> ExceptT
     DecoderError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)]
-> ExceptT
     TxCmdError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$
          Either DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
-> ExceptT
     DecoderError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either
   DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
 -> ExceptT
      DecoderError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> Either
     DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
-> ExceptT
     DecoderError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$
            Era era
-> TxBodyContent (LedgerEra era)
-> Either
     DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era.
Era era
-> TxBodyContent (LedgerEra era)
-> Either
     DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
Exp.extractAllIndexedPlutusScriptWitnesses Era era
forall era. IsEra era => Era era
Exp.useEra TxBodyContent (LedgerEra era)
txBodyContent
      [AnyIndexedPlutusScriptWitness (LedgerEra era)]
scriptWitnessesAfterBalance <-
        Either TxCmdError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
-> ExceptT
     TxCmdError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TxCmdError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
 -> ExceptT
      TxCmdError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> (Either
      DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
    -> Either
         TxCmdError [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> Either
     DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
-> ExceptT
     TxCmdError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DecoderError -> TxCmdError)
-> Either
     DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
-> Either
     TxCmdError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> TxCmdError
TxCmdCBORDecodeError (Either
   DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
 -> ExceptT
      TxCmdError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> Either
     DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
-> ExceptT
     TxCmdError IO [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$
          Era era
-> TxBodyContent (LedgerEra era)
-> Either
     DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era.
Era era
-> TxBodyContent (LedgerEra era)
-> Either
     DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
Exp.extractAllIndexedPlutusScriptWitnesses Era era
forall era. IsEra era => Era era
Exp.useEra ((UnsignedTx era, TxBodyContent (LedgerEra era))
-> TxBodyContent (LedgerEra era)
forall a b. (a, b) -> b
snd (UnsignedTx era, TxBodyContent (LedgerEra era))
r)
      Bool -> ExceptT TxCmdError IO () -> ExceptT TxCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        ( [AnyIndexedPlutusScriptWitness (LedgerEra era)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AnyIndexedPlutusScriptWitness (LedgerEra era)]
scriptWitnessesBeforeBalance
            Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [AnyIndexedPlutusScriptWitness (LedgerEra era)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AnyIndexedPlutusScriptWitness (LedgerEra era)]
scriptWitnessesAfterBalance
        )
        (ExceptT TxCmdError IO () -> ExceptT TxCmdError IO ())
-> ExceptT TxCmdError IO () -> ExceptT TxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ 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
$ [AnyIndexedPlutusScriptWitness (LedgerEra era)]
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)] -> TxCmdError
forall era.
[AnyIndexedPlutusScriptWitness (LedgerEra era)]
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)] -> TxCmdError
LostScriptWitnesses [AnyIndexedPlutusScriptWitness (LedgerEra era)]
scriptWitnessesBeforeBalance [AnyIndexedPlutusScriptWitness (LedgerEra era)]
scriptWitnessesAfterBalance

      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 (UnsignedTx era -> Lovelace
forall era. UnsignedTx era -> Lovelace
Exp.getUnsignedTxFee UnsignedTx era
unsignedTx)

      (UnsignedTx era, TxBodyContent (LedgerEra era))
-> ExceptT
     TxCmdError IO (UnsignedTx era, TxBodyContent (LedgerEra era))
forall a. a -> ExceptT TxCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnsignedTx era, TxBodyContent (LedgerEra era))
r

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

getAllReferenceInputs
  :: [Exp.AnyWitness (Exp.LedgerEra era)]
  -> [Exp.AnyWitness (Exp.LedgerEra era)]
  -> [Exp.AnyWitness (Exp.LedgerEra era)]
  -- \^ Certificate witnesses
  -> [Exp.AnyWitness (Exp.LedgerEra era)]
  -> [Exp.AnyWitness (Exp.LedgerEra era)]
  -> [Exp.AnyWitness (Exp.LedgerEra era)]
  -> [TxIn]
  -- \^ Read only reference inputs
  -> [TxIn]
getAllReferenceInputs :: forall era.
[AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
  [AnyWitness (LedgerEra era)]
spendingWitnesses
  [AnyWitness (LedgerEra era)]
mintWitnesses
  [AnyWitness (LedgerEra era)]
certScriptWitnesses
  [AnyWitness (LedgerEra era)]
withdrawals
  [AnyWitness (LedgerEra era)]
votingProceduresAndMaybeScriptWits
  [AnyWitness (LedgerEra era)]
propProceduresAnMaybeScriptWits
  [TxIn]
readOnlyRefIns = do
    let txinsWitByRefInputs :: [TxIn]
txinsWitByRefInputs = (AnyWitness (LedgerEra era) -> Maybe TxIn)
-> [AnyWitness (LedgerEra era)] -> [TxIn]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnyWitness (LedgerEra era) -> Maybe TxIn
forall era. AnyWitness era -> Maybe TxIn
Exp.getAnyWitnessReferenceInput [AnyWitness (LedgerEra era)]
spendingWitnesses
        mintingRefInputs :: [TxIn]
mintingRefInputs = (AnyWitness (LedgerEra era) -> Maybe TxIn)
-> [AnyWitness (LedgerEra era)] -> [TxIn]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnyWitness (LedgerEra era) -> Maybe TxIn
forall era. AnyWitness era -> Maybe TxIn
Exp.getAnyWitnessReferenceInput [AnyWitness (LedgerEra era)]
mintWitnesses
        certsWitByRefInputs :: [TxIn]
certsWitByRefInputs = (AnyWitness (LedgerEra era) -> Maybe TxIn)
-> [AnyWitness (LedgerEra era)] -> [TxIn]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnyWitness (LedgerEra era) -> Maybe TxIn
forall era. AnyWitness era -> Maybe TxIn
Exp.getAnyWitnessReferenceInput [AnyWitness (LedgerEra era)]
certScriptWitnesses
        withdrawalsWitByRefInputs :: [TxIn]
withdrawalsWitByRefInputs = (AnyWitness (LedgerEra era) -> Maybe TxIn)
-> [AnyWitness (LedgerEra era)] -> [TxIn]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnyWitness (LedgerEra era) -> Maybe TxIn
forall era. AnyWitness era -> Maybe TxIn
Exp.getAnyWitnessReferenceInput [AnyWitness (LedgerEra era)]
withdrawals
        votesWitByRefInputs :: [TxIn]
votesWitByRefInputs = (AnyWitness (LedgerEra era) -> Maybe TxIn)
-> [AnyWitness (LedgerEra era)] -> [TxIn]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnyWitness (LedgerEra era) -> Maybe TxIn
forall era. AnyWitness era -> Maybe TxIn
Exp.getAnyWitnessReferenceInput [AnyWitness (LedgerEra era)]
votingProceduresAndMaybeScriptWits
        propsWitByRefInputs :: [TxIn]
propsWitByRefInputs = (AnyWitness (LedgerEra era) -> Maybe TxIn)
-> [AnyWitness (LedgerEra era)] -> [TxIn]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnyWitness (LedgerEra era) -> Maybe TxIn
forall era. AnyWitness era -> Maybe TxIn
Exp.getAnyWitnessReferenceInput [AnyWitness (LedgerEra era)]
propProceduresAnMaybeScriptWits

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

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
  :: (L.MultiAsset, [(PolicyId, Exp.AnyWitness (Exp.LedgerEra era))])
  -> Either TxCmdError (Exp.TxMintValue (Exp.LedgerEra era))
createTxMintValue :: forall era.
(MultiAsset, [(PolicyId, AnyWitness (LedgerEra era))])
-> Either TxCmdError (TxMintValue (LedgerEra era))
createTxMintValue (MultiAsset
val, [(PolicyId, AnyWitness (LedgerEra 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
&& [(PolicyId, AnyWitness (LedgerEra era))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [(PolicyId, AnyWitness (LedgerEra era))]
scriptWitnesses
    then TxMintValue (LedgerEra era)
-> Either TxCmdError (TxMintValue (LedgerEra era))
forall a. a -> Either TxCmdError a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxMintValue (LedgerEra era)
 -> Either TxCmdError (TxMintValue (LedgerEra era)))
-> TxMintValue (LedgerEra era)
-> Either TxCmdError (TxMintValue (LedgerEra era))
forall a b. (a -> b) -> a -> b
$ Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era))
-> TxMintValue (LedgerEra era)
forall era.
Map PolicyId (PolicyAssets, AnyWitness era) -> TxMintValue era
Exp.TxMintValue Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era))
forall k a. Map k a
Map.empty
    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

      let witnessesProvidedMap :: Map PolicyId (AnyWitness (LedgerEra era))
witnessesProvidedMap = [Item (Map PolicyId (AnyWitness (LedgerEra era)))]
-> Map PolicyId (AnyWitness (LedgerEra era))
forall l. IsList l => [Item l] -> l
fromList [(PolicyId, AnyWitness (LedgerEra era))]
[Item (Map PolicyId (AnyWitness (LedgerEra era)))]
scriptWitnesses
          witnessesProvidedSet :: Set PolicyId
          witnessesProvidedSet :: Set PolicyId
witnessesProvidedSet = Map PolicyId (AnyWitness (LedgerEra era)) -> Set PolicyId
forall k a. Map k a -> Set k
Map.keysSet Map PolicyId (AnyWitness (LedgerEra 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 (LedgerEra era)
-> Either TxCmdError (TxMintValue (LedgerEra era))
forall a. a -> Either TxCmdError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxMintValue (LedgerEra era)
 -> Either TxCmdError (TxMintValue (LedgerEra era)))
-> TxMintValue (LedgerEra era)
-> Either TxCmdError (TxMintValue (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
        Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era))
-> TxMintValue (LedgerEra era)
forall era.
Map PolicyId (PolicyAssets, AnyWitness era) -> TxMintValue era
Exp.TxMintValue (Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era))
 -> TxMintValue (LedgerEra era))
-> Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era))
-> TxMintValue (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
          (PolicyAssets
 -> AnyWitness (LedgerEra era)
 -> (PolicyAssets, AnyWitness (LedgerEra era)))
-> Map PolicyId PolicyAssets
-> Map PolicyId (AnyWitness (LedgerEra era))
-> Map PolicyId (PolicyAssets, AnyWitness (LedgerEra era))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
            (\PolicyAssets
assets AnyWitness (LedgerEra era)
wit -> (PolicyAssets
assets, AnyWitness (LedgerEra era)
wit))
            Map PolicyId PolicyAssets
policiesWithAssets
            Map PolicyId (AnyWitness (LedgerEra 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
    AnyScript ConwayEra
script <-
      forall (m :: * -> *) era.
(MonadIO m, IsEra era) =>
FilePath -> m (AnyScript (LedgerEra era))
readAnyScript @_ @ConwayEra FilePath
sFile
    let hash :: ScriptHash
hash = ScriptHash -> ScriptHash
fromShelleyScriptHash (ScriptHash -> ScriptHash) -> ScriptHash -> ScriptHash
forall a b. (a -> b) -> a -> b
$ AnyScript (LedgerEra ConwayEra) -> ScriptHash
forall era. IsEra era => AnyScript (LedgerEra era) -> ScriptHash
Exp.hashAnyScript AnyScript (LedgerEra ConwayEra)
AnyScript ConwayEra
script
    IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> (Text -> IO ()) -> Text -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
Text.putStrLn (Text -> RIO e ()) -> Text -> RIO e ()
forall a b. (a -> b) -> a -> b
$ ScriptHash -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText ScriptHash
hash

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
    HashableScriptData
d <- (ScriptDataError -> TxCmdError)
-> ExceptT ScriptDataError IO HashableScriptData
-> ExceptT TxCmdError IO HashableScriptData
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> TxCmdError
TxCmdScriptDataError (ExceptT ScriptDataError IO HashableScriptData
 -> ExceptT TxCmdError IO HashableScriptData)
-> ExceptT ScriptDataError IO HashableScriptData
-> ExceptT TxCmdError IO HashableScriptData
forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData
forall (m :: * -> *).
MonadIO m =>
ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData
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 (HashableScriptData -> Hash ScriptData
hashScriptDataBytes HashableScriptData
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

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