{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Cardano.CLI.Shelley.Run.Transaction
  ( ShelleyTxCmdError(..)
  , renderShelleyTxCmdError
  , runTransactionCmd
  , readFileTx
  , readProtocolParametersSourceSpec
  , toTxOutInAnyEra
  ) where

import           Control.Monad (forM, forM_, void)
import           Control.Monad.IO.Class (MonadIO (..))
import           Control.Monad.Trans (MonadTrans (..))
import           Control.Monad.Trans.Except (ExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, hoistMaybe, left,
                   newExceptT, onLeft, onNothing)
import           Data.Aeson.Encode.Pretty (encodePretty)
import           Data.Bifunctor (Bifunctor (..))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import           Data.Data ((:~:) (..))
import           Data.Foldable (Foldable (..))
import           Data.Function ((&))
import qualified Data.List as List
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (catMaybes, fromMaybe)
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import           Data.Type.Equality (TestEquality (..))
import qualified System.IO as IO

import           Cardano.Api
import           Cardano.Api.Byron hiding (SomeByronSigningKey (..))
import           Cardano.Api.Shelley

import           Cardano.CLI.Helpers (printWarning)
import           Cardano.CLI.Run.Friendly (friendlyTxBS, friendlyTxBodyBS)
import           Cardano.CLI.Shelley.Output
import           Cardano.CLI.Shelley.Parsers
import           Cardano.CLI.Shelley.Run.Genesis
import           Cardano.CLI.Shelley.Run.Read
import           Cardano.CLI.Shelley.Run.Validate
import           Cardano.CLI.Types

import           Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx

{- HLINT ignore "Use let" -}

data ShelleyTxCmdError
  = ShelleyTxCmdMetadataError MetadataError
  | ShelleyTxCmdScriptWitnessError ScriptWitnessError
  | ShelleyTxCmdProtocolParamsError ProtocolParamsError
  | ShelleyTxCmdScriptFileError (FileError ScriptDecodeError)
  | ShelleyTxCmdReadTextViewFileError !(FileError TextEnvelopeError)
  | ShelleyTxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError
  | ShelleyTxCmdRequiredSignerByronKeyError !SigningKeyFile
  | ShelleyTxCmdWriteFileError !(FileError ())
  | ShelleyTxCmdEraConsensusModeMismatch
      !(Maybe FilePath)
      !AnyConsensusMode
      !AnyCardanoEra
      -- ^ Era
  | ShelleyTxCmdBootstrapWitnessError !ShelleyBootstrapWitnessError
  | ShelleyTxCmdSocketEnvError !EnvSocketError
  | ShelleyTxCmdTxSubmitError !Text
  | ShelleyTxCmdTxSubmitErrorEraMismatch !EraMismatch
  | ShelleyTxCmdTxFeatureMismatch !AnyCardanoEra !TxFeature
  | ShelleyTxCmdTxBodyError !TxBodyError
  | ShelleyTxCmdNotImplemented !Text
  | ShelleyTxCmdWitnessEraMismatch !AnyCardanoEra !AnyCardanoEra !WitnessFile
  | ShelleyTxCmdScriptLanguageNotSupportedInEra !AnyScriptLanguage !AnyCardanoEra
  | ShelleyTxCmdReferenceScriptsNotSupportedInEra !AnyCardanoEra
  | ShelleyTxCmdPolicyIdsMissing ![PolicyId]
  | ShelleyTxCmdPolicyIdsExcess  ![PolicyId]
  | ShelleyTxCmdUnsupportedMode !AnyConsensusMode
  | ShelleyTxCmdByronEra
  | ShelleyTxCmdEraConsensusModeMismatchTxBalance
      !TxBuildOutputOptions
      !AnyConsensusMode
      !AnyCardanoEra
  | ShelleyTxCmdBalanceTxBody !TxBodyErrorAutoBalance
  | ShelleyTxCmdTxInsDoNotExist !TxInsExistError
  | ShelleyTxCmdMinimumUTxOErr !MinimumUTxOError
  | ShelleyTxCmdPParamsErr !ProtocolParametersError
  | ShelleyTxCmdTextEnvCddlError
      !(FileError TextEnvelopeError)
      !(FileError TextEnvelopeCddlError)
  | ShelleyTxCmdTxExecUnitsErr !TransactionValidityError
  | ShelleyTxCmdPlutusScriptCostErr !PlutusScriptCostError
  | ShelleyTxCmdPParamExecutionUnitsNotAvailable
  | ShelleyTxCmdPlutusScriptsRequireCardanoMode
  | ShelleyTxCmdProtocolParametersNotPresentInTxBody
  | ShelleyTxCmdTxEraCastErr EraCastError
  | ShelleyTxCmdQueryConvenienceError !QueryConvenienceError
  | ShelleyTxCmdQueryNotScriptLocked !ScriptLockedTxInsError
  | ShelleyTxCmdScriptDataError !ScriptDataError
  | ShelleyTxCmdCddlError CddlError
  | ShelleyTxCmdCddlWitnessError CddlWitnessError
  | ShelleyTxCmdRequiredSignerError RequiredSignerError
  -- Validation errors
  | ShelleyTxCmdAuxScriptsValidationError TxAuxScriptsValidationError
  | ShelleyTxCmdTotalCollateralValidationError TxTotalCollateralValidationError
  | ShelleyTxCmdReturnCollateralValidationError TxReturnCollateralValidationError
  | ShelleyTxCmdTxFeeValidationError TxFeeValidationError
  | ShelleyTxCmdTxValidityLowerBoundValidationError TxValidityLowerBoundValidationError
  | ShelleyTxCmdTxValidityUpperBoundValidationError TxValidityUpperBoundValidationError
  | ShelleyTxCmdRequiredSignersValidationError TxRequiredSignersValidationError
  | ShelleyTxCmdProtocolParametersValidationError TxProtocolParametersValidationError
  | ShelleyTxCmdTxWithdrawalsValidationError TxWithdrawalsValidationError
  | ShelleyTxCmdTxCertificatesValidationError TxCertificatesValidationError
  | ShelleyTxCmdTxUpdateProposalValidationError TxUpdateProposalValidationError
  | ShelleyTxCmdScriptValidityValidationError TxScriptValidityValidationError

renderShelleyTxCmdError :: ShelleyTxCmdError -> Text
renderShelleyTxCmdError :: ShelleyTxCmdError -> Text
renderShelleyTxCmdError ShelleyTxCmdError
err =
  case ShelleyTxCmdError
err of
    ShelleyTxCmdReadTextViewFileError FileError TextEnvelopeError
fileErr -> FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError FileError TextEnvelopeError
fileErr)
    ShelleyTxCmdScriptFileError FileError ScriptDecodeError
fileErr -> FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError FileError ScriptDecodeError
fileErr)
    ShelleyTxCmdReadWitnessSigningDataError ReadWitnessSigningDataError
witSignDataErr ->
      ReadWitnessSigningDataError -> Text
renderReadWitnessSigningDataError ReadWitnessSigningDataError
witSignDataErr
    ShelleyTxCmdRequiredSignerByronKeyError (SigningKeyFile FilePath
fp) ->
      Text
"Byron key witness was used as a required signer: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow FilePath
fp
    ShelleyTxCmdWriteFileError FileError ()
fileErr -> FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError FileError ()
fileErr)
    ShelleyTxCmdSocketEnvError EnvSocketError
envSockErr -> EnvSocketError -> Text
renderEnvSocketError EnvSocketError
envSockErr
    ShelleyTxCmdTxSubmitError Text
res -> Text
"Error while submitting tx: " forall a. Semigroup a => a -> a -> a
<> Text
res
    ShelleyTxCmdTxSubmitErrorEraMismatch EraMismatch{Text
ledgerEraName :: EraMismatch -> Text
ledgerEraName :: Text
ledgerEraName, Text
otherEraName :: EraMismatch -> Text
otherEraName :: Text
otherEraName} ->
      Text
"The era of the node and the tx do not match. " forall a. Semigroup a => a -> a -> a
<>
      Text
"The node is running in the " forall a. Semigroup a => a -> a -> a
<> Text
ledgerEraName forall a. Semigroup a => a -> a -> a
<>
      Text
" era, but the transaction is for the " forall a. Semigroup a => a -> a -> a
<> Text
otherEraName forall a. Semigroup a => a -> a -> a
<> Text
" era."
    ShelleyTxCmdBootstrapWitnessError ShelleyBootstrapWitnessError
sbwErr ->
      ShelleyBootstrapWitnessError -> Text
renderShelleyBootstrapWitnessError ShelleyBootstrapWitnessError
sbwErr
    ShelleyTxCmdTxFeatureMismatch AnyCardanoEra
era TxFeature
TxFeatureImplicitFees ->
      Text
"An explicit transaction fee must be specified for " forall a. Semigroup a => a -> a -> a
<>
      AnyCardanoEra -> Text
renderEra AnyCardanoEra
era forall a. Semigroup a => a -> a -> a
<> Text
" era transactions."

    ShelleyTxCmdTxFeatureMismatch (AnyCardanoEra CardanoEra era
ShelleyEra)
                                  TxFeature
TxFeatureValidityNoUpperBound ->
      Text
"A TTL must be specified for Shelley era transactions."

    ShelleyTxCmdTxFeatureMismatch AnyCardanoEra
era TxFeature
feature ->
      TxFeature -> Text
renderFeature TxFeature
feature forall a. Semigroup a => a -> a -> a
<> Text
" cannot be used for " forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Text
renderEra AnyCardanoEra
era forall a. Semigroup a => a -> a -> a
<>
      Text
" era transactions."

    ShelleyTxCmdTxBodyError TxBodyError
err' ->
      Text
"Transaction validaton error: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError TxBodyError
err')

    ShelleyTxCmdNotImplemented Text
msg ->
      Text
"Feature not yet implemented: " forall a. Semigroup a => a -> a -> a
<> Text
msg

    ShelleyTxCmdWitnessEraMismatch AnyCardanoEra
era AnyCardanoEra
era' (WitnessFile FilePath
file) ->
      Text
"The era of a witness does not match the era of the transaction. " forall a. Semigroup a => a -> a -> a
<>
      Text
"The transaction is for the " forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Text
renderEra AnyCardanoEra
era forall a. Semigroup a => a -> a -> a
<> Text
" era, but the " forall a. Semigroup a => a -> a -> a
<>
      Text
"witness in " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow FilePath
file forall a. Semigroup a => a -> a -> a
<> Text
" is for the " forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Text
renderEra AnyCardanoEra
era' forall a. Semigroup a => a -> a -> a
<> Text
" era."

    ShelleyTxCmdScriptLanguageNotSupportedInEra (AnyScriptLanguage ScriptLanguage lang
lang) AnyCardanoEra
era ->
      Text
"The script language " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow ScriptLanguage lang
lang forall a. Semigroup a => a -> a -> a
<> Text
" is not supported in the " forall a. Semigroup a => a -> a -> a
<>
      AnyCardanoEra -> Text
renderEra AnyCardanoEra
era forall a. Semigroup a => a -> a -> a
<> Text
" era."

    ShelleyTxCmdEraConsensusModeMismatch Maybe FilePath
fp AnyConsensusMode
mode AnyCardanoEra
era ->
       Text
"Submitting " forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Text
renderEra AnyCardanoEra
era forall a. Semigroup a => a -> a -> a
<> Text
" era transaction (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow Maybe FilePath
fp forall a. Semigroup a => a -> a -> a
<>
       Text
") is not supported in the " forall a. Semigroup a => a -> a -> a
<> AnyConsensusMode -> Text
renderMode AnyConsensusMode
mode forall a. Semigroup a => a -> a -> a
<> Text
" consensus mode."
    ShelleyTxCmdPolicyIdsMissing [PolicyId]
policyids -> forall a. Monoid a => [a] -> a
mconcat
      [ Text
"The \"--mint\" flag specifies an asset with a policy Id, but no "
      , Text
"corresponding monetary policy script has been provided as a witness "
      , Text
"(via the \"--mint-script-file\" flag). The policy Id in question is: "
      , Text -> [Text] -> Text
Text.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText [PolicyId]
policyids)
      ]

    ShelleyTxCmdPolicyIdsExcess [PolicyId]
policyids -> forall a. Monoid a => [a] -> a
mconcat
      [ Text
"A script provided to witness minting does not correspond to the policy "
      , Text
"id of any asset specified in the \"--mint\" field. The script hash is: "
      , Text -> [Text] -> Text
Text.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText [PolicyId]
policyids)
      ]
    ShelleyTxCmdUnsupportedMode AnyConsensusMode
mode -> Text
"Unsupported mode: " forall a. Semigroup a => a -> a -> a
<> AnyConsensusMode -> Text
renderMode AnyConsensusMode
mode
    ShelleyTxCmdError
ShelleyTxCmdByronEra -> Text
"This query cannot be used for the Byron era"
    ShelleyTxCmdEraConsensusModeMismatchTxBalance TxBuildOutputOptions
fp AnyConsensusMode
mode AnyCardanoEra
era ->
       Text
"Cannot balance " forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Text
renderEra AnyCardanoEra
era forall a. Semigroup a => a -> a -> a
<> Text
" era transaction body (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow TxBuildOutputOptions
fp forall a. Semigroup a => a -> a -> a
<>
       Text
") because is not supported in the " forall a. Semigroup a => a -> a -> a
<> AnyConsensusMode -> Text
renderMode AnyConsensusMode
mode forall a. Semigroup a => a -> a -> a
<> Text
" consensus mode."
    ShelleyTxCmdBalanceTxBody TxBodyErrorAutoBalance
err' -> FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxBodyErrorAutoBalance
err'
    ShelleyTxCmdTxInsDoNotExist TxInsExistError
e ->
      TxInsExistError -> Text
renderTxInsExistError TxInsExistError
e
    ShelleyTxCmdMinimumUTxOErr MinimumUTxOError
err' -> FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError MinimumUTxOError
err'
    ShelleyTxCmdPParamsErr ProtocolParametersError
err' -> FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError ProtocolParametersError
err'
    ShelleyTxCmdTextEnvCddlError FileError TextEnvelopeError
textEnvErr FileError TextEnvelopeCddlError
cddlErr -> forall a. Monoid a => [a] -> a
mconcat
      [ Text
"Failed to decode neither the cli's serialisation format nor the ledger's "
      , Text
"CDDL serialisation format. TextEnvelope error: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError FileError TextEnvelopeError
textEnvErr) forall a. Semigroup a => a -> a -> a
<> Text
"\n"
      , Text
"TextEnvelopeCddl error: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError FileError TextEnvelopeCddlError
cddlErr)
      ]
    ShelleyTxCmdTxExecUnitsErr TransactionValidityError
err' ->  FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TransactionValidityError
err'
    ShelleyTxCmdPlutusScriptCostErr PlutusScriptCostError
err'-> FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError PlutusScriptCostError
err'
    ShelleyTxCmdError
ShelleyTxCmdPParamExecutionUnitsNotAvailable -> forall a. Monoid a => [a] -> a
mconcat
      [ Text
"Execution units not available in the protocol parameters. This is "
      , Text
"likely due to not being in the Alonzo era"
      ]
    ShelleyTxCmdReferenceScriptsNotSupportedInEra (AnyCardanoEra CardanoEra era
era) ->
      Text
"TxCmd: Reference scripts not supported in era: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow CardanoEra era
era
    ShelleyTxCmdTxEraCastErr (EraCastError value
value CardanoEra fromEra
fromEra CardanoEra toEra
toEra) ->
      Text
"Unable to cast era from " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow CardanoEra fromEra
fromEra forall a. Semigroup a => a -> a -> a
<> Text
" to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow CardanoEra toEra
toEra forall a. Semigroup a => a -> a -> a
<> Text
" the value " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow value
value
    ShelleyTxCmdQueryConvenienceError QueryConvenienceError
e ->
      QueryConvenienceError -> Text
renderQueryConvenienceError QueryConvenienceError
e
    ShelleyTxCmdQueryNotScriptLocked ScriptLockedTxInsError
e ->
      ScriptLockedTxInsError -> Text
renderNotScriptLockedTxInsError ScriptLockedTxInsError
e
    ShelleyTxCmdError
ShelleyTxCmdPlutusScriptsRequireCardanoMode ->
      Text
"Plutus scripts are only available in CardanoMode"
    ShelleyTxCmdError
ShelleyTxCmdProtocolParametersNotPresentInTxBody ->
      Text
"Protocol parameters were not found in transaction body"
    ShelleyTxCmdMetadataError MetadataError
e -> MetadataError -> Text
renderMetadataError MetadataError
e
    ShelleyTxCmdScriptWitnessError ScriptWitnessError
e -> ScriptWitnessError -> Text
renderScriptWitnessError ScriptWitnessError
e
    ShelleyTxCmdScriptDataError ScriptDataError
e -> ScriptDataError -> Text
renderScriptDataError ScriptDataError
e
    ShelleyTxCmdProtocolParamsError ProtocolParamsError
e -> ProtocolParamsError -> Text
renderProtocolParamsError ProtocolParamsError
e
    ShelleyTxCmdCddlError CddlError
e -> FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError CddlError
e
    ShelleyTxCmdCddlWitnessError CddlWitnessError
e -> FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError CddlWitnessError
e
    ShelleyTxCmdRequiredSignerError RequiredSignerError
e -> FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError RequiredSignerError
e
    -- Validation errors
    ShelleyTxCmdAuxScriptsValidationError TxAuxScriptsValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxAuxScriptsValidationError
e
    ShelleyTxCmdTotalCollateralValidationError TxTotalCollateralValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxTotalCollateralValidationError
e
    ShelleyTxCmdReturnCollateralValidationError TxReturnCollateralValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxReturnCollateralValidationError
e
    ShelleyTxCmdTxFeeValidationError TxFeeValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxFeeValidationError
e
    ShelleyTxCmdTxValidityLowerBoundValidationError TxValidityLowerBoundValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxValidityLowerBoundValidationError
e
    ShelleyTxCmdTxValidityUpperBoundValidationError TxValidityUpperBoundValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxValidityUpperBoundValidationError
e
    ShelleyTxCmdRequiredSignersValidationError TxRequiredSignersValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxRequiredSignersValidationError
e
    ShelleyTxCmdProtocolParametersValidationError TxProtocolParametersValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxProtocolParametersValidationError
e
    ShelleyTxCmdTxWithdrawalsValidationError TxWithdrawalsValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxWithdrawalsValidationError
e
    ShelleyTxCmdTxCertificatesValidationError TxCertificatesValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxCertificatesValidationError
e
    ShelleyTxCmdTxUpdateProposalValidationError TxUpdateProposalValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxUpdateProposalValidationError
e
    ShelleyTxCmdScriptValidityValidationError TxScriptValidityValidationError
e ->
      FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> FilePath
displayError TxScriptValidityValidationError
e

renderFeature :: TxFeature -> Text
renderFeature :: TxFeature -> Text
renderFeature TxFeature
TxFeatureShelleyAddresses     = Text
"Shelley addresses"
renderFeature TxFeature
TxFeatureExplicitFees         = Text
"Explicit fees"
renderFeature TxFeature
TxFeatureImplicitFees         = Text
"Implicit fees"
renderFeature TxFeature
TxFeatureValidityLowerBound   = Text
"A validity lower bound"
renderFeature TxFeature
TxFeatureValidityUpperBound   = Text
"A validity upper bound"
renderFeature TxFeature
TxFeatureValidityNoUpperBound = Text
"An absent validity upper bound"
renderFeature TxFeature
TxFeatureTxMetadata           = Text
"Transaction metadata"
renderFeature TxFeature
TxFeatureAuxScripts           = Text
"Auxiliary scripts"
renderFeature TxFeature
TxFeatureWithdrawals          = Text
"Reward account withdrawals"
renderFeature TxFeature
TxFeatureCertificates         = Text
"Certificates"
renderFeature TxFeature
TxFeatureMintValue            = Text
"Asset minting"
renderFeature TxFeature
TxFeatureMultiAssetOutputs    = Text
"Multi-Asset outputs"
renderFeature TxFeature
TxFeatureScriptWitnesses      = Text
"Script witnesses"
renderFeature TxFeature
TxFeatureShelleyKeys          = Text
"Shelley keys"
renderFeature TxFeature
TxFeatureCollateral           = Text
"Collateral inputs"
renderFeature TxFeature
TxFeatureProtocolParameters   = Text
"Protocol parameters"
renderFeature TxFeature
TxFeatureTxOutDatum           = Text
"Transaction output datums"
renderFeature TxFeature
TxFeatureScriptValidity       = Text
"Script validity"
renderFeature TxFeature
TxFeatureExtraKeyWits         = Text
"Required signers"
renderFeature TxFeature
TxFeatureInlineDatums         = Text
"Inline datums"
renderFeature TxFeature
TxFeatureTotalCollateral      = Text
"Total collateral"
renderFeature TxFeature
TxFeatureReferenceInputs      = Text
"Reference inputs"
renderFeature TxFeature
TxFeatureReturnCollateral     = Text
"Return collateral"

runTransactionCmd :: TransactionCmd -> ExceptT ShelleyTxCmdError IO ()
runTransactionCmd :: TransactionCmd -> ExceptT ShelleyTxCmdError IO ()
runTransactionCmd TransactionCmd
cmd =
  case TransactionCmd
cmd of
    TxBuild AnyCardanoEra
era AnyConsensusModeParams
consensusModeParams NetworkId
nid Maybe ScriptValidity
mScriptValidity Maybe Word
mOverrideWits [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
readOnlyRefIns
            [RequiredSigner]
reqSigners [TxIn]
txinsc Maybe TxOutAnyEra
mReturnColl Maybe Lovelace
mTotCollateral [TxOutAnyEra]
txouts TxOutChangeAddress
changeAddr Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue Maybe SlotNo
mLowBound
            Maybe SlotNo
mUpperBound [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certs [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls TxMetadataJsonSchema
metadataSchema [ScriptFile]
scriptFiles [MetadataFile]
metadataFiles Maybe ProtocolParamsSourceSpec
mPparams
            Maybe UpdateProposalFile
mUpProp TxBuildOutputOptions
outputOptions -> do
      AnyCardanoEra
-> AnyConsensusModeParams
-> NetworkId
-> Maybe ScriptValidity
-> Maybe Word
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [RequiredSigner]
-> [TxIn]
-> Maybe TxOutAnyEra
-> Maybe Lovelace
-> [TxOutAnyEra]
-> TxOutChangeAddress
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> Maybe SlotNo
-> Maybe SlotNo
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBuildOutputOptions
-> ExceptT ShelleyTxCmdError IO ()
runTxBuildCmd AnyCardanoEra
era AnyConsensusModeParams
consensusModeParams NetworkId
nid Maybe ScriptValidity
mScriptValidity Maybe Word
mOverrideWits [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
readOnlyRefIns
            [RequiredSigner]
reqSigners [TxIn]
txinsc Maybe TxOutAnyEra
mReturnColl Maybe Lovelace
mTotCollateral [TxOutAnyEra]
txouts TxOutChangeAddress
changeAddr Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue Maybe SlotNo
mLowBound
            Maybe SlotNo
mUpperBound [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certs [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls TxMetadataJsonSchema
metadataSchema [ScriptFile]
scriptFiles [MetadataFile]
metadataFiles Maybe ProtocolParamsSourceSpec
mPparams
            Maybe UpdateProposalFile
mUpProp TxBuildOutputOptions
outputOptions
    TxBuildRaw AnyCardanoEra
era Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
readOnlyRefIns [TxIn]
txinsc Maybe TxOutAnyEra
mReturnColl
               Maybe Lovelace
mTotColl [RequiredSigner]
reqSigners [TxOutAnyEra]
txouts Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue Maybe SlotNo
mLowBound Maybe SlotNo
mUpperBound Maybe Lovelace
fee [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certs [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls
               TxMetadataJsonSchema
metadataSchema [ScriptFile]
scriptFiles [MetadataFile]
metadataFiles Maybe ProtocolParamsSourceSpec
mpparams Maybe UpdateProposalFile
mUpProp TxBodyFile
out -> do
      AnyCardanoEra
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [TxIn]
-> Maybe TxOutAnyEra
-> Maybe Lovelace
-> [RequiredSigner]
-> [TxOutAnyEra]
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> Maybe SlotNo
-> Maybe SlotNo
-> Maybe Lovelace
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBodyFile
-> ExceptT ShelleyTxCmdError IO ()
runTxBuildRawCmd AnyCardanoEra
era Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
readOnlyRefIns [TxIn]
txinsc Maybe TxOutAnyEra
mReturnColl
               Maybe Lovelace
mTotColl [RequiredSigner]
reqSigners [TxOutAnyEra]
txouts Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue Maybe SlotNo
mLowBound Maybe SlotNo
mUpperBound Maybe Lovelace
fee [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certs [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls
               TxMetadataJsonSchema
metadataSchema [ScriptFile]
scriptFiles [MetadataFile]
metadataFiles Maybe ProtocolParamsSourceSpec
mpparams Maybe UpdateProposalFile
mUpProp TxBodyFile
out
    TxSign InputTxBodyOrTxFile
txinfile [WitnessSigningData]
skfiles Maybe NetworkId
network TxFile
txoutfile ->
      InputTxBodyOrTxFile
-> [WitnessSigningData]
-> Maybe NetworkId
-> TxFile
-> ExceptT ShelleyTxCmdError IO ()
runTxSign InputTxBodyOrTxFile
txinfile [WitnessSigningData]
skfiles Maybe NetworkId
network TxFile
txoutfile
    TxSubmit AnyConsensusModeParams
anyConsensusModeParams NetworkId
network FilePath
txFp ->
      AnyConsensusModeParams
-> NetworkId -> FilePath -> ExceptT ShelleyTxCmdError IO ()
runTxSubmit AnyConsensusModeParams
anyConsensusModeParams NetworkId
network FilePath
txFp
    TxCalculateMinFee TxBodyFile
txbody Maybe NetworkId
mnw ProtocolParamsSourceSpec
pGenesisOrParamsFile TxInCount
nInputs TxOutCount
nOutputs
                      TxShelleyWitnessCount
nShelleyKeyWitnesses TxByronWitnessCount
nByronKeyWitnesses ->
      TxBodyFile
-> Maybe NetworkId
-> ProtocolParamsSourceSpec
-> TxInCount
-> TxOutCount
-> TxShelleyWitnessCount
-> TxByronWitnessCount
-> ExceptT ShelleyTxCmdError IO ()
runTxCalculateMinFee TxBodyFile
txbody Maybe NetworkId
mnw ProtocolParamsSourceSpec
pGenesisOrParamsFile TxInCount
nInputs TxOutCount
nOutputs
                           TxShelleyWitnessCount
nShelleyKeyWitnesses TxByronWitnessCount
nByronKeyWitnesses
    TxCalculateMinRequiredUTxO AnyCardanoEra
era ProtocolParamsSourceSpec
pParamSpec TxOutAnyEra
txOuts -> AnyCardanoEra
-> ProtocolParamsSourceSpec
-> TxOutAnyEra
-> ExceptT ShelleyTxCmdError IO ()
runTxCalculateMinRequiredUTxO AnyCardanoEra
era ProtocolParamsSourceSpec
pParamSpec TxOutAnyEra
txOuts
    TxHashScriptData ScriptDataOrFile
scriptDataOrFile -> ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO ()
runTxHashScriptData ScriptDataOrFile
scriptDataOrFile
    TxGetTxId InputTxBodyOrTxFile
txinfile -> InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxGetTxId InputTxBodyOrTxFile
txinfile
    TxView InputTxBodyOrTxFile
txinfile -> InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxView InputTxBodyOrTxFile
txinfile
    TxMintedPolicyId ScriptFile
sFile -> ScriptFile -> ExceptT ShelleyTxCmdError IO ()
runTxCreatePolicyId ScriptFile
sFile
    TxCreateWitness TxBodyFile
txBodyfile WitnessSigningData
witSignData Maybe NetworkId
mbNw OutputFile
outFile ->
      TxBodyFile
-> WitnessSigningData
-> Maybe NetworkId
-> OutputFile
-> ExceptT ShelleyTxCmdError IO ()
runTxCreateWitness TxBodyFile
txBodyfile WitnessSigningData
witSignData Maybe NetworkId
mbNw OutputFile
outFile
    TxAssembleTxBodyWitness TxBodyFile
txBodyFile [WitnessFile]
witnessFile OutputFile
outFile ->
      TxBodyFile
-> [WitnessFile] -> OutputFile -> ExceptT ShelleyTxCmdError IO ()
runTxSignWitness TxBodyFile
txBodyFile [WitnessFile]
witnessFile OutputFile
outFile

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

runTxBuildCmd
  :: AnyCardanoEra
  -> AnyConsensusModeParams
  -> NetworkId
  -> Maybe ScriptValidity
  -> Maybe Word -- ^ Override the required number of tx witnesses
  -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))] -- ^ Transaction inputs with optional spending scripts
  -> [TxIn] -- ^ Read only reference inputs
  -> [RequiredSigner] -- ^ Required signers
  -> [TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts.
  -> Maybe TxOutAnyEra -- ^ Return collateral
  -> Maybe Lovelace -- ^ Total collateral
  -> [TxOutAnyEra]
  -> TxOutChangeAddress
  -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
  -> Maybe SlotNo -- ^ Validity lower bound
  -> Maybe SlotNo -- ^ Validity upper bound
  -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))] -- ^ Withdrawals with potential script witness
  -> TxMetadataJsonSchema
  -> [ScriptFile]
  -> [MetadataFile]
  -> Maybe ProtocolParamsSourceSpec
  -> Maybe UpdateProposalFile
  -> TxBuildOutputOptions
  -> ExceptT ShelleyTxCmdError IO ()
runTxBuildCmd :: AnyCardanoEra
-> AnyConsensusModeParams
-> NetworkId
-> Maybe ScriptValidity
-> Maybe Word
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [RequiredSigner]
-> [TxIn]
-> Maybe TxOutAnyEra
-> Maybe Lovelace
-> [TxOutAnyEra]
-> TxOutChangeAddress
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> Maybe SlotNo
-> Maybe SlotNo
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBuildOutputOptions
-> ExceptT ShelleyTxCmdError IO ()
runTxBuildCmd
  (AnyCardanoEra CardanoEra era
cEra) consensusModeParams :: AnyConsensusModeParams
consensusModeParams@(AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
nid Maybe ScriptValidity
mScriptValidity Maybe Word
mOverrideWits [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
readOnlyRefIns
  [RequiredSigner]
reqSigners [TxIn]
txinsc Maybe TxOutAnyEra
mReturnColl Maybe Lovelace
mTotCollateral [TxOutAnyEra]
txouts TxOutChangeAddress
changeAddr Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue Maybe SlotNo
mLowBound
  Maybe SlotNo
mUpperBound [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certs [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls TxMetadataJsonSchema
metadataSchema [ScriptFile]
scriptFiles [MetadataFile]
metadataFiles Maybe ProtocolParamsSourceSpec
mPparams Maybe UpdateProposalFile
mUpProp TxBuildOutputOptions
outputOptions = do
  -- The user can specify an era prior to the era that the node is currently in.
  -- We cannot use the user specified era to construct a query against a node because it may differ
  -- from the node's era and this will result in the 'QueryEraMismatch' failure.

  SocketPath FilePath
sockPath <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO (Either EnvSocketError SocketPath)
readEnvSocketPath forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnvSocketError -> ShelleyTxCmdError
ShelleyTxCmdSocketEnvError)

  let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = LocalNodeConnectInfo
                            { localConsensusModeParams :: ConsensusModeParams mode
localConsensusModeParams = ConsensusModeParams mode
cModeParams
                            , localNodeNetworkId :: NetworkId
localNodeNetworkId = NetworkId
nid
                            , localNodeSocketPath :: FilePath
localNodeSocketPath = FilePath
sockPath
                            }

  AnyCardanoEra CardanoEra era
nodeEra <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> IO (Either AcquiringFailure AnyCardanoEra)
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo)
    forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConvenienceError -> ShelleyTxCmdError
ShelleyTxCmdQueryConvenienceError forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryConvenienceError
AcqFailure)

  [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptWitnessError -> ShelleyTxCmdError
ShelleyTxCmdScriptWitnessError forall a b. (a -> b) -> a -> b
$ forall era a ctx.
CardanoEra era
-> [(a, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))]
readScriptWitnessFiles CardanoEra era
cEra [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins
  [(CertificateFile, Maybe (ScriptWitness WitCtxStake era))]
certFilesAndMaybeScriptWits <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptWitnessError -> ShelleyTxCmdError
ShelleyTxCmdScriptWitnessError forall a b. (a -> b) -> a -> b
$ forall era a ctx.
CardanoEra era
-> [(a, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))]
readScriptWitnessFiles CardanoEra era
cEra [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certs
  [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeScriptWits <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
             [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Maybe (ScriptWitness WitCtxStake era)
mSwit) (forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyTxCmdError
ShelleyTxCmdReadTextViewFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
                 forall a.
HasTextEnvelope a =>
AsType a -> FilePath -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType Certificate
AsCertificate FilePath
certFile)
             | (CertificateFile FilePath
certFile, Maybe (ScriptWitness WitCtxStake era)
mSwit) <- [(CertificateFile, Maybe (ScriptWitness WitCtxStake era))]
certFilesAndMaybeScriptWits
             ]
  [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawalsAndMaybeScriptWits <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptWitnessError -> ShelleyTxCmdError
ShelleyTxCmdScriptWitnessError
                                     forall a b. (a -> b) -> a -> b
$ forall era a b ctx.
CardanoEra era
-> [(a, b, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, b, Maybe (ScriptWitness ctx era))]
readScriptWitnessFilesThruple CardanoEra era
cEra [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls
  TxMetadataInEra era
txMetadata <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT MetadataError -> ShelleyTxCmdError
ShelleyTxCmdMetadataError
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> IO (Either MetadataError (TxMetadataInEra era))
readTxMetadata CardanoEra era
cEra TxMetadataJsonSchema
metadataSchema [MetadataFile]
metadataFiles
  (Value, [ScriptWitness WitCtxMint era])
valuesWithScriptWits <- forall era.
CardanoEra era
-> (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT
     ShelleyTxCmdError IO (Value, [ScriptWitness WitCtxMint era])
readValueScriptWitnesses CardanoEra era
cEra forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a. Monoid a => a
mempty, []) Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue
  [ScriptInAnyLang]
scripts <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ShelleyTxCmdError
ShelleyTxCmdScriptFileError forall a b. (a -> b) -> a -> b
$
                     forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptFile -> FilePath
unScriptFile) [ScriptFile]
scriptFiles
  TxAuxScripts era
txAuxScripts <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxAuxScriptsValidationError -> ShelleyTxCmdError
ShelleyTxCmdAuxScriptsValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> [ScriptInAnyLang]
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
validateTxAuxScripts CardanoEra era
cEra [ScriptInAnyLang]
scripts
  Maybe ProtocolParameters
mpparams <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe ProtocolParamsSourceSpec
mPparams forall a b. (a -> b) -> a -> b
$ \ProtocolParamsSourceSpec
ppFp ->
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ProtocolParamsError -> ShelleyTxCmdError
ShelleyTxCmdProtocolParamsError (ProtocolParamsSourceSpec
-> ExceptT ProtocolParamsError IO ProtocolParameters
readProtocolParametersSourceSpec ProtocolParamsSourceSpec
ppFp)

  Maybe UpdateProposal
mProp <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe UpdateProposalFile
mUpProp forall a b. (a -> b) -> a -> b
$ \(UpdateProposalFile FilePath
upFp) ->
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyTxCmdError
ShelleyTxCmdReadTextViewFileError (forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
AsType a -> FilePath -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType UpdateProposal
AsUpdateProposal FilePath
upFp)
  [Hash PaymentKey]
requiredSigners  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT RequiredSignerError -> ShelleyTxCmdError
ShelleyTxCmdRequiredSignerError forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequiredSigner -> IO (Either RequiredSignerError (Hash PaymentKey))
readRequiredSigner) [RequiredSigner]
reqSigners
  Maybe (TxOut CtxTx era)
mReturnCollateral <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe TxOutAnyEra
mReturnColl forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> TxOutAnyEra -> ExceptT ShelleyTxCmdError IO (TxOut CtxTx era)
toTxOutInAnyEra CardanoEra era
cEra

  [TxOut CtxTx era]
txOuts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall era.
CardanoEra era
-> TxOutAnyEra -> ExceptT ShelleyTxCmdError IO (TxOut CtxTx era)
toTxOutInAnyEra CardanoEra era
cEra) [TxOutAnyEra]
txouts

  -- the same collateral input can be used for several plutus scripts
  let filteredTxinsc :: [TxIn]
filteredTxinsc = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [TxIn]
txinsc

  -- We need to construct the txBodycontent outside of runTxBuild
  BalancedTxBody TxBodyContent BuildTx era
txBodycontent TxBody era
balancedTxBody TxOut CtxTx era
_ Lovelace
_
    <- forall era.
CardanoEra era
-> AnyConsensusModeParams
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> TxOutChangeAddress
-> (Value, [ScriptWitness WitCtxMint era])
-> Maybe SlotNo
-> Maybe SlotNo
-> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitness WitCtxStake era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> Maybe ProtocolParameters
-> Maybe UpdateProposal
-> Maybe Word
-> TxBuildOutputOptions
-> ExceptT ShelleyTxCmdError IO (BalancedTxBody era)
runTxBuild CardanoEra era
cEra AnyConsensusModeParams
consensusModeParams NetworkId
nid Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits [TxIn]
readOnlyRefIns [TxIn]
filteredTxinsc
                  Maybe (TxOut CtxTx era)
mReturnCollateral Maybe Lovelace
mTotCollateral [TxOut CtxTx era]
txOuts TxOutChangeAddress
changeAddr (Value, [ScriptWitness WitCtxMint era])
valuesWithScriptWits Maybe SlotNo
mLowBound
                  Maybe SlotNo
mUpperBound [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeScriptWits [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawalsAndMaybeScriptWits
                  [Hash PaymentKey]
requiredSigners TxAuxScripts era
txAuxScripts TxMetadataInEra era
txMetadata Maybe ProtocolParameters
mpparams Maybe UpdateProposal
mProp Maybe Word
mOverrideWits TxBuildOutputOptions
outputOptions

  let allReferenceInputs :: [TxIn]
allReferenceInputs = forall era.
[(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
-> [ScriptWitness WitCtxMint era]
-> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitness WitCtxStake era))]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
                             [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits
                             (forall a b. (a, b) -> b
snd (Value, [ScriptWitness WitCtxMint era])
valuesWithScriptWits)
                             [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeScriptWits
                             [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawalsAndMaybeScriptWits
                             [TxIn]
readOnlyRefIns

  let inputsThatRequireWitnessing :: [TxIn]
inputsThatRequireWitnessing = [TxIn
input | (TxIn
input,Maybe (ScriptWitness WitCtxTxIn era)
_) <- [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits]
      allTxInputs :: [TxIn]
allTxInputs = [TxIn]
inputsThatRequireWitnessing forall a. [a] -> [a] -> [a]
++ [TxIn]
allReferenceInputs forall a. [a] -> [a] -> [a]
++ [TxIn]
filteredTxinsc

  -- TODO: Calculating the script cost should live as a different command.
  -- Why? Because then we can simply read a txbody and figure out
  -- the script cost vs having to build the tx body each time
  case TxBuildOutputOptions
outputOptions of
    OutputScriptCostOnly FilePath
fp -> do
      let BuildTxWith Maybe ProtocolParameters
mTxProtocolParams = forall build era.
TxBodyContent build era
-> BuildTxWith build (Maybe ProtocolParameters)
txProtocolParams TxBodyContent BuildTx era
txBodycontent

      ProtocolParameters
pparams <- forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ProtocolParameters
mTxProtocolParams forall a b. a -> (a -> b) -> b
& forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ShelleyTxCmdError
ShelleyTxCmdProtocolParametersNotPresentInTxBody)


      ExecutionUnitPrices
executionUnitPrices <- forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamPrices ProtocolParameters
pparams) forall a b. a -> (a -> b) -> b
& forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ShelleyTxCmdError
ShelleyTxCmdPParamExecutionUnitsNotAvailable)

      let consensusMode :: ConsensusMode mode
consensusMode = forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
          bpp :: BundledProtocolParameters era
bpp = forall era.
CardanoEra era
-> ProtocolParameters -> BundledProtocolParameters era
bundleProtocolParams CardanoEra era
cEra ProtocolParameters
pparams

      case ConsensusMode mode
consensusMode of
        ConsensusMode mode
CardanoMode -> do
          (UTxO era
nodeEraUTxO, ProtocolParameters
_, EraHistory CardanoMode
eraHistory, SystemStart
systemStart, Set PoolId
_) <-
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall era.
CardanoEra era
-> NetworkId
-> [TxIn]
-> IO
     (Either
        QueryConvenienceError
        (UTxO era, ProtocolParameters, EraHistory CardanoMode, SystemStart,
         Set PoolId))
queryStateForBalancedTx CardanoEra era
nodeEra NetworkId
nid [TxIn]
allTxInputs)
              forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConvenienceError -> ShelleyTxCmdError
ShelleyTxCmdQueryConvenienceError)

          -- Why do we cast the era? The user can specify an era prior to the era that the node is currently in.
          -- We cannot use the user specified era to construct a query against a node because it may differ
          -- from the node's era and this will result in the 'QueryEraMismatch' failure.
          UTxO era
txEraUtxo <- forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) fromEra toEra.
(EraCast f, IsCardanoEra fromEra, IsCardanoEra toEra) =>
CardanoEra toEra -> f fromEra -> Either EraCastError (f toEra)
eraCast CardanoEra era
cEra UTxO era
nodeEraUTxO) forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraCastError -> ShelleyTxCmdError
ShelleyTxCmdTxEraCastErr)

          Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)
scriptExecUnitsMap <-
            forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT TransactionValidityError -> ShelleyTxCmdError
ShelleyTxCmdTxExecUnitsErr forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
              forall a b. (a -> b) -> a -> b
$ forall era.
SystemStart
-> LedgerEpochInfo
-> BundledProtocolParameters era
-> UTxO era
-> TxBody era
-> Either
     TransactionValidityError
     (Map
        ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits))
evaluateTransactionExecutionUnits
                  SystemStart
systemStart (forall mode. EraHistory mode -> LedgerEpochInfo
toLedgerEpochInfo EraHistory CardanoMode
eraHistory)
                  BundledProtocolParameters era
bpp UTxO era
txEraUtxo TxBody era
balancedTxBody

          [ScriptCostOutput]
scriptCostOutput <-
            forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT PlutusScriptCostError -> ShelleyTxCmdError
ShelleyTxCmdPlutusScriptCostErr forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
              forall a b. (a -> b) -> a -> b
$ forall era.
UTxO era
-> ExecutionUnitPrices
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
-> Map
     ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)
-> Either PlutusScriptCostError [ScriptCostOutput]
renderScriptCosts
                  UTxO era
txEraUtxo
                  ExecutionUnitPrices
executionUnitPrices
                  (forall era.
TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
collectTxBodyScriptWitnesses TxBodyContent BuildTx era
txBodycontent)
                  Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)
scriptExecUnitsMap
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
fp forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encodePretty [ScriptCostOutput]
scriptCostOutput
        ConsensusMode mode
_ -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ShelleyTxCmdError
ShelleyTxCmdPlutusScriptsRequireCardanoMode

    OutputTxBodyOnly (TxBodyFile FilePath
fpath) ->
      let noWitTx :: Tx era
noWitTx = forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody era
balancedTxBody
      in  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall era.
IsCardanoEra era =>
FilePath -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCddl FilePath
fpath Tx era
noWitTx)
            forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError () -> ShelleyTxCmdError
ShelleyTxCmdWriteFileError)


runTxBuildRawCmd
  :: AnyCardanoEra
  -> Maybe ScriptValidity
  -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
  -> [TxIn] -- ^ Read only reference inputs
  -> [TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts.
  -> Maybe TxOutAnyEra
  -> Maybe Lovelace -- ^ Total collateral
  -> [RequiredSigner]
  -> [TxOutAnyEra]
  -> Maybe (Value, [ScriptWitnessFiles WitCtxMint]) -- ^ Multi-Asset value with script witness
  -> Maybe SlotNo -- ^ Validity lower bound
  -> Maybe SlotNo -- ^ Validity upper bound
  -> Maybe Lovelace -- ^ Tx fee
  -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> TxMetadataJsonSchema
  -> [ScriptFile]
  -> [MetadataFile]
  -> Maybe ProtocolParamsSourceSpec
  -> Maybe UpdateProposalFile
  -> TxBodyFile
  -> ExceptT ShelleyTxCmdError IO ()
runTxBuildRawCmd :: AnyCardanoEra
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [TxIn]
-> Maybe TxOutAnyEra
-> Maybe Lovelace
-> [RequiredSigner]
-> [TxOutAnyEra]
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> Maybe SlotNo
-> Maybe SlotNo
-> Maybe Lovelace
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBodyFile
-> ExceptT ShelleyTxCmdError IO ()
runTxBuildRawCmd
  (AnyCardanoEra CardanoEra era
cEra) Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
readOnlyRefIns [TxIn]
txinsc Maybe TxOutAnyEra
mReturnColl
  Maybe Lovelace
mTotColl [RequiredSigner]
reqSigners [TxOutAnyEra]
txouts Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue Maybe SlotNo
mLowBound Maybe SlotNo
mUpperBound Maybe Lovelace
fee [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certs [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls
  TxMetadataJsonSchema
metadataSchema [ScriptFile]
scriptFiles [MetadataFile]
metadataFiles Maybe ProtocolParamsSourceSpec
mpparams Maybe UpdateProposalFile
mUpProp (TxBodyFile FilePath
out) = do
  [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptWitnessError -> ShelleyTxCmdError
ShelleyTxCmdScriptWitnessError
                                forall a b. (a -> b) -> a -> b
$ forall era a ctx.
CardanoEra era
-> [(a, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))]
readScriptWitnessFiles CardanoEra era
cEra [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins
  [(CertificateFile, Maybe (ScriptWitness WitCtxStake era))]
certFilesAndMaybeScriptWits <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptWitnessError -> ShelleyTxCmdError
ShelleyTxCmdScriptWitnessError
                                   forall a b. (a -> b) -> a -> b
$ forall era a ctx.
CardanoEra era
-> [(a, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))]
readScriptWitnessFiles CardanoEra era
cEra [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certs
  [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeScriptWits <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
             [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Maybe (ScriptWitness WitCtxStake era)
mSwit) (forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyTxCmdError
ShelleyTxCmdReadTextViewFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
                 forall a.
HasTextEnvelope a =>
AsType a -> FilePath -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType Certificate
AsCertificate FilePath
certFile)
             | (CertificateFile FilePath
certFile, Maybe (ScriptWitness WitCtxStake era)
mSwit) <- [(CertificateFile, Maybe (ScriptWitness WitCtxStake era))]
certFilesAndMaybeScriptWits
             ]
  [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawalsAndMaybeScriptWits <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptWitnessError -> ShelleyTxCmdError
ShelleyTxCmdScriptWitnessError
                                     forall a b. (a -> b) -> a -> b
$ forall era a b ctx.
CardanoEra era
-> [(a, b, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, b, Maybe (ScriptWitness ctx era))]
readScriptWitnessFilesThruple CardanoEra era
cEra [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls
  TxMetadataInEra era
txMetadata <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT MetadataError -> ShelleyTxCmdError
ShelleyTxCmdMetadataError
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> IO (Either MetadataError (TxMetadataInEra era))
readTxMetadata CardanoEra era
cEra TxMetadataJsonSchema
metadataSchema [MetadataFile]
metadataFiles
  (Value, [ScriptWitness WitCtxMint era])
valuesWithScriptWits <- forall era.
CardanoEra era
-> (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT
     ShelleyTxCmdError IO (Value, [ScriptWitness WitCtxMint era])
readValueScriptWitnesses CardanoEra era
cEra forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a. Monoid a => a
mempty, []) Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue
  [ScriptInAnyLang]
scripts <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ShelleyTxCmdError
ShelleyTxCmdScriptFileError forall a b. (a -> b) -> a -> b
$
                     forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptFile -> FilePath
unScriptFile) [ScriptFile]
scriptFiles
  TxAuxScripts era
txAuxScripts <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxAuxScriptsValidationError -> ShelleyTxCmdError
ShelleyTxCmdAuxScriptsValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> [ScriptInAnyLang]
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
validateTxAuxScripts CardanoEra era
cEra [ScriptInAnyLang]
scripts

  Maybe ProtocolParameters
pparams <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe ProtocolParamsSourceSpec
mpparams forall a b. (a -> b) -> a -> b
$ \ProtocolParamsSourceSpec
ppFp ->
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ProtocolParamsError -> ShelleyTxCmdError
ShelleyTxCmdProtocolParamsError (ProtocolParamsSourceSpec
-> ExceptT ProtocolParamsError IO ProtocolParameters
readProtocolParametersSourceSpec ProtocolParamsSourceSpec
ppFp)

  Maybe UpdateProposal
mProp <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe UpdateProposalFile
mUpProp forall a b. (a -> b) -> a -> b
$ \(UpdateProposalFile FilePath
upFp) ->
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyTxCmdError
ShelleyTxCmdReadTextViewFileError (forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
AsType a -> FilePath -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType UpdateProposal
AsUpdateProposal FilePath
upFp)

  [Hash PaymentKey]
requiredSigners  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT RequiredSignerError -> ShelleyTxCmdError
ShelleyTxCmdRequiredSignerError forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequiredSigner -> IO (Either RequiredSignerError (Hash PaymentKey))
readRequiredSigner) [RequiredSigner]
reqSigners
  Maybe (TxOut CtxTx era)
mReturnCollateral <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe TxOutAnyEra
mReturnColl forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> TxOutAnyEra -> ExceptT ShelleyTxCmdError IO (TxOut CtxTx era)
toTxOutInAnyEra CardanoEra era
cEra
  [TxOut CtxTx era]
txOuts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall era.
CardanoEra era
-> TxOutAnyEra -> ExceptT ShelleyTxCmdError IO (TxOut CtxTx era)
toTxOutInAnyEra CardanoEra era
cEra) [TxOutAnyEra]
txouts

    -- the same collateral input can be used for several plutus scripts
  let filteredTxinsc :: [TxIn]
filteredTxinsc = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [TxIn]
txinsc

  TxBody era
txBody <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> Maybe SlotNo
-> Maybe Lovelace
-> (Value, [ScriptWitness WitCtxMint era])
-> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitness WitCtxStake era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> Maybe ProtocolParameters
-> Maybe UpdateProposal
-> Either ShelleyTxCmdError (TxBody era)
runTxBuildRaw CardanoEra era
cEra Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits [TxIn]
readOnlyRefIns [TxIn]
filteredTxinsc
                          Maybe (TxOut CtxTx era)
mReturnCollateral Maybe Lovelace
mTotColl [TxOut CtxTx era]
txOuts Maybe SlotNo
mLowBound Maybe SlotNo
mUpperBound Maybe Lovelace
fee (Value, [ScriptWitness WitCtxMint era])
valuesWithScriptWits
                          [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeScriptWits [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawalsAndMaybeScriptWits [Hash PaymentKey]
requiredSigners TxAuxScripts era
txAuxScripts
                          TxMetadataInEra era
txMetadata Maybe ProtocolParameters
pparams Maybe UpdateProposal
mProp

  let noWitTx :: Tx era
noWitTx = forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody era
txBody
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
cEra forall a b. (a -> b) -> a -> b
$ forall era.
IsCardanoEra era =>
FilePath -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCddl FilePath
out Tx era
noWitTx)
    forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError () -> ShelleyTxCmdError
ShelleyTxCmdWriteFileError)


runTxBuildRaw
  :: CardanoEra era
  -> Maybe ScriptValidity
  -- ^ Mark script as expected to pass or fail validation
  -> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
  -- ^ TxIn with potential script witness
  -> [TxIn]
  -- ^ Read only reference inputs
  -> [TxIn]
  -- ^ TxIn for collateral
  -> Maybe (TxOut CtxTx era)
  -- ^ Return collateral
  -> Maybe Lovelace
  -- ^ Total collateral
  -> [TxOut CtxTx era]
  -> Maybe SlotNo
  -- ^ Tx lower bound
  -> Maybe SlotNo
  -- ^ Tx upper bound
  -> Maybe Lovelace
  -- ^ Tx fee
  -> (Value, [ScriptWitness WitCtxMint era])
  -- ^ Multi-Asset value(s)
  -> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
  -> [Hash PaymentKey]
  -- ^ Required signers
  -> TxAuxScripts era
  -> TxMetadataInEra era
  -> Maybe ProtocolParameters
  -> Maybe UpdateProposal
  -> Either ShelleyTxCmdError (TxBody era)
runTxBuildRaw :: forall era.
CardanoEra era
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> Maybe SlotNo
-> Maybe SlotNo
-> Maybe Lovelace
-> (Value, [ScriptWitness WitCtxMint era])
-> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitness WitCtxStake era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> Maybe ProtocolParameters
-> Maybe UpdateProposal
-> Either ShelleyTxCmdError (TxBody era)
runTxBuildRaw CardanoEra era
era
              Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits
              [TxIn]
readOnlyRefIns [TxIn]
txinsc
              Maybe (TxOut CtxTx era)
mReturnCollateral Maybe Lovelace
mTotCollateral [TxOut CtxTx era]
txouts
              Maybe SlotNo
mLowerBound Maybe SlotNo
mUpperBound
              Maybe Lovelace
mFee (Value, [ScriptWitness WitCtxMint era])
valuesWithScriptWits
              [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeSriptWits [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawals [Hash PaymentKey]
reqSigners
              TxAuxScripts era
txAuxScripts TxMetadataInEra era
txMetadata Maybe ProtocolParameters
mpparams Maybe UpdateProposal
mUpdateProp = do

    let allReferenceInputs :: [TxIn]
allReferenceInputs = forall era.
[(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
-> [ScriptWitness WitCtxMint era]
-> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitness WitCtxStake era))]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
                               [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits
                               (forall a b. (a, b) -> b
snd (Value, [ScriptWitness WitCtxMint era])
valuesWithScriptWits)
                               [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeSriptWits
                               [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawals
                               [TxIn]
readOnlyRefIns

    TxInsCollateral era
validatedCollateralTxIns <- forall era.
CardanoEra era
-> [TxIn] -> Either ShelleyTxCmdError (TxInsCollateral era)
validateTxInsCollateral CardanoEra era
era [TxIn]
txinsc
    TxInsReference BuildTx era
validatedRefInputs <- forall era.
CardanoEra era
-> [TxIn] -> Either ShelleyTxCmdError (TxInsReference BuildTx era)
validateTxInsReference CardanoEra era
era [TxIn]
allReferenceInputs
    TxTotalCollateral era
validatedTotCollateral
      <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxTotalCollateralValidationError -> ShelleyTxCmdError
ShelleyTxCmdTotalCollateralValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe Lovelace
-> Either TxTotalCollateralValidationError (TxTotalCollateral era)
validateTxTotalCollateral CardanoEra era
era Maybe Lovelace
mTotCollateral
    TxReturnCollateral CtxTx era
validatedRetCol
      <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxReturnCollateralValidationError -> ShelleyTxCmdError
ShelleyTxCmdReturnCollateralValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe (TxOut CtxTx era)
-> Either
     TxReturnCollateralValidationError (TxReturnCollateral CtxTx era)
validateTxReturnCollateral CardanoEra era
era Maybe (TxOut CtxTx era)
mReturnCollateral
    TxFee era
validatedFee
      <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxFeeValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxFeeValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe Lovelace -> Either TxFeeValidationError (TxFee era)
validateTxFee CardanoEra era
era Maybe Lovelace
mFee
    (TxValidityLowerBound era, TxValidityUpperBound era)
validatedBounds <- (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxValidityLowerBoundValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxValidityLowerBoundValidationError (forall era.
CardanoEra era
-> Maybe SlotNo
-> Either
     TxValidityLowerBoundValidationError (TxValidityLowerBound era)
validateTxValidityLowerBound CardanoEra era
era Maybe SlotNo
mLowerBound)
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxValidityUpperBoundValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxValidityUpperBoundValidationError (forall era.
CardanoEra era
-> Maybe SlotNo
-> Either
     TxValidityUpperBoundValidationError (TxValidityUpperBound era)
validateTxValidityUpperBound CardanoEra era
era Maybe SlotNo
mUpperBound)
    TxExtraKeyWitnesses era
validatedReqSigners
      <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxRequiredSignersValidationError -> ShelleyTxCmdError
ShelleyTxCmdRequiredSignersValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> [Hash PaymentKey]
-> Either
     TxRequiredSignersValidationError (TxExtraKeyWitnesses era)
validateRequiredSigners CardanoEra era
era [Hash PaymentKey]
reqSigners
    BuildTxWith BuildTx (Maybe ProtocolParameters)
validatedPParams
      <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxProtocolParametersValidationError -> ShelleyTxCmdError
ShelleyTxCmdProtocolParametersValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe ProtocolParameters
-> Either
     TxProtocolParametersValidationError
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters CardanoEra era
era Maybe ProtocolParameters
mpparams
    TxWithdrawals BuildTx era
validatedTxWtdrwls
      <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxWithdrawalsValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxWithdrawalsValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitness WitCtxStake era))]
-> Either TxWithdrawalsValidationError (TxWithdrawals BuildTx era)
validateTxWithdrawals CardanoEra era
era [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawals
    TxCertificates BuildTx era
validatedTxCerts
      <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxCertificatesValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxCertificatesValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
-> Either
     TxCertificatesValidationError (TxCertificates BuildTx era)
validateTxCertificates CardanoEra era
era [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeSriptWits
    TxUpdateProposal era
validatedTxUpProp
      <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxUpdateProposalValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxUpdateProposalValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe UpdateProposal
-> Either TxUpdateProposalValidationError (TxUpdateProposal era)
validateTxUpdateProposal CardanoEra era
era Maybe UpdateProposal
mUpdateProp
    TxMintValue BuildTx era
validatedMintValue
      <- forall era.
CardanoEra era
-> (Value, [ScriptWitness WitCtxMint era])
-> Either ShelleyTxCmdError (TxMintValue BuildTx era)
createTxMintValue CardanoEra era
era (Value, [ScriptWitness WitCtxMint era])
valuesWithScriptWits
    TxScriptValidity era
validatedTxScriptValidity
      <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxScriptValidityValidationError -> ShelleyTxCmdError
ShelleyTxCmdScriptValidityValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe ScriptValidity
-> Either TxScriptValidityValidationError (TxScriptValidity era)
validateTxScriptValidity CardanoEra era
era Maybe ScriptValidity
mScriptValidity

    let txBodyContent :: TxBodyContent BuildTx era
txBodyContent = forall build era.
TxIns build era
-> TxInsCollateral era
-> TxInsReference build era
-> [TxOut CtxTx era]
-> TxTotalCollateral era
-> TxReturnCollateral CtxTx era
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> TxExtraKeyWitnesses era
-> BuildTxWith build (Maybe ProtocolParameters)
-> TxWithdrawals build era
-> TxCertificates build era
-> TxUpdateProposal era
-> TxMintValue build era
-> TxScriptValidity era
-> TxBodyContent build era
TxBodyContent
                          (forall era.
[(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits)
                          TxInsCollateral era
validatedCollateralTxIns
                          TxInsReference BuildTx era
validatedRefInputs
                          [TxOut CtxTx era]
txouts
                          TxTotalCollateral era
validatedTotCollateral
                          TxReturnCollateral CtxTx era
validatedRetCol
                          TxFee era
validatedFee
                          (TxValidityLowerBound era, TxValidityUpperBound era)
validatedBounds
                          TxMetadataInEra era
txMetadata
                          TxAuxScripts era
txAuxScripts
                          TxExtraKeyWitnesses era
validatedReqSigners
                          BuildTxWith BuildTx (Maybe ProtocolParameters)
validatedPParams
                          TxWithdrawals BuildTx era
validatedTxWtdrwls
                          TxCertificates BuildTx era
validatedTxCerts
                          TxUpdateProposal era
validatedTxUpProp
                          TxMintValue BuildTx era
validatedMintValue
                          TxScriptValidity era
validatedTxScriptValidity

    forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxBodyError -> ShelleyTxCmdError
ShelleyTxCmdTxBodyError forall a b. (a -> b) -> a -> b
$
      forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era forall a b. (a -> b) -> a -> b
$ forall era.
IsCardanoEra era =>
TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
createAndValidateTransactionBody TxBodyContent BuildTx era
txBodyContent

runTxBuild
  :: CardanoEra era
  -> AnyConsensusModeParams
  -> NetworkId
  -> Maybe ScriptValidity
  -- ^ Mark script as expected to pass or fail validation
  -> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
  -- ^ Read only reference inputs
  -> [TxIn]
  -- ^ TxIn with potential script witness
  -> [TxIn]
  -- ^ TxIn for collateral
  -> Maybe (TxOut CtxTx era)
  -- ^ Return collateral
  -> Maybe Lovelace
  -- ^ Total collateral
  -> [TxOut CtxTx era]
  -- ^ Normal outputs
  -> TxOutChangeAddress
  -- ^ A change output
  -> (Value, [ScriptWitness WitCtxMint era])
  -- ^ Multi-Asset value(s)
  -> Maybe SlotNo
  -- ^ Tx lower bound
  -> Maybe SlotNo
  -- ^ Tx upper bound
  -> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
  -> [Hash PaymentKey]
  -- ^ Required signers
  -> TxAuxScripts era
  -> TxMetadataInEra era
  -> Maybe ProtocolParameters
  -> Maybe UpdateProposal
  -> Maybe Word
  -> TxBuildOutputOptions
  -> ExceptT ShelleyTxCmdError IO (BalancedTxBody era)
runTxBuild :: forall era.
CardanoEra era
-> AnyConsensusModeParams
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
-> [TxIn]
-> [TxIn]
-> Maybe (TxOut CtxTx era)
-> Maybe Lovelace
-> [TxOut CtxTx era]
-> TxOutChangeAddress
-> (Value, [ScriptWitness WitCtxMint era])
-> Maybe SlotNo
-> Maybe SlotNo
-> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitness WitCtxStake era))]
-> [Hash PaymentKey]
-> TxAuxScripts era
-> TxMetadataInEra era
-> Maybe ProtocolParameters
-> Maybe UpdateProposal
-> Maybe Word
-> TxBuildOutputOptions
-> ExceptT ShelleyTxCmdError IO (BalancedTxBody era)
runTxBuild CardanoEra era
era (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
networkId Maybe ScriptValidity
mScriptValidity
           [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits [TxIn]
readOnlyRefIns [TxIn]
txinsc Maybe (TxOut CtxTx era)
mReturnCollateral Maybe Lovelace
mTotCollateral [TxOut CtxTx era]
txouts
           (TxOutChangeAddress AddressAny
changeAddr) (Value, [ScriptWitness WitCtxMint era])
valuesWithScriptWits Maybe SlotNo
mLowerBound Maybe SlotNo
mUpperBound
           [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeScriptWits [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawals [Hash PaymentKey]
reqSigners TxAuxScripts era
txAuxScripts TxMetadataInEra era
txMetadata Maybe ProtocolParameters
mpparams
           Maybe UpdateProposal
mUpdatePropF Maybe Word
mOverrideWits TxBuildOutputOptions
outputOptions = do

  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ProtocolParameters
mpparams forall a b. (a -> b) -> a -> b
$ \ProtocolParameters
_ ->
    FilePath -> IO ()
printWarning FilePath
"'--protocol-params-file' for 'transaction build' is deprecated"

  let consensusMode :: ConsensusMode mode
consensusMode = forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
      dummyFee :: Maybe Lovelace
dummyFee = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Lovelace
Lovelace Integer
0
      inputsThatRequireWitnessing :: [TxIn]
inputsThatRequireWitnessing = [TxIn
input | (TxIn
input,Maybe (ScriptWitness WitCtxTxIn era)
_) <- [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits]

  -- Pure
  let allReferenceInputs :: [TxIn]
allReferenceInputs = forall era.
[(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
-> [ScriptWitness WitCtxMint era]
-> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitness WitCtxStake era))]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
                             [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits
                             (forall a b. (a, b) -> b
snd (Value, [ScriptWitness WitCtxMint era])
valuesWithScriptWits)
                             [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeScriptWits
                             [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawals [TxIn]
readOnlyRefIns

  TxInsCollateral era
validatedCollateralTxIns <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> [TxIn] -> Either ShelleyTxCmdError (TxInsCollateral era)
validateTxInsCollateral CardanoEra era
era [TxIn]
txinsc
  TxInsReference BuildTx era
validatedRefInputs <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> [TxIn] -> Either ShelleyTxCmdError (TxInsReference BuildTx era)
validateTxInsReference CardanoEra era
era [TxIn]
allReferenceInputs
  TxTotalCollateral era
validatedTotCollateral
    <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxTotalCollateralValidationError -> ShelleyTxCmdError
ShelleyTxCmdTotalCollateralValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe Lovelace
-> Either TxTotalCollateralValidationError (TxTotalCollateral era)
validateTxTotalCollateral CardanoEra era
era Maybe Lovelace
mTotCollateral
  TxReturnCollateral CtxTx era
validatedRetCol
    <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxReturnCollateralValidationError -> ShelleyTxCmdError
ShelleyTxCmdReturnCollateralValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe (TxOut CtxTx era)
-> Either
     TxReturnCollateralValidationError (TxReturnCollateral CtxTx era)
validateTxReturnCollateral CardanoEra era
era Maybe (TxOut CtxTx era)
mReturnCollateral
  TxFee era
dFee <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxFeeValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxFeeValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe Lovelace -> Either TxFeeValidationError (TxFee era)
validateTxFee CardanoEra era
era Maybe Lovelace
dummyFee
  (TxValidityLowerBound era, TxValidityUpperBound era)
validatedBounds <- (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxValidityLowerBoundValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxValidityLowerBoundValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe SlotNo
-> Either
     TxValidityLowerBoundValidationError (TxValidityLowerBound era)
validateTxValidityLowerBound CardanoEra era
era Maybe SlotNo
mLowerBound)
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxValidityUpperBoundValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxValidityUpperBoundValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe SlotNo
-> Either
     TxValidityUpperBoundValidationError (TxValidityUpperBound era)
validateTxValidityUpperBound CardanoEra era
era Maybe SlotNo
mUpperBound)
  TxExtraKeyWitnesses era
validatedReqSigners <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxRequiredSignersValidationError -> ShelleyTxCmdError
ShelleyTxCmdRequiredSignersValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> [Hash PaymentKey]
-> Either
     TxRequiredSignersValidationError (TxExtraKeyWitnesses era)
validateRequiredSigners CardanoEra era
era [Hash PaymentKey]
reqSigners)
  TxWithdrawals BuildTx era
validatedTxWtdrwls <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxWithdrawalsValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxWithdrawalsValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitness WitCtxStake era))]
-> Either TxWithdrawalsValidationError (TxWithdrawals BuildTx era)
validateTxWithdrawals CardanoEra era
era [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawals)
  TxCertificates BuildTx era
validatedTxCerts <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxCertificatesValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxCertificatesValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
-> Either
     TxCertificatesValidationError (TxCertificates BuildTx era)
validateTxCertificates CardanoEra era
era [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeScriptWits)
  TxUpdateProposal era
validatedTxUpProp <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxUpdateProposalValidationError -> ShelleyTxCmdError
ShelleyTxCmdTxUpdateProposalValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe UpdateProposal
-> Either TxUpdateProposalValidationError (TxUpdateProposal era)
validateTxUpdateProposal CardanoEra era
era Maybe UpdateProposal
mUpdatePropF)
  TxMintValue BuildTx era
validatedMintValue <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> (Value, [ScriptWitness WitCtxMint era])
-> Either ShelleyTxCmdError (TxMintValue BuildTx era)
createTxMintValue CardanoEra era
era (Value, [ScriptWitness WitCtxMint era])
valuesWithScriptWits
  TxScriptValidity era
validatedTxScriptValidity <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxScriptValidityValidationError -> ShelleyTxCmdError
ShelleyTxCmdScriptValidityValidationError forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe ScriptValidity
-> Either TxScriptValidityValidationError (TxScriptValidity era)
validateTxScriptValidity CardanoEra era
era Maybe ScriptValidity
mScriptValidity)

  case (ConsensusMode mode
consensusMode, forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era) of
    (ConsensusMode mode
CardanoMode, ShelleyBasedEra ShelleyBasedEra era
_sbe) -> do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode CardanoMode
CardanoMode)
        forall a b. a -> (a -> b) -> b
& forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxBuildOutputOptions
-> AnyConsensusMode -> AnyCardanoEra -> ShelleyTxCmdError
ShelleyTxCmdEraConsensusModeMismatchTxBalance TxBuildOutputOptions
outputOptions
                            (forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode CardanoMode
CardanoMode) (forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era)))

      SocketPath FilePath
sockPath <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO (Either EnvSocketError SocketPath)
readEnvSocketPath forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnvSocketError -> ShelleyTxCmdError
ShelleyTxCmdSocketEnvError)

      let allTxInputs :: [TxIn]
allTxInputs = [TxIn]
inputsThatRequireWitnessing forall a. [a] -> [a] -> [a]
++ [TxIn]
allReferenceInputs forall a. [a] -> [a] -> [a]
++ [TxIn]
txinsc
          localNodeConnInfo :: LocalNodeConnectInfo CardanoMode
localNodeConnInfo = LocalNodeConnectInfo
                                     { localConsensusModeParams :: ConsensusModeParams CardanoMode
localConsensusModeParams = EpochSlots -> ConsensusModeParams CardanoMode
CardanoModeParams forall a b. (a -> b) -> a -> b
$ Word64 -> EpochSlots
EpochSlots Word64
21600
                                     , localNodeNetworkId :: NetworkId
localNodeNetworkId = NetworkId
networkId
                                     , localNodeSocketPath :: FilePath
localNodeSocketPath = FilePath
sockPath
                                     }
      AnyCardanoEra CardanoEra era
nodeEra <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> IO (Either AcquiringFailure AnyCardanoEra)
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo CardanoMode
localNodeConnInfo)
        forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConvenienceError -> ShelleyTxCmdError
ShelleyTxCmdQueryConvenienceError forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryConvenienceError
AcqFailure)

      (UTxO era
nodeEraUTxO, ProtocolParameters
pparams, EraHistory CardanoMode
eraHistory, SystemStart
systemStart, Set PoolId
stakePools) <-
        forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT QueryConvenienceError -> ShelleyTxCmdError
ShelleyTxCmdQueryConvenienceError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> NetworkId
-> [TxIn]
-> IO
     (Either
        QueryConvenienceError
        (UTxO era, ProtocolParameters, EraHistory CardanoMode, SystemStart,
         Set PoolId))
queryStateForBalancedTx CardanoEra era
nodeEra NetworkId
networkId [TxIn]
allTxInputs

      BuildTxWith BuildTx (Maybe ProtocolParameters)
validatedPParams <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxProtocolParametersValidationError -> ShelleyTxCmdError
ShelleyTxCmdProtocolParametersValidationError
                                      forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Maybe ProtocolParameters
-> Either
     TxProtocolParametersValidationError
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters CardanoEra era
era (forall a. a -> Maybe a
Just ProtocolParameters
pparams)

      let txBodyContent :: TxBodyContent BuildTx era
txBodyContent = forall build era.
TxIns build era
-> TxInsCollateral era
-> TxInsReference build era
-> [TxOut CtxTx era]
-> TxTotalCollateral era
-> TxReturnCollateral CtxTx era
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> TxExtraKeyWitnesses era
-> BuildTxWith build (Maybe ProtocolParameters)
-> TxWithdrawals build era
-> TxCertificates build era
-> TxUpdateProposal era
-> TxMintValue build era
-> TxScriptValidity era
-> TxBodyContent build era
TxBodyContent
                          (forall era.
[(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
inputsAndMaybeScriptWits)
                          TxInsCollateral era
validatedCollateralTxIns
                          TxInsReference BuildTx era
validatedRefInputs
                          [TxOut CtxTx era]
txouts
                          TxTotalCollateral era
validatedTotCollateral
                          TxReturnCollateral CtxTx era
validatedRetCol
                          TxFee era
dFee
                          (TxValidityLowerBound era, TxValidityUpperBound era)
validatedBounds
                          TxMetadataInEra era
txMetadata
                          TxAuxScripts era
txAuxScripts
                          TxExtraKeyWitnesses era
validatedReqSigners
                          BuildTxWith BuildTx (Maybe ProtocolParameters)
validatedPParams
                          TxWithdrawals BuildTx era
validatedTxWtdrwls
                          TxCertificates BuildTx era
validatedTxCerts
                          TxUpdateProposal era
validatedTxUpProp
                          TxMintValue BuildTx era
validatedMintValue
                          TxScriptValidity era
validatedTxScriptValidity

      forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT TxInsExistError -> ShelleyTxCmdError
ShelleyTxCmdTxInsDoNotExist
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall era. [TxIn] -> UTxO era -> Either TxInsExistError ()
txInsExistInUTxO [TxIn]
allTxInputs UTxO era
nodeEraUTxO
      forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptLockedTxInsError -> ShelleyTxCmdError
ShelleyTxCmdQueryNotScriptLocked
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall era. [TxIn] -> UTxO era -> Either ScriptLockedTxInsError ()
notScriptLockedTxIns [TxIn]
txinsc UTxO era
nodeEraUTxO

      AddressInEra era
cAddr <- forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era.
CardanoEra era -> AddressAny -> Either FilePath (AddressInEra era)
anyAddressInEra CardanoEra era
era AddressAny
changeAddr)
        forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"runTxBuild: Byron address used: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show AddressAny
changeAddr) -- should this throw instead?

      -- Why do we cast the era? The user can specify an era prior to the era that the node is currently in.
      -- We cannot use the user specified era to construct a query against a node because it may differ
      -- from the node's era and this will result in the 'QueryEraMismatch' failure.
      UTxO era
txEraUtxo <- forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) fromEra toEra.
(EraCast f, IsCardanoEra fromEra, IsCardanoEra toEra) =>
CardanoEra toEra -> f fromEra -> Either EraCastError (f toEra)
eraCast CardanoEra era
era UTxO era
nodeEraUTxO) forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraCastError -> ShelleyTxCmdError
ShelleyTxCmdTxEraCastErr)

      balancedTxBody :: BalancedTxBody era
balancedTxBody@(BalancedTxBody TxBodyContent BuildTx era
_ TxBody era
_ TxOut CtxTx era
_ Lovelace
fee) <-
        forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT TxBodyErrorAutoBalance -> ShelleyTxCmdError
ShelleyTxCmdBalanceTxBody
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
          forall a b. (a -> b) -> a -> b
$ forall era.
IsShelleyBasedEra era =>
SystemStart
-> LedgerEpochInfo
-> ProtocolParameters
-> Set PoolId
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either TxBodyErrorAutoBalance (BalancedTxBody era)
makeTransactionBodyAutoBalance SystemStart
systemStart (forall mode. EraHistory mode -> LedgerEpochInfo
toLedgerEpochInfo EraHistory CardanoMode
eraHistory)
                                           ProtocolParameters
pparams Set PoolId
stakePools UTxO era
txEraUtxo TxBodyContent BuildTx era
txBodyContent
                                           AddressInEra era
cAddr Maybe Word
mOverrideWits

      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"Estimated transaction fee: " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> FilePath
show Lovelace
fee :: String)

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

    (ConsensusMode mode
CardanoMode, CardanoEraStyle era
LegacyByronEra) -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ShelleyTxCmdError
ShelleyTxCmdByronEra

    (ConsensusMode mode
wrongMode, CardanoEraStyle era
_) -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (AnyConsensusMode -> ShelleyTxCmdError
ShelleyTxCmdUnsupportedMode (forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
wrongMode))

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

-- | An enumeration of era-dependent features where we have to check that it
-- is permissible to use this feature in this era.
--
data TxFeature = TxFeatureShelleyAddresses
               | TxFeatureExplicitFees
               | TxFeatureImplicitFees
               | TxFeatureValidityLowerBound
               | TxFeatureValidityUpperBound
               | TxFeatureValidityNoUpperBound
               | TxFeatureTxMetadata
               | TxFeatureAuxScripts
               | TxFeatureWithdrawals
               | TxFeatureCertificates
               | TxFeatureMintValue
               | TxFeatureMultiAssetOutputs
               | TxFeatureScriptWitnesses
               | TxFeatureShelleyKeys
               | TxFeatureCollateral
               | TxFeatureProtocolParameters
               | TxFeatureTxOutDatum
               | TxFeatureScriptValidity
               | TxFeatureExtraKeyWits
               | TxFeatureInlineDatums
               | TxFeatureTotalCollateral
               | TxFeatureReferenceInputs
               | TxFeatureReturnCollateral
  deriving Int -> TxFeature -> ShowS
[TxFeature] -> ShowS
TxFeature -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TxFeature] -> ShowS
$cshowList :: [TxFeature] -> ShowS
show :: TxFeature -> FilePath
$cshow :: TxFeature -> FilePath
showsPrec :: Int -> TxFeature -> ShowS
$cshowsPrec :: Int -> TxFeature -> ShowS
Show

txFeatureMismatch :: CardanoEra era
                  -> TxFeature
                  -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch :: forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
feature =
    forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxFeature -> ShelleyTxCmdError
ShelleyTxCmdTxFeatureMismatch (forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era) TxFeature
feature

txFeatureMismatchPure :: CardanoEra era
                      -> TxFeature
                      -> Either ShelleyTxCmdError a
txFeatureMismatchPure :: forall era a.
CardanoEra era -> TxFeature -> Either ShelleyTxCmdError a
txFeatureMismatchPure CardanoEra era
era TxFeature
feature =
    forall a b. a -> Either a b
Left (AnyCardanoEra -> TxFeature -> ShelleyTxCmdError
ShelleyTxCmdTxFeatureMismatch (forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era) TxFeature
feature)


validateTxIns
  :: [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
  -> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns :: forall era.
[(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns = forall a b. (a -> b) -> [a] -> [b]
map forall era.
(TxIn, Maybe (ScriptWitness WitCtxTxIn era))
-> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
convert
 where
   convert
     :: (TxIn, Maybe (ScriptWitness WitCtxTxIn era))
     -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
   convert :: forall era.
(TxIn, Maybe (ScriptWitness WitCtxTxIn era))
-> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
convert (TxIn
txin, Maybe (ScriptWitness WitCtxTxIn era)
mScriptWitness) =
     case Maybe (ScriptWitness WitCtxTxIn era)
mScriptWitness of
       Just ScriptWitness WitCtxTxIn era
sWit ->
         (TxIn
txin , forall a. a -> BuildTxWith BuildTx a
BuildTxWith forall a b. (a -> b) -> a -> b
$ forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
ScriptWitnessForSpending ScriptWitness WitCtxTxIn era
sWit)
       Maybe (ScriptWitness WitCtxTxIn era)
Nothing ->
         (TxIn
txin, forall a. a -> BuildTxWith BuildTx a
BuildTxWith forall a b. (a -> b) -> a -> b
$ forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxTxIn
KeyWitnessForSpending)


validateTxInsCollateral :: CardanoEra era
                        -> [TxIn]
                        -> Either ShelleyTxCmdError (TxInsCollateral era)
validateTxInsCollateral :: forall era.
CardanoEra era
-> [TxIn] -> Either ShelleyTxCmdError (TxInsCollateral era)
validateTxInsCollateral CardanoEra era
_   []    = forall (m :: * -> *) a. Monad m => a -> m a
return forall era. TxInsCollateral era
TxInsCollateralNone
validateTxInsCollateral CardanoEra era
era [TxIn]
txins =
    case forall era. CardanoEra era -> Maybe (CollateralSupportedInEra era)
collateralSupportedInEra CardanoEra era
era of
      Maybe (CollateralSupportedInEra era)
Nothing -> forall era a.
CardanoEra era -> TxFeature -> Either ShelleyTxCmdError a
txFeatureMismatchPure CardanoEra era
era TxFeature
TxFeatureCollateral
      Just CollateralSupportedInEra era
supported -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall era.
CollateralSupportedInEra era -> [TxIn] -> TxInsCollateral era
TxInsCollateral CollateralSupportedInEra era
supported [TxIn]
txins)

validateTxInsReference
  :: CardanoEra era
  -> [TxIn]
  -> Either ShelleyTxCmdError (TxInsReference BuildTx era)
validateTxInsReference :: forall era.
CardanoEra era
-> [TxIn] -> Either ShelleyTxCmdError (TxInsReference BuildTx era)
validateTxInsReference CardanoEra era
_ []  = forall (m :: * -> *) a. Monad m => a -> m a
return forall build era. TxInsReference build era
TxInsReferenceNone
validateTxInsReference CardanoEra era
era [TxIn]
allRefIns =
  case forall era.
CardanoEra era
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
era of
    Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
Nothing -> forall era a.
CardanoEra era -> TxFeature -> Either ShelleyTxCmdError a
txFeatureMismatchPure CardanoEra era
era TxFeature
TxFeatureReferenceInputs
    Just ReferenceTxInsScriptsInlineDatumsSupportedInEra era
supp -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall era build.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> [TxIn] -> TxInsReference build era
TxInsReference ReferenceTxInsScriptsInlineDatumsSupportedInEra era
supp [TxIn]
allRefIns


getAllReferenceInputs
 :: [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
 -> [ScriptWitness WitCtxMint era]
 -> [(Certificate , Maybe (ScriptWitness WitCtxStake era))]
 -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
 -> [TxIn] -- ^ Read only reference inputs
 -> [TxIn]
getAllReferenceInputs :: forall era.
[(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
-> [ScriptWitness WitCtxMint era]
-> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitness WitCtxStake era))]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
txins [ScriptWitness WitCtxMint era]
mintWitnesses [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certFiles [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawals [TxIn]
readOnlyRefIns = do
  let txinsWitByRefInputs :: [Maybe TxIn]
txinsWitByRefInputs = [forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getReferenceInput ScriptWitness WitCtxTxIn era
sWit | (TxIn
_, Just ScriptWitness WitCtxTxIn era
sWit) <- [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
txins]
      mintingRefInputs :: [Maybe TxIn]
mintingRefInputs = forall a b. (a -> b) -> [a] -> [b]
map forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getReferenceInput [ScriptWitness WitCtxMint era]
mintWitnesses
      certsWitByRefInputs :: [Maybe TxIn]
certsWitByRefInputs = [forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getReferenceInput ScriptWitness WitCtxStake era
sWit | (Certificate
_, Just ScriptWitness WitCtxStake era
sWit) <- [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certFiles]
      withdrawalsWitByRefInputs :: [Maybe TxIn]
withdrawalsWitByRefInputs = [forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getReferenceInput ScriptWitness WitCtxStake era
sWit | (StakeAddress
_, Lovelace
_, Just ScriptWitness WitCtxStake era
sWit) <- [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawals]

  forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Maybe TxIn]
txinsWitByRefInputs
                     , [Maybe TxIn]
mintingRefInputs
                     , [Maybe TxIn]
certsWitByRefInputs
                     , [Maybe TxIn]
withdrawalsWitByRefInputs
                     , forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [TxIn]
readOnlyRefIns
                     ]
 where
  getReferenceInput
    :: ScriptWitness witctx era -> Maybe TxIn
  getReferenceInput :: forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getReferenceInput ScriptWitness witctx era
sWit =
    case ScriptWitness witctx era
sWit of
      PlutusScriptWitness ScriptLanguageInEra lang era
_ PlutusScriptVersion lang
_ (PReferenceScript TxIn
refIn Maybe ScriptHash
_) ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
_ -> forall a. a -> Maybe a
Just TxIn
refIn
      PlutusScriptWitness ScriptLanguageInEra lang era
_ PlutusScriptVersion lang
_ PScript{} ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
_ -> forall a. Maybe a
Nothing
      SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
_ (SReferenceScript TxIn
refIn Maybe ScriptHash
_)  -> forall a. a -> Maybe a
Just TxIn
refIn
      SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
_ SScript{}  -> forall a. Maybe a
Nothing

toAddressInAnyEra
  :: CardanoEra era
  -> AddressAny
  -> Either ShelleyTxCmdError (AddressInEra era)
toAddressInAnyEra :: forall era.
CardanoEra era
-> AddressAny -> Either ShelleyTxCmdError (AddressInEra era)
toAddressInAnyEra CardanoEra era
era AddressAny
addrAny =
  case AddressAny
addrAny of
    AddressByron   Address ByronAddr
bAddr -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall addrtype era.
AddressTypeInEra addrtype era
-> Address addrtype -> AddressInEra era
AddressInEra forall era. AddressTypeInEra ByronAddr era
ByronAddressInAnyEra Address ByronAddr
bAddr)
    AddressShelley Address ShelleyAddr
sAddr ->
      case forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era of
        CardanoEraStyle era
LegacyByronEra -> forall era a.
CardanoEra era -> TxFeature -> Either ShelleyTxCmdError a
txFeatureMismatchPure CardanoEra era
era TxFeature
TxFeatureShelleyAddresses
        ShelleyBasedEra ShelleyBasedEra era
era' ->
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall addrtype era.
AddressTypeInEra addrtype era
-> Address addrtype -> AddressInEra era
AddressInEra (forall era. ShelleyBasedEra era -> AddressTypeInEra ShelleyAddr era
ShelleyAddressInEra ShelleyBasedEra era
era') Address ShelleyAddr
sAddr)

toTxOutValueInAnyEra
  :: CardanoEra era
  -> Value
  -> Either ShelleyTxCmdError (TxOutValue era)
toTxOutValueInAnyEra :: forall era.
CardanoEra era
-> Value -> Either ShelleyTxCmdError (TxOutValue era)
toTxOutValueInAnyEra CardanoEra era
era Value
val =
  case forall era.
CardanoEra era
-> Either
     (OnlyAdaSupportedInEra era) (MultiAssetSupportedInEra era)
multiAssetSupportedInEra CardanoEra era
era of
    Left OnlyAdaSupportedInEra era
adaOnlyInEra ->
      case Value -> Maybe Lovelace
valueToLovelace Value
val of
        Just Lovelace
l  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall era. OnlyAdaSupportedInEra era -> Lovelace -> TxOutValue era
TxOutAdaOnly OnlyAdaSupportedInEra era
adaOnlyInEra Lovelace
l)
        Maybe Lovelace
Nothing -> forall era a.
CardanoEra era -> TxFeature -> Either ShelleyTxCmdError a
txFeatureMismatchPure CardanoEra era
era TxFeature
TxFeatureMultiAssetOutputs
    Right MultiAssetSupportedInEra era
multiAssetInEra -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall era. MultiAssetSupportedInEra era -> Value -> TxOutValue era
TxOutValue MultiAssetSupportedInEra era
multiAssetInEra Value
val)

toTxOutInAnyEra :: CardanoEra era
                -> TxOutAnyEra
                -> ExceptT ShelleyTxCmdError IO (TxOut CtxTx era)
toTxOutInAnyEra :: forall era.
CardanoEra era
-> TxOutAnyEra -> ExceptT ShelleyTxCmdError IO (TxOut CtxTx era)
toTxOutInAnyEra CardanoEra era
era (TxOutAnyEra AddressAny
addr' Value
val' TxOutDatumAnyEra
mDatumHash ReferenceScriptAnyEra
refScriptFp) = do
  AddressInEra era
addr <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> AddressAny -> Either ShelleyTxCmdError (AddressInEra era)
toAddressInAnyEra CardanoEra era
era AddressAny
addr'
  TxOutValue era
val <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era
-> Value -> Either ShelleyTxCmdError (TxOutValue era)
toTxOutValueInAnyEra CardanoEra era
era Value
val'
  (TxOutDatum CtxTx era
datum, ReferenceScript era
refScript)
    <- case (forall era. CardanoEra era -> Maybe (ScriptDataSupportedInEra era)
scriptDataSupportedInEra CardanoEra era
era, forall era.
CardanoEra era
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
era) of
         (Maybe (ScriptDataSupportedInEra era)
Nothing, Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall ctx era. TxOutDatum ctx era
TxOutDatumNone, forall era. ReferenceScript era
ReferenceScriptNone)
         (Just ScriptDataSupportedInEra era
sup, Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
Nothing)->
           (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
ScriptDataSupportedInEra era
-> TxOutDatumAnyEra
-> ExceptT ShelleyTxCmdError IO (TxOutDatum CtxTx era)
toTxAlonzoDatum ScriptDataSupportedInEra era
sup TxOutDatumAnyEra
mDatumHash forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall era. ReferenceScript era
ReferenceScriptNone
         (Just ScriptDataSupportedInEra era
sup, Just ReferenceTxInsScriptsInlineDatumsSupportedInEra era
inlineDatumRefScriptSupp) ->
           forall era.
ScriptDataSupportedInEra era
-> ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> TxOutDatumAnyEra
-> ReferenceScriptAnyEra
-> ExceptT
     ShelleyTxCmdError IO (TxOutDatum CtxTx era, ReferenceScript era)
toTxDatumReferenceScriptBabbage ScriptDataSupportedInEra era
sup ReferenceTxInsScriptsInlineDatumsSupportedInEra era
inlineDatumRefScriptSupp TxOutDatumAnyEra
mDatumHash ReferenceScriptAnyEra
refScriptFp
         (Maybe (ScriptDataSupportedInEra era)
Nothing, Just ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_) ->
           -- TODO: Figure out how to make this state unrepresentable
           forall a. HasCallStack => FilePath -> a
error FilePath
"toTxOutInAnyEra: Should not be possible that inline datums are allowed but datums are not"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
TxOut AddressInEra era
addr TxOutValue era
val TxOutDatum CtxTx era
datum ReferenceScript era
refScript
 where
  getReferenceScript
    :: ReferenceScriptAnyEra
    -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era
    -> ExceptT ShelleyTxCmdError IO (ReferenceScript era)
  getReferenceScript :: forall era.
ReferenceScriptAnyEra
-> ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ExceptT ShelleyTxCmdError IO (ReferenceScript era)
getReferenceScript ReferenceScriptAnyEra
ReferenceScriptAnyEraNone ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall era. ReferenceScript era
ReferenceScriptNone
  getReferenceScript (ReferenceScriptAnyEra FilePath
fp) ReferenceTxInsScriptsInlineDatumsSupportedInEra era
supp = do
    forall era.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptInAnyLang -> ReferenceScript era
ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra era
supp
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ShelleyTxCmdError
ShelleyTxCmdScriptFileError (FilePath
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang FilePath
fp)

  toTxDatumReferenceScriptBabbage
    :: ScriptDataSupportedInEra era
    -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era
    -> TxOutDatumAnyEra
    -> ReferenceScriptAnyEra
    -> ExceptT ShelleyTxCmdError IO (TxOutDatum CtxTx era, ReferenceScript era)
  toTxDatumReferenceScriptBabbage :: forall era.
ScriptDataSupportedInEra era
-> ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> TxOutDatumAnyEra
-> ReferenceScriptAnyEra
-> ExceptT
     ShelleyTxCmdError IO (TxOutDatum CtxTx era, ReferenceScript era)
toTxDatumReferenceScriptBabbage ScriptDataSupportedInEra era
sDataSupp ReferenceTxInsScriptsInlineDatumsSupportedInEra era
inlineRefSupp TxOutDatumAnyEra
cliDatum ReferenceScriptAnyEra
refScriptFp' = do
    ReferenceScript era
refScript <- forall era.
ReferenceScriptAnyEra
-> ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ExceptT ShelleyTxCmdError IO (ReferenceScript era)
getReferenceScript ReferenceScriptAnyEra
refScriptFp' ReferenceTxInsScriptsInlineDatumsSupportedInEra era
inlineRefSupp
    case TxOutDatumAnyEra
cliDatum of
       TxOutDatumAnyEra
TxOutDatumByNone -> do
         forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall ctx era. TxOutDatum ctx era
TxOutDatumNone, ReferenceScript era
refScript)
       TxOutDatumByHashOnly Hash ScriptData
dh -> do
         forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era ctx.
ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatum ctx era
TxOutDatumHash ScriptDataSupportedInEra era
sDataSupp Hash ScriptData
dh, ReferenceScript era
refScript)
       TxOutDatumByHashOf ScriptDataOrFile
fileOrSdata -> do
         ScriptRedeemer
sData <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ShelleyTxCmdError
ShelleyTxCmdScriptDataError
                    forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO ScriptRedeemer
readScriptDataOrFile ScriptDataOrFile
fileOrSdata
         forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era ctx.
ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatum ctx era
TxOutDatumHash ScriptDataSupportedInEra era
sDataSupp forall a b. (a -> b) -> a -> b
$ ScriptRedeemer -> Hash ScriptData
hashScriptDataBytes ScriptRedeemer
sData, ReferenceScript era
refScript)
       TxOutDatumByValue ScriptDataOrFile
fileOrSdata -> do
         ScriptRedeemer
sData <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ShelleyTxCmdError
ShelleyTxCmdScriptDataError
                    forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO ScriptRedeemer
readScriptDataOrFile ScriptDataOrFile
fileOrSdata
         forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era.
ScriptDataSupportedInEra era
-> ScriptRedeemer -> TxOutDatum CtxTx era
TxOutDatumInTx ScriptDataSupportedInEra era
sDataSupp ScriptRedeemer
sData, ReferenceScript era
refScript)
       TxOutInlineDatumByValue ScriptDataOrFile
fileOrSdata -> do
         ScriptRedeemer
sData <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ShelleyTxCmdError
ShelleyTxCmdScriptDataError
                    forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO ScriptRedeemer
readScriptDataOrFile ScriptDataOrFile
fileOrSdata
         forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era ctx.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptRedeemer -> TxOutDatum ctx era
TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra era
inlineRefSupp ScriptRedeemer
sData, ReferenceScript era
refScript)

  toTxAlonzoDatum
    :: ScriptDataSupportedInEra era
    -> TxOutDatumAnyEra
    -> ExceptT ShelleyTxCmdError IO (TxOutDatum CtxTx era)
  toTxAlonzoDatum :: forall era.
ScriptDataSupportedInEra era
-> TxOutDatumAnyEra
-> ExceptT ShelleyTxCmdError IO (TxOutDatum CtxTx era)
toTxAlonzoDatum ScriptDataSupportedInEra era
supp TxOutDatumAnyEra
cliDatum =
    case TxOutDatumAnyEra
cliDatum of
      TxOutDatumByHashOnly Hash ScriptData
h -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era ctx.
ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatum ctx era
TxOutDatumHash ScriptDataSupportedInEra era
supp Hash ScriptData
h)
      TxOutDatumByHashOf ScriptDataOrFile
sDataOrFile -> do
        ScriptRedeemer
sData <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ShelleyTxCmdError
ShelleyTxCmdScriptDataError
                   forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO ScriptRedeemer
readScriptDataOrFile ScriptDataOrFile
sDataOrFile
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era ctx.
ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatum ctx era
TxOutDatumHash ScriptDataSupportedInEra era
supp forall a b. (a -> b) -> a -> b
$ ScriptRedeemer -> Hash ScriptData
hashScriptDataBytes ScriptRedeemer
sData)
      TxOutDatumByValue ScriptDataOrFile
sDataOrFile -> do
        ScriptRedeemer
sData <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ShelleyTxCmdError
ShelleyTxCmdScriptDataError
                   forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO ScriptRedeemer
readScriptDataOrFile ScriptDataOrFile
sDataOrFile
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era.
ScriptDataSupportedInEra era
-> ScriptRedeemer -> TxOutDatum CtxTx era
TxOutDatumInTx ScriptDataSupportedInEra era
supp ScriptRedeemer
sData)
      TxOutInlineDatumByValue ScriptDataOrFile
_ ->
        forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureInlineDatums
      TxOutDatumAnyEra
TxOutDatumByNone -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall ctx era. TxOutDatum ctx era
TxOutDatumNone


-- TODO: Currently we specify the policyId with the '--mint' option on the cli
-- and we added a separate '--policy-id' parser that parses the policy id for the
-- given reference input (since we don't have the script in this case). To avoid asking
-- for the policy id twice (in the build command) we can potentially query the UTxO and
-- access the script (and therefore the policy id).
createTxMintValue :: forall era. CardanoEra era
                  -> (Value, [ScriptWitness WitCtxMint era])
                  -> Either ShelleyTxCmdError (TxMintValue BuildTx era)
createTxMintValue :: forall era.
CardanoEra era
-> (Value, [ScriptWitness WitCtxMint era])
-> Either ShelleyTxCmdError (TxMintValue BuildTx era)
createTxMintValue CardanoEra era
era (Value
val, [ScriptWitness WitCtxMint era]
scriptWitnesses) =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null (Value -> [(AssetId, Quantity)]
valueToList Value
val) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [ScriptWitness WitCtxMint era]
scriptWitnesses
  then forall (m :: * -> *) a. Monad m => a -> m a
return forall build era. TxMintValue build era
TxMintNone
  else do
    case forall era.
CardanoEra era
-> Either
     (OnlyAdaSupportedInEra era) (MultiAssetSupportedInEra era)
multiAssetSupportedInEra CardanoEra era
era of
      Left OnlyAdaSupportedInEra era
_ -> forall era a.
CardanoEra era -> TxFeature -> Either ShelleyTxCmdError a
txFeatureMismatchPure CardanoEra era
era TxFeature
TxFeatureMintValue
      Right MultiAssetSupportedInEra era
supported -> do
        -- The set of policy ids for which we need witnesses:
        let witnessesNeededSet :: Set PolicyId
            witnessesNeededSet :: Set PolicyId
witnessesNeededSet =
              forall a. Ord a => [a] -> Set a
Set.fromList [ PolicyId
pid | (AssetId PolicyId
pid AssetName
_, Quantity
_) <- Value -> [(AssetId, Quantity)]
valueToList Value
val ]

        let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
            witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
witnessesProvidedMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ [ScriptWitness WitCtxMint era]
-> [(PolicyId, ScriptWitness WitCtxMint era)]
gatherMintingWitnesses [ScriptWitness WitCtxMint era]
scriptWitnesses

            witnessesProvidedSet :: Set PolicyId
witnessesProvidedSet = forall k a. Map k a -> Set k
Map.keysSet Map PolicyId (ScriptWitness WitCtxMint era)
witnessesProvidedMap

        -- Check not too many, nor too few:
        Set PolicyId -> Set PolicyId -> Either ShelleyTxCmdError ()
validateAllWitnessesProvided   Set PolicyId
witnessesNeededSet Set PolicyId
witnessesProvidedSet
        Set PolicyId -> Set PolicyId -> Either ShelleyTxCmdError ()
validateNoUnnecessaryWitnesses Set PolicyId
witnessesNeededSet Set PolicyId
witnessesProvidedSet

        forall (m :: * -> *) a. Monad m => a -> m a
return (forall era build.
MultiAssetSupportedInEra era
-> Value
-> BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue build era
TxMintValue MultiAssetSupportedInEra era
supported Value
val (forall a. a -> BuildTxWith BuildTx a
BuildTxWith Map PolicyId (ScriptWitness WitCtxMint era)
witnessesProvidedMap))
 where
  gatherMintingWitnesses
    :: [ScriptWitness WitCtxMint era]
    -> [(PolicyId, ScriptWitness WitCtxMint era)]
  gatherMintingWitnesses :: [ScriptWitness WitCtxMint era]
-> [(PolicyId, ScriptWitness WitCtxMint era)]
gatherMintingWitnesses [] = []
  gatherMintingWitnesses (ScriptWitness WitCtxMint era
sWit : [ScriptWitness WitCtxMint era]
rest) =
    case forall witctx era. ScriptWitness witctx era -> Maybe PolicyId
scriptWitnessPolicyId ScriptWitness WitCtxMint era
sWit of
      Maybe PolicyId
Nothing -> [ScriptWitness WitCtxMint era]
-> [(PolicyId, ScriptWitness WitCtxMint era)]
gatherMintingWitnesses [ScriptWitness WitCtxMint era]
rest
      Just PolicyId
pid -> (PolicyId
pid, ScriptWitness WitCtxMint era
sWit) forall a. a -> [a] -> [a]
: [ScriptWitness WitCtxMint era]
-> [(PolicyId, ScriptWitness WitCtxMint era)]
gatherMintingWitnesses [ScriptWitness WitCtxMint era]
rest

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

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

scriptWitnessPolicyId :: ScriptWitness witctx era -> Maybe PolicyId
scriptWitnessPolicyId :: forall witctx era. ScriptWitness witctx era -> Maybe PolicyId
scriptWitnessPolicyId (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
_ (SScript SimpleScript
script)) =
   forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lang. Script lang -> PolicyId
scriptPolicyId forall a b. (a -> b) -> a -> b
$ SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script
scriptWitnessPolicyId (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
_ (SReferenceScript TxIn
_ Maybe ScriptHash
mPid)) =
   ScriptHash -> PolicyId
PolicyId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScriptHash
mPid
scriptWitnessPolicyId (PlutusScriptWitness ScriptLanguageInEra lang era
_ PlutusScriptVersion lang
version (PScript PlutusScript lang
script) ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
_) =
   forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lang. Script lang -> PolicyId
scriptPolicyId forall a b. (a -> b) -> a -> b
$ forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion lang
version PlutusScript lang
script
scriptWitnessPolicyId (PlutusScriptWitness ScriptLanguageInEra lang era
_ PlutusScriptVersion lang
_ (PReferenceScript TxIn
_ Maybe ScriptHash
mPid) ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
_) =
   ScriptHash -> PolicyId
PolicyId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScriptHash
mPid


readValueScriptWitnesses
  :: CardanoEra era
  -> (Value, [ScriptWitnessFiles WitCtxMint])
  -> ExceptT ShelleyTxCmdError IO (Value, [ScriptWitness WitCtxMint era])
readValueScriptWitnesses :: forall era.
CardanoEra era
-> (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT
     ShelleyTxCmdError IO (Value, [ScriptWitness WitCtxMint era])
readValueScriptWitnesses CardanoEra era
era (Value
v, [ScriptWitnessFiles WitCtxMint]
sWitFiles) = do
  [ScriptWitness WitCtxMint era]
sWits <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptWitnessError -> ShelleyTxCmdError
ShelleyTxCmdScriptWitnessError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era witctx.
CardanoEra era
-> ScriptWitnessFiles witctx
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
readScriptWitness CardanoEra era
era) [ScriptWitnessFiles WitCtxMint]
sWitFiles
  forall (m :: * -> *) a. Monad m => a -> m a
return (Value
v, [ScriptWitness WitCtxMint era]
sWits)

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

runTxSign :: InputTxBodyOrTxFile
          -> [WitnessSigningData]
          -> Maybe NetworkId
          -> TxFile
          -> ExceptT ShelleyTxCmdError IO ()
runTxSign :: InputTxBodyOrTxFile
-> [WitnessSigningData]
-> Maybe NetworkId
-> TxFile
-> ExceptT ShelleyTxCmdError IO ()
runTxSign InputTxBodyOrTxFile
txOrTxBody [WitnessSigningData]
witSigningData Maybe NetworkId
mnw (TxFile FilePath
outTxFile) = do
  [SomeWitness]
sks <-  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ReadWitnessSigningDataError -> ShelleyTxCmdError
ShelleyTxCmdReadWitnessSigningDataError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitnessSigningData
-> IO (Either ReadWitnessSigningDataError SomeWitness)
readWitnessSigningData) [WitnessSigningData]
witSigningData

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

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

      InAnyShelleyBasedEra ShelleyBasedEra era
_era Tx era
tx <-
          forall (a :: * -> *).
Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
"sign for Byron era transactions" InAnyCardanoEra Tx
anyTx

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

      [KeyWitness era]
byronWitnesses <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyBootstrapWitnessError -> ShelleyTxCmdError
ShelleyTxCmdBootstrapWitnessError
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
                          forall a b. (a -> b) -> a -> b
$ forall era.
IsShelleyBasedEra era =>
Maybe NetworkId
-> TxBody era
-> [ShelleyBootstrapWitnessSigningKeyData]
-> Either ShelleyBootstrapWitnessError [KeyWitness era]
mkShelleyBootstrapWitnesses Maybe NetworkId
mnw TxBody era
txbody [ShelleyBootstrapWitnessSigningKeyData]
sksByron

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

      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall era.
IsCardanoEra era =>
FilePath -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCddl FilePath
outTxFile Tx era
signedTx)
        forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError () -> ShelleyTxCmdError
ShelleyTxCmdWriteFileError)

    InputTxBodyFile (TxBodyFile FilePath
txbodyFilePath) -> do
      FileOrPipe
txbodyFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txbodyFilePath
      IncompleteTx
unwitnessed <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT CddlError -> ShelleyTxCmdError
ShelleyTxCmdCddlError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
                       forall a b. (a -> b) -> a -> b
$ FileOrPipe -> IO (Either CddlError IncompleteTx)
readFileTxBody FileOrPipe
txbodyFile

      case IncompleteTx
unwitnessed of
        IncompleteCddlFormattedTx InAnyCardanoEra Tx
anyTx -> do
         InAnyShelleyBasedEra ShelleyBasedEra era
_era Tx era
unwitTx <-
           forall (a :: * -> *).
Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
"sign for Byron era transactions" InAnyCardanoEra Tx
anyTx

         let txbody :: TxBody era
txbody = forall era. Tx era -> TxBody era
getTxBody Tx era
unwitTx
         -- Byron witnesses require the network ID. This can either be provided
         -- directly or derived from a provided Byron address.
         [KeyWitness era]
byronWitnesses <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyBootstrapWitnessError -> ShelleyTxCmdError
ShelleyTxCmdBootstrapWitnessError
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
           forall a b. (a -> b) -> a -> b
$ forall era.
IsShelleyBasedEra era =>
Maybe NetworkId
-> TxBody era
-> [ShelleyBootstrapWitnessSigningKeyData]
-> Either ShelleyBootstrapWitnessError [KeyWitness era]
mkShelleyBootstrapWitnesses Maybe NetworkId
mnw TxBody era
txbody [ShelleyBootstrapWitnessSigningKeyData]
sksByron

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

         forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall era.
IsCardanoEra era =>
FilePath -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCddl FilePath
outTxFile Tx era
tx)
            forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError () -> ShelleyTxCmdError
ShelleyTxCmdWriteFileError)

        UnwitnessedCliFormattedTxBody InAnyCardanoEra TxBody
anyTxbody -> do
          InAnyShelleyBasedEra ShelleyBasedEra era
_era TxBody era
txbody <-
            --TODO: in principle we should be able to support Byron era txs too
            forall (a :: * -> *).
Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
"sign for Byron era transactions" InAnyCardanoEra TxBody
anyTxbody
          -- Byron witnesses require the network ID. This can either be provided
          -- directly or derived from a provided Byron address.
          [KeyWitness era]
byronWitnesses <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyBootstrapWitnessError -> ShelleyTxCmdError
ShelleyTxCmdBootstrapWitnessError
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
            forall a b. (a -> b) -> a -> b
$ forall era.
IsShelleyBasedEra era =>
Maybe NetworkId
-> TxBody era
-> [ShelleyBootstrapWitnessSigningKeyData]
-> Either ShelleyBootstrapWitnessError [KeyWitness era]
mkShelleyBootstrapWitnesses Maybe NetworkId
mnw TxBody era
txbody [ShelleyBootstrapWitnessSigningKeyData]
sksByron

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

          forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyTxCmdError
ShelleyTxCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
            forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
outTxFile forall a. Maybe a
Nothing Tx era
tx

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


runTxSubmit
  :: AnyConsensusModeParams
  -> NetworkId
  -> FilePath
  -> ExceptT ShelleyTxCmdError IO ()
runTxSubmit :: AnyConsensusModeParams
-> NetworkId -> FilePath -> ExceptT ShelleyTxCmdError IO ()
runTxSubmit (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network FilePath
txFilePath = do
    SocketPath FilePath
sockPath <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO (Either EnvSocketError SocketPath)
readEnvSocketPath forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnvSocketError -> ShelleyTxCmdError
ShelleyTxCmdSocketEnvError)

    FileOrPipe
txFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txFilePath
    InAnyCardanoEra CardanoEra era
era Tx era
tx <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FileOrPipe -> IO (Either CddlError (InAnyCardanoEra Tx))
readFileTx FileOrPipe
txFile) forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. CddlError -> ShelleyTxCmdError
ShelleyTxCmdCddlError)
    let cMode :: AnyConsensusMode
cMode = forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode forall a b. (a -> b) -> a -> b
$ forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
    EraInMode era mode
eraInMode <- forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe
                   (Maybe FilePath
-> AnyConsensusMode -> AnyCardanoEra -> ShelleyTxCmdError
ShelleyTxCmdEraConsensusModeMismatch (forall a. a -> Maybe a
Just FilePath
txFilePath) AnyConsensusMode
cMode (forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era))
                   (forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era forall a b. (a -> b) -> a -> b
$ forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams)
    let txInMode :: TxInMode mode
txInMode = forall era mode. Tx era -> EraInMode era mode -> TxInMode mode
TxInMode Tx era
tx EraInMode era mode
eraInMode
        localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = LocalNodeConnectInfo
                              { localConsensusModeParams :: ConsensusModeParams mode
localConsensusModeParams = ConsensusModeParams mode
cModeParams
                              , localNodeNetworkId :: NetworkId
localNodeNetworkId = NetworkId
network
                              , localNodeSocketPath :: FilePath
localNodeSocketPath = FilePath
sockPath
                              }

    SubmitResult (TxValidationErrorInMode mode)
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall mode.
LocalNodeConnectInfo mode
-> TxInMode mode
-> IO (SubmitResult (TxValidationErrorInMode mode))
submitTxToNodeLocal LocalNodeConnectInfo mode
localNodeConnInfo TxInMode mode
txInMode
    case SubmitResult (TxValidationErrorInMode mode)
res of
      SubmitResult (TxValidationErrorInMode mode)
Net.Tx.SubmitSuccess -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn Text
"Transaction successfully submitted."
      Net.Tx.SubmitFail TxValidationErrorInMode mode
reason ->
        case TxValidationErrorInMode mode
reason of
          TxValidationErrorInMode TxValidationError era
err EraInMode era mode
_eraInMode -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ShelleyTxCmdError
ShelleyTxCmdTxSubmitError forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show TxValidationError era
err
          TxValidationEraMismatch EraMismatch
mismatchErr -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ EraMismatch -> ShelleyTxCmdError
ShelleyTxCmdTxSubmitErrorEraMismatch EraMismatch
mismatchErr

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

runTxCalculateMinFee
  :: TxBodyFile
  -> Maybe NetworkId
  -> ProtocolParamsSourceSpec
  -> TxInCount
  -> TxOutCount
  -> TxShelleyWitnessCount
  -> TxByronWitnessCount
  -> ExceptT ShelleyTxCmdError IO ()
runTxCalculateMinFee :: TxBodyFile
-> Maybe NetworkId
-> ProtocolParamsSourceSpec
-> TxInCount
-> TxOutCount
-> TxShelleyWitnessCount
-> TxByronWitnessCount
-> ExceptT ShelleyTxCmdError IO ()
runTxCalculateMinFee (TxBodyFile FilePath
txbodyFilePath) Maybe NetworkId
nw ProtocolParamsSourceSpec
protocolParamsSourceSpec
                     (TxInCount Int
nInputs) (TxOutCount Int
nOutputs)
                     (TxShelleyWitnessCount Int
nShelleyKeyWitnesses)
                     (TxByronWitnessCount Int
nByronKeyWitnesses) = do

    FileOrPipe
txbodyFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txbodyFilePath
    IncompleteTx
unwitnessed <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT CddlError -> ShelleyTxCmdError
ShelleyTxCmdCddlError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
                     forall a b. (a -> b) -> a -> b
$ FileOrPipe -> IO (Either CddlError IncompleteTx)
readFileTxBody FileOrPipe
txbodyFile
    ProtocolParameters
pparams <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ProtocolParamsError -> ShelleyTxCmdError
ShelleyTxCmdProtocolParamsError
                 forall a b. (a -> b) -> a -> b
$ ProtocolParamsSourceSpec
-> ExceptT ProtocolParamsError IO ProtocolParameters
readProtocolParametersSourceSpec ProtocolParamsSourceSpec
protocolParamsSourceSpec
    case IncompleteTx
unwitnessed of
      IncompleteCddlFormattedTx InAnyCardanoEra Tx
anyTx -> do
        InAnyShelleyBasedEra ShelleyBasedEra era
_era Tx era
unwitTx <-
          forall (a :: * -> *).
Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
"sign for Byron era transactions" InAnyCardanoEra Tx
anyTx
        let txbody :: TxBody era
txbody =  forall era. Tx era -> TxBody era
getTxBody Tx era
unwitTx
        let tx :: Tx era
tx = forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody era
txbody
            Lovelace Integer
fee = forall era.
IsShelleyBasedEra era =>
NetworkId
-> Natural
-> Natural
-> Tx era
-> Int
-> Int
-> Int
-> Int
-> Lovelace
estimateTransactionFee
                             (forall a. a -> Maybe a -> a
fromMaybe NetworkId
Mainnet Maybe NetworkId
nw)
                             (ProtocolParameters -> Natural
protocolParamTxFeeFixed ProtocolParameters
pparams)
                             (ProtocolParameters -> Natural
protocolParamTxFeePerByte ProtocolParameters
pparams)
                             Tx era
tx
                             Int
nInputs Int
nOutputs
                             Int
nByronKeyWitnesses Int
nShelleyKeyWitnesses

        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ (forall a. Show a => a -> FilePath
show Integer
fee :: String) forall a. Semigroup a => a -> a -> a
<> FilePath
" Lovelace"

      UnwitnessedCliFormattedTxBody InAnyCardanoEra TxBody
anyTxBody -> do
        InAnyShelleyBasedEra ShelleyBasedEra era
_era TxBody era
txbody <-
              --TODO: in principle we should be able to support Byron era txs too
              forall (a :: * -> *).
Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
"calculate-min-fee for Byron era transactions" InAnyCardanoEra TxBody
anyTxBody

        let tx :: Tx era
tx = forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody era
txbody
            Lovelace Integer
fee = forall era.
IsShelleyBasedEra era =>
NetworkId
-> Natural
-> Natural
-> Tx era
-> Int
-> Int
-> Int
-> Int
-> Lovelace
estimateTransactionFee
                             (forall a. a -> Maybe a -> a
fromMaybe NetworkId
Mainnet Maybe NetworkId
nw)
                             (ProtocolParameters -> Natural
protocolParamTxFeeFixed ProtocolParameters
pparams)
                             (ProtocolParameters -> Natural
protocolParamTxFeePerByte ProtocolParameters
pparams)
                             Tx era
tx
                             Int
nInputs Int
nOutputs
                             Int
nByronKeyWitnesses Int
nShelleyKeyWitnesses

        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ (forall a. Show a => a -> FilePath
show Integer
fee :: String) forall a. Semigroup a => a -> a -> a
<> FilePath
" Lovelace"

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

runTxCalculateMinRequiredUTxO
  :: AnyCardanoEra
  -> ProtocolParamsSourceSpec
  -> TxOutAnyEra
  -> ExceptT ShelleyTxCmdError IO ()
runTxCalculateMinRequiredUTxO :: AnyCardanoEra
-> ProtocolParamsSourceSpec
-> TxOutAnyEra
-> ExceptT ShelleyTxCmdError IO ()
runTxCalculateMinRequiredUTxO (AnyCardanoEra CardanoEra era
era) ProtocolParamsSourceSpec
protocolParamsSourceSpec TxOutAnyEra
txOut = do
  ProtocolParameters
pp <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ProtocolParamsError -> ShelleyTxCmdError
ShelleyTxCmdProtocolParamsError
          forall a b. (a -> b) -> a -> b
$ ProtocolParamsSourceSpec
-> ExceptT ProtocolParamsError IO ProtocolParameters
readProtocolParametersSourceSpec ProtocolParamsSourceSpec
protocolParamsSourceSpec
  TxOut CtxTx era
out <- forall era.
CardanoEra era
-> TxOutAnyEra -> ExceptT ShelleyTxCmdError IO (TxOut CtxTx era)
toTxOutInAnyEra CardanoEra era
era TxOutAnyEra
txOut
  case forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era of
    CardanoEraStyle era
LegacyByronEra -> forall a. HasCallStack => FilePath -> a
error FilePath
"runTxCalculateMinRequiredUTxO: Byron era not implemented yet"
    ShelleyBasedEra ShelleyBasedEra era
sbe -> do
      forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ProtocolParametersError -> ShelleyTxCmdError
ShelleyTxCmdPParamsErr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
        forall a b. (a -> b) -> a -> b
$ forall era.
IsCardanoEra era =>
ShelleyBasedEra era
-> ProtocolParameters -> Either ProtocolParametersError ()
checkProtocolParameters ShelleyBasedEra era
sbe ProtocolParameters
pp
      Lovelace
minValue <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT MinimumUTxOError -> ShelleyTxCmdError
ShelleyTxCmdMinimumUTxOErr
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall era.
ShelleyBasedEra era
-> TxOut CtxTx era
-> BundledProtocolParameters era
-> Either MinimumUTxOError Lovelace
calculateMinimumUTxO ShelleyBasedEra era
sbe TxOut CtxTx era
out (forall era.
CardanoEra era
-> ProtocolParameters -> BundledProtocolParameters era
bundleProtocolParams CardanoEra era
era ProtocolParameters
pp)
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> IO ()
IO.print forall a b. (a -> b) -> a -> b
$ Lovelace
minValue

runTxCreatePolicyId :: ScriptFile -> ExceptT ShelleyTxCmdError IO ()
runTxCreatePolicyId :: ScriptFile -> ExceptT ShelleyTxCmdError IO ()
runTxCreatePolicyId (ScriptFile FilePath
sFile) = do
  ScriptInAnyLang ScriptLanguage lang
_ Script lang
script <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ShelleyTxCmdError
ShelleyTxCmdScriptFileError forall a b. (a -> b) -> a -> b
$
                                FilePath
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang FilePath
sFile
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
Text.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText forall a b. (a -> b) -> a -> b
$ forall lang. Script lang -> ScriptHash
hashScript Script lang
script


-- | Error reading the data required to construct a key witness.


partitionSomeWitnesses
  :: [ByronOrShelleyWitness]
  -> ( [ShelleyBootstrapWitnessSigningKeyData]
     , [ShelleyWitnessSigningKey]
     )
partitionSomeWitnesses :: [ByronOrShelleyWitness]
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
partitionSomeWitnesses = forall {a} {a}. ([a], [a]) -> ([a], [a])
reversePartitionedWits forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([ShelleyBootstrapWitnessSigningKeyData],
 [ShelleyWitnessSigningKey])
-> ByronOrShelleyWitness
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
go forall a. Monoid a => a
mempty
  where
    reversePartitionedWits :: ([a], [a]) -> ([a], [a])
reversePartitionedWits ([a]
bw, [a]
skw) =
      (forall a. [a] -> [a]
reverse [a]
bw, 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
byronWitforall a. a -> [a] -> [a]
:[ShelleyBootstrapWitnessSigningKeyData]
byronAcc, [ShelleyWitnessSigningKey]
shelleyKeyAcc)
        AShelleyKeyWitness ShelleyWitnessSigningKey
shelleyKeyWit ->
          ([ShelleyBootstrapWitnessSigningKeyData]
byronAcc, ShelleyWitnessSigningKey
shelleyKeyWitforall a. a -> [a] -> [a]
:[ShelleyWitnessSigningKey]
shelleyKeyAcc)


-- | Error constructing a Shelley bootstrap witness (i.e. a Byron key witness
-- in the Shelley era).
data ShelleyBootstrapWitnessError
  = MissingNetworkIdOrByronAddressError
  -- ^ Neither a network ID nor a Byron address were provided to construct the
  -- Shelley bootstrap witness. One or the other is required.
  deriving Int -> ShelleyBootstrapWitnessError -> ShowS
[ShelleyBootstrapWitnessError] -> ShowS
ShelleyBootstrapWitnessError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyBootstrapWitnessError] -> ShowS
$cshowList :: [ShelleyBootstrapWitnessError] -> ShowS
show :: ShelleyBootstrapWitnessError -> FilePath
$cshow :: ShelleyBootstrapWitnessError -> FilePath
showsPrec :: Int -> ShelleyBootstrapWitnessError -> ShowS
$cshowsPrec :: Int -> ShelleyBootstrapWitnessError -> ShowS
Show

-- | Render an error message for a 'ShelleyBootstrapWitnessError'.
renderShelleyBootstrapWitnessError :: ShelleyBootstrapWitnessError -> Text
renderShelleyBootstrapWitnessError :: ShelleyBootstrapWitnessError -> Text
renderShelleyBootstrapWitnessError ShelleyBootstrapWitnessError
MissingNetworkIdOrByronAddressError =
  Text
"Transactions witnessed by a Byron signing key must be accompanied by a "
    forall a. Semigroup a => a -> a -> a
<> Text
"network ID. Either provide a network ID or provide a Byron "
    forall a. Semigroup a => a -> a -> a
<> Text
"address with each Byron signing key (network IDs can be derived "
    forall a. Semigroup a => a -> a -> a
<> Text
"from Byron addresses)."

-- | Construct a Shelley bootstrap witness (i.e. a Byron key witness in the
-- Shelley era).
mkShelleyBootstrapWitness
  :: IsShelleyBasedEra era
  => Maybe NetworkId
  -> TxBody era
  -> ShelleyBootstrapWitnessSigningKeyData
  -> Either ShelleyBootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness :: forall era.
IsShelleyBasedEra era =>
Maybe NetworkId
-> TxBody era
-> ShelleyBootstrapWitnessSigningKeyData
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness Maybe NetworkId
Nothing TxBody era
_ (ShelleyBootstrapWitnessSigningKeyData SigningKey ByronKey
_ Maybe (Address ByronAddr)
Nothing) =
  forall a b. a -> Either a b
Left ShelleyBootstrapWitnessError
MissingNetworkIdOrByronAddressError
mkShelleyBootstrapWitness (Just NetworkId
nw) TxBody era
txBody (ShelleyBootstrapWitnessSigningKeyData SigningKey ByronKey
skey Maybe (Address ByronAddr)
Nothing) =
  forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall era.
IsShelleyBasedEra era =>
WitnessNetworkIdOrByronAddress
-> TxBody era -> SigningKey ByronKey -> KeyWitness era
makeShelleyBootstrapWitness (NetworkId -> WitnessNetworkIdOrByronAddress
WitnessNetworkId NetworkId
nw) TxBody era
txBody SigningKey ByronKey
skey
mkShelleyBootstrapWitness Maybe NetworkId
_ TxBody era
txBody (ShelleyBootstrapWitnessSigningKeyData SigningKey ByronKey
skey (Just Address ByronAddr
addr)) =
  forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall era.
IsShelleyBasedEra era =>
WitnessNetworkIdOrByronAddress
-> TxBody era -> SigningKey ByronKey -> KeyWitness era
makeShelleyBootstrapWitness (Address ByronAddr -> WitnessNetworkIdOrByronAddress
WitnessByronAddress Address ByronAddr
addr) TxBody era
txBody SigningKey ByronKey
skey

-- | Attempt to construct Shelley bootstrap witnesses until an error is
-- encountered.
mkShelleyBootstrapWitnesses
  :: IsShelleyBasedEra era
  => Maybe NetworkId
  -> TxBody era
  -> [ShelleyBootstrapWitnessSigningKeyData]
  -> Either ShelleyBootstrapWitnessError [KeyWitness era]
mkShelleyBootstrapWitnesses :: forall era.
IsShelleyBasedEra era =>
Maybe NetworkId
-> TxBody era
-> [ShelleyBootstrapWitnessSigningKeyData]
-> Either ShelleyBootstrapWitnessError [KeyWitness era]
mkShelleyBootstrapWitnesses Maybe NetworkId
mnw TxBody era
txBody =
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall era.
IsShelleyBasedEra era =>
Maybe NetworkId
-> TxBody era
-> ShelleyBootstrapWitnessSigningKeyData
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness Maybe NetworkId
mnw TxBody era
txBody)


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

runTxHashScriptData :: ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO ()
runTxHashScriptData :: ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO ()
runTxHashScriptData ScriptDataOrFile
scriptDataOrFile = do
    ScriptRedeemer
d <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ShelleyTxCmdError
ShelleyTxCmdScriptDataError forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO ScriptRedeemer
readScriptDataOrFile ScriptDataOrFile
scriptDataOrFile
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn forall a b. (a -> b) -> a -> b
$ forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (ScriptRedeemer -> Hash ScriptData
hashScriptDataBytes ScriptRedeemer
d)

runTxGetTxId :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxGetTxId :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxGetTxId InputTxBodyOrTxFile
txfile = do
    InAnyCardanoEra CardanoEra era
_era TxBody era
txbody <-
      case InputTxBodyOrTxFile
txfile of
        InputTxBodyFile (TxBodyFile FilePath
txbodyFilePath) -> do
          FileOrPipe
txbodyFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txbodyFilePath
          IncompleteTx
unwitnessed <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT CddlError -> ShelleyTxCmdError
ShelleyTxCmdCddlError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
                           forall a b. (a -> b) -> a -> b
$ FileOrPipe -> IO (Either CddlError IncompleteTx)
readFileTxBody FileOrPipe
txbodyFile
          case IncompleteTx
unwitnessed of
            UnwitnessedCliFormattedTxBody InAnyCardanoEra TxBody
anyTxBody -> forall (m :: * -> *) a. Monad m => a -> m a
return InAnyCardanoEra TxBody
anyTxBody
            IncompleteCddlFormattedTx (InAnyCardanoEra CardanoEra era
era Tx era
tx) ->
              forall (m :: * -> *) a. Monad m => a -> m a
return (forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
era (forall era. Tx era -> TxBody era
getTxBody Tx era
tx))

        InputTxFile (TxFile FilePath
txFilePath) -> do
          FileOrPipe
txFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txFilePath
          InAnyCardanoEra CardanoEra era
era Tx era
tx <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FileOrPipe -> IO (Either CddlError (InAnyCardanoEra Tx))
readFileTx FileOrPipe
txFile) forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. CddlError -> ShelleyTxCmdError
ShelleyTxCmdCddlError)
          forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
era forall a b. (a -> b) -> a -> b
$ forall era. Tx era -> TxBody era
getTxBody Tx era
tx

    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn forall a b. (a -> b) -> a -> b
$ forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (forall era. TxBody era -> TxId
getTxId TxBody era
txbody)

runTxView :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxView :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxView = \case
  InputTxBodyFile (TxBodyFile FilePath
txbodyFilePath) -> do
    FileOrPipe
txbodyFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txbodyFilePath
    IncompleteTx
unwitnessed <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT CddlError -> ShelleyTxCmdError
ShelleyTxCmdCddlError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
                     forall a b. (a -> b) -> a -> b
$ FileOrPipe -> IO (Either CddlError IncompleteTx)
readFileTxBody FileOrPipe
txbodyFile
    InAnyCardanoEra CardanoEra era
era TxBody era
txbody <-
      case IncompleteTx
unwitnessed of
        UnwitnessedCliFormattedTxBody InAnyCardanoEra TxBody
anyTxBody -> forall (f :: * -> *) a. Applicative f => a -> f a
pure InAnyCardanoEra TxBody
anyTxBody
        IncompleteCddlFormattedTx (InAnyCardanoEra CardanoEra era
era Tx era
tx) ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
era (forall era. Tx era -> TxBody era
getTxBody Tx era
tx)
    --TODO: Why are we maintaining friendlyTxBodyBS and friendlyTxBS?
    -- In the case of a transaction body, we can simply call makeSignedTransaction []
    -- to get a transaction which allows us to reuse friendlyTxBS!
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStr forall a b. (a -> b) -> a -> b
$ forall era.
IsCardanoEra era =>
CardanoEra era -> TxBody era -> ByteString
friendlyTxBodyBS CardanoEra era
era TxBody era
txbody
  InputTxFile (TxFile FilePath
txFilePath) -> do
    FileOrPipe
txFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txFilePath
    InAnyCardanoEra CardanoEra era
era Tx era
tx <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FileOrPipe -> IO (Either CddlError (InAnyCardanoEra Tx))
readFileTx FileOrPipe
txFile) forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. CddlError -> ShelleyTxCmdError
ShelleyTxCmdCddlError)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStr forall a b. (a -> b) -> a -> b
$ forall era.
IsCardanoEra era =>
CardanoEra era -> Tx era -> ByteString
friendlyTxBS CardanoEra era
era Tx era
tx


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

runTxCreateWitness
  :: TxBodyFile
  -> WitnessSigningData
  -> Maybe NetworkId
  -> OutputFile
  -> ExceptT ShelleyTxCmdError IO ()
runTxCreateWitness :: TxBodyFile
-> WitnessSigningData
-> Maybe NetworkId
-> OutputFile
-> ExceptT ShelleyTxCmdError IO ()
runTxCreateWitness (TxBodyFile FilePath
txbodyFilePath) WitnessSigningData
witSignData Maybe NetworkId
mbNw (OutputFile FilePath
oFile) = do
  FileOrPipe
txbodyFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txbodyFilePath
  IncompleteTx
unwitnessed <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT CddlError -> ShelleyTxCmdError
ShelleyTxCmdCddlError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
                   forall a b. (a -> b) -> a -> b
$ FileOrPipe -> IO (Either CddlError IncompleteTx)
readFileTxBody FileOrPipe
txbodyFile
  case IncompleteTx
unwitnessed of
    IncompleteCddlFormattedTx InAnyCardanoEra Tx
anyTx -> do
     InAnyShelleyBasedEra ShelleyBasedEra era
sbe Tx era
cddlTx <-
       forall (a :: * -> *).
Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
"sign for Byron era transactions" InAnyCardanoEra Tx
anyTx

     let txbody :: TxBody era
txbody = forall era. Tx era -> TxBody era
getTxBody Tx era
cddlTx
     SomeWitness
someWit <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ReadWitnessSigningDataError -> ShelleyTxCmdError
ShelleyTxCmdReadWitnessSigningDataError
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ WitnessSigningData
-> IO (Either ReadWitnessSigningDataError SomeWitness)
readWitnessSigningData WitnessSigningData
witSignData
     KeyWitness era
witness <-
       case SomeWitness -> ByronOrShelleyWitness
categoriseSomeWitness SomeWitness
someWit of
         -- Byron witnesses require the network ID. This can either be provided
         -- directly or derived from a provided Byron address.
         AByronWitness ShelleyBootstrapWitnessSigningKeyData
bootstrapWitData ->
           forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyBootstrapWitnessError -> ShelleyTxCmdError
ShelleyTxCmdBootstrapWitnessError
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
             forall a b. (a -> b) -> a -> b
$ forall era.
IsShelleyBasedEra era =>
Maybe NetworkId
-> TxBody era
-> ShelleyBootstrapWitnessSigningKeyData
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness Maybe NetworkId
mbNw TxBody era
txbody ShelleyBootstrapWitnessSigningKeyData
bootstrapWitData
         AShelleyKeyWitness ShelleyWitnessSigningKey
skShelley ->
           forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
IsShelleyBasedEra era =>
TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
makeShelleyKeyWitness TxBody era
txbody ShelleyWitnessSigningKey
skShelley

     forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyTxCmdError
ShelleyTxCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
       forall a b. (a -> b) -> a -> b
$ forall era.
ShelleyBasedEra era
-> FilePath -> KeyWitness era -> IO (Either (FileError ()) ())
writeTxWitnessFileTextEnvelopeCddl ShelleyBasedEra era
sbe FilePath
oFile KeyWitness era
witness

    UnwitnessedCliFormattedTxBody InAnyCardanoEra TxBody
anyTxbody -> do
      InAnyShelleyBasedEra ShelleyBasedEra era
_era TxBody era
txbody <-
        forall (a :: * -> *).
Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
"sign for Byron era transactions" InAnyCardanoEra TxBody
anyTxbody

      SomeWitness
someWit <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ReadWitnessSigningDataError -> ShelleyTxCmdError
ShelleyTxCmdReadWitnessSigningDataError
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ WitnessSigningData
-> IO (Either ReadWitnessSigningDataError SomeWitness)
readWitnessSigningData WitnessSigningData
witSignData

      KeyWitness era
witness <-
        case SomeWitness -> ByronOrShelleyWitness
categoriseSomeWitness SomeWitness
someWit of
          -- Byron witnesses require the network ID. This can either be provided
          -- directly or derived from a provided Byron address.
          AByronWitness ShelleyBootstrapWitnessSigningKeyData
bootstrapWitData ->
            forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyBootstrapWitnessError -> ShelleyTxCmdError
ShelleyTxCmdBootstrapWitnessError
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
              forall a b. (a -> b) -> a -> b
$ forall era.
IsShelleyBasedEra era =>
Maybe NetworkId
-> TxBody era
-> ShelleyBootstrapWitnessSigningKeyData
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness Maybe NetworkId
mbNw TxBody era
txbody ShelleyBootstrapWitnessSigningKeyData
bootstrapWitData
          AShelleyKeyWitness ShelleyWitnessSigningKey
skShelley ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
IsShelleyBasedEra era =>
TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
makeShelleyKeyWitness TxBody era
txbody ShelleyWitnessSigningKey
skShelley

      forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyTxCmdError
ShelleyTxCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
        forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
oFile forall a. Maybe a
Nothing KeyWitness era
witness

runTxSignWitness
  :: TxBodyFile
  -> [WitnessFile]
  -> OutputFile
  -> ExceptT ShelleyTxCmdError IO ()
runTxSignWitness :: TxBodyFile
-> [WitnessFile] -> OutputFile -> ExceptT ShelleyTxCmdError IO ()
runTxSignWitness (TxBodyFile FilePath
txbodyFilePath) [WitnessFile]
witnessFiles (OutputFile FilePath
oFp) = do
    FileOrPipe
txbodyFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
txbodyFilePath
    IncompleteTx
unwitnessed <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT CddlError -> ShelleyTxCmdError
ShelleyTxCmdCddlError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
                     forall a b. (a -> b) -> a -> b
$ FileOrPipe -> IO (Either CddlError IncompleteTx)
readFileTxBody FileOrPipe
txbodyFile
    case IncompleteTx
unwitnessed of
      UnwitnessedCliFormattedTxBody (InAnyCardanoEra CardanoEra era
era TxBody era
txbody) -> do
        [KeyWitness era]
witnesses <-
          forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
            [ do InAnyCardanoEra CardanoEra era
era' KeyWitness era
witness <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT CddlWitnessError -> ShelleyTxCmdError
ShelleyTxCmdCddlWitnessError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
                                                   forall a b. (a -> b) -> a -> b
$ FilePath
-> IO (Either CddlWitnessError (InAnyCardanoEra KeyWitness))
readFileTxKeyWitness FilePath
file
                 case forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality CardanoEra era
era CardanoEra era
era' of
                   Maybe (era :~: era)
Nothing   -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> AnyCardanoEra -> WitnessFile -> ShelleyTxCmdError
ShelleyTxCmdWitnessEraMismatch
                                         (forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era)
                                         (forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era')
                                         WitnessFile
witnessFile
                   Just era :~: era
Refl -> forall (m :: * -> *) a. Monad m => a -> m a
return KeyWitness era
witness
            | witnessFile :: WitnessFile
witnessFile@(WitnessFile FilePath
file) <- [WitnessFile]
witnessFiles
            ]

        let tx :: Tx era
tx = forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness era]
witnesses TxBody era
txbody
        forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyTxCmdError
ShelleyTxCmdWriteFileError
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
oFp forall a. Maybe a
Nothing Tx era
tx

      IncompleteCddlFormattedTx (InAnyCardanoEra CardanoEra era
era Tx era
anyTx) -> do
        let txbody :: TxBody era
txbody = forall era. Tx era -> TxBody era
getTxBody Tx era
anyTx

        [KeyWitness era]
witnesses <-
          forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
            [ do InAnyCardanoEra CardanoEra era
era' KeyWitness era
witness <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT CddlWitnessError -> ShelleyTxCmdError
ShelleyTxCmdCddlWitnessError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
                                                   forall a b. (a -> b) -> a -> b
$ FilePath
-> IO (Either CddlWitnessError (InAnyCardanoEra KeyWitness))
readFileTxKeyWitness FilePath
file
                 case forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality CardanoEra era
era CardanoEra era
era' of
                   Maybe (era :~: era)
Nothing   -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> AnyCardanoEra -> WitnessFile -> ShelleyTxCmdError
ShelleyTxCmdWitnessEraMismatch
                                         (forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era)
                                         (forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era')
                                         WitnessFile
witnessFile
                   Just era :~: era
Refl -> forall (m :: * -> *) a. Monad m => a -> m a
return KeyWitness era
witness
            | witnessFile :: WitnessFile
witnessFile@(WitnessFile FilePath
file) <- [WitnessFile]
witnessFiles ]

        let tx :: Tx era
tx = forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness era]
witnesses TxBody era
txbody

        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall era.
IsCardanoEra era =>
FilePath -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCddl FilePath
oFp Tx era
tx) forall a b. a -> (a -> b) -> b
& forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall b c a. (b -> c) -> (a -> b) -> a -> c