{-# 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.Ledger.Hashes (DataHash)
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
    , IncludeCurrentTreasuryValue
includeCurrentTreasuryValue :: IncludeCurrentTreasuryValue
includeCurrentTreasuryValue :: forall era.
TransactionBuildCmdArgs era -> IncludeCurrentTreasuryValue
includeCurrentTreasuryValue
    , Maybe TxTreasuryDonation
mTreasuryDonation :: Maybe TxTreasuryDonation
mTreasuryDonation :: forall era. TransactionBuildCmdArgs era -> Maybe TxTreasuryDonation
mTreasuryDonation
    , 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

    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 = ((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

    certFilesAndMaybeScriptWits <-
      readCertificateScriptWitnesses certificates

    -- TODO: Conway Era - How can we make this more composable?
    certsAndMaybeScriptWits
      :: [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))] <-
      sequence
        [ (,mSwit)
            <$> ( fromEitherIOCli @(FileError TextEnvelopeError) $
                    obtainCommonConstraints currentEra $
                      readFileTextEnvelope (File certFile)
                )
        | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits
        ]

    forM_ certsAndMaybeScriptWits (fromExceptTCli . checkCertificateHashes . fst)

    withdrawalsAndMaybeScriptWits <-
      mapM readWithdrawalScriptWitness withdrawals
    txMetadata <-
      readTxMetadata currentEra metadataSchema metadataFiles
    let (mintedMultiAsset, sWitFiles) = fromMaybe mempty mMintedAssets
    mintingWitnesses <-
      mapM readMintScriptWitness sWitFiles
    scripts <-
      mapM (readFileScriptInAnyLang . unFile) scriptFiles
    txAuxScripts <-
      fromEitherCli $ validateTxAuxScripts scripts

    mProp <- case 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

    requiredSigners <-
      mapM (fromEitherIOCli . readRequiredSigner) reqSigners
    mReturnCollateralAndDatums <-
      forM mReturnColl toTxOutInShelleyBasedEra
    let mReturnCollateral = (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> TxOut (LedgerEra era)
forall a b. (a, b) -> a
fst ((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
 -> TxOut (LedgerEra era))
-> Maybe
     (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Maybe (TxOut (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
mReturnCollateralAndDatums
        returnCollDatums = Map DataHash (Data (LedgerEra era))
-> ((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
    -> Map DataHash (Data (LedgerEra era)))
-> Maybe
     (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Map DataHash (Data (LedgerEra era))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map DataHash (Data (LedgerEra era))
forall a. Monoid a => a
mempty (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Map DataHash (Data (LedgerEra era))
forall a b. (a, b) -> b
snd Maybe (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
mReturnCollateralAndDatums

    txOutsAndDatums <- mapM toTxOutInEra txouts
    let txOuts = ((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
 -> TxOut (LedgerEra era))
-> [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
-> [TxOut (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> TxOut (LedgerEra era)
forall a b. (a, b) -> a
fst [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
txOutsAndDatums
        supplementalDatums = [Map DataHash (Data (LedgerEra era))]
-> Map DataHash (Data (LedgerEra era))
forall a. Monoid a => [a] -> a
mconcat (((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
 -> Map DataHash (Data (LedgerEra era)))
-> [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
-> [Map DataHash (Data (LedgerEra era))]
forall a b. (a -> b) -> [a] -> [b]
map (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Map DataHash (Data (LedgerEra era))
forall a b. (a, b) -> b
snd [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
txOutsAndDatums) Map DataHash (Data (LedgerEra era))
-> Map DataHash (Data (LedgerEra era))
-> Map DataHash (Data (LedgerEra era))
forall a. Semigroup a => a -> a -> a
<> Map DataHash (Data (LedgerEra era))
returnCollDatums

    -- Conway related
    votingProceduresAndMaybeScriptWits :: [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] <-
      readVotingProceduresFiles voteFiles

    forM_ votingProceduresAndMaybeScriptWits (fromExceptTCli . checkVotingProcedureHashes . fst)

    proposals <-
      readTxGovernanceActions proposalFiles

    forM_ proposals (fromExceptTCli . checkProposalHashes . fst)

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

    let 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 =
          [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 -> Set StakeCredential -> Set StakeCredential
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set StakeCredential
returnAddrHashes Set StakeCredential
treasuryWithdrawalAddresses

    (balances, _) <-
      fromEitherIOCli
        ( executeLocalStateQueryExpr
            nodeConnInfo
            Consensus.VolatileTip
            (queryStakeAddresses eon allAddrHashes networkId)
        )
        & fromEitherCIOCli
        & fromEitherCIOCli

    let 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

    unless (null unregisteredAddresses) $
      throwCliError $
        TxCmdUnregisteredStakeAddress unregisteredAddresses

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

    let allReferenceInputs =
          [AnyWitness (LedgerEra era)]
-> [AnyScriptWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
forall era.
[AnyWitness (LedgerEra era)]
-> [AnyScriptWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
            [AnyWitness (LedgerEra era)]
spendingScriptWitnesses
            (((PolicyId, AnyScriptWitness (LedgerEra era))
 -> AnyScriptWitness (LedgerEra era))
-> [(PolicyId, AnyScriptWitness (LedgerEra era))]
-> [AnyScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (PolicyId, AnyScriptWitness (LedgerEra era))
-> AnyScriptWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(PolicyId, AnyScriptWitness (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
input | (TxIn
input, Maybe (ScriptRequirements 'TxInItem)
_) <- [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
txins]
        allTxInputs = [TxIn]
inputsThatRequireWitnessing [TxIn] -> [TxIn] -> [TxIn]
forall a. [a] -> [a] -> [a]
++ [TxIn]
allReferenceInputs [TxIn] -> [TxIn] -> [TxIn]
forall a. [a] -> [a] -> [a]
++ [TxIn]
filteredTxinsc

    AnyCardanoEra nodeEra <-
      fromEitherIOCli (executeLocalStateQueryExpr nodeConnInfo Consensus.VolatileTip queryCurrentEra)
        & fromEitherCIOCli

    (txEraUtxo, _, eraHistory, systemStart, _, _, _, featuredCurrentTreasuryValueM) <-
      fromEitherIOCli
        ( executeLocalStateQueryExpr
            nodeConnInfo
            Consensus.VolatileTip
            (queryStateForBalancedTx nodeEra allTxInputs [])
        )
        & fromEitherCIOCli

    let mCurrenTreasuryValue = case IncludeCurrentTreasuryValue
includeCurrentTreasuryValue of
          IncludeCurrentTreasuryValue
IncludeCurrentTreasuryValue -> 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
          IncludeCurrentTreasuryValue
ExcludeCurrentTreasuryValue -> Maybe TxCurrentTreasuryValue
forall a. Maybe a
Nothing

    -- We need to construct the txBodycontent outside of runTxBuild
    (balancedTxBody@(Exp.UnsignedTx tx), txBodyContent) <-
      fromExceptTCli $
        runTxBuild
          nodeSocketPath
          networkId
          mScriptValidity
          txinsAndMaybeScriptWits
          allReferenceInputs
          filteredTxinsc
          mReturnCollateral
          mTotalCollateral
          txOuts
          changeAddresses
          (mintedMultiAsset, mintingWitnesses)
          mValidityLowerBound
          mValidityUpperBound
          certsAndMaybeScriptWits
          withdrawalsAndMaybeScriptWits
          requiredSigners
          txAuxScripts
          txMetadata
          mProp
          mOverrideWitnesses
          votingProceduresAndMaybeScriptWits
          proposals
          mCurrenTreasuryValue
          mTreasuryDonation
          supplementalDatums

    -- 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 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 <-
          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 executionUnitPrices :: L.Prices = obtainCommonConstraints (Exp.useEra @era) $ pparams ^. L.ppPricesL

        Refl <-
          testEquality era' nodeEra
            & fromMaybeCli (NodeEraMismatchError era' nodeEra)

        let 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 =
              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 = UnsignedTx (LedgerEra era)
-> UTxO (LedgerEra era) -> Map ScriptWitnessIndex ScriptHash
forall era.
IsEra era =>
UnsignedTx (LedgerEra era)
-> UTxO (LedgerEra era) -> Map ScriptWitnessIndex ScriptHash
Exp.collectPlutusScriptHashes UnsignedTx (LedgerEra era)
balancedTxBody UTxO (LedgerEra era)
ledgerUTxO

        scriptCostOutput <-
          fromEitherCli $
            renderScriptCostsWithScriptHashesMap
              executionUnitPrices
              scriptHashes
              scriptExecUnitsMap
        liftIO $ LBS.writeFile (unFile fp) $ encodePretty 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

toTxOutInEra
  :: Exp.IsEra era
  => TxOutAnyEra
  -> CIO e (Exp.TxOut (Exp.LedgerEra era), Map.Map DataHash (L.Data (Exp.LedgerEra era)))
toTxOutInEra :: forall era e.
IsEra era =>
TxOutAnyEra
-> CIO
     e (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
toTxOutInEra (TxOutAnyEra AddressAny
addr' Value
val' TxOutDatumAnyEra
mDatumHash ReferenceScriptAnyEra
refScriptFp) = do
  let addr :: AddressInEra era
addr = ShelleyBasedEra era -> AddressAny -> AddressInEra era
forall era. ShelleyBasedEra era -> AddressAny -> AddressInEra era
anyAddressInShelleyBasedEra (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) AddressAny
addr'
  o <- 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 (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) AddressInEra era
addr Value
val' TxOutDatumAnyEra
mDatumHash ReferenceScriptAnyEra
refScriptFp
  fromEitherCli $ Exp.fromLegacyTxOut o

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
currentTreasuryValue :: Maybe TxCurrentTreasuryValue
currentTreasuryValue :: forall era.
TransactionBuildEstimateCmdArgs era -> Maybe TxCurrentTreasuryValue
currentTreasuryValue
    , Maybe TxTreasuryDonation
treasuryDonation :: Maybe TxTreasuryDonation
treasuryDonation :: forall era.
TransactionBuildEstimateCmdArgs era -> Maybe TxTreasuryDonation
treasuryDonation
    , 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

    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

    txInsAndMaybeScriptWits <-
      readSpendScriptWitnesses txins

    certFilesAndMaybeScriptWits <-
      readCertificateScriptWitnesses @era certificates

    withdrawalsAndMaybeScriptWits <-
      mapM readWithdrawalScriptWitness withdrawals
    txMetadata <-
      readTxMetadata currentEra metadataSchema metadataFiles

    let (mas, sWitFiles) = fromMaybe mempty mMintedAssets
    valuesWithScriptWits <-
      (mas,) <$> mapM readMintScriptWitness sWitFiles

    scripts <-
      mapM (readFileScriptInAnyLang . unFile) scriptFiles
    txAuxScripts <-
      fromEitherCli $ validateTxAuxScripts scripts

    requiredSigners <-
      mapM (fromEitherIOCli . readRequiredSigner) reqSigners

    mReturnCollateralAndDatums <- mapM toTxOutInShelleyBasedEra mReturnColl
    let mReturnCollateral = (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> TxOut (LedgerEra era)
forall a b. (a, b) -> a
fst ((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
 -> TxOut (LedgerEra era))
-> Maybe
     (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Maybe (TxOut (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
mReturnCollateralAndDatums
        returnCollDatums = Map DataHash (Data (LedgerEra era))
-> ((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
    -> Map DataHash (Data (LedgerEra era)))
-> Maybe
     (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Map DataHash (Data (LedgerEra era))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map DataHash (Data (LedgerEra era))
forall a. Monoid a => a
mempty (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Map DataHash (Data (LedgerEra era))
forall a b. (a, b) -> b
snd Maybe (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
mReturnCollateralAndDatums

    txOutsAndDatums <- mapM toTxOutInEra txouts
    let txOuts = ((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
 -> TxOut (LedgerEra era))
-> [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
-> [TxOut (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> TxOut (LedgerEra era)
forall a b. (a, b) -> a
fst [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
txOutsAndDatums
        supplementalDatums = [Map DataHash (Data (LedgerEra era))]
-> Map DataHash (Data (LedgerEra era))
forall a. Monoid a => [a] -> a
mconcat (((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
 -> Map DataHash (Data (LedgerEra era)))
-> [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
-> [Map DataHash (Data (LedgerEra era))]
forall a b. (a -> b) -> [a] -> [b]
map (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Map DataHash (Data (LedgerEra era))
forall a b. (a, b) -> b
snd [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
txOutsAndDatums) Map DataHash (Data (LedgerEra era))
-> Map DataHash (Data (LedgerEra era))
-> Map DataHash (Data (LedgerEra era))
forall a. Semigroup a => a -> a -> a
<> Map DataHash (Data (LedgerEra era))
returnCollDatums

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

    -- Conway related
    votingProceduresAndMaybeScriptWits <-
      inEonForShelleyBasedEra
        (pure 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
        )
        sbe

    proposals <- readTxGovernanceActions proposalFiles

    certsAndMaybeScriptWits <-
      sequence $
        [ (,mSwit)
            <$> ( obtainCommonConstraints currentEra $
                    fromEitherIOCli $
                      readFileTextEnvelope (File certFile)
                )
        | (CertificateFile certFile, mSwit :: Exp.AnyWitness (Exp.LedgerEra era)) <-
            certFilesAndMaybeScriptWits
        ]

    txBodyContent <-
      fromEitherCli $
        constructTxBodyContent
          mScriptValidity
          (Just ledgerPParams)
          txInsAndMaybeScriptWits
          readOnlyRefIns
          filteredTxinsc
          mReturnCollateral
          Nothing -- TODO: Remove total collateral parameter from estimateBalancedTxBody
          txOuts
          mValidityLowerBound
          mValidityUpperBound
          valuesWithScriptWits
          certsAndMaybeScriptWits
          withdrawalsAndMaybeScriptWits
          requiredSigners
          0
          txAuxScripts
          txMetadata
          votingProceduresAndMaybeScriptWits
          proposals
          currentTreasuryValue
          treasuryDonation
          supplementalDatums

    let 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 (Item (Map StakeCredential Lovelace))]
-> [Item (Map 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 =
          [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 (Item (Map (Credential 'DRepRole) Lovelace))]
-> [Item (Map (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 =
          [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 (Item (Set PoolId))] -> [Item (Set 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 -> Maybe Lovelace -> Lovelace
forall a. a -> Maybe a -> a
fromMaybe Lovelace
0 Maybe Lovelace
plutusCollateral
        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
              ]

    balancedTxBody :: Exp.TxBodyContent (Exp.LedgerEra era) <-
      fromEitherCli $
        first TxCmdFeeEstimationError $
          Exp.estimateBalancedTxBody
            currentEra
            txBodyContent
            ledgerPParams
            poolsToDeregister
            stakeCredentialsToDeregisterMap
            drepsToDeregisterMap
            pScriptExecUnits
            totCol
            shelleyWitnesses
            (fromMaybe 0 mByronWitnesses)
            (maybe 0 unReferenceScriptSize totalReferenceScriptSize)
            (anyAddressInShelleyBasedEra sbe changeAddr)
            (obtainCommonConstraints currentEra $ toLedgerValue (convert currentEra) totalUTxOValue)

    let unsignedTx = Era era
-> TxBodyContent (LedgerEra era) -> UnsignedTx (LedgerEra era)
forall era.
Era era
-> TxBodyContent (LedgerEra era) -> UnsignedTx (LedgerEra era)
Exp.makeUnsignedTx Era era
currentEra TxBodyContent (LedgerEra era)
balancedTxBody
    fromEitherIOCli
      $ ( if isCborOutCanonical == TxCborCanonical
            then writeTxFileTextEnvelopeCanonical
            else writeTxFileTextEnvelope
        )
        (convert currentEra)
        txBodyOutFile
      $ unsignedToToApiTx unsignedTx

unsignedToToApiTx :: forall era. Exp.IsEra era => Exp.UnsignedTx (Exp.LedgerEra era) -> Api.Tx era
unsignedToToApiTx :: forall era. IsEra era => UnsignedTx (LedgerEra 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
  (stakeCred, 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
  return (fromShelleyStakeCredential stakeCred, 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
mCurrentTreasuryValue :: Maybe TxCurrentTreasuryValue
mCurrentTreasuryValue :: forall era.
TransactionBuildRawCmdArgs era -> Maybe TxCurrentTreasuryValue
mCurrentTreasuryValue
    , Maybe TxTreasuryDonation
mTreasuryDonation :: Maybe TxTreasuryDonation
mTreasuryDonation :: forall era.
TransactionBuildRawCmdArgs era -> Maybe TxTreasuryDonation
mTreasuryDonation
    , 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
    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

    certFilesAndMaybeScriptWits :: [(CertificateFile, Exp.AnyWitness (Exp.LedgerEra era))] <-
      readCertificateScriptWitnesses certificates

    withdrawalsAndMaybeScriptWits <-
      mapM readWithdrawalScriptWitness withdrawals
    txMetadata <-
      readTxMetadata (convert Exp.useEra) metadataSchema metadataFiles

    let (mas, sWitFiles) = fromMaybe mempty mMintedAssets
    valuesWithScriptWits <-
      (mas,)
        <$> mapM readMintScriptWitness sWitFiles

    scripts <-
      mapM (readFileScriptInAnyLang . unFile) scriptFiles
    txAuxScripts <-
      fromEitherCli $
        validateTxAuxScripts scripts

    pparams <- forM mProtocolParamsFile $ \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 = 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 <- case 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

    requiredSigners <-
      mapM (fromEitherIOCli . readRequiredSigner) reqSigners

    mReturnCollateralAndDatums <- mapM toTxOutInShelleyBasedEra mReturnColl
    let mReturnCollateral = (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> TxOut (LedgerEra era)
forall a b. (a, b) -> a
fst ((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
 -> TxOut (LedgerEra era))
-> Maybe
     (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Maybe (TxOut (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
mReturnCollateralAndDatums
        returnCollDatums = Map DataHash (Data (LedgerEra era))
-> ((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
    -> Map DataHash (Data (LedgerEra era)))
-> Maybe
     (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Map DataHash (Data (LedgerEra era))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map DataHash (Data (LedgerEra era))
forall a. Monoid a => a
mempty (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Map DataHash (Data (LedgerEra era))
forall a b. (a, b) -> b
snd Maybe (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
mReturnCollateralAndDatums

    txOutsAndDatums <- mapM toTxOutInEra txouts
    let txOuts = ((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
 -> TxOut (LedgerEra era))
-> [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
-> [TxOut (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> TxOut (LedgerEra era)
forall a b. (a, b) -> a
fst [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
txOutsAndDatums
        supplementalDatums = [Map DataHash (Data (LedgerEra era))]
-> Map DataHash (Data (LedgerEra era))
forall a. Monoid a => [a] -> a
mconcat (((TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
 -> Map DataHash (Data (LedgerEra era)))
-> [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
-> [Map DataHash (Data (LedgerEra era))]
forall a b. (a -> b) -> [a] -> [b]
map (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))
-> Map DataHash (Data (LedgerEra era))
forall a b. (a, b) -> b
snd [(TxOut (LedgerEra era), Map DataHash (Data (LedgerEra era)))]
txOutsAndDatums) Map DataHash (Data (LedgerEra era))
-> Map DataHash (Data (LedgerEra era))
-> Map DataHash (Data (LedgerEra era))
forall a. Semigroup a => a -> a -> a
<> Map DataHash (Data (LedgerEra era))
returnCollDatums

    -- the same collateral input can be used for several plutus scripts
    let 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
    votingProceduresAndMaybeScriptWits <-
      conwayEraOnwardsConstraints (convert $ Exp.useEra @era) $
        readVotingProceduresFiles voteFiles

    proposals <-
      readTxGovernanceActions @era proposalFiles

    certsAndMaybeScriptWits <-
      sequence
        [ (,mSwit)
            <$> ( obtainCommonConstraints eon $
                    fromEitherIOCli $
                      readFileTextEnvelope (File certFile)
                )
        | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits
        ]
    txBody :: Exp.UnsignedTx (Exp.LedgerEra era) <-
      fromEitherCli $
        runTxBuildRaw
          mScriptValidity
          txInsAndMaybeScriptWits
          readOnlyRefIns
          filteredTxinsc
          mReturnCollateral
          mTotalCollateral
          txOuts
          mValidityLowerBound
          mValidityUpperBound
          fee
          valuesWithScriptWits
          certsAndMaybeScriptWits
          withdrawalsAndMaybeScriptWits
          requiredSigners
          txAuxScripts
          txMetadata
          mLedgerPParams
          votingProceduresAndMaybeScriptWits
          proposals
          mCurrentTreasuryValue
          mTreasuryDonation
          supplementalDatums
    let Exp.UnsignedTx lTx = txBody
        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
    fromEitherIOCli $
      if isCborOutCanonical == TxCborCanonical
        then writeTxFileTextEnvelopeCanonical (convert Exp.useEra) txBodyOutFile noWitTx
        else writeTxFileTextEnvelope (convert Exp.useEra) txBodyOutFile 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 (Exp.TxOut (Exp.LedgerEra era))
  -- ^ Return collateral
  -> Maybe Lovelace
  -- ^ Total collateral
  -> [Exp.TxOut (Exp.LedgerEra era)]
  -> Maybe SlotNo
  -- ^ Tx lower bound
  -> TxValidityUpperBound era
  -- ^ Tx upper bound
  -> Lovelace
  -- ^ Tx fee
  -> (L.MultiAsset, [(PolicyId, Exp.AnyScriptWitness (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
  -> Maybe TxTreasuryDonation
  -> Map.Map DataHash (L.Data (Exp.LedgerEra era))
  -- ^ Supplemental datums
  -> Either TxCmdError (Exp.UnsignedTx (Exp.LedgerEra era))
runTxBuildRaw :: forall era.
IsEra era =>
Maybe ScriptValidity
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut (LedgerEra era))
-> Maybe Lovelace
-> [TxOut (LedgerEra era)]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> Lovelace
-> (MultiAsset, [(PolicyId, AnyScriptWitness (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
-> Maybe TxTreasuryDonation
-> Map DataHash (Data (LedgerEra era))
-> Either TxCmdError (UnsignedTx (LedgerEra era))
runTxBuildRaw
  Maybe ScriptValidity
mScriptValidity
  [(TxIn, AnyWitness (LedgerEra era))]
inputsAndMaybeScriptWits
  [TxIn]
readOnlyRefIns
  [TxIn]
txinsc
  Maybe (TxOut (LedgerEra era))
mReturnCollateral
  Maybe Lovelace
mTotCollateral
  [TxOut (LedgerEra era)]
txouts
  Maybe SlotNo
mLowerBound
  TxValidityUpperBound era
mUpperBound
  Lovelace
fee
  (MultiAsset, [(PolicyId, AnyScriptWitness (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
mCurrentTreasury
  Maybe TxTreasuryDonation
mTreasuryDonation
  Map DataHash (Data (LedgerEra era))
suppDatums = do
    txBodyContent <-
      Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut (LedgerEra era))
-> Maybe Lovelace
-> [TxOut (LedgerEra era)]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [(PolicyId, AnyScriptWitness (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
-> Maybe TxTreasuryDonation
-> Map DataHash (Data (LedgerEra era))
-> Either TxCmdError (TxBodyContent (LedgerEra era))
forall era.
IsEra era =>
Maybe ScriptValidity
-> Maybe (PParams (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut (LedgerEra era))
-> Maybe Lovelace
-> [TxOut (LedgerEra era)]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [(PolicyId, AnyScriptWitness (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
-> Maybe TxTreasuryDonation
-> Map DataHash (Data (LedgerEra era))
-> 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 (LedgerEra era))
mReturnCollateral
        Maybe Lovelace
mTotCollateral
        [TxOut (LedgerEra era)]
txouts
        Maybe SlotNo
mLowerBound
        TxValidityUpperBound era
mUpperBound
        (MultiAsset, [(PolicyId, AnyScriptWitness (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
mCurrentTreasury
        Maybe TxTreasuryDonation
mTreasuryDonation
        Map DataHash (Data (LedgerEra era))
suppDatums

    return $ Exp.makeUnsignedTx Exp.useEra 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 (Exp.TxOut (Exp.LedgerEra era))
  -- ^ Return collateral
  -> Maybe Lovelace
  -- ^ Total collateral
  -> [Exp.TxOut (Exp.LedgerEra era)]
  -- ^ Normal outputs
  -> Maybe SlotNo
  -- ^ Tx lower bound
  -> TxValidityUpperBound era
  -- ^ Tx upper bound
  -> (L.MultiAsset, [(PolicyId, Exp.AnyScriptWitness (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
  -> Maybe 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.
  -> Map.Map DataHash (L.Data (Exp.LedgerEra era))
  -- ^ Supplemental datums
  -> 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 (LedgerEra era))
-> Maybe Lovelace
-> [TxOut (LedgerEra era)]
-> Maybe SlotNo
-> TxValidityUpperBound era
-> (MultiAsset, [(PolicyId, AnyScriptWitness (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
-> Maybe TxTreasuryDonation
-> Map DataHash (Data (LedgerEra era))
-> 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 (LedgerEra era))
mReturnCollateral
  Maybe Lovelace
mTotCollateral
  [TxOut (LedgerEra era)]
txouts
  Maybe SlotNo
mLowerBound
  (TxValidityUpperBound ShelleyBasedEra era
_ Maybe SlotNo
mUpperBound)
  (MultiAsset, [(PolicyId, AnyScriptWitness (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
mCurrentTreasury
  Maybe TxTreasuryDonation
mTreasuryDonation
  Map DataHash (Data (LedgerEra era))
suppDatums =
    do
      let allReferenceInputs :: [TxIn]
allReferenceInputs =
            [AnyWitness (LedgerEra era)]
-> [AnyScriptWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
forall era.
[AnyWitness (LedgerEra era)]
-> [AnyScriptWitness (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, AnyScriptWitness (LedgerEra era))
 -> AnyScriptWitness (LedgerEra era))
-> [(PolicyId, AnyScriptWitness (LedgerEra era))]
-> [AnyScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (PolicyId, AnyScriptWitness (LedgerEra era))
-> AnyScriptWitness (LedgerEra era)
forall a b. (a, b) -> b
snd ([(PolicyId, AnyScriptWitness (LedgerEra era))]
 -> [AnyScriptWitness (LedgerEra era)])
-> [(PolicyId, AnyScriptWitness (LedgerEra era))]
-> [AnyScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
-> [(PolicyId, AnyScriptWitness (LedgerEra era))]
forall a b. (a, b) -> b
snd (MultiAsset, [(PolicyId, AnyScriptWitness (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 Maybe (TxReturnCollateral (LedgerEra era))
txRetCollateral :: Maybe (Exp.TxReturnCollateral (Exp.LedgerEra era)) =
            Maybe (TxOut (LedgerEra era))
mReturnCollateral Maybe (TxOut (LedgerEra era))
-> (TxOut (LedgerEra era) -> TxReturnCollateral (LedgerEra era))
-> Maybe (TxReturnCollateral (LedgerEra era))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Exp.TxOut TxOut (LedgerEra era)
o) ->
              TxOut (LedgerEra era) -> TxReturnCollateral (LedgerEra era)
forall era. TxOut era -> TxReturnCollateral era
Exp.TxReturnCollateral (TxOut (LedgerEra era)
o :: (L.TxOut (Exp.LedgerEra era)))

      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
          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
          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

      validatedMintValue <- (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
-> Either TxCmdError (TxMintValue (LedgerEra era))
forall era.
(MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
-> Either TxCmdError (TxMintValue (LedgerEra era))
createTxMintValue (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
valuesWithScriptWits
      let 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
      validatedVotingProcedures <-
        first (TxCmdTxGovDuplicateVotes . TxGovDuplicateVotes) $
          Exp.mkTxVotingProcedures vProcedures
      let 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 =
            [(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 = TxCurrentTreasuryValue -> Lovelace
unTxCurrentTreasuryValue (TxCurrentTreasuryValue -> Lovelace)
-> Maybe TxCurrentTreasuryValue -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TxCurrentTreasuryValue
mCurrentTreasury
          validatedTreasuryDonation = TxTreasuryDonation -> Lovelace
unTxTreasuryDonation (TxTreasuryDonation -> Lovelace)
-> Maybe TxTreasuryDonation -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TxTreasuryDonation
mTreasuryDonation
      let 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
      return
        ( Exp.defaultTxBodyContent
            & Exp.setTxIns inputsAndMaybeScriptWits
            & Exp.setTxInsCollateral txinsc
            & Exp.setTxInsReference refInputs
            & Exp.setTxOuts txouts
            & maybe id Exp.setTxReturnCollateral txRetCollateral
            & maybe id Exp.setTxTotalCollateral txTotCollateral
            & Exp.setTxFee fee
            & maybe id Exp.setTxValidityLowerBound mLowerBound
            & maybe id Exp.setTxValidityUpperBound mUpperBound
            & Exp.setTxMetadata expTxMetadata
            & Exp.setTxAuxScripts auxScripts
            & Exp.setTxWithdrawals validatedWithdrawals
            & Exp.setTxExtraKeyWits (Exp.TxExtraKeyWitnesses reqSigners)
            & maybe id (Exp.setTxProtocolParams . Exp.obtainCommonConstraints (Exp.useEra @era)) mPparams
            & Exp.setTxCertificates
              (Exp.mkTxCertificates Exp.useEra certsAndMaybeScriptWits)
            & Exp.setTxMintValue validatedMintValue
            & Exp.setTxScriptValidity (fromMaybe ScriptValid mScriptValidity)
            & Exp.setTxVotingProcedures validatedVotingProcedures
            & Exp.setTxProposalProcedures validatedTxProposals
            & maybe id Exp.setTxCurrentTreasuryValue validatedCurrentTreasuryValue
            & maybe id Exp.setTxTreasuryDonation validatedTreasuryDonation
            & Exp.setTxSupplementalDatums suppDatums
        )

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 (Exp.TxOut (Exp.LedgerEra era))
  -- ^ Return collateral
  -> Maybe Lovelace
  -- ^ Total collateral
  -> [Exp.TxOut (Exp.LedgerEra era)]
  -- ^ Normal outputs
  -> TxOutChangeAddress
  -- ^ A change output
  -> (L.MultiAsset, [(PolicyId, Exp.AnyScriptWitness (Exp.LedgerEra era))])
  -- ^ Multi-Asset value(s)
  -> Maybe SlotNo
  -- ^ Tx lower bound
  -> TxValidityUpperBound era
  -- ^ Tx upper bound
  -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Lovelace, 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
  -> Maybe TxTreasuryDonation
  -- ^ The current treasury value and the donation.
  -> Map.Map DataHash (L.Data (Exp.LedgerEra era))
  -- ^ Supplemental datums
  -> ExceptT TxCmdError IO (Exp.UnsignedTx (Exp.LedgerEra era), Exp.TxBodyContent (Exp.LedgerEra era))
runTxBuild :: forall era.
(IsEra era, HasCallStack) =>
SocketPath
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut (LedgerEra era))
-> Maybe Lovelace
-> [TxOut (LedgerEra era)]
-> TxOutChangeAddress
-> (MultiAsset, [(PolicyId, AnyScriptWitness (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
-> Maybe TxTreasuryDonation
-> Map DataHash (Data (LedgerEra era))
-> ExceptT
     TxCmdError
     IO
     (UnsignedTx (LedgerEra era), TxBodyContent (LedgerEra era))
runTxBuild
  SocketPath
socketPath
  NetworkId
networkId
  Maybe ScriptValidity
mScriptValidity
  [(TxIn, AnyWitness (LedgerEra era))]
inputsAndMaybeScriptWits
  [TxIn]
readOnlyRefIns
  [TxIn]
txinsc
  Maybe (TxOut (LedgerEra era))
mReturnCollateral
  Maybe Lovelace
mTotCollateral
  [TxOut (LedgerEra era)]
txouts
  (TxOutChangeAddress AddressAny
changeAddr)
  (MultiAsset, [(PolicyId, AnyScriptWitness (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
mCurrentTreasury
  Maybe TxTreasuryDonation
mTreasuryDonation
  Map DataHash (Data (LedgerEra era))
suppDatums = 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 (LedgerEra era), TxBodyContent (LedgerEra era)))
-> ExceptT
     TxCmdError
     IO
     (UnsignedTx (LedgerEra era), TxBodyContent (LedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  ExceptT
    TxCmdError
    IO
    (UnsignedTx (LedgerEra era), TxBodyContent (LedgerEra era)))
 -> ExceptT
      TxCmdError
      IO
      (UnsignedTx (LedgerEra era), TxBodyContent (LedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
    ExceptT
      TxCmdError
      IO
      (UnsignedTx (LedgerEra era), TxBodyContent (LedgerEra era)))
-> ExceptT
     TxCmdError
     IO
     (UnsignedTx (LedgerEra 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)]
-> [AnyScriptWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
forall era.
[AnyWitness (LedgerEra era)]
-> [AnyScriptWitness (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, AnyScriptWitness (LedgerEra era))
 -> AnyScriptWitness (LedgerEra era))
-> [(PolicyId, AnyScriptWitness (LedgerEra era))]
-> [AnyScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (PolicyId, AnyScriptWitness (LedgerEra era))
-> AnyScriptWitness (LedgerEra era)
forall a b. (a, b) -> b
snd ([(PolicyId, AnyScriptWitness (LedgerEra era))]
 -> [AnyScriptWitness (LedgerEra era)])
-> [(PolicyId, AnyScriptWitness (LedgerEra era))]
-> [AnyScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
-> [(PolicyId, AnyScriptWitness (LedgerEra era))]
forall a b. (a, b) -> b
snd (MultiAsset, [(PolicyId, AnyScriptWitness (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 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)

      Refl <-
        testEquality era nodeEra
          & hoistMaybe (TxCmdTxNodeEraMismatchError $ NodeEraMismatchError era nodeEra)

      let 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)
      (txEraUtxo, pparams, eraHistory, systemStart, stakePools, stakeDelegDeposits, drepDelegDeposits, _) <-
        lift
          ( executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip $
              queryStateForBalancedTx nodeEra allTxInputs certsToQuery
          )
          & onLeft (left . TxCmdQueryConvenienceError . AcqFailure)
          & onLeft (left . TxCmdQueryConvenienceError)

      txBodyContent <-
        hoistEither $
          constructTxBodyContent
            mScriptValidity
            (Just $ fromShelleyLedgerPParamsShim Exp.useEra $ unLedgerProtocolParameters pparams)
            inputsAndMaybeScriptWits
            readOnlyRefIns
            txinsc
            mReturnCollateral
            mTotCollateral
            txouts
            mLowerBound
            mUpperBound
            mintValueWithScriptWits
            certsAndMaybeScriptWits
            withdrawals
            reqSigners
            0
            txAuxScripts
            txMetadata
            votingProcedures
            proposals
            mCurrentTreasury
            mTreasuryDonation
            suppDatums

      firstExceptT TxCmdTxInsDoNotExist
        . hoistEither
        $ txInsExistInUTxO allTxInputs txEraUtxo
      firstExceptT TxCmdQueryNotScriptLocked
        . hoistEither
        $ notScriptLockedTxIns txinsc txEraUtxo
      let 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
      cAddr <-
        pure (anyAddressInEra era changeAddr)
          & onLeft (error $ "runTxBuild: Byron address used: " <> show changeAddr) -- should this throw instead?
      r@(unsignedTx, _) <-
        firstExceptT (TxCmdBalanceTxBody . AnyTxBodyErrorAutoBalance)
          . hoistEither
          $ Exp.makeTransactionBodyAutoBalance
            systemStart
            (toLedgerEpochInfo eraHistory)
            (Exp.obtainCommonConstraints (Exp.useEra @era) $ unLedgerProtocolParameters pparams)
            stakePools
            stakeDelegDeposits
            (Map.map L.fromCompact drepDelegDeposits)
            (obtainCommonConstraints (Exp.useEra @era) ledgerUTxO)
            txBodyContent
            cAddr
            mOverrideWits
      -- Check to see if we lost any scripts during balancing
      scriptWitnessesBeforeBalance <-
        firstExceptT TxCmdCBORDecodeError $
          hoistEither $
            Exp.extractAllIndexedPlutusScriptWitnesses Exp.useEra txBodyContent
      scriptWitnessesAfterBalance <-
        hoistEither . first TxCmdCBORDecodeError $
          Exp.extractAllIndexedPlutusScriptWitnesses Exp.useEra (snd r)
      when
        ( length scriptWitnessesBeforeBalance
            /= length scriptWitnessesAfterBalance
        )
        $ left
        $ LostScriptWitnesses scriptWitnessesBeforeBalance scriptWitnessesAfterBalance

      liftIO . putStrLn . docToString $
        "Estimated transaction fee:" <+> pretty (Exp.getUnsignedTxFee unsignedTx)

      return r

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

getAllReferenceInputs
  :: [Exp.AnyWitness (Exp.LedgerEra era)]
  -> [Exp.AnyScriptWitness (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)]
-> [AnyScriptWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
  [AnyWitness (LedgerEra era)]
spendingWitnesses
  [AnyScriptWitness (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 = (AnyScriptWitness (LedgerEra era) -> Maybe TxIn)
-> [AnyScriptWitness (LedgerEra era)] -> [TxIn]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnyScriptWitness (LedgerEra era) -> Maybe TxIn
forall era. AnyScriptWitness era -> Maybe TxIn
Exp.getAnyScriptWitnessReferenceInput [AnyScriptWitness (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 (Exp.TxOut (Exp.LedgerEra era), Map.Map DataHash (L.Data (Exp.LedgerEra era)))
toTxOutInShelleyBasedEra :: forall era e.
IsEra era =>
TxOutShelleyBasedEra
-> CIO
     e (TxOut (LedgerEra era), Map DataHash (Data (LedgerEra 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'
  o <- 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
  fromEitherCli $ Exp.fromLegacyTxOut o

-- 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.AnyScriptWitness (Exp.LedgerEra era))])
  -> Either TxCmdError (Exp.TxMintValue (Exp.LedgerEra era))
createTxMintValue :: forall era.
(MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
-> Either TxCmdError (TxMintValue (LedgerEra era))
createTxMintValue (MultiAsset
val, [(PolicyId, AnyScriptWitness (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, AnyScriptWitness (LedgerEra era))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [(PolicyId, AnyScriptWitness (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, AnyScriptWitness (LedgerEra era))
-> TxMintValue (LedgerEra era)
forall era.
Map PolicyId (PolicyAssets, AnyScriptWitness era)
-> TxMintValue era
Exp.TxMintValue Map PolicyId (PolicyAssets, AnyScriptWitness (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 (AnyScriptWitness (LedgerEra era))
witnessesProvidedMap = [Item (Map PolicyId (AnyScriptWitness (LedgerEra era)))]
-> Map PolicyId (AnyScriptWitness (LedgerEra era))
forall l. IsList l => [Item l] -> l
fromList [(PolicyId, AnyScriptWitness (LedgerEra era))]
[Item (Map PolicyId (AnyScriptWitness (LedgerEra era)))]
scriptWitnesses
          witnessesProvidedSet :: Set PolicyId
          witnessesProvidedSet :: Set PolicyId
witnessesProvidedSet = Map PolicyId (AnyScriptWitness (LedgerEra era)) -> Set PolicyId
forall k a. Map k a -> Set k
Map.keysSet Map PolicyId (AnyScriptWitness (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, AnyScriptWitness (LedgerEra era))
-> TxMintValue (LedgerEra era)
forall era.
Map PolicyId (PolicyAssets, AnyScriptWitness era)
-> TxMintValue era
Exp.TxMintValue (Map PolicyId (PolicyAssets, AnyScriptWitness (LedgerEra era))
 -> TxMintValue (LedgerEra era))
-> Map PolicyId (PolicyAssets, AnyScriptWitness (LedgerEra era))
-> TxMintValue (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
          (PolicyAssets
 -> AnyScriptWitness (LedgerEra era)
 -> (PolicyAssets, AnyScriptWitness (LedgerEra era)))
-> Map PolicyId PolicyAssets
-> Map PolicyId (AnyScriptWitness (LedgerEra era))
-> Map PolicyId (PolicyAssets, AnyScriptWitness (LedgerEra era))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
            (,)
            Map PolicyId PolicyAssets
policiesWithAssets
            Map PolicyId (AnyScriptWitness (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
    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 (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeSigningWitness sks

    case txOrTxBody of
      InputTxFile (File FilePath
inputTxFilePath) -> do
        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
        anyTx <- lift (readFileTx inputTxFile) & onLeft (left . TxCmdTextEnvError)

        InAnyShelleyBasedEra sbe tx@(ShelleyTx _ ledgerTx) <- pure anyTx

        let (apiTxBody, existingTxKeyWits) = getTxBodyAndWitnesses tx

        byronWitnesses <-
          firstExceptT TxCmdBootstrapWitnessError . liftEither $
            forM sksByron $
              shelleyBasedEraConstraints sbe $
                mkShelleyBootstrapWitness sbe mNetworkId (ledgerTx ^. L.bodyTxL)

        let 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]
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 = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness era]
allKeyWits TxBody era
apiTxBody

        modifyError TxCmdWriteFileError $
          hoistIOEither $
            if isCborOutCanonical == TxCborCanonical
              then writeTxFileTextEnvelopeCanonical sbe outTxFile signedTx
              else writeTxFileTextEnvelope sbe outTxFile signedTx
      InputTxBodyFile (File FilePath
txbodyFilePath) -> do
        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 <-
          firstExceptT TxCmdTextEnvError . newExceptT $
            readFileTxBody txbodyFile

        case unwitnessed of
          IncompleteTxBody InAnyShelleyBasedEra TxBody
anyTxBody -> do
            InAnyShelleyBasedEra sbe txbody@(ShelleyTxBody _ ledgerTxBody _ _ _ _) <- 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.
            byronWitnesses <-
              firstExceptT TxCmdBootstrapWitnessError . liftEither $
                forM sksByron $
                  mkShelleyBootstrapWitness sbe mNetworkId ledgerTxBody

            let 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 = [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

            modifyError TxCmdWriteFileError $
              hoistIOEither $
                if isCborOutCanonical == TxCborCanonical
                  then writeTxFileTextEnvelopeCanonical sbe outTxFile tx
                  else writeTxFileTextEnvelope sbe outTxFile 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
    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 era tx <-
      lift (readFileTx txFileOrPipe) & onLeft (left . TxCmdTextEnvError)
    let txInMode = ShelleyBasedEra era -> Tx era -> TxInMode
forall era. ShelleyBasedEra era -> Tx era -> TxInMode
TxInMode ShelleyBasedEra era
era Tx era
tx
    res <- liftIO $ submitTxToNodeLocal nodeConnInfo txInMode
    case 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
    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
    unwitnessed <-
      fromEitherIOCli $
        readFileTxBody txbodyFile

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

    InAnyShelleyBasedEra sbe txbody <- pure $ unIncompleteTxBody unwitnessed

    era <- fromEitherCli $ Exp.sbeToEra sbe
    lpparams <-
      fromExceptTCli @ProtocolParamsError $
        Exp.obtainCommonConstraints era $
          readProtocolParameters protocolParamsFile

    let 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 =
          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
shelleyfee Lovelace -> Lovelace -> Lovelace
forall a. Num a => a -> a -> a
+ Lovelace
byronfee
        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 = [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]

    outputFormat
      & ( id
            . 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.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.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.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 :: forall era. TransactionCalculateMinValueCmdArgs era -> Era era
era = Era era
era :: Exp.Era era
    , ProtocolParamsFile
protocolParamsFile :: ProtocolParamsFile
protocolParamsFile :: forall era.
TransactionCalculateMinValueCmdArgs era -> ProtocolParamsFile
protocolParamsFile
    , TxOutShelleyBasedEra
txOut :: TxOutShelleyBasedEra
txOut :: forall era.
TransactionCalculateMinValueCmdArgs era -> TxOutShelleyBasedEra
txOut
    } = do
    pp :: L.PParams (Exp.LedgerEra era) <-
      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 (LedgerEra era)))
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  ExceptT ProtocolParamsError IO (PParams (LedgerEra era)))
 -> ExceptT ProtocolParamsError IO (PParams (LedgerEra era)))
-> (EraCommonConstraints era =>
    ExceptT ProtocolParamsError IO (PParams (LedgerEra era)))
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra 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)
    (out, _suppDatums :: Map.Map DataHash (L.Data (Exp.LedgerEra era))) <-
      obtainCommonConstraints era $ toTxOutInShelleyBasedEra txOut

    let minValue = PParams (LedgerEra era) -> TxOut (LedgerEra era) -> Lovelace
forall era.
HasCallStack =>
PParams (LedgerEra era) -> TxOut (LedgerEra era) -> Lovelace
Exp.calculateMinimumUTxO PParams (LedgerEra era)
pp TxOut (LedgerEra era)
out
    liftIO . IO.print $ 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
    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 txEra tx@(ShelleyTx sbe ledgerTx) <-
      liftIO (readFileTx txFileOrPipeIn) & onLeft (left . TxCmdTextEnvError)

    let 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 nodeEra, systemStart, eraHistory, txEraUtxo, pparams) <-
      case 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
                eCurrentEra <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
queryCurrentEra
                eSystemStart <- querySystemStart
                eEraHistory <- queryEraHistory
                eeUtxo <- queryUtxo txEra (QueryUTxOByTxIn relevantTxIns)
                ePp <- queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe Api.QueryProtocolParameters
                return $ do
                  currentEra <- first QceUnsupportedNtcVersion eCurrentEra
                  systemStart <- first QceUnsupportedNtcVersion eSystemStart
                  eraHistory <- first QceUnsupportedNtcVersion eEraHistory
                  utxo <- first QueryEraMismatch =<< first QceUnsupportedNtcVersion eeUtxo
                  pp <- first QueryEraMismatch =<< first QceUnsupportedNtcVersion ePp
                  return (currentEra, systemStart, eraHistory, utxo, LedgerProtocolParameters 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 <- 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
            buildTransactionContext
              era
              systemStartSource
              mustExtendSafeZone
              eraHistoryFile
              utxoFile
              protocolParamsFile

    Refl <-
      testEquality nodeEra (convert txEra)
        & hoistMaybe
          ( TxCmdTxSubmitErrorEraMismatch $
              EraMismatch{ledgerEraName = docToText $ pretty nodeEra, otherEraName = docToText $ pretty txEra}
          )

    aeo <- forEraMaybeEon nodeEra & hoistMaybe (TxCmdAlonzoEraOnwardsRequired nodeEra)
    calculatePlutusScriptsCosts aeo systemStart eraHistory pparams txEraUtxo 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

      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 =
            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 <-
        firstExceptT TxCmdPlutusScriptCostErr $
          hoistEither $
            renderScriptCostsWithScriptHashesMap
              executionUnitPrices
              scriptHashes
              scriptExecUnitsMap
      liftIO
        $ ( case 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
          )
        $ encodePretty 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
    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 <-
      onLeft (left . TxCmdTextEnvError) $
        liftIO $
          readFileTextEnvelope eraHistoryFile
    systemStart <- case 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
        (byronGenesisData, _) <- (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 = GenesisData -> UTCTime
Byron.gdStartTime GenesisData
byronGenesisData
        return $ SystemStart systemStartUTCTime
    utxosBytes <- modifyError TxCmdUtxoFileError (ExceptT $ readByteStringFile utxoFile)
    utxos <- liftEither . first TxCmdUtxoJsonError $ Aeson.eitherDecodeStrict' utxosBytes
    let 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
    return
      ( AnyCardanoEra (convert era)
      , systemStart
      , eraHistory
      , utxos
      , LedgerProtocolParameters ledgerPParams
      )

runTransactionPolicyIdCmd
  :: Cmd.TransactionPolicyIdCmdArgs
  -> CIO e ()
runTransactionPolicyIdCmd :: forall e. TransactionPolicyIdCmdArgs -> CIO e ()
runTransactionPolicyIdCmd
  Cmd.TransactionPolicyIdCmdArgs
    { scriptFile :: TransactionPolicyIdCmdArgs -> ScriptFile
scriptFile = File FilePath
sFile
    } = do
    script <-
      forall (m :: * -> *) era.
(MonadIO m, IsEra era) =>
FilePath -> m (AnyScript (LedgerEra era))
readAnyScript @_ @ConwayEra FilePath
sFile
    let 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
    liftIO . Text.putStrLn $ serialiseToRawBytesHexText 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
    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
    liftIO $ BS.putStrLn $ serialiseToRawBytesHex (hashScriptDataBytes 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 _era txbody <-
      case InputTxBodyOrTxFile
inputTxBodyOrTxFile of
        InputTxBodyFile (File FilePath
txbodyFilePath) -> do
          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 <-
            firstExceptT TxCmdTextEnvError . newExceptT $
              readFileTxBody txbodyFile
          return $ unIncompleteTxBody unwitnessed
        InputTxFile (File FilePath
txFilePath) -> do
          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 era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdTextEnvError)
          return . InAnyShelleyBasedEra era $ getTxBody tx

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

    liftIO $
      outputFormat
        & ( id
              . 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.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.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.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
    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 <-
      firstExceptT TxCmdTextEnvError . newExceptT $
        readFileTxBody txbodyFile
    case unwitnessed of
      IncompleteTxBody InAnyShelleyBasedEra TxBody
anyTxBody -> do
        InAnyShelleyBasedEra sbe txbody@(ShelleyTxBody _ ledgerTxBody _ _ _ _) <- 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
        someWit <-
          firstExceptT TxCmdReadWitnessSigningDataError
            . newExceptT
            $ readWitnessSigningData witnessSigningData
        witness <-
          case categoriseSomeSigningWitness 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

        firstExceptT TxCmdWriteFileError . newExceptT $
          writeTxWitnessFileTextEnvelope sbe outFile 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
    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 era txbody) <-
      lift (readFileTxBody txbodyFile) & onLeft (left . TxCmdTextEnvError)
    witnesses <-
      sequence
        [ do
            InAnyShelleyBasedEra era' witness <-
              lift (readFileTxKeyWitness file)
                & onLeft (left . TxCmdTextEnvError)

            case testEquality 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 file) <- witnessFiles
        ]

    let tx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness era]
witnesses TxBody era
txbody
    modifyError TxCmdWriteFileError $
      hoistIOEither $
        if isCborOutCanonical == TxCborCanonical
          then writeTxFileTextEnvelopeCanonical era outFile tx
          else writeTxFileTextEnvelope era outFile 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