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

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

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

import           Cardano.Prelude hiding (All, Any)
import           Prelude (String, error)

import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import           Data.Type.Equality (TestEquality (..))

import           Control.Concurrent.STM
import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither,
                   hoistMaybe, left, newExceptT)

import           Cardano.Api
import           Cardano.Api.Byron hiding (SomeByronSigningKey (..))
import           Cardano.Api.Shelley
import           Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardMary, StandardShelley)

--TODO: do this nicely via the API too:
import qualified Cardano.Binary as CBOR

--TODO: following import needed for orphan Eq Script instance
import           Cardano.Ledger.ShelleyMA.TxBody ()
import           Shelley.Spec.Ledger.Scripts ()

import           Cardano.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
import           Cardano.CLI.Run.Friendly (friendlyTxBodyBS)
import           Cardano.CLI.Shelley.Key (InputDecodeError, readSigningKeyFileAnyOf)
import           Cardano.CLI.Shelley.Parsers
import           Cardano.CLI.Shelley.Run.Genesis (ShelleyGenesisCmdError (..), readShelleyGenesis,
                   renderShelleyGenesisCmdError)
import           Cardano.CLI.Shelley.Run.Query (ShelleyQueryCmdLocalStateQueryError (..),
                   renderLocalStateQueryError)
import           Cardano.CLI.Shelley.Script
import           Cardano.CLI.Types
import           Ouroboros.Consensus.BlockchainTime.WallClock.Types (SystemStart (..))
import           Ouroboros.Consensus.Byron.Ledger (ByronBlock)
import           Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr)
import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Client as Net.Query
import           Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..))
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Net.Query
import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx

import qualified System.IO as IO

{- HLINT ignore "Use let" -}

data ShelleyTxCmdError
  = ShelleyTxCmdAesonDecodeProtocolParamsError !FilePath !Text
  | ShelleyTxCmdReadFileError !(FileError ())
  | ShelleyTxCmdScriptFileError (FileError ScriptDecodeError)
  | ShelleyTxCmdReadTextViewFileError !(FileError TextEnvelopeError)
  | ShelleyTxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError
  | ShelleyTxCmdWriteFileError !(FileError ())
  | ShelleyTxCmdEraConsensusModeMismatch
      !(Maybe FilePath)
      !AnyConsensusMode
      !AnyCardanoEra
      -- ^ Era
  | ShelleyTxCmdMetadataJsonParseError !FilePath !String
  | ShelleyTxCmdMetadataConversionError !FilePath !TxMetadataJsonError
  | ShelleyTxCmdMetaValidationError !FilePath ![(Word64, TxMetadataRangeError)]
  | ShelleyTxCmdScriptDataJsonParseError  !FilePath !String
  | ShelleyTxCmdScriptDataConversionError !FilePath !ScriptDataJsonError
  | ShelleyTxCmdScriptDataValidationError !FilePath !ScriptDataRangeError
  | ShelleyTxCmdMetaDecodeError !FilePath !CBOR.DecoderError
  | ShelleyTxCmdBootstrapWitnessError !ShelleyBootstrapWitnessError
  | ShelleyTxCmdSocketEnvError !EnvSocketError
  | ShelleyTxCmdTxSubmitError !Text
  | ShelleyTxCmdTxSubmitErrorByron !(ApplyTxErr ByronBlock)
  | ShelleyTxCmdTxSubmitErrorShelley !(ApplyTxErr (ShelleyBlock StandardShelley))
  | ShelleyTxCmdTxSubmitErrorAllegra !(ApplyTxErr (ShelleyBlock StandardAllegra))
  | ShelleyTxCmdTxSubmitErrorMary !(ApplyTxErr (ShelleyBlock StandardMary))
  | ShelleyTxCmdTxSubmitErrorEraMismatch !EraMismatch
  | ShelleyTxCmdTxFeatureMismatch !AnyCardanoEra !TxFeature
  | ShelleyTxCmdTxBodyError !TxBodyError
  | ShelleyTxCmdNotImplemented !Text
  | ShelleyTxCmdWitnessEraMismatch !AnyCardanoEra !AnyCardanoEra !WitnessFile
  | ShelleyTxCmdScriptLanguageNotSupportedInEra !AnyScriptLanguage !AnyCardanoEra
  | ShelleyTxCmdScriptExpectedSimple !FilePath !AnyScriptLanguage
  | ShelleyTxCmdScriptExpectedPlutus !FilePath !AnyScriptLanguage
  | ShelleyTxCmdGenesisCmdError !ShelleyGenesisCmdError
  | ShelleyTxCmdPolicyIdsMissing ![PolicyId]
  | ShelleyTxCmdPolicyIdsExcess  ![PolicyId]
  | ShelleyTxCmdAcquireFailure !AcquireFailure
  | ShelleyTxCmdUnsupportedMode !AnyConsensusMode
  | ShelleyTxCmdByronEra
  | ShelleyTxCmdEraConsensusModeMismatchTxBalance
      !TxBodyFile
      !AnyConsensusMode
      !AnyCardanoEra
  | ShelleyTxCmdBalanceTxBody !TxBodyErrorAutoBalance
  | ShelleyTxCmdEraConsensusModeMismatchQuery !AnyConsensusMode !AnyCardanoEra
  | ShelleyTxCmdByronEraQuery
  | ShelleyTxCmdLocalStateQueryError !ShelleyQueryCmdLocalStateQueryError

  deriving Int -> ShelleyTxCmdError -> ShowS
[ShelleyTxCmdError] -> ShowS
ShelleyTxCmdError -> String
(Int -> ShelleyTxCmdError -> ShowS)
-> (ShelleyTxCmdError -> String)
-> ([ShelleyTxCmdError] -> ShowS)
-> Show ShelleyTxCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyTxCmdError] -> ShowS
$cshowList :: [ShelleyTxCmdError] -> ShowS
show :: ShelleyTxCmdError -> String
$cshow :: ShelleyTxCmdError -> String
showsPrec :: Int -> ShelleyTxCmdError -> ShowS
$cshowsPrec :: Int -> ShelleyTxCmdError -> ShowS
Show


renderShelleyTxCmdError :: ShelleyTxCmdError -> Text
renderShelleyTxCmdError :: ShelleyTxCmdError -> Text
renderShelleyTxCmdError ShelleyTxCmdError
err =
  case ShelleyTxCmdError
err of
    ShelleyTxCmdReadFileError FileError ()
fileErr -> String -> Text
Text.pack (FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fileErr)
    ShelleyTxCmdReadTextViewFileError FileError TextEnvelopeError
fileErr -> String -> Text
Text.pack (FileError TextEnvelopeError -> String
forall e. Error e => e -> String
displayError FileError TextEnvelopeError
fileErr)
    ShelleyTxCmdScriptFileError FileError ScriptDecodeError
fileErr -> String -> Text
Text.pack (FileError ScriptDecodeError -> String
forall e. Error e => e -> String
displayError FileError ScriptDecodeError
fileErr)
    ShelleyTxCmdReadWitnessSigningDataError ReadWitnessSigningDataError
witSignDataErr ->
      ReadWitnessSigningDataError -> Text
renderReadWitnessSigningDataError ReadWitnessSigningDataError
witSignDataErr
    ShelleyTxCmdWriteFileError FileError ()
fileErr -> String -> Text
Text.pack (FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fileErr)
    ShelleyTxCmdMetadataJsonParseError String
fp String
jsonErr ->
       Text
"Invalid JSON format in file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show String
fp
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nJSON parse error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
jsonErr
    ShelleyTxCmdMetadataConversionError String
fp TxMetadataJsonError
metadataErr ->
       Text
"Error reading metadata at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show String
fp
                             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (TxMetadataJsonError -> String
forall e. Error e => e -> String
displayError TxMetadataJsonError
metadataErr)
    ShelleyTxCmdMetaDecodeError String
fp DecoderError
metadataErr ->
       Text
"Error decoding CBOR metadata at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show String
fp
                             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show DecoderError
metadataErr
    ShelleyTxCmdMetaValidationError String
fp [(Word64, TxMetadataRangeError)]
errs ->
      Text
"Error validating transaction metadata at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text -> [Text] -> Text
Text.intercalate Text
"\n"
        [ Text
"key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (TxMetadataRangeError -> String
forall e. Error e => e -> String
displayError TxMetadataRangeError
valErr)
        | (Word64
k, TxMetadataRangeError
valErr) <- [(Word64, TxMetadataRangeError)]
errs ]

    ShelleyTxCmdScriptDataJsonParseError  String
fp String
jsonErr ->
       Text
"Invalid JSON format in file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       Text
"\nJSON parse error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
jsonErr
    ShelleyTxCmdScriptDataConversionError String
fp ScriptDataJsonError
cerr ->
       Text
"Error reading metadata at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show String
fp
                             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ScriptDataJsonError -> String
forall e. Error e => e -> String
displayError ScriptDataJsonError
cerr)
    ShelleyTxCmdScriptDataValidationError String
fp ScriptDataRangeError
verr ->
      Text
"Error validating script data at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      String -> Text
Text.pack (ScriptDataRangeError -> String
forall e. Error e => e -> String
displayError ScriptDataRangeError
verr)

    ShelleyTxCmdSocketEnvError EnvSocketError
envSockErr -> EnvSocketError -> Text
renderEnvSocketError EnvSocketError
envSockErr
    ShelleyTxCmdAesonDecodeProtocolParamsError String
fp Text
decErr ->
      Text
"Error while decoding the protocol parameters at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show String
fp
                                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Text
decErr
    ShelleyTxCmdTxSubmitError Text
res -> Text
"Error while submitting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
res
    ShelleyTxCmdTxSubmitErrorByron ApplyTxErr ByronBlock
res ->
      Text
"Error while submitting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ApplyMempoolPayloadErr -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ApplyMempoolPayloadErr
ApplyTxErr ByronBlock
res)
    ShelleyTxCmdTxSubmitErrorShelley ApplyTxErr (ShelleyBlock StandardShelley)
res ->
      Text
"Error while submitting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ApplyTxError StandardShelley -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ApplyTxErr (ShelleyBlock StandardShelley)
ApplyTxError StandardShelley
res)
    ShelleyTxCmdTxSubmitErrorAllegra ApplyTxErr (ShelleyBlock StandardAllegra)
res ->
      Text
"Error while submitting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ApplyTxError StandardAllegra -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ApplyTxErr (ShelleyBlock StandardAllegra)
ApplyTxError StandardAllegra
res)
    ShelleyTxCmdTxSubmitErrorMary ApplyTxErr (ShelleyBlock StandardMary)
res ->
      Text
"Error while submitting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ApplyTxError StandardMary -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ApplyTxErr (ShelleyBlock StandardMary)
ApplyTxError StandardMary
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. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
"The node is running in the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ledgerEraName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
" era, but the transaction is for the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
otherEraName Text -> Text -> Text
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      AnyCardanoEra -> Text
renderEra AnyCardanoEra
era Text -> Text -> Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" cannot be used for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Text
renderEra AnyCardanoEra
era Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
" era transactions."

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

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

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

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

    ShelleyTxCmdScriptExpectedSimple String
file (AnyScriptLanguage ScriptLanguage lang
lang) ->
      String -> Text
Text.pack String
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": expected a script in the simple script language, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
"but it is actually using " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ScriptLanguage lang -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show ScriptLanguage lang
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Alternatively, to use " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
"a Plutus script, you must also specify the redeemer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
"(datum if appropriate) and script execution units."

    ShelleyTxCmdScriptExpectedPlutus String
file (AnyScriptLanguage ScriptLanguage lang
lang) ->
      String -> Text
Text.pack String
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": expected a script in the Plutus script language, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
"but it is actually using " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ScriptLanguage lang -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show ScriptLanguage lang
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."

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

    ShelleyTxCmdPolicyIdsExcess [PolicyId]
policyids ->
      Text
"A script provided to witness minting does not correspond to the policy \
      \id of any asset specified in the \"--mint\" field. The script hash is: "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " ((PolicyId -> Text) -> [PolicyId] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map PolicyId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText [PolicyId]
policyids)
    ShelleyTxCmdAcquireFailure AcquireFailure
acquireFail -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ AcquireFailure -> String
forall a b. (Show a, ConvertText String b) => a -> b
show AcquireFailure
acquireFail
    ShelleyTxCmdUnsupportedMode AnyConsensusMode
mode -> Text
"Unsupported mode: " Text -> Text -> Text
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 TxBodyFile
fp AnyConsensusMode
mode AnyCardanoEra
era ->
       Text
"Cannot balance " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Text
renderEra AnyCardanoEra
era Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" era transaction body (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxBodyFile -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show TxBodyFile
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       Text
") because is not supported in the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AnyConsensusMode -> Text
renderMode AnyConsensusMode
mode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" consensus mode."
    ShelleyTxCmdEraConsensusModeMismatchQuery (AnyConsensusMode ConsensusMode mode
cMode) (AnyCardanoEra CardanoEra era
era) ->
      Text
"Consensus mode and era mismatch. Consensus mode: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConsensusMode mode -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show ConsensusMode mode
cMode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
" Era: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CardanoEra era -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show CardanoEra era
era
    ShelleyTxCmdError
ShelleyTxCmdByronEraQuery -> Text
"Query not available in Byron era"
    ShelleyTxCmdLocalStateQueryError ShelleyQueryCmdLocalStateQueryError
err' -> ShelleyQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError ShelleyQueryCmdLocalStateQueryError
err'
    ShelleyTxCmdBalanceTxBody TxBodyErrorAutoBalance
err' -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TxBodyErrorAutoBalance -> String
forall e. Error e => e -> String
displayError TxBodyErrorAutoBalance
err'

renderEra :: AnyCardanoEra -> Text
renderEra :: AnyCardanoEra -> Text
renderEra (AnyCardanoEra CardanoEra era
ByronEra)   = Text
"Byron"
renderEra (AnyCardanoEra CardanoEra era
ShelleyEra) = Text
"Shelley"
renderEra (AnyCardanoEra CardanoEra era
AllegraEra) = Text
"Allegra"
renderEra (AnyCardanoEra CardanoEra era
MaryEra)    = Text
"Mary"
renderEra (AnyCardanoEra CardanoEra era
AlonzoEra)  = Text
"Alonzo"

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"

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]
txinsc [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 TxBodyFile
out ->
      AnyCardanoEra
-> AnyConsensusModeParams
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [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
-> TxBodyFile
-> Maybe Word
-> ExceptT ShelleyTxCmdError IO ()
runTxBuild AnyCardanoEra
era AnyConsensusModeParams
consensusModeParams NetworkId
nid Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
txinsc [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 TxBodyFile
out Maybe Word
mOverrideWits
    TxBuildRaw AnyCardanoEra
era Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
txinsc [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 ->
      AnyCardanoEra
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [TxOutAnyEra]
-> Maybe SlotNo
-> Maybe SlotNo
-> Maybe Lovelace
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBodyFile
-> ExceptT ShelleyTxCmdError IO ()
runTxBuildRaw AnyCardanoEra
era Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
txinsc [TxOutAnyEra]
txouts Maybe SlotNo
mLowBound Maybe SlotNo
mUpperBound
                    Maybe Lovelace
fee Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue [(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 TxBodyFile
txinfile [WitnessSigningData]
skfiles Maybe NetworkId
network TxFile
txoutfile ->
      TxBodyFile
-> [WitnessSigningData]
-> Maybe NetworkId
-> TxFile
-> ExceptT ShelleyTxCmdError IO ()
runTxSign TxBodyFile
txinfile [WitnessSigningData]
skfiles Maybe NetworkId
network TxFile
txoutfile
    TxSubmit AnyConsensusModeParams
anyConensusModeParams NetworkId
network String
txFp ->
      AnyConsensusModeParams
-> NetworkId -> String -> ExceptT ShelleyTxCmdError IO ()
runTxSubmit AnyConsensusModeParams
anyConensusModeParams NetworkId
network String
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
    TxCalculateMinValue ProtocolParamsSourceSpec
pParamSpec Value
txOuts -> ProtocolParamsSourceSpec
-> Value -> ExceptT ShelleyTxCmdError IO ()
runTxCalculateMinValue ProtocolParamsSourceSpec
pParamSpec Value
txOuts
    TxHashScriptData ScriptDataOrFile
scriptDataOrFile -> ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO ()
runTxHashScriptData ScriptDataOrFile
scriptDataOrFile
    TxGetTxId InputTxFile
txinfile -> InputTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxGetTxId InputTxFile
txinfile
    TxView InputTxFile
txinfile -> InputTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxView InputTxFile
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
--

runTxBuildRaw
  :: AnyCardanoEra
  -> Maybe ScriptValidity
  -- ^ Mark script as expected to pass or fail validation
  -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
  -- ^ TxIn with potential script witness
  -> [TxIn]
  -- ^ TxIn for collateral
  -> [TxOutAnyEra]
  -> Maybe SlotNo
  -- ^ Tx lower bound
  -> Maybe SlotNo
  -- ^ Tx upper bound
  -> Maybe Lovelace
  -- ^ Tx fee
  -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
  -- ^ Multi-Asset value(s)
  -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> TxMetadataJsonSchema
  -> [ScriptFile]
  -> [MetadataFile]
  -> Maybe ProtocolParamsSourceSpec
  -> Maybe UpdateProposalFile
  -> TxBodyFile
  -> ExceptT ShelleyTxCmdError IO ()
runTxBuildRaw :: AnyCardanoEra
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [TxOutAnyEra]
-> Maybe SlotNo
-> Maybe SlotNo
-> Maybe Lovelace
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBodyFile
-> ExceptT ShelleyTxCmdError IO ()
runTxBuildRaw (AnyCardanoEra CardanoEra era
era)
              Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
inputsAndScripts [TxIn]
inputsCollateral [TxOutAnyEra]
txouts
              Maybe SlotNo
mLowerBound Maybe SlotNo
mUpperBound
              Maybe Lovelace
mFee Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue
              [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals
              TxMetadataJsonSchema
metadataSchema [ScriptFile]
scriptFiles
              [MetadataFile]
metadataFiles Maybe ProtocolParamsSourceSpec
mpparams Maybe UpdateProposalFile
mUpdatePropFile
              (TxBodyFile String
fpath) = do
    TxBodyContent BuildTx era
txBodyContent <-
      TxIns BuildTx era
-> TxInsCollateral era
-> [TxOut era]
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> BuildTxWith BuildTx (TxExtraScriptData era)
-> TxExtraKeyWitnesses era
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
-> TxWithdrawals BuildTx era
-> TxCertificates BuildTx era
-> TxUpdateProposal era
-> TxMintValue BuildTx era
-> BuildTxWith BuildTx (TxScriptValidity era)
-> TxBodyContent BuildTx era
forall build era.
TxIns build era
-> TxInsCollateral era
-> [TxOut era]
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> BuildTxWith build (TxExtraScriptData era)
-> TxExtraKeyWitnesses era
-> BuildTxWith build (Maybe ProtocolParameters)
-> TxWithdrawals build era
-> TxCertificates build era
-> TxUpdateProposal era
-> TxMintValue build era
-> BuildTxWith build (TxScriptValidity era)
-> TxBodyContent build era
TxBodyContent
        (TxIns BuildTx era
 -> TxInsCollateral era
 -> [TxOut era]
 -> TxFee era
 -> (TxValidityLowerBound era, TxValidityUpperBound era)
 -> TxMetadataInEra era
 -> TxAuxScripts era
 -> BuildTxWith BuildTx (TxExtraScriptData era)
 -> TxExtraKeyWitnesses era
 -> BuildTxWith BuildTx (Maybe ProtocolParameters)
 -> TxWithdrawals BuildTx era
 -> TxCertificates BuildTx era
 -> TxUpdateProposal era
 -> TxMintValue BuildTx era
 -> BuildTxWith BuildTx (TxScriptValidity era)
 -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxIns BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxInsCollateral era
      -> [TxOut era]
      -> TxFee era
      -> (TxValidityLowerBound era, TxValidityUpperBound era)
      -> TxMetadataInEra era
      -> TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoEra era
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT ShelleyTxCmdError IO (TxIns BuildTx era)
forall era.
CardanoEra era
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT
     ShelleyTxCmdError
     IO
     [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns  CardanoEra era
era [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
inputsAndScripts
        ExceptT
  ShelleyTxCmdError
  IO
  (TxInsCollateral era
   -> [TxOut era]
   -> TxFee era
   -> (TxValidityLowerBound era, TxValidityUpperBound era)
   -> TxMetadataInEra era
   -> TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxInsCollateral era)
-> ExceptT
     ShelleyTxCmdError
     IO
     ([TxOut era]
      -> TxFee era
      -> (TxValidityLowerBound era, TxValidityUpperBound era)
      -> TxMetadataInEra era
      -> TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> [TxIn] -> ExceptT ShelleyTxCmdError IO (TxInsCollateral era)
forall era.
CardanoEra era
-> [TxIn] -> ExceptT ShelleyTxCmdError IO (TxInsCollateral era)
validateTxInsCollateral
                           CardanoEra era
era [TxIn]
inputsCollateral
        ExceptT
  ShelleyTxCmdError
  IO
  ([TxOut era]
   -> TxFee era
   -> (TxValidityLowerBound era, TxValidityUpperBound era)
   -> TxMetadataInEra era
   -> TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO [TxOut era]
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxFee era
      -> (TxValidityLowerBound era, TxValidityUpperBound era)
      -> TxMetadataInEra era
      -> TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> [TxOutAnyEra] -> ExceptT ShelleyTxCmdError IO [TxOut era]
forall era.
CardanoEra era
-> [TxOutAnyEra] -> ExceptT ShelleyTxCmdError IO [TxOut era]
validateTxOuts CardanoEra era
era [TxOutAnyEra]
txouts
        ExceptT
  ShelleyTxCmdError
  IO
  (TxFee era
   -> (TxValidityLowerBound era, TxValidityUpperBound era)
   -> TxMetadataInEra era
   -> TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxFee era)
-> ExceptT
     ShelleyTxCmdError
     IO
     ((TxValidityLowerBound era, TxValidityUpperBound era)
      -> TxMetadataInEra era
      -> TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe Lovelace -> ExceptT ShelleyTxCmdError IO (TxFee era)
forall era.
CardanoEra era
-> Maybe Lovelace -> ExceptT ShelleyTxCmdError IO (TxFee era)
validateTxFee  CardanoEra era
era Maybe Lovelace
mFee
        ExceptT
  ShelleyTxCmdError
  IO
  ((TxValidityLowerBound era, TxValidityUpperBound era)
   -> TxMetadataInEra era
   -> TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxValidityLowerBound era, TxValidityUpperBound era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxMetadataInEra era
      -> TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) (TxValidityLowerBound era
 -> TxValidityUpperBound era
 -> (TxValidityLowerBound era, TxValidityUpperBound era))
-> ExceptT ShelleyTxCmdError IO (TxValidityLowerBound era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxValidityUpperBound era
      -> (TxValidityLowerBound era, TxValidityUpperBound era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO (TxValidityLowerBound era)
forall era.
CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO (TxValidityLowerBound era)
validateTxValidityLowerBound CardanoEra era
era Maybe SlotNo
mLowerBound
                 ExceptT
  ShelleyTxCmdError
  IO
  (TxValidityUpperBound era
   -> (TxValidityLowerBound era, TxValidityUpperBound era))
-> ExceptT ShelleyTxCmdError IO (TxValidityUpperBound era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxValidityLowerBound era, TxValidityUpperBound era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO (TxValidityUpperBound era)
forall era.
CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO (TxValidityUpperBound era)
validateTxValidityUpperBound CardanoEra era
era Maybe SlotNo
mUpperBound)
        ExceptT
  ShelleyTxCmdError
  IO
  (TxMetadataInEra era
   -> TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
forall era.
CardanoEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
validateTxMetadataInEra  CardanoEra era
era TxMetadataJsonSchema
metadataSchema [MetadataFile]
metadataFiles
        ExceptT
  ShelleyTxCmdError
  IO
  (TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> [ScriptFile] -> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
forall era.
CardanoEra era
-> [ScriptFile] -> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
validateTxAuxScripts     CardanoEra era
era [ScriptFile]
scriptFiles
        ExceptT
  ShelleyTxCmdError
  IO
  (BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxExtraScriptData era))
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BuildTxWith BuildTx (TxExtraScriptData era)
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxExtraScriptData era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxExtraScriptData era
-> BuildTxWith BuildTx (TxExtraScriptData era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith TxExtraScriptData era
forall era. TxExtraScriptData era
TxExtraScriptDataNone) --TODO alonzo: support this
        ExceptT
  ShelleyTxCmdError
  IO
  (TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxExtraKeyWitnesses era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxExtraKeyWitnesses era
-> ExceptT ShelleyTxCmdError IO (TxExtraKeyWitnesses era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxExtraKeyWitnesses era
forall era. TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone --TODO alonzo: support this
        ExceptT
  ShelleyTxCmdError
  IO
  (BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe ProtocolParamsSourceSpec
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
forall era.
CardanoEra era
-> Maybe ProtocolParamsSourceSpec
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters CardanoEra era
era Maybe ProtocolParamsSourceSpec
mpparams
        ExceptT
  ShelleyTxCmdError
  IO
  (TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
forall era.
CardanoEra era
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
validateTxWithdrawals    CardanoEra era
era [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals
        ExceptT
  ShelleyTxCmdError
  IO
  (TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
forall era.
CardanoEra era
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
validateTxCertificates   CardanoEra era
era [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles
        ExceptT
  ShelleyTxCmdError
  IO
  (TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe UpdateProposalFile
-> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
forall era.
CardanoEra era
-> Maybe UpdateProposalFile
-> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
validateTxUpdateProposal CardanoEra era
era Maybe UpdateProposalFile
mUpdatePropFile
        ExceptT
  ShelleyTxCmdError
  IO
  (TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
forall era.
CardanoEra era
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
validateTxMintValue      CardanoEra era
era Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue
        ExceptT
  ShelleyTxCmdError
  IO
  (BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
-> ExceptT ShelleyTxCmdError IO (TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe ScriptValidity
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
forall era.
CardanoEra era
-> Maybe ScriptValidity
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
validateTxScriptValidity CardanoEra era
era Maybe ScriptValidity
mScriptValidity

    TxBody era
txBody <-
      (TxBodyError -> ShelleyTxCmdError)
-> ExceptT TxBodyError IO (TxBody era)
-> ExceptT ShelleyTxCmdError IO (TxBody era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT TxBodyError -> ShelleyTxCmdError
ShelleyTxCmdTxBodyError (ExceptT TxBodyError IO (TxBody era)
 -> ExceptT ShelleyTxCmdError IO (TxBody era))
-> (Either TxBodyError (TxBody era)
    -> ExceptT TxBodyError IO (TxBody era))
-> Either TxBodyError (TxBody era)
-> ExceptT ShelleyTxCmdError IO (TxBody era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either TxBodyError (TxBody era)
-> ExceptT TxBodyError IO (TxBody era)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TxBodyError (TxBody era)
 -> ExceptT ShelleyTxCmdError IO (TxBody era))
-> Either TxBodyError (TxBody era)
-> ExceptT ShelleyTxCmdError IO (TxBody era)
forall a b. (a -> b) -> a -> b
$
        TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
forall era.
IsCardanoEra era =>
TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
makeTransactionBody TxBodyContent BuildTx era
txBodyContent

    (FileError () -> ShelleyTxCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyTxCmdError
ShelleyTxCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT ShelleyTxCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyTxCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT ShelleyTxCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT ShelleyTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      String
-> Maybe TextEnvelopeDescr
-> TxBody era
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
fpath Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing TxBody era
txBody


runTxBuild
  :: AnyCardanoEra
  -> AnyConsensusModeParams
  -> NetworkId
  -> Maybe ScriptValidity
  -- ^ Mark script as expected to pass or fail validation
  -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
  -- ^ TxIn with potential script witness
  -> [TxIn]
  -- ^ TxIn for collateral
  -> [TxOutAnyEra]
  -- ^ Normal outputs
  -> TxOutChangeAddress
  -- ^ A change output
  -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
  -- ^ Multi-Asset value(s)
  -> Maybe SlotNo
  -- ^ Tx lower bound
  -> Maybe SlotNo
  -- ^ Tx upper bound
  -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> TxMetadataJsonSchema
  -> [ScriptFile]
  -> [MetadataFile]
  -> Maybe ProtocolParamsSourceSpec
  -> Maybe UpdateProposalFile
  -> TxBodyFile
  -> Maybe Word
  -> ExceptT ShelleyTxCmdError IO ()
runTxBuild :: AnyCardanoEra
-> AnyConsensusModeParams
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [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
-> TxBodyFile
-> Maybe Word
-> ExceptT ShelleyTxCmdError IO ()
runTxBuild (AnyCardanoEra CardanoEra era
era) (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
networkId Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
txinsc [TxOutAnyEra]
txouts
           (TxOutChangeAddress AddressAny
changeAddr) Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue Maybe SlotNo
mLowerBound Maybe SlotNo
mUpperBound [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals
           TxMetadataJsonSchema
metadataSchema [ScriptFile]
scriptFiles [MetadataFile]
metadataFiles Maybe ProtocolParamsSourceSpec
mpparams Maybe UpdateProposalFile
mUpdatePropFile outBody :: TxBodyFile
outBody@(TxBodyFile String
fpath)
           Maybe Word
mOverrideWits = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyTxCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyTxCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyTxCmdError
ShelleyTxCmdSocketEnvError ExceptT EnvSocketError IO SocketPath
readEnvSocketPath

  let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
networkId String
sockPath
      consensusMode :: ConsensusMode mode
consensusMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
      dummyFee :: Maybe Lovelace
dummyFee = Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Lovelace -> Maybe Lovelace) -> Lovelace -> Maybe Lovelace
forall a b. (a -> b) -> a -> b
$ Integer -> Lovelace
Lovelace Integer
0
      onlyInputs :: [TxIn]
onlyInputs = [TxIn
input | (TxIn
input,Maybe (ScriptWitnessFiles WitCtxTxIn)
_) <- [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins]
  case (ConsensusMode mode
consensusMode, CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era) of
    (ConsensusMode mode
CardanoMode, ShelleyBasedEra ShelleyBasedEra era
sbe) -> do
      TxBodyContent BuildTx era
txBodyContent <-
        TxIns BuildTx era
-> TxInsCollateral era
-> [TxOut era]
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> BuildTxWith BuildTx (TxExtraScriptData era)
-> TxExtraKeyWitnesses era
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
-> TxWithdrawals BuildTx era
-> TxCertificates BuildTx era
-> TxUpdateProposal era
-> TxMintValue BuildTx era
-> BuildTxWith BuildTx (TxScriptValidity era)
-> TxBodyContent BuildTx era
forall build era.
TxIns build era
-> TxInsCollateral era
-> [TxOut era]
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> BuildTxWith build (TxExtraScriptData era)
-> TxExtraKeyWitnesses era
-> BuildTxWith build (Maybe ProtocolParameters)
-> TxWithdrawals build era
-> TxCertificates build era
-> TxUpdateProposal era
-> TxMintValue build era
-> BuildTxWith build (TxScriptValidity era)
-> TxBodyContent build era
TxBodyContent
          (TxIns BuildTx era
 -> TxInsCollateral era
 -> [TxOut era]
 -> TxFee era
 -> (TxValidityLowerBound era, TxValidityUpperBound era)
 -> TxMetadataInEra era
 -> TxAuxScripts era
 -> BuildTxWith BuildTx (TxExtraScriptData era)
 -> TxExtraKeyWitnesses era
 -> BuildTxWith BuildTx (Maybe ProtocolParameters)
 -> TxWithdrawals BuildTx era
 -> TxCertificates BuildTx era
 -> TxUpdateProposal era
 -> TxMintValue BuildTx era
 -> BuildTxWith BuildTx (TxScriptValidity era)
 -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxIns BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxInsCollateral era
      -> [TxOut era]
      -> TxFee era
      -> (TxValidityLowerBound era, TxValidityUpperBound era)
      -> TxMetadataInEra era
      -> TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoEra era
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT ShelleyTxCmdError IO (TxIns BuildTx era)
forall era.
CardanoEra era
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT
     ShelleyTxCmdError
     IO
     [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns               CardanoEra era
era [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins
          ExceptT
  ShelleyTxCmdError
  IO
  (TxInsCollateral era
   -> [TxOut era]
   -> TxFee era
   -> (TxValidityLowerBound era, TxValidityUpperBound era)
   -> TxMetadataInEra era
   -> TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxInsCollateral era)
-> ExceptT
     ShelleyTxCmdError
     IO
     ([TxOut era]
      -> TxFee era
      -> (TxValidityLowerBound era, TxValidityUpperBound era)
      -> TxMetadataInEra era
      -> TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> [TxIn] -> ExceptT ShelleyTxCmdError IO (TxInsCollateral era)
forall era.
CardanoEra era
-> [TxIn] -> ExceptT ShelleyTxCmdError IO (TxInsCollateral era)
validateTxInsCollateral     CardanoEra era
era [TxIn]
txinsc
          ExceptT
  ShelleyTxCmdError
  IO
  ([TxOut era]
   -> TxFee era
   -> (TxValidityLowerBound era, TxValidityUpperBound era)
   -> TxMetadataInEra era
   -> TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO [TxOut era]
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxFee era
      -> (TxValidityLowerBound era, TxValidityUpperBound era)
      -> TxMetadataInEra era
      -> TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> [TxOutAnyEra] -> ExceptT ShelleyTxCmdError IO [TxOut era]
forall era.
CardanoEra era
-> [TxOutAnyEra] -> ExceptT ShelleyTxCmdError IO [TxOut era]
validateTxOuts              CardanoEra era
era [TxOutAnyEra]
txouts
          ExceptT
  ShelleyTxCmdError
  IO
  (TxFee era
   -> (TxValidityLowerBound era, TxValidityUpperBound era)
   -> TxMetadataInEra era
   -> TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxFee era)
-> ExceptT
     ShelleyTxCmdError
     IO
     ((TxValidityLowerBound era, TxValidityUpperBound era)
      -> TxMetadataInEra era
      -> TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe Lovelace -> ExceptT ShelleyTxCmdError IO (TxFee era)
forall era.
CardanoEra era
-> Maybe Lovelace -> ExceptT ShelleyTxCmdError IO (TxFee era)
validateTxFee               CardanoEra era
era Maybe Lovelace
dummyFee
          ExceptT
  ShelleyTxCmdError
  IO
  ((TxValidityLowerBound era, TxValidityUpperBound era)
   -> TxMetadataInEra era
   -> TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxValidityLowerBound era, TxValidityUpperBound era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxMetadataInEra era
      -> TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) (TxValidityLowerBound era
 -> TxValidityUpperBound era
 -> (TxValidityLowerBound era, TxValidityUpperBound era))
-> ExceptT ShelleyTxCmdError IO (TxValidityLowerBound era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxValidityUpperBound era
      -> (TxValidityLowerBound era, TxValidityUpperBound era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO (TxValidityLowerBound era)
forall era.
CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO (TxValidityLowerBound era)
validateTxValidityLowerBound CardanoEra era
era Maybe SlotNo
mLowerBound
                   ExceptT
  ShelleyTxCmdError
  IO
  (TxValidityUpperBound era
   -> (TxValidityLowerBound era, TxValidityUpperBound era))
-> ExceptT ShelleyTxCmdError IO (TxValidityUpperBound era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxValidityLowerBound era, TxValidityUpperBound era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO (TxValidityUpperBound era)
forall era.
CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO (TxValidityUpperBound era)
validateTxValidityUpperBound CardanoEra era
era Maybe SlotNo
mUpperBound)
          ExceptT
  ShelleyTxCmdError
  IO
  (TxMetadataInEra era
   -> TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
forall era.
CardanoEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
validateTxMetadataInEra     CardanoEra era
era TxMetadataJsonSchema
metadataSchema [MetadataFile]
metadataFiles
          ExceptT
  ShelleyTxCmdError
  IO
  (TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> [ScriptFile] -> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
forall era.
CardanoEra era
-> [ScriptFile] -> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
validateTxAuxScripts        CardanoEra era
era [ScriptFile]
scriptFiles
          ExceptT
  ShelleyTxCmdError
  IO
  (BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxExtraScriptData era))
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BuildTxWith BuildTx (TxExtraScriptData era)
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxExtraScriptData era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxExtraScriptData era
-> BuildTxWith BuildTx (TxExtraScriptData era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith TxExtraScriptData era
forall era. TxExtraScriptData era
TxExtraScriptDataNone) --TODO alonzo: support this
          ExceptT
  ShelleyTxCmdError
  IO
  (TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxExtraKeyWitnesses era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxExtraKeyWitnesses era
-> ExceptT ShelleyTxCmdError IO (TxExtraKeyWitnesses era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxExtraKeyWitnesses era
forall era. TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone --TODO alonzo: support this
          ExceptT
  ShelleyTxCmdError
  IO
  (BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe ProtocolParamsSourceSpec
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
forall era.
CardanoEra era
-> Maybe ProtocolParamsSourceSpec
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters  CardanoEra era
era Maybe ProtocolParamsSourceSpec
mpparams
          ExceptT
  ShelleyTxCmdError
  IO
  (TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
forall era.
CardanoEra era
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
validateTxWithdrawals       CardanoEra era
era [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals
          ExceptT
  ShelleyTxCmdError
  IO
  (TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
forall era.
CardanoEra era
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
validateTxCertificates      CardanoEra era
era [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles
          ExceptT
  ShelleyTxCmdError
  IO
  (TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxMintValue BuildTx era
      -> BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe UpdateProposalFile
-> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
forall era.
CardanoEra era
-> Maybe UpdateProposalFile
-> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
validateTxUpdateProposal    CardanoEra era
era Maybe UpdateProposalFile
mUpdatePropFile
          ExceptT
  ShelleyTxCmdError
  IO
  (TxMintValue BuildTx era
   -> BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (TxScriptValidity era)
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
forall era.
CardanoEra era
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
validateTxMintValue         CardanoEra era
era Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue
          ExceptT
  ShelleyTxCmdError
  IO
  (BuildTxWith BuildTx (TxScriptValidity era)
   -> TxBodyContent BuildTx era)
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
-> ExceptT ShelleyTxCmdError IO (TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoEra era
-> Maybe ScriptValidity
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
forall era.
CardanoEra era
-> Maybe ScriptValidity
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
validateTxScriptValidity    CardanoEra era
era Maybe ScriptValidity
mScriptValidity

      -- TODO: Combine queries
      let localConnInfo :: LocalNodeConnectInfo CardanoMode
localConnInfo = LocalNodeConnectInfo :: forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo
                            { localConsensusModeParams :: ConsensusModeParams CardanoMode
localConsensusModeParams = EpochSlots -> ConsensusModeParams CardanoMode
CardanoModeParams (Word64 -> EpochSlots
EpochSlots Word64
21600)
                            , localNodeNetworkId :: NetworkId
localNodeNetworkId       = NetworkId
networkId
                            , localNodeSocketPath :: String
localNodeSocketPath      = String
sockPath
                            }

      EraInMode era CardanoMode
eInMode <- case CardanoEra era
-> ConsensusMode CardanoMode -> Maybe (EraInMode era CardanoMode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode CardanoMode
CardanoMode of
                   Just EraInMode era CardanoMode
result -> EraInMode era CardanoMode
-> ExceptT ShelleyTxCmdError IO (EraInMode era CardanoMode)
forall (m :: * -> *) a. Monad m => a -> m a
return EraInMode era CardanoMode
result
                   Maybe (EraInMode era CardanoMode)
Nothing ->
                     ShelleyTxCmdError
-> ExceptT ShelleyTxCmdError IO (EraInMode era CardanoMode)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxBodyFile
-> AnyConsensusMode -> AnyCardanoEra -> ShelleyTxCmdError
ShelleyTxCmdEraConsensusModeMismatchTxBalance TxBodyFile
outBody
                            (ConsensusMode CardanoMode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode CardanoMode
CardanoMode) (CardanoEra era -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era))

      let utxoQuery :: QueryInMode CardanoMode (Either EraMismatch (UTxO era))
utxoQuery = EraInMode era CardanoMode
-> QueryInEra era (UTxO era)
-> QueryInMode CardanoMode (Either EraMismatch (UTxO era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era CardanoMode
eInMode (QueryInEra era (UTxO era)
 -> QueryInMode CardanoMode (Either EraMismatch (UTxO era)))
-> QueryInEra era (UTxO era)
-> QueryInMode CardanoMode (Either EraMismatch (UTxO era))
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era (UTxO era)
-> QueryInEra era (UTxO era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe
                        (QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
QueryUTxO (QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era))
-> (Set TxIn -> QueryUTxOFilter)
-> Set TxIn
-> QueryInShelleyBasedEra era (UTxO era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Set TxIn -> QueryUTxOFilter
QueryUTxOByTxIn (Set TxIn -> QueryInShelleyBasedEra era (UTxO era))
-> Set TxIn -> QueryInShelleyBasedEra era (UTxO era)
forall a b. (a -> b) -> a -> b
$ [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxIn]
onlyInputs)
      let pParamsQuery :: QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
pParamsQuery = EraInMode era CardanoMode
-> QueryInEra era ProtocolParameters
-> QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era CardanoMode
eInMode (QueryInEra era ProtocolParameters
 -> QueryInMode CardanoMode (Either EraMismatch ProtocolParameters))
-> QueryInEra era ProtocolParameters
-> QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era ProtocolParameters
-> QueryInEra era ProtocolParameters
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era ProtocolParameters
forall era. QueryInShelleyBasedEra era ProtocolParameters
QueryProtocolParameters
      UTxO era
utxo <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch (UTxO era))
-> ExceptT ShelleyTxCmdError IO (UTxO era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyTxCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
LocalNodeConnectInfo CardanoMode
localConnInfo QueryInMode mode (Either EraMismatch (UTxO era))
QueryInMode CardanoMode (Either EraMismatch (UTxO era))
utxoQuery
      ProtocolParameters
pparams <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyTxCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
LocalNodeConnectInfo CardanoMode
localConnInfo QueryInMode mode (Either EraMismatch ProtocolParameters)
QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
pParamsQuery
      (EraHistory CardanoMode
eraHistory, SystemStart
systemStart) <- (AcquireFailure -> ShelleyTxCmdError)
-> ExceptT AcquireFailure IO (EraHistory CardanoMode, SystemStart)
-> ExceptT
     ShelleyTxCmdError IO (EraHistory CardanoMode, SystemStart)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyTxCmdError
ShelleyTxCmdAcquireFailure
                                     (ExceptT AcquireFailure IO (EraHistory CardanoMode, SystemStart)
 -> ExceptT
      ShelleyTxCmdError IO (EraHistory CardanoMode, SystemStart))
-> ExceptT AcquireFailure IO (EraHistory CardanoMode, SystemStart)
-> ExceptT
     ShelleyTxCmdError IO (EraHistory CardanoMode, SystemStart)
forall a b. (a -> b) -> a -> b
$ IO (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
-> ExceptT AcquireFailure IO (EraHistory CardanoMode, SystemStart)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
 -> ExceptT AcquireFailure IO (EraHistory CardanoMode, SystemStart))
-> IO (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
-> ExceptT AcquireFailure IO (EraHistory CardanoMode, SystemStart)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo CardanoMode
-> Maybe ChainPoint
-> IO (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
queryEraHistoryAndSystemStart LocalNodeConnectInfo mode
LocalNodeConnectInfo CardanoMode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing

      let cAddr :: AddressInEra era
cAddr = case CardanoEra era -> AddressAny -> Maybe (AddressInEra era)
forall era.
CardanoEra era -> AddressAny -> Maybe (AddressInEra era)
anyAddressInEra CardanoEra era
era AddressAny
changeAddr of
                    Just AddressInEra era
addr -> AddressInEra era
addr
                    Maybe (AddressInEra era)
Nothing -> String -> AddressInEra era
forall a. HasCallStack => String -> a
error (String -> AddressInEra era) -> String -> AddressInEra era
forall a b. (a -> b) -> a -> b
$ String
"runTxBuild: Byron address used: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> AddressAny -> String
forall a b. (Show a, ConvertText String b) => a -> b
show AddressAny
changeAddr

      TxBody era
balancedTxBody <-
        (TxBodyErrorAutoBalance -> ShelleyTxCmdError)
-> ExceptT TxBodyErrorAutoBalance IO (TxBody era)
-> ExceptT ShelleyTxCmdError IO (TxBody era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT TxBodyErrorAutoBalance -> ShelleyTxCmdError
ShelleyTxCmdBalanceTxBody
          (ExceptT TxBodyErrorAutoBalance IO (TxBody era)
 -> ExceptT ShelleyTxCmdError IO (TxBody era))
-> (Either TxBodyErrorAutoBalance (TxBody era)
    -> ExceptT TxBodyErrorAutoBalance IO (TxBody era))
-> Either TxBodyErrorAutoBalance (TxBody era)
-> ExceptT ShelleyTxCmdError IO (TxBody era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either TxBodyErrorAutoBalance (TxBody era)
-> ExceptT TxBodyErrorAutoBalance IO (TxBody era)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
          (Either TxBodyErrorAutoBalance (TxBody era)
 -> ExceptT ShelleyTxCmdError IO (TxBody era))
-> Either TxBodyErrorAutoBalance (TxBody era)
-> ExceptT ShelleyTxCmdError IO (TxBody era)
forall a b. (a -> b) -> a -> b
$ EraInMode era CardanoMode
-> SystemStart
-> EraHistory CardanoMode
-> ProtocolParameters
-> Set PoolId
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either TxBodyErrorAutoBalance (TxBody era)
forall era mode.
IsShelleyBasedEra era =>
EraInMode era mode
-> SystemStart
-> EraHistory mode
-> ProtocolParameters
-> Set PoolId
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either TxBodyErrorAutoBalance (TxBody era)
makeTransactionBodyAutoBalance EraInMode era CardanoMode
eInMode SystemStart
systemStart EraHistory CardanoMode
eraHistory
                                           ProtocolParameters
pparams Set PoolId
forall a. Set a
Set.empty UTxO era
utxo TxBodyContent BuildTx era
txBodyContent
                                           AddressInEra era
cAddr Maybe Word
mOverrideWits

      (FileError () -> ShelleyTxCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyTxCmdError
ShelleyTxCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT ShelleyTxCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyTxCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
        (IO (Either (FileError ()) ()) -> ExceptT ShelleyTxCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT ShelleyTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> TxBody era
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
fpath Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing TxBody era
balancedTxBody

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

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

queryEraHistoryAndSystemStart
  :: LocalNodeConnectInfo CardanoMode
  -> Maybe ChainPoint
  -> IO (Either Net.Query.AcquireFailure (EraHistory CardanoMode, SystemStart))
queryEraHistoryAndSystemStart :: LocalNodeConnectInfo CardanoMode
-> Maybe ChainPoint
-> IO (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
queryEraHistoryAndSystemStart LocalNodeConnectInfo CardanoMode
connctInfo Maybe ChainPoint
mpoint = do
    TMVar (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
resultVar <- IO
  (TMVar
     (Either AcquireFailure (EraHistory CardanoMode, SystemStart)))
forall a. IO (TMVar a)
newEmptyTMVarIO
    LocalNodeConnectInfo CardanoMode
-> LocalNodeClientProtocolsInMode CardanoMode -> IO ()
forall mode.
LocalNodeConnectInfo mode
-> LocalNodeClientProtocolsInMode mode -> IO ()
connectToLocalNode
      LocalNodeConnectInfo CardanoMode
connctInfo
      LocalNodeClientProtocols :: forall block point tip tx txerr (query :: * -> *) (m :: * -> *).
LocalChainSyncClient block point tip m
-> Maybe (LocalTxSubmissionClient tx txerr m ())
-> Maybe (LocalStateQueryClient block point query m ())
-> LocalNodeClientProtocols block point tip tx txerr query m
LocalNodeClientProtocols
      { localChainSyncClient :: LocalChainSyncClient
  (BlockInMode CardanoMode) ChainPoint ChainTip IO
localChainSyncClient    = LocalChainSyncClient
  (BlockInMode CardanoMode) ChainPoint ChainTip IO
forall block point tip (m :: * -> *).
LocalChainSyncClient block point tip m
NoLocalChainSyncClient
      , localStateQueryClient :: Maybe
  (LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ())
localStateQueryClient   = LocalStateQueryClient
  (BlockInMode CardanoMode)
  ChainPoint
  (QueryInMode CardanoMode)
  IO
  ()
-> Maybe
     (LocalStateQueryClient
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall a. a -> Maybe a
Just (Maybe ChainPoint
-> TMVar
     (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
-> LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
singleQuery Maybe ChainPoint
mpoint TMVar (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
resultVar)
      , localTxSubmissionClient :: Maybe
  (LocalTxSubmissionClient
     (TxInMode CardanoMode) (TxValidationErrorInMode CardanoMode) IO ())
localTxSubmissionClient = Maybe
  (LocalTxSubmissionClient
     (TxInMode CardanoMode) (TxValidationErrorInMode CardanoMode) IO ())
forall a. Maybe a
Nothing
      }
    STM (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
-> IO (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
forall a. STM a -> IO a
atomically (TMVar (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
-> STM
     (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
forall a. TMVar a -> STM a
takeTMVar TMVar (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
resultVar)
  where
    singleQuery
      :: Maybe ChainPoint
      -> TMVar (Either Net.Query.AcquireFailure (EraHistory CardanoMode, SystemStart))
      -> Net.Query.LocalStateQueryClient (BlockInMode CardanoMode) ChainPoint
                                         (QueryInMode CardanoMode) IO ()
    singleQuery :: Maybe ChainPoint
-> TMVar
     (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
-> LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
singleQuery Maybe ChainPoint
mPointVar' TMVar (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
resultVar' =
      IO
  (ClientStIdle
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ())
-> LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall block point (query :: * -> *) (m :: * -> *) a.
m (ClientStIdle block point query m a)
-> LocalStateQueryClient block point query m a
LocalStateQueryClient (IO
   (ClientStIdle
      (BlockInMode CardanoMode)
      ChainPoint
      (QueryInMode CardanoMode)
      IO
      ())
 -> LocalStateQueryClient
      (BlockInMode CardanoMode)
      ChainPoint
      (QueryInMode CardanoMode)
      IO
      ())
-> IO
     (ClientStIdle
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
-> LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall a b. (a -> b) -> a -> b
$ do
      ClientStIdle
  (BlockInMode CardanoMode)
  ChainPoint
  (QueryInMode CardanoMode)
  IO
  ()
-> IO
     (ClientStIdle
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle
   (BlockInMode CardanoMode)
   ChainPoint
   (QueryInMode CardanoMode)
   IO
   ()
 -> IO
      (ClientStIdle
         (BlockInMode CardanoMode)
         ChainPoint
         (QueryInMode CardanoMode)
         IO
         ()))
-> (ClientStAcquiring
      (BlockInMode CardanoMode)
      ChainPoint
      (QueryInMode CardanoMode)
      IO
      ()
    -> ClientStIdle
         (BlockInMode CardanoMode)
         ChainPoint
         (QueryInMode CardanoMode)
         IO
         ())
-> ClientStAcquiring
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
-> IO
     (ClientStIdle
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe ChainPoint
-> ClientStAcquiring
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
-> ClientStIdle
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall point block (query :: * -> *) (m :: * -> *) a.
Maybe point
-> ClientStAcquiring block point query m a
-> ClientStIdle block point query m a
Net.Query.SendMsgAcquire Maybe ChainPoint
mPointVar' (ClientStAcquiring
   (BlockInMode CardanoMode)
   ChainPoint
   (QueryInMode CardanoMode)
   IO
   ()
 -> IO
      (ClientStIdle
         (BlockInMode CardanoMode)
         ChainPoint
         (QueryInMode CardanoMode)
         IO
         ()))
-> ClientStAcquiring
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
-> IO
     (ClientStIdle
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall a b. (a -> b) -> a -> b
$
        ClientStAcquiring :: forall block point (query :: * -> *) (m :: * -> *) a.
m (ClientStAcquired block point query m a)
-> (AcquireFailure -> m (ClientStIdle block point query m a))
-> ClientStAcquiring block point query m a
Net.Query.ClientStAcquiring
        { recvMsgAcquired :: IO
  (ClientStAcquired
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ())
Net.Query.recvMsgAcquired =
          ClientStAcquired
  (BlockInMode CardanoMode)
  ChainPoint
  (QueryInMode CardanoMode)
  IO
  ()
-> IO
     (ClientStAcquired
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired
   (BlockInMode CardanoMode)
   ChainPoint
   (QueryInMode CardanoMode)
   IO
   ()
 -> IO
      (ClientStAcquired
         (BlockInMode CardanoMode)
         ChainPoint
         (QueryInMode CardanoMode)
         IO
         ()))
-> ClientStAcquired
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
-> IO
     (ClientStAcquired
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall a b. (a -> b) -> a -> b
$ QueryInMode CardanoMode (EraHistory CardanoMode)
-> ClientStQuerying
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
     (EraHistory CardanoMode)
-> ClientStAcquired
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall (query :: * -> *) result block point (m :: * -> *) a.
query result
-> ClientStQuerying block point query m a result
-> ClientStAcquired block point query m a
Net.Query.SendMsgQuery (ConsensusModeIsMultiEra CardanoMode
-> QueryInMode CardanoMode (EraHistory CardanoMode)
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode (EraHistory mode)
QueryEraHistory ConsensusModeIsMultiEra CardanoMode
CardanoModeIsMultiEra) (ClientStQuerying
   (BlockInMode CardanoMode)
   ChainPoint
   (QueryInMode CardanoMode)
   IO
   ()
   (EraHistory CardanoMode)
 -> ClientStAcquired
      (BlockInMode CardanoMode)
      ChainPoint
      (QueryInMode CardanoMode)
      IO
      ())
-> ClientStQuerying
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
     (EraHistory CardanoMode)
-> ClientStAcquired
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall a b. (a -> b) -> a -> b
$
            ClientStQuerying :: forall block point (query :: * -> *) (m :: * -> *) a result.
(result -> m (ClientStAcquired block point query m a))
-> ClientStQuerying block point query m a result
Net.Query.ClientStQuerying
            { recvMsgResult :: EraHistory CardanoMode
-> IO
     (ClientStAcquired
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
Net.Query.recvMsgResult = \EraHistory CardanoMode
result1 -> do
              ClientStAcquired
  (BlockInMode CardanoMode)
  ChainPoint
  (QueryInMode CardanoMode)
  IO
  ()
-> IO
     (ClientStAcquired
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired
   (BlockInMode CardanoMode)
   ChainPoint
   (QueryInMode CardanoMode)
   IO
   ()
 -> IO
      (ClientStAcquired
         (BlockInMode CardanoMode)
         ChainPoint
         (QueryInMode CardanoMode)
         IO
         ()))
-> ClientStAcquired
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
-> IO
     (ClientStAcquired
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall a b. (a -> b) -> a -> b
$ QueryInMode CardanoMode SystemStart
-> ClientStQuerying
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
     SystemStart
-> ClientStAcquired
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall (query :: * -> *) result block point (m :: * -> *) a.
query result
-> ClientStQuerying block point query m a result
-> ClientStAcquired block point query m a
Net.Query.SendMsgQuery QueryInMode CardanoMode SystemStart
forall mode. QueryInMode mode SystemStart
QuerySystemStart (ClientStQuerying
   (BlockInMode CardanoMode)
   ChainPoint
   (QueryInMode CardanoMode)
   IO
   ()
   SystemStart
 -> ClientStAcquired
      (BlockInMode CardanoMode)
      ChainPoint
      (QueryInMode CardanoMode)
      IO
      ())
-> ClientStQuerying
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
     SystemStart
-> ClientStAcquired
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall a b. (a -> b) -> a -> b
$
                ClientStQuerying :: forall block point (query :: * -> *) (m :: * -> *) a result.
(result -> m (ClientStAcquired block point query m a))
-> ClientStQuerying block point query m a result
Net.Query.ClientStQuerying
                { recvMsgResult :: SystemStart
-> IO
     (ClientStAcquired
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
Net.Query.recvMsgResult = \SystemStart
result2 -> do
                  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
-> Either AcquireFailure (EraHistory CardanoMode, SystemStart)
-> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
resultVar' ((EraHistory CardanoMode, SystemStart)
-> Either AcquireFailure (EraHistory CardanoMode, SystemStart)
forall a b. b -> Either a b
Right (EraHistory CardanoMode
result1, SystemStart
result2))

                  ClientStAcquired
  (BlockInMode CardanoMode)
  ChainPoint
  (QueryInMode CardanoMode)
  IO
  ()
-> IO
     (ClientStAcquired
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired
   (BlockInMode CardanoMode)
   ChainPoint
   (QueryInMode CardanoMode)
   IO
   ()
 -> IO
      (ClientStAcquired
         (BlockInMode CardanoMode)
         ChainPoint
         (QueryInMode CardanoMode)
         IO
         ()))
-> ClientStAcquired
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
-> IO
     (ClientStAcquired
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall a b. (a -> b) -> a -> b
$ IO
  (ClientStIdle
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ())
-> ClientStAcquired
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall (m :: * -> *) block point (query :: * -> *) a.
m (ClientStIdle block point query m a)
-> ClientStAcquired block point query m a
Net.Query.SendMsgRelease (IO
   (ClientStIdle
      (BlockInMode CardanoMode)
      ChainPoint
      (QueryInMode CardanoMode)
      IO
      ())
 -> ClientStAcquired
      (BlockInMode CardanoMode)
      ChainPoint
      (QueryInMode CardanoMode)
      IO
      ())
-> IO
     (ClientStIdle
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
-> ClientStAcquired
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall a b. (a -> b) -> a -> b
$ ClientStIdle
  (BlockInMode CardanoMode)
  ChainPoint
  (QueryInMode CardanoMode)
  IO
  ()
-> IO
     (ClientStIdle
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle
   (BlockInMode CardanoMode)
   ChainPoint
   (QueryInMode CardanoMode)
   IO
   ()
 -> IO
      (ClientStIdle
         (BlockInMode CardanoMode)
         ChainPoint
         (QueryInMode CardanoMode)
         IO
         ()))
-> ClientStIdle
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
-> IO
     (ClientStIdle
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall a b. (a -> b) -> a -> b
$ ()
-> ClientStIdle
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall a block point (query :: * -> *) (m :: * -> *).
a -> ClientStIdle block point query m a
Net.Query.SendMsgDone ()
                }
            }
        , recvMsgFailure :: AcquireFailure
-> IO
     (ClientStIdle
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
Net.Query.recvMsgFailure = \AcquireFailure
failure -> do
            STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
-> Either AcquireFailure (EraHistory CardanoMode, SystemStart)
-> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either AcquireFailure (EraHistory CardanoMode, SystemStart))
resultVar' (AcquireFailure
-> Either AcquireFailure (EraHistory CardanoMode, SystemStart)
forall a b. a -> Either a b
Left AcquireFailure
failure)
            ClientStIdle
  (BlockInMode CardanoMode)
  ChainPoint
  (QueryInMode CardanoMode)
  IO
  ()
-> IO
     (ClientStIdle
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle
   (BlockInMode CardanoMode)
   ChainPoint
   (QueryInMode CardanoMode)
   IO
   ()
 -> IO
      (ClientStIdle
         (BlockInMode CardanoMode)
         ChainPoint
         (QueryInMode CardanoMode)
         IO
         ()))
-> ClientStIdle
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
-> IO
     (ClientStIdle
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall a b. (a -> b) -> a -> b
$ ()
-> ClientStIdle
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall a block point (query :: * -> *) (m :: * -> *).
a -> ClientStIdle block point query m a
Net.Query.SendMsgDone ()
        }


-- ----------------------------------------------------------------------------
-- 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
  deriving Int -> TxFeature -> ShowS
[TxFeature] -> ShowS
TxFeature -> String
(Int -> TxFeature -> ShowS)
-> (TxFeature -> String)
-> ([TxFeature] -> ShowS)
-> Show TxFeature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxFeature] -> ShowS
$cshowList :: [TxFeature] -> ShowS
show :: TxFeature -> String
$cshow :: TxFeature -> String
showsPrec :: Int -> TxFeature -> ShowS
$cshowsPrec :: Int -> TxFeature -> ShowS
Show

txFeatureMismatch :: CardanoEra era
                  -> TxFeature
                  -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch :: CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
feature =
    ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO a
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (AnyCardanoEra -> TxFeature -> ShelleyTxCmdError
ShelleyTxCmdTxFeatureMismatch (CardanoEra era -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era) TxFeature
feature)

validateTxIns
  :: forall era.
     CardanoEra era
  -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
  -> ExceptT ShelleyTxCmdError IO
             [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns :: CardanoEra era
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT
     ShelleyTxCmdError
     IO
     [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns CardanoEra era
era = ((TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
 -> ExceptT
      ShelleyTxCmdError
      IO
      (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)))
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT
     ShelleyTxCmdError
     IO
     [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
convert
 where
   convert
     :: (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
     -> ExceptT ShelleyTxCmdError IO
                (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
   convert :: (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
convert (TxIn
txin, Maybe (ScriptWitnessFiles WitCtxTxIn)
mScriptWitnessFiles) =
     case Maybe (ScriptWitnessFiles WitCtxTxIn)
mScriptWitnessFiles of
       Just ScriptWitnessFiles WitCtxTxIn
scriptWitnessFiles -> do
         ScriptWitness WitCtxTxIn era
sWit <- CardanoEra era
-> ScriptWitnessFiles WitCtxTxIn
-> ExceptT ShelleyTxCmdError IO (ScriptWitness WitCtxTxIn era)
forall era witctx.
CardanoEra era
-> ScriptWitnessFiles witctx
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
createScriptWitness CardanoEra era
era ScriptWitnessFiles WitCtxTxIn
scriptWitnessFiles
         (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
forall (m :: * -> *) a. Monad m => a -> m a
return ( TxIn
txin
                , Witness WitCtxTxIn era
-> BuildTxWith BuildTx (Witness WitCtxTxIn era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn era
 -> BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> Witness WitCtxTxIn era
-> BuildTxWith BuildTx (Witness WitCtxTxIn era)
forall a b. (a -> b) -> a -> b
$ ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn era -> Witness WitCtxTxIn era
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
ScriptWitnessForSpending ScriptWitness WitCtxTxIn era
sWit
                )
       Maybe (ScriptWitnessFiles WitCtxTxIn)
Nothing -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
forall (m :: * -> *) a. Monad m => a -> m a
return (TxIn
txin, Witness WitCtxTxIn era
-> BuildTxWith BuildTx (Witness WitCtxTxIn era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn era
 -> BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> Witness WitCtxTxIn era
-> BuildTxWith BuildTx (Witness WitCtxTxIn era)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn era
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxTxIn
KeyWitnessForSpending)


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


validateTxOuts :: forall era.
                  CardanoEra era
               -> [TxOutAnyEra]
               -> ExceptT ShelleyTxCmdError IO [TxOut era]
validateTxOuts :: CardanoEra era
-> [TxOutAnyEra] -> ExceptT ShelleyTxCmdError IO [TxOut era]
validateTxOuts CardanoEra era
era = (TxOutAnyEra -> ExceptT ShelleyTxCmdError IO (TxOut era))
-> [TxOutAnyEra] -> ExceptT ShelleyTxCmdError IO [TxOut era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxOutAnyEra -> ExceptT ShelleyTxCmdError IO (TxOut era)
toTxOutInAnyEra
  where
    toTxOutInAnyEra :: TxOutAnyEra
                    -> ExceptT ShelleyTxCmdError IO (TxOut era)
    toTxOutInAnyEra :: TxOutAnyEra -> ExceptT ShelleyTxCmdError IO (TxOut era)
toTxOutInAnyEra (TxOutAnyEra AddressAny
addr Value
val Maybe (Hash ScriptData)
mDatumHash) =
      case (CardanoEra era -> Maybe (ScriptDataSupportedInEra era)
forall era. CardanoEra era -> Maybe (ScriptDataSupportedInEra era)
scriptDataSupportedInEra CardanoEra era
era, Maybe (Hash ScriptData)
mDatumHash) of
        (Maybe (ScriptDataSupportedInEra era)
_, Maybe (Hash ScriptData)
Nothing) ->
          AddressInEra era
-> TxOutValue era -> TxOutDatumHash era -> TxOut era
forall era.
AddressInEra era
-> TxOutValue era -> TxOutDatumHash era -> TxOut era
TxOut (AddressInEra era
 -> TxOutValue era -> TxOutDatumHash era -> TxOut era)
-> ExceptT ShelleyTxCmdError IO (AddressInEra era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxOutValue era -> TxOutDatumHash era -> TxOut era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddressAny -> ExceptT ShelleyTxCmdError IO (AddressInEra era)
toAddressInAnyEra AddressAny
addr
                ExceptT
  ShelleyTxCmdError
  IO
  (TxOutValue era -> TxOutDatumHash era -> TxOut era)
-> ExceptT ShelleyTxCmdError IO (TxOutValue era)
-> ExceptT ShelleyTxCmdError IO (TxOutDatumHash era -> TxOut era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> ExceptT ShelleyTxCmdError IO (TxOutValue era)
toTxOutValueInAnyEra Value
val
                ExceptT ShelleyTxCmdError IO (TxOutDatumHash era -> TxOut era)
-> ExceptT ShelleyTxCmdError IO (TxOutDatumHash era)
-> ExceptT ShelleyTxCmdError IO (TxOut era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxOutDatumHash era
-> ExceptT ShelleyTxCmdError IO (TxOutDatumHash era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxOutDatumHash era
forall era. TxOutDatumHash era
TxOutDatumHashNone
        (Just ScriptDataSupportedInEra era
supported, Just Hash ScriptData
dh) ->
          AddressInEra era
-> TxOutValue era -> TxOutDatumHash era -> TxOut era
forall era.
AddressInEra era
-> TxOutValue era -> TxOutDatumHash era -> TxOut era
TxOut (AddressInEra era
 -> TxOutValue era -> TxOutDatumHash era -> TxOut era)
-> ExceptT ShelleyTxCmdError IO (AddressInEra era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (TxOutValue era -> TxOutDatumHash era -> TxOut era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddressAny -> ExceptT ShelleyTxCmdError IO (AddressInEra era)
toAddressInAnyEra AddressAny
addr
                ExceptT
  ShelleyTxCmdError
  IO
  (TxOutValue era -> TxOutDatumHash era -> TxOut era)
-> ExceptT ShelleyTxCmdError IO (TxOutValue era)
-> ExceptT ShelleyTxCmdError IO (TxOutDatumHash era -> TxOut era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> ExceptT ShelleyTxCmdError IO (TxOutValue era)
toTxOutValueInAnyEra Value
val
                ExceptT ShelleyTxCmdError IO (TxOutDatumHash era -> TxOut era)
-> ExceptT ShelleyTxCmdError IO (TxOutDatumHash era)
-> ExceptT ShelleyTxCmdError IO (TxOut era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxOutDatumHash era
-> ExceptT ShelleyTxCmdError IO (TxOutDatumHash era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatumHash era
forall era.
ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatumHash era
TxOutDatumHash ScriptDataSupportedInEra era
supported Hash ScriptData
dh)
        (Maybe (ScriptDataSupportedInEra era)
Nothing, Just Hash ScriptData
_) ->
          CardanoEra era
-> TxFeature -> ExceptT ShelleyTxCmdError IO (TxOut era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureTxOutDatum

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

            ShelleyBasedEra ShelleyBasedEra era
era' ->
              AddressInEra era -> ExceptT ShelleyTxCmdError IO (AddressInEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return (AddressTypeInEra ShelleyAddr era
-> Address ShelleyAddr -> AddressInEra era
forall addrtype era.
AddressTypeInEra addrtype era
-> Address addrtype -> AddressInEra era
AddressInEra (ShelleyBasedEra era -> AddressTypeInEra ShelleyAddr era
forall era. ShelleyBasedEra era -> AddressTypeInEra ShelleyAddr era
ShelleyAddressInEra ShelleyBasedEra era
era') Address ShelleyAddr
sAddr)

    toTxOutValueInAnyEra :: Value -> ExceptT ShelleyTxCmdError IO (TxOutValue era)
    toTxOutValueInAnyEra :: Value -> ExceptT ShelleyTxCmdError IO (TxOutValue era)
toTxOutValueInAnyEra Value
val =
      case CardanoEra era
-> Either
     (OnlyAdaSupportedInEra era) (MultiAssetSupportedInEra era)
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  -> TxOutValue era -> ExceptT ShelleyTxCmdError IO (TxOutValue era)
forall (m :: * -> *) a. Monad m => a -> m a
return (OnlyAdaSupportedInEra era -> Lovelace -> TxOutValue era
forall era. OnlyAdaSupportedInEra era -> Lovelace -> TxOutValue era
TxOutAdaOnly OnlyAdaSupportedInEra era
adaOnlyInEra Lovelace
l)
            Maybe Lovelace
Nothing -> CardanoEra era
-> TxFeature -> ExceptT ShelleyTxCmdError IO (TxOutValue era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureMultiAssetOutputs
        Right MultiAssetSupportedInEra era
multiAssetInEra -> TxOutValue era -> ExceptT ShelleyTxCmdError IO (TxOutValue era)
forall (m :: * -> *) a. Monad m => a -> m a
return (MultiAssetSupportedInEra era -> Value -> TxOutValue era
forall era. MultiAssetSupportedInEra era -> Value -> TxOutValue era
TxOutValue MultiAssetSupportedInEra era
multiAssetInEra Value
val)


validateTxFee :: CardanoEra era
              -> Maybe Lovelace
              -> ExceptT ShelleyTxCmdError IO (TxFee era)
validateTxFee :: CardanoEra era
-> Maybe Lovelace -> ExceptT ShelleyTxCmdError IO (TxFee era)
validateTxFee CardanoEra era
era Maybe Lovelace
mfee =
    case (CardanoEra era
-> Either (TxFeesImplicitInEra era) (TxFeesExplicitInEra era)
forall era.
CardanoEra era
-> Either (TxFeesImplicitInEra era) (TxFeesExplicitInEra era)
txFeesExplicitInEra CardanoEra era
era, Maybe Lovelace
mfee) of
      (Left  TxFeesImplicitInEra era
implicit, Maybe Lovelace
Nothing)  -> TxFee era -> ExceptT ShelleyTxCmdError IO (TxFee era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxFeesImplicitInEra era -> TxFee era
forall era. TxFeesImplicitInEra era -> TxFee era
TxFeeImplicit TxFeesImplicitInEra era
implicit)
      (Right TxFeesExplicitInEra era
explicit, Just Lovelace
fee) -> TxFee era -> ExceptT ShelleyTxCmdError IO (TxFee era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxFeesExplicitInEra era -> Lovelace -> TxFee era
forall era. TxFeesExplicitInEra era -> Lovelace -> TxFee era
TxFeeExplicit TxFeesExplicitInEra era
explicit Lovelace
fee)

      (Right TxFeesExplicitInEra era
_, Maybe Lovelace
Nothing) -> CardanoEra era
-> TxFeature -> ExceptT ShelleyTxCmdError IO (TxFee era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureImplicitFees
      (Left  TxFeesImplicitInEra era
_, Just Lovelace
_)  -> CardanoEra era
-> TxFeature -> ExceptT ShelleyTxCmdError IO (TxFee era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureExplicitFees


validateTxValidityLowerBound :: CardanoEra era
                             -> Maybe SlotNo
                             -> ExceptT ShelleyTxCmdError IO
                                        (TxValidityLowerBound era)
validateTxValidityLowerBound :: CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO (TxValidityLowerBound era)
validateTxValidityLowerBound CardanoEra era
_ Maybe SlotNo
Nothing = TxValidityLowerBound era
-> ExceptT ShelleyTxCmdError IO (TxValidityLowerBound era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxValidityLowerBound era
forall era. TxValidityLowerBound era
TxValidityNoLowerBound
validateTxValidityLowerBound CardanoEra era
era (Just SlotNo
slot) =
    case CardanoEra era -> Maybe (ValidityLowerBoundSupportedInEra era)
forall era.
CardanoEra era -> Maybe (ValidityLowerBoundSupportedInEra era)
validityLowerBoundSupportedInEra CardanoEra era
era of
      Maybe (ValidityLowerBoundSupportedInEra era)
Nothing -> CardanoEra era
-> TxFeature
-> ExceptT ShelleyTxCmdError IO (TxValidityLowerBound era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureValidityLowerBound
      Just ValidityLowerBoundSupportedInEra era
supported -> TxValidityLowerBound era
-> ExceptT ShelleyTxCmdError IO (TxValidityLowerBound era)
forall (m :: * -> *) a. Monad m => a -> m a
return (ValidityLowerBoundSupportedInEra era
-> SlotNo -> TxValidityLowerBound era
forall era.
ValidityLowerBoundSupportedInEra era
-> SlotNo -> TxValidityLowerBound era
TxValidityLowerBound ValidityLowerBoundSupportedInEra era
supported SlotNo
slot)


validateTxValidityUpperBound :: CardanoEra era
                             -> Maybe SlotNo
                             -> ExceptT ShelleyTxCmdError IO
                                        (TxValidityUpperBound era)
validateTxValidityUpperBound :: CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO (TxValidityUpperBound era)
validateTxValidityUpperBound CardanoEra era
era Maybe SlotNo
Nothing =
    case CardanoEra era -> Maybe (ValidityNoUpperBoundSupportedInEra era)
forall era.
CardanoEra era -> Maybe (ValidityNoUpperBoundSupportedInEra era)
validityNoUpperBoundSupportedInEra CardanoEra era
era of
      Maybe (ValidityNoUpperBoundSupportedInEra era)
Nothing -> CardanoEra era
-> TxFeature
-> ExceptT ShelleyTxCmdError IO (TxValidityUpperBound era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureValidityNoUpperBound
      Just ValidityNoUpperBoundSupportedInEra era
supported -> TxValidityUpperBound era
-> ExceptT ShelleyTxCmdError IO (TxValidityUpperBound era)
forall (m :: * -> *) a. Monad m => a -> m a
return (ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra era
supported)
validateTxValidityUpperBound CardanoEra era
era (Just SlotNo
slot) =
    case CardanoEra era -> Maybe (ValidityUpperBoundSupportedInEra era)
forall era.
CardanoEra era -> Maybe (ValidityUpperBoundSupportedInEra era)
validityUpperBoundSupportedInEra CardanoEra era
era of
      Maybe (ValidityUpperBoundSupportedInEra era)
Nothing -> CardanoEra era
-> TxFeature
-> ExceptT ShelleyTxCmdError IO (TxValidityUpperBound era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureValidityUpperBound
      Just ValidityUpperBoundSupportedInEra era
supported -> TxValidityUpperBound era
-> ExceptT ShelleyTxCmdError IO (TxValidityUpperBound era)
forall (m :: * -> *) a. Monad m => a -> m a
return (ValidityUpperBoundSupportedInEra era
-> SlotNo -> TxValidityUpperBound era
forall era.
ValidityUpperBoundSupportedInEra era
-> SlotNo -> TxValidityUpperBound era
TxValidityUpperBound ValidityUpperBoundSupportedInEra era
supported SlotNo
slot)


validateTxMetadataInEra :: CardanoEra era
                        -> TxMetadataJsonSchema
                        -> [MetadataFile]
                        -> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
validateTxMetadataInEra :: CardanoEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
validateTxMetadataInEra CardanoEra era
_ TxMetadataJsonSchema
_ [] = TxMetadataInEra era
-> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxMetadataInEra era
forall era. TxMetadataInEra era
TxMetadataNone
validateTxMetadataInEra CardanoEra era
era TxMetadataJsonSchema
schema [MetadataFile]
files =
    case CardanoEra era -> Maybe (TxMetadataSupportedInEra era)
forall era. CardanoEra era -> Maybe (TxMetadataSupportedInEra era)
txMetadataSupportedInEra CardanoEra era
era of
      Maybe (TxMetadataSupportedInEra era)
Nothing -> CardanoEra era
-> TxFeature -> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureTxMetadata
      Just TxMetadataSupportedInEra era
supported -> do
        TxMetadata
metadata <- [TxMetadata] -> TxMetadata
forall a. Monoid a => [a] -> a
mconcat ([TxMetadata] -> TxMetadata)
-> ExceptT ShelleyTxCmdError IO [TxMetadata]
-> ExceptT ShelleyTxCmdError IO TxMetadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MetadataFile -> ExceptT ShelleyTxCmdError IO TxMetadata)
-> [MetadataFile] -> ExceptT ShelleyTxCmdError IO [TxMetadata]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TxMetadataJsonSchema
-> MetadataFile -> ExceptT ShelleyTxCmdError IO TxMetadata
readFileTxMetadata TxMetadataJsonSchema
schema) [MetadataFile]
files
        TxMetadataInEra era
-> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxMetadataSupportedInEra era -> TxMetadata -> TxMetadataInEra era
forall era.
TxMetadataSupportedInEra era -> TxMetadata -> TxMetadataInEra era
TxMetadataInEra TxMetadataSupportedInEra era
supported TxMetadata
metadata)


validateTxAuxScripts :: CardanoEra era
                     -> [ScriptFile]
                     -> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
validateTxAuxScripts :: CardanoEra era
-> [ScriptFile] -> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
validateTxAuxScripts CardanoEra era
_ [] = TxAuxScripts era -> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxAuxScripts era
forall era. TxAuxScripts era
TxAuxScriptsNone
validateTxAuxScripts CardanoEra era
era [ScriptFile]
files =
  case CardanoEra era -> Maybe (AuxScriptsSupportedInEra era)
forall era. CardanoEra era -> Maybe (AuxScriptsSupportedInEra era)
auxScriptsSupportedInEra CardanoEra era
era of
    Maybe (AuxScriptsSupportedInEra era)
Nothing -> CardanoEra era
-> TxFeature -> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureAuxScripts
    Just AuxScriptsSupportedInEra era
supported -> do
      [ScriptInEra era]
scripts <- [ExceptT ShelleyTxCmdError IO (ScriptInEra era)]
-> ExceptT ShelleyTxCmdError IO [ScriptInEra era]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ do ScriptInAnyLang
script <- (FileError ScriptDecodeError -> ShelleyTxCmdError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ShelleyTxCmdError
ShelleyTxCmdScriptFileError (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
 -> ExceptT ShelleyTxCmdError IO ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
                         String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang String
file
             CardanoEra era
-> ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO (ScriptInEra era)
forall era.
CardanoEra era
-> ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO (ScriptInEra era)
validateScriptSupportedInEra CardanoEra era
era ScriptInAnyLang
script
        | ScriptFile String
file <- [ScriptFile]
files ]
      TxAuxScripts era -> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxAuxScripts era
 -> ExceptT ShelleyTxCmdError IO (TxAuxScripts era))
-> TxAuxScripts era
-> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
forall a b. (a -> b) -> a -> b
$ AuxScriptsSupportedInEra era
-> [ScriptInEra era] -> TxAuxScripts era
forall era.
AuxScriptsSupportedInEra era
-> [ScriptInEra era] -> TxAuxScripts era
TxAuxScripts AuxScriptsSupportedInEra era
supported [ScriptInEra era]
scripts

validateTxWithdrawals
  :: forall era.
     CardanoEra era
  -> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
validateTxWithdrawals :: CardanoEra era
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
validateTxWithdrawals CardanoEra era
_ [] = TxWithdrawals BuildTx era
-> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxWithdrawals BuildTx era
forall build era. TxWithdrawals build era
TxWithdrawalsNone
validateTxWithdrawals CardanoEra era
era [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals =
  case CardanoEra era -> Maybe (WithdrawalsSupportedInEra era)
forall era. CardanoEra era -> Maybe (WithdrawalsSupportedInEra era)
withdrawalsSupportedInEra CardanoEra era
era of
    Maybe (WithdrawalsSupportedInEra era)
Nothing -> CardanoEra era
-> TxFeature
-> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureWithdrawals
    Just WithdrawalsSupportedInEra era
supported -> do
      [(StakeAddress, Lovelace,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
convWithdrawals <- ((StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))
 -> ExceptT
      ShelleyTxCmdError
      IO
      (StakeAddress, Lovelace,
       BuildTxWith BuildTx (Witness WitCtxStake era)))
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT
     ShelleyTxCmdError
     IO
     [(StakeAddress, Lovelace,
       BuildTxWith BuildTx (Witness WitCtxStake era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))
-> ExceptT
     ShelleyTxCmdError
     IO
     (StakeAddress, Lovelace,
      BuildTxWith BuildTx (Witness WitCtxStake era))
convert [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals
      TxWithdrawals BuildTx era
-> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
forall (m :: * -> *) a. Monad m => a -> m a
return (WithdrawalsSupportedInEra era
-> [(StakeAddress, Lovelace,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
-> TxWithdrawals BuildTx era
forall era build.
WithdrawalsSupportedInEra era
-> [(StakeAddress, Lovelace,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
TxWithdrawals WithdrawalsSupportedInEra era
supported [(StakeAddress, Lovelace,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
convWithdrawals)
 where
  convert
    :: (StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))
    -> ExceptT ShelleyTxCmdError IO
              (StakeAddress,
               Lovelace,
               BuildTxWith BuildTx (Witness WitCtxStake era))
  convert :: (StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))
-> ExceptT
     ShelleyTxCmdError
     IO
     (StakeAddress, Lovelace,
      BuildTxWith BuildTx (Witness WitCtxStake era))
convert (StakeAddress
sAddr, Lovelace
ll, Maybe (ScriptWitnessFiles WitCtxStake)
mScriptWitnessFiles) =
    case Maybe (ScriptWitnessFiles WitCtxStake)
mScriptWitnessFiles of
      Just ScriptWitnessFiles WitCtxStake
scriptWitnessFiles -> do
        ScriptWitness WitCtxStake era
sWit <- CardanoEra era
-> ScriptWitnessFiles WitCtxStake
-> ExceptT ShelleyTxCmdError IO (ScriptWitness WitCtxStake era)
forall era witctx.
CardanoEra era
-> ScriptWitnessFiles witctx
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
createScriptWitness CardanoEra era
era ScriptWitnessFiles WitCtxStake
scriptWitnessFiles
        (StakeAddress, Lovelace,
 BuildTxWith BuildTx (Witness WitCtxStake era))
-> ExceptT
     ShelleyTxCmdError
     IO
     (StakeAddress, Lovelace,
      BuildTxWith BuildTx (Witness WitCtxStake era))
forall (m :: * -> *) a. Monad m => a -> m a
return ( StakeAddress
sAddr
               , Lovelace
ll
               , Witness WitCtxStake era
-> BuildTxWith BuildTx (Witness WitCtxStake era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxStake era
 -> BuildTxWith BuildTx (Witness WitCtxStake era))
-> Witness WitCtxStake era
-> BuildTxWith BuildTx (Witness WitCtxStake era)
forall a b. (a -> b) -> a -> b
$ ScriptWitnessInCtx WitCtxStake
-> ScriptWitness WitCtxStake era -> Witness WitCtxStake era
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxStake
ScriptWitnessForStakeAddr ScriptWitness WitCtxStake era
sWit
               )
      Maybe (ScriptWitnessFiles WitCtxStake)
Nothing -> (StakeAddress, Lovelace,
 BuildTxWith BuildTx (Witness WitCtxStake era))
-> ExceptT
     ShelleyTxCmdError
     IO
     (StakeAddress, Lovelace,
      BuildTxWith BuildTx (Witness WitCtxStake era))
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeAddress
sAddr,Lovelace
ll, Witness WitCtxStake era
-> BuildTxWith BuildTx (Witness WitCtxStake era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxStake era
 -> BuildTxWith BuildTx (Witness WitCtxStake era))
-> Witness WitCtxStake era
-> BuildTxWith BuildTx (Witness WitCtxStake era)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxStake -> Witness WitCtxStake era
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxStake
KeyWitnessForStakeAddr)

validateTxCertificates
  :: forall era.
     CardanoEra era
  -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
validateTxCertificates :: CardanoEra era
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
validateTxCertificates CardanoEra era
era [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles =
  case CardanoEra era -> Maybe (CertificatesSupportedInEra era)
forall era.
CardanoEra era -> Maybe (CertificatesSupportedInEra era)
certificatesSupportedInEra CardanoEra era
era of
    Maybe (CertificatesSupportedInEra era)
Nothing
      | [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles -> TxCertificates BuildTx era
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxCertificates BuildTx era
forall build era. TxCertificates build era
TxCertificatesNone
      | Bool
otherwise      -> CardanoEra era
-> TxFeature
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureCertificates
    Just CertificatesSupportedInEra era
supported -> do
      [Certificate]
certs <- [ExceptT ShelleyTxCmdError IO Certificate]
-> ExceptT ShelleyTxCmdError IO [Certificate]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                 [ (FileError TextEnvelopeError -> ShelleyTxCmdError)
-> ExceptT (FileError TextEnvelopeError) IO Certificate
-> ExceptT ShelleyTxCmdError IO Certificate
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyTxCmdError
ShelleyTxCmdReadTextViewFileError (ExceptT (FileError TextEnvelopeError) IO Certificate
 -> ExceptT ShelleyTxCmdError IO Certificate)
-> (IO (Either (FileError TextEnvelopeError) Certificate)
    -> ExceptT (FileError TextEnvelopeError) IO Certificate)
-> IO (Either (FileError TextEnvelopeError) Certificate)
-> ExceptT ShelleyTxCmdError IO Certificate
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError TextEnvelopeError) Certificate)
-> ExceptT (FileError TextEnvelopeError) IO Certificate
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) Certificate)
 -> ExceptT ShelleyTxCmdError IO Certificate)
-> IO (Either (FileError TextEnvelopeError) Certificate)
-> ExceptT ShelleyTxCmdError IO Certificate
forall a b. (a -> b) -> a -> b
$
                     AsType Certificate
-> String -> IO (Either (FileError TextEnvelopeError) Certificate)
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType Certificate
AsCertificate String
certFile
                 | CertificateFile String
certFile <- ((CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
 -> CertificateFile)
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [CertificateFile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
-> CertificateFile
forall a b. (a, b) -> a
fst [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles ]
      Map StakeCredential (Witness WitCtxStake era)
reqWits <- [(StakeCredential, Witness WitCtxStake era)]
-> Map StakeCredential (Witness WitCtxStake era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(StakeCredential, Witness WitCtxStake era)]
 -> Map StakeCredential (Witness WitCtxStake era))
-> ([Maybe (StakeCredential, Witness WitCtxStake era)]
    -> [(StakeCredential, Witness WitCtxStake era)])
-> [Maybe (StakeCredential, Witness WitCtxStake era)]
-> Map StakeCredential (Witness WitCtxStake era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Maybe (StakeCredential, Witness WitCtxStake era)]
-> [(StakeCredential, Witness WitCtxStake era)]
forall a. [Maybe a] -> [a]
catMaybes  ([Maybe (StakeCredential, Witness WitCtxStake era)]
 -> Map StakeCredential (Witness WitCtxStake era))
-> ExceptT
     ShelleyTxCmdError
     IO
     [Maybe (StakeCredential, Witness WitCtxStake era)]
-> ExceptT
     ShelleyTxCmdError
     IO
     (Map StakeCredential (Witness WitCtxStake era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
 -> ExceptT
      ShelleyTxCmdError
      IO
      (Maybe (StakeCredential, Witness WitCtxStake era)))
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT
     ShelleyTxCmdError
     IO
     [Maybe (StakeCredential, Witness WitCtxStake era)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
-> ExceptT
     ShelleyTxCmdError
     IO
     (Maybe (StakeCredential, Witness WitCtxStake era))
convert [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles
      TxCertificates BuildTx era
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxCertificates BuildTx era
 -> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era))
-> TxCertificates BuildTx era
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
forall a b. (a -> b) -> a -> b
$ CertificatesSupportedInEra era
-> [Certificate]
-> BuildTxWith
     BuildTx (Map StakeCredential (Witness WitCtxStake era))
-> TxCertificates BuildTx era
forall era build.
CertificatesSupportedInEra era
-> [Certificate]
-> BuildTxWith
     build (Map StakeCredential (Witness WitCtxStake era))
-> TxCertificates build era
TxCertificates CertificatesSupportedInEra era
supported [Certificate]
certs (BuildTxWith
   BuildTx (Map StakeCredential (Witness WitCtxStake era))
 -> TxCertificates BuildTx era)
-> BuildTxWith
     BuildTx (Map StakeCredential (Witness WitCtxStake era))
-> TxCertificates BuildTx era
forall a b. (a -> b) -> a -> b
$ Map StakeCredential (Witness WitCtxStake era)
-> BuildTxWith
     BuildTx (Map StakeCredential (Witness WitCtxStake era))
forall a. a -> BuildTxWith BuildTx a
BuildTxWith Map StakeCredential (Witness WitCtxStake era)
reqWits
  where
   -- We get the stake credential witness for a certificate that requires it.
   -- NB: Only stake address deregistration and delegation requires
   -- witnessing (witness can be script or key)
   deriveStakeCredentialWitness
     :: CertificateFile
     -> ExceptT ShelleyTxCmdError IO (Maybe StakeCredential)
   deriveStakeCredentialWitness :: CertificateFile
-> ExceptT ShelleyTxCmdError IO (Maybe StakeCredential)
deriveStakeCredentialWitness (CertificateFile String
certFile) = do
     Certificate
cert <- (FileError TextEnvelopeError -> ShelleyTxCmdError)
-> ExceptT (FileError TextEnvelopeError) IO Certificate
-> ExceptT ShelleyTxCmdError IO Certificate
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyTxCmdError
ShelleyTxCmdReadTextViewFileError (ExceptT (FileError TextEnvelopeError) IO Certificate
 -> ExceptT ShelleyTxCmdError IO Certificate)
-> (IO (Either (FileError TextEnvelopeError) Certificate)
    -> ExceptT (FileError TextEnvelopeError) IO Certificate)
-> IO (Either (FileError TextEnvelopeError) Certificate)
-> ExceptT ShelleyTxCmdError IO Certificate
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError TextEnvelopeError) Certificate)
-> ExceptT (FileError TextEnvelopeError) IO Certificate
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
               (IO (Either (FileError TextEnvelopeError) Certificate)
 -> ExceptT ShelleyTxCmdError IO Certificate)
-> IO (Either (FileError TextEnvelopeError) Certificate)
-> ExceptT ShelleyTxCmdError IO Certificate
forall a b. (a -> b) -> a -> b
$ AsType Certificate
-> String -> IO (Either (FileError TextEnvelopeError) Certificate)
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType Certificate
AsCertificate String
certFile
     case Certificate
cert of
       StakeAddressDeregistrationCertificate StakeCredential
sCred -> Maybe StakeCredential
-> ExceptT ShelleyTxCmdError IO (Maybe StakeCredential)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe StakeCredential
 -> ExceptT ShelleyTxCmdError IO (Maybe StakeCredential))
-> Maybe StakeCredential
-> ExceptT ShelleyTxCmdError IO (Maybe StakeCredential)
forall a b. (a -> b) -> a -> b
$ StakeCredential -> Maybe StakeCredential
forall a. a -> Maybe a
Just StakeCredential
sCred
       StakeAddressDelegationCertificate StakeCredential
sCred PoolId
_ -> Maybe StakeCredential
-> ExceptT ShelleyTxCmdError IO (Maybe StakeCredential)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe StakeCredential
 -> ExceptT ShelleyTxCmdError IO (Maybe StakeCredential))
-> Maybe StakeCredential
-> ExceptT ShelleyTxCmdError IO (Maybe StakeCredential)
forall a b. (a -> b) -> a -> b
$ StakeCredential -> Maybe StakeCredential
forall a. a -> Maybe a
Just StakeCredential
sCred
       Certificate
_ -> Maybe StakeCredential
-> ExceptT ShelleyTxCmdError IO (Maybe StakeCredential)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StakeCredential
forall a. Maybe a
Nothing

   convert
     :: (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
     -> ExceptT ShelleyTxCmdError IO
                (Maybe (StakeCredential, Witness WitCtxStake era))
   convert :: (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
-> ExceptT
     ShelleyTxCmdError
     IO
     (Maybe (StakeCredential, Witness WitCtxStake era))
convert (CertificateFile
cert, Maybe (ScriptWitnessFiles WitCtxStake)
mScriptWitnessFiles) = do
     Maybe StakeCredential
mStakeCred <- CertificateFile
-> ExceptT ShelleyTxCmdError IO (Maybe StakeCredential)
deriveStakeCredentialWitness CertificateFile
cert
     case Maybe StakeCredential
mStakeCred of
       Maybe StakeCredential
Nothing -> Maybe (StakeCredential, Witness WitCtxStake era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (Maybe (StakeCredential, Witness WitCtxStake era))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (StakeCredential, Witness WitCtxStake era)
forall a. Maybe a
Nothing
       Just StakeCredential
sCred ->
         case Maybe (ScriptWitnessFiles WitCtxStake)
mScriptWitnessFiles of
           Just ScriptWitnessFiles WitCtxStake
scriptWitnessFiles -> do
            ScriptWitness WitCtxStake era
sWit <- CardanoEra era
-> ScriptWitnessFiles WitCtxStake
-> ExceptT ShelleyTxCmdError IO (ScriptWitness WitCtxStake era)
forall era witctx.
CardanoEra era
-> ScriptWitnessFiles witctx
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
createScriptWitness CardanoEra era
era ScriptWitnessFiles WitCtxStake
scriptWitnessFiles
            Maybe (StakeCredential, Witness WitCtxStake era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (Maybe (StakeCredential, Witness WitCtxStake era))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (StakeCredential, Witness WitCtxStake era)
 -> ExceptT
      ShelleyTxCmdError
      IO
      (Maybe (StakeCredential, Witness WitCtxStake era)))
-> Maybe (StakeCredential, Witness WitCtxStake era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (Maybe (StakeCredential, Witness WitCtxStake era))
forall a b. (a -> b) -> a -> b
$ (StakeCredential, Witness WitCtxStake era)
-> Maybe (StakeCredential, Witness WitCtxStake era)
forall a. a -> Maybe a
Just ( StakeCredential
sCred
                          , ScriptWitnessInCtx WitCtxStake
-> ScriptWitness WitCtxStake era -> Witness WitCtxStake era
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxStake
ScriptWitnessForStakeAddr ScriptWitness WitCtxStake era
sWit
                          )

           Maybe (ScriptWitnessFiles WitCtxStake)
Nothing -> Maybe (StakeCredential, Witness WitCtxStake era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (Maybe (StakeCredential, Witness WitCtxStake era))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (StakeCredential, Witness WitCtxStake era)
 -> ExceptT
      ShelleyTxCmdError
      IO
      (Maybe (StakeCredential, Witness WitCtxStake era)))
-> Maybe (StakeCredential, Witness WitCtxStake era)
-> ExceptT
     ShelleyTxCmdError
     IO
     (Maybe (StakeCredential, Witness WitCtxStake era))
forall a b. (a -> b) -> a -> b
$ (StakeCredential, Witness WitCtxStake era)
-> Maybe (StakeCredential, Witness WitCtxStake era)
forall a. a -> Maybe a
Just (StakeCredential
sCred, KeyWitnessInCtx WitCtxStake -> Witness WitCtxStake era
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxStake
KeyWitnessForStakeAddr)

validateProtocolParameters
  :: CardanoEra era
  -> Maybe ProtocolParamsSourceSpec
  -> ExceptT ShelleyTxCmdError IO
            (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters :: CardanoEra era
-> Maybe ProtocolParamsSourceSpec
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters CardanoEra era
_ Maybe ProtocolParamsSourceSpec
Nothing = BuildTxWith BuildTx (Maybe ProtocolParameters)
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ProtocolParameters
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith Maybe ProtocolParameters
forall a. Maybe a
Nothing)
validateProtocolParameters CardanoEra era
era (Just ProtocolParamsSourceSpec
pparamsspec) =
    case CardanoEra era -> Maybe (ScriptDataSupportedInEra era)
forall era. CardanoEra era -> Maybe (ScriptDataSupportedInEra era)
scriptDataSupportedInEra CardanoEra era
era of
      Maybe (ScriptDataSupportedInEra era)
Nothing -> CardanoEra era
-> TxFeature
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureProtocolParameters
      Just ScriptDataSupportedInEra era
_  -> Maybe ProtocolParameters
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Maybe ProtocolParameters
 -> BuildTxWith BuildTx (Maybe ProtocolParameters))
-> (ProtocolParameters -> Maybe ProtocolParameters)
-> ProtocolParameters
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ProtocolParameters -> Maybe ProtocolParameters
forall a. a -> Maybe a
Just (ProtocolParameters
 -> BuildTxWith BuildTx (Maybe ProtocolParameters))
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
-> ExceptT
     ShelleyTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   ProtocolParamsSourceSpec
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
readProtocolParametersSourceSpec ProtocolParamsSourceSpec
pparamsspec

validateTxUpdateProposal :: CardanoEra era
                         -> Maybe UpdateProposalFile
                         -> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
validateTxUpdateProposal :: CardanoEra era
-> Maybe UpdateProposalFile
-> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
validateTxUpdateProposal CardanoEra era
_ Maybe UpdateProposalFile
Nothing = TxUpdateProposal era
-> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxUpdateProposal era
forall era. TxUpdateProposal era
TxUpdateProposalNone
validateTxUpdateProposal CardanoEra era
era (Just (UpdateProposalFile String
file)) =
    case CardanoEra era -> Maybe (UpdateProposalSupportedInEra era)
forall era.
CardanoEra era -> Maybe (UpdateProposalSupportedInEra era)
updateProposalSupportedInEra CardanoEra era
era of
      Maybe (UpdateProposalSupportedInEra era)
Nothing -> CardanoEra era
-> TxFeature -> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureCertificates
      Just UpdateProposalSupportedInEra era
supported -> do
         UpdateProposal
prop <- (FileError TextEnvelopeError -> ShelleyTxCmdError)
-> ExceptT (FileError TextEnvelopeError) IO UpdateProposal
-> ExceptT ShelleyTxCmdError IO UpdateProposal
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyTxCmdError
ShelleyTxCmdReadTextViewFileError (ExceptT (FileError TextEnvelopeError) IO UpdateProposal
 -> ExceptT ShelleyTxCmdError IO UpdateProposal)
-> ExceptT (FileError TextEnvelopeError) IO UpdateProposal
-> ExceptT ShelleyTxCmdError IO UpdateProposal
forall a b. (a -> b) -> a -> b
$ IO (Either (FileError TextEnvelopeError) UpdateProposal)
-> ExceptT (FileError TextEnvelopeError) IO UpdateProposal
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) UpdateProposal)
 -> ExceptT (FileError TextEnvelopeError) IO UpdateProposal)
-> IO (Either (FileError TextEnvelopeError) UpdateProposal)
-> ExceptT (FileError TextEnvelopeError) IO UpdateProposal
forall a b. (a -> b) -> a -> b
$
                   AsType UpdateProposal
-> String
-> IO (Either (FileError TextEnvelopeError) UpdateProposal)
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType UpdateProposal
AsUpdateProposal String
file
         TxUpdateProposal era
-> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
forall (m :: * -> *) a. Monad m => a -> m a
return (UpdateProposalSupportedInEra era
-> UpdateProposal -> TxUpdateProposal era
forall era.
UpdateProposalSupportedInEra era
-> UpdateProposal -> TxUpdateProposal era
TxUpdateProposal UpdateProposalSupportedInEra era
supported UpdateProposal
prop)

validateTxScriptValidity :: forall era.
     CardanoEra era
  -> Maybe ScriptValidity
  -> ExceptT ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
validateTxScriptValidity :: CardanoEra era
-> Maybe ScriptValidity
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
validateTxScriptValidity CardanoEra era
_ Maybe ScriptValidity
Nothing = BuildTxWith BuildTx (TxScriptValidity era)
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BuildTxWith BuildTx (TxScriptValidity era)
 -> ExceptT
      ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era)))
-> BuildTxWith BuildTx (TxScriptValidity era)
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
forall a b. (a -> b) -> a -> b
$ TxScriptValidity era -> BuildTxWith BuildTx (TxScriptValidity era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith TxScriptValidity era
forall era. TxScriptValidity era
TxScriptValidityNone
validateTxScriptValidity CardanoEra era
era (Just ScriptValidity
scriptValidity) =
  case CardanoEra era -> Maybe (TxScriptValiditySupportedInEra era)
forall era.
CardanoEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInCardanoEra CardanoEra era
era of
    Maybe (TxScriptValiditySupportedInEra era)
Nothing -> CardanoEra era
-> TxFeature
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch CardanoEra era
era TxFeature
TxFeatureScriptValidity
    Just TxScriptValiditySupportedInEra era
supported -> BuildTxWith BuildTx (TxScriptValidity era)
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BuildTxWith BuildTx (TxScriptValidity era)
 -> ExceptT
      ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era)))
-> (TxScriptValidity era
    -> BuildTxWith BuildTx (TxScriptValidity era))
-> TxScriptValidity era
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxScriptValidity era -> BuildTxWith BuildTx (TxScriptValidity era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (TxScriptValidity era
 -> ExceptT
      ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era)))
-> TxScriptValidity era
-> ExceptT
     ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era))
forall a b. (a -> b) -> a -> b
$ TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
forall era.
TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
TxScriptValidity TxScriptValiditySupportedInEra era
supported ScriptValidity
scriptValidity

validateTxMintValue :: forall era.
                       CardanoEra era
                    -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
                    -> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
validateTxMintValue :: CardanoEra era
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
validateTxMintValue CardanoEra era
_ Maybe (Value, [ScriptWitnessFiles WitCtxMint])
Nothing = TxMintValue BuildTx era
-> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxMintValue BuildTx era
forall build era. TxMintValue build era
TxMintNone
validateTxMintValue CardanoEra era
era (Just (Value
val, [ScriptWitnessFiles WitCtxMint]
scriptWitnessFiles)) =
    case CardanoEra era
-> Either
     (OnlyAdaSupportedInEra era) (MultiAssetSupportedInEra era)
forall era.
CardanoEra era
-> Either
     (OnlyAdaSupportedInEra era) (MultiAssetSupportedInEra era)
multiAssetSupportedInEra CardanoEra era
era of
      Left OnlyAdaSupportedInEra era
_ -> CardanoEra era
-> TxFeature
-> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
forall era a.
CardanoEra era -> TxFeature -> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch 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 =
              [PolicyId] -> Set PolicyId
forall a. Ord a => [a] -> Set a
Set.fromList [ PolicyId
pid | (AssetId PolicyId
pid AssetName
_, Quantity
_) <- Value -> [(AssetId, Quantity)]
valueToList Value
val ]

        -- The set (and map) of policy ids for which we have witnesses:
        [ScriptWitness WitCtxMint era]
witnesses <- (ScriptWitnessFiles WitCtxMint
 -> ExceptT ShelleyTxCmdError IO (ScriptWitness WitCtxMint era))
-> [ScriptWitnessFiles WitCtxMint]
-> ExceptT ShelleyTxCmdError IO [ScriptWitness WitCtxMint era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CardanoEra era
-> ScriptWitnessFiles WitCtxMint
-> ExceptT ShelleyTxCmdError IO (ScriptWitness WitCtxMint era)
forall era witctx.
CardanoEra era
-> ScriptWitnessFiles witctx
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
createScriptWitness CardanoEra era
era) [ScriptWitnessFiles WitCtxMint]
scriptWitnessFiles
        let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
            witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
witnessesProvidedMap = [(PolicyId, ScriptWitness WitCtxMint era)]
-> Map PolicyId (ScriptWitness WitCtxMint era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                                     [ (ScriptWitness WitCtxMint era -> PolicyId
forall witctx era. ScriptWitness witctx era -> PolicyId
scriptWitnessPolicyId ScriptWitness WitCtxMint era
witness, ScriptWitness WitCtxMint era
witness)
                                     | ScriptWitness WitCtxMint era
witness <- [ScriptWitness WitCtxMint era]
witnesses ]
            witnessesProvidedSet :: Set PolicyId
witnessesProvidedSet = Map PolicyId (ScriptWitness WitCtxMint era) -> Set PolicyId
forall k a. Map k a -> Set k
Map.keysSet Map PolicyId (ScriptWitness WitCtxMint era)
witnessesProvidedMap

        -- Check not too many, nor too few:
        Set PolicyId -> Set PolicyId -> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *).
Monad m =>
Set PolicyId -> Set PolicyId -> ExceptT ShelleyTxCmdError m ()
validateAllWitnessesProvided   Set PolicyId
witnessesNeededSet Set PolicyId
witnessesProvidedSet
        Set PolicyId -> Set PolicyId -> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *).
Monad m =>
Set PolicyId -> Set PolicyId -> ExceptT ShelleyTxCmdError m ()
validateNoUnnecessaryWitnesses Set PolicyId
witnessesNeededSet Set PolicyId
witnessesProvidedSet

        TxMintValue BuildTx era
-> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
forall (m :: * -> *) a. Monad m => a -> m a
return (MultiAssetSupportedInEra era
-> Value
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue BuildTx era
forall era build.
MultiAssetSupportedInEra era
-> Value
-> BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue build era
TxMintValue MultiAssetSupportedInEra era
supported Value
val (Map PolicyId (ScriptWitness WitCtxMint era)
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
forall a. a -> BuildTxWith BuildTx a
BuildTxWith Map PolicyId (ScriptWitness WitCtxMint era)
witnessesProvidedMap))
 where
    validateAllWitnessesProvided :: Set PolicyId -> Set PolicyId -> ExceptT ShelleyTxCmdError m ()
validateAllWitnessesProvided Set PolicyId
witnessesNeeded Set PolicyId
witnessesProvided
      | [PolicyId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PolicyId]
witnessesMissing = () -> ExceptT ShelleyTxCmdError m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = ShelleyTxCmdError -> ExceptT ShelleyTxCmdError m ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ([PolicyId] -> ShelleyTxCmdError
ShelleyTxCmdPolicyIdsMissing [PolicyId]
witnessesMissing)
      where
        witnessesMissing :: [PolicyId]
witnessesMissing = Set PolicyId -> [PolicyId]
forall a. Set a -> [a]
Set.elems (Set PolicyId
witnessesNeeded Set PolicyId -> Set PolicyId -> Set PolicyId
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PolicyId
witnessesProvided)

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

scriptWitnessPolicyId :: ScriptWitness witctx era -> PolicyId
scriptWitnessPolicyId :: ScriptWitness witctx era -> PolicyId
scriptWitnessPolicyId ScriptWitness witctx era
witness =
  case ScriptWitness witctx era -> ScriptInEra era
forall witctx era. ScriptWitness witctx era -> ScriptInEra era
scriptWitnessScript ScriptWitness witctx era
witness of
    ScriptInEra ScriptLanguageInEra lang era
_ Script lang
script -> Script lang -> PolicyId
forall lang. Script lang -> PolicyId
scriptPolicyId Script lang
script


createScriptWitness
  :: CardanoEra era
  -> ScriptWitnessFiles witctx
  -> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
createScriptWitness :: CardanoEra era
-> ScriptWitnessFiles witctx
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
createScriptWitness CardanoEra era
era (SimpleScriptWitnessFile (ScriptFile String
scriptFile)) = do
    script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) <- (FileError ScriptDecodeError -> ShelleyTxCmdError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ShelleyTxCmdError
ShelleyTxCmdScriptFileError (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
 -> ExceptT ShelleyTxCmdError IO ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
                                         String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang String
scriptFile
    ScriptInEra ScriptLanguageInEra lang era
langInEra Script lang
script'   <- CardanoEra era
-> ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO (ScriptInEra era)
forall era.
CardanoEra era
-> ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO (ScriptInEra era)
validateScriptSupportedInEra CardanoEra era
era ScriptInAnyLang
script
    case Script lang
script' of
      SimpleScript SimpleScriptVersion lang
version SimpleScript lang
sscript ->
        ScriptWitness witctx era
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptWitness witctx era
 -> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era))
-> ScriptWitness witctx era
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra lang era
-> SimpleScriptVersion lang
-> SimpleScript lang
-> ScriptWitness witctx era
forall lang era witctx.
ScriptLanguageInEra lang era
-> SimpleScriptVersion lang
-> SimpleScript lang
-> ScriptWitness witctx era
SimpleScriptWitness
                   ScriptLanguageInEra lang era
langInEra SimpleScriptVersion lang
version SimpleScript lang
sscript

      -- If the supplied cli flags were for a simple script (i.e. the user did
      -- not supply the datum, redeemer or ex units), but the script file turns
      -- out to be a valid plutus script, then we must fail.
      PlutusScript{} ->
        ShelleyTxCmdError
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyTxCmdError
 -> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era))
-> ShelleyTxCmdError
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$ String -> AnyScriptLanguage -> ShelleyTxCmdError
ShelleyTxCmdScriptExpectedSimple
                 String
scriptFile
                 (ScriptLanguage lang -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang)

createScriptWitness CardanoEra era
era (PlutusScriptWitnessFiles
                          (ScriptFile String
scriptFile)
                          ScriptDatumOrFile witctx
datumOrFile
                          ScriptDataOrFile
redeemerOrFile
                          ExecutionUnits
execUnits) = do
    script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) <- (FileError ScriptDecodeError -> ShelleyTxCmdError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ShelleyTxCmdError
ShelleyTxCmdScriptFileError (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
 -> ExceptT ShelleyTxCmdError IO ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
                                         String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang String
scriptFile
    ScriptInEra ScriptLanguageInEra lang era
langInEra Script lang
script'   <- CardanoEra era
-> ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO (ScriptInEra era)
forall era.
CardanoEra era
-> ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO (ScriptInEra era)
validateScriptSupportedInEra CardanoEra era
era ScriptInAnyLang
script
    case Script lang
script' of
      PlutusScript PlutusScriptVersion lang
version PlutusScript lang
pscript -> do
        ScriptDatum witctx
datum    <- ScriptDatumOrFile witctx
-> ExceptT ShelleyTxCmdError IO (ScriptDatum witctx)
forall witctx.
ScriptDatumOrFile witctx
-> ExceptT ShelleyTxCmdError IO (ScriptDatum witctx)
readScriptDatumOrFile    ScriptDatumOrFile witctx
datumOrFile
        ScriptData
redeemer <- ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO ScriptData
readScriptRedeemerOrFile ScriptDataOrFile
redeemerOrFile
        ScriptWitness witctx era
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptWitness witctx era
 -> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era))
-> ScriptWitness witctx era
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScript lang
-> ScriptDatum witctx
-> ScriptData
-> ExecutionUnits
-> ScriptWitness witctx era
forall lang era witctx.
ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScript lang
-> ScriptDatum witctx
-> ScriptData
-> ExecutionUnits
-> ScriptWitness witctx era
PlutusScriptWitness
                   ScriptLanguageInEra lang era
langInEra PlutusScriptVersion lang
version PlutusScript lang
pscript
                   ScriptDatum witctx
datum
                   ScriptData
redeemer
                   ExecutionUnits
execUnits

      -- If the supplied cli flags were for a plutus script (i.e. the user did
      -- supply the datum, redeemer and ex units), but the script file turns
      -- out to be a valid simple script, then we must fail.
      SimpleScript{} ->
        ShelleyTxCmdError
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyTxCmdError
 -> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era))
-> ShelleyTxCmdError
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$ String -> AnyScriptLanguage -> ShelleyTxCmdError
ShelleyTxCmdScriptExpectedPlutus
                 String
scriptFile
                 (ScriptLanguage lang -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang)


readScriptDatumOrFile :: ScriptDatumOrFile witctx
                      -> ExceptT ShelleyTxCmdError IO (ScriptDatum witctx)
readScriptDatumOrFile :: ScriptDatumOrFile witctx
-> ExceptT ShelleyTxCmdError IO (ScriptDatum witctx)
readScriptDatumOrFile (ScriptDatumOrFileForTxIn ScriptDataOrFile
df) = ScriptData -> ScriptDatum WitCtxTxIn
ScriptDatumForTxIn (ScriptData -> ScriptDatum WitCtxTxIn)
-> ExceptT ShelleyTxCmdError IO ScriptData
-> ExceptT ShelleyTxCmdError IO (ScriptDatum WitCtxTxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                                        ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO ScriptData
readScriptDataOrFile ScriptDataOrFile
df
readScriptDatumOrFile ScriptDatumOrFile witctx
NoScriptDatumOrFileForMint    = ScriptDatum WitCtxMint
-> ExceptT ShelleyTxCmdError IO (ScriptDatum WitCtxMint)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatum WitCtxMint
NoScriptDatumForMint
readScriptDatumOrFile ScriptDatumOrFile witctx
NoScriptDatumOrFileForStake   = ScriptDatum WitCtxStake
-> ExceptT ShelleyTxCmdError IO (ScriptDatum WitCtxStake)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatum WitCtxStake
NoScriptDatumForStake

readScriptRedeemerOrFile :: ScriptRedeemerOrFile
                         -> ExceptT ShelleyTxCmdError IO ScriptRedeemer
readScriptRedeemerOrFile :: ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO ScriptData
readScriptRedeemerOrFile = ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO ScriptData
readScriptDataOrFile

readScriptDataOrFile :: ScriptDataOrFile
                     -> ExceptT ShelleyTxCmdError IO ScriptData
readScriptDataOrFile :: ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO ScriptData
readScriptDataOrFile (ScriptDataValue ScriptData
d) = ScriptData -> ExceptT ShelleyTxCmdError IO ScriptData
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptData
d
readScriptDataOrFile (ScriptDataFile String
fp) = do
    ByteString
bs <- (IOException -> ShelleyTxCmdError)
-> IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyTxCmdError
ShelleyTxCmdReadFileError (FileError () -> ShelleyTxCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyTxCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fp) (IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString)
-> IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
            String -> IO ByteString
LBS.readFile String
fp
    Value
v  <- (String -> ShelleyTxCmdError)
-> ExceptT String IO Value -> ExceptT ShelleyTxCmdError IO Value
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> String -> ShelleyTxCmdError
ShelleyTxCmdScriptDataJsonParseError String
fp) (ExceptT String IO Value -> ExceptT ShelleyTxCmdError IO Value)
-> ExceptT String IO Value -> ExceptT ShelleyTxCmdError IO Value
forall a b. (a -> b) -> a -> b
$
            Either String Value -> ExceptT String IO Value
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either String Value -> ExceptT String IO Value)
-> Either String Value -> ExceptT String IO Value
forall a b. (a -> b) -> a -> b
$
              ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
bs
    ScriptData
sd <- (ScriptDataJsonError -> ShelleyTxCmdError)
-> ExceptT ScriptDataJsonError IO ScriptData
-> ExceptT ShelleyTxCmdError IO ScriptData
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> ScriptDataJsonError -> ShelleyTxCmdError
ShelleyTxCmdScriptDataConversionError String
fp) (ExceptT ScriptDataJsonError IO ScriptData
 -> ExceptT ShelleyTxCmdError IO ScriptData)
-> ExceptT ScriptDataJsonError IO ScriptData
-> ExceptT ShelleyTxCmdError IO ScriptData
forall a b. (a -> b) -> a -> b
$
            Either ScriptDataJsonError ScriptData
-> ExceptT ScriptDataJsonError IO ScriptData
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ScriptDataJsonError ScriptData
 -> ExceptT ScriptDataJsonError IO ScriptData)
-> Either ScriptDataJsonError ScriptData
-> ExceptT ScriptDataJsonError IO ScriptData
forall a b. (a -> b) -> a -> b
$
              ScriptDataJsonSchema
-> Value -> Either ScriptDataJsonError ScriptData
scriptDataFromJson ScriptDataJsonSchema
ScriptDataJsonDetailedSchema Value
v
    (ScriptDataRangeError -> ShelleyTxCmdError)
-> ExceptT ScriptDataRangeError IO ()
-> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> ScriptDataRangeError -> ShelleyTxCmdError
ShelleyTxCmdScriptDataValidationError String
fp) (ExceptT ScriptDataRangeError IO ()
 -> ExceptT ShelleyTxCmdError IO ())
-> ExceptT ScriptDataRangeError IO ()
-> ExceptT ShelleyTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      Either ScriptDataRangeError ()
-> ExceptT ScriptDataRangeError IO ()
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ScriptDataRangeError ()
 -> ExceptT ScriptDataRangeError IO ())
-> Either ScriptDataRangeError ()
-> ExceptT ScriptDataRangeError IO ()
forall a b. (a -> b) -> a -> b
$
        ScriptData -> Either ScriptDataRangeError ()
validateScriptData ScriptData
sd
    ScriptData -> ExceptT ShelleyTxCmdError IO ScriptData
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptData
sd


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

runTxSign :: TxBodyFile
          -> [WitnessSigningData]
          -> Maybe NetworkId
          -> TxFile
          -> ExceptT ShelleyTxCmdError IO ()
runTxSign :: TxBodyFile
-> [WitnessSigningData]
-> Maybe NetworkId
-> TxFile
-> ExceptT ShelleyTxCmdError IO ()
runTxSign (TxBodyFile String
txbodyFile) [WitnessSigningData]
witSigningData Maybe NetworkId
mnw (TxFile String
txFile) = do
  InAnyShelleyBasedEra ShelleyBasedEra era
_era TxBody era
txbody <-
        --TODO: in principle we should be able to support Byron era txs too
        Text
-> InAnyCardanoEra TxBody
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra TxBody)
forall (a :: * -> *).
Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
"sign for Byron era transactions"
    (InAnyCardanoEra TxBody
 -> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra TxBody))
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra TxBody)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
readFileTxBody String
txbodyFile

  [SomeWitness]
sks <- (ReadWitnessSigningDataError -> ShelleyTxCmdError)
-> ExceptT ReadWitnessSigningDataError IO [SomeWitness]
-> ExceptT ShelleyTxCmdError IO [SomeWitness]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ReadWitnessSigningDataError -> ShelleyTxCmdError
ShelleyTxCmdReadWitnessSigningDataError (ExceptT ReadWitnessSigningDataError IO [SomeWitness]
 -> ExceptT ShelleyTxCmdError IO [SomeWitness])
-> ExceptT ReadWitnessSigningDataError IO [SomeWitness]
-> ExceptT ShelleyTxCmdError IO [SomeWitness]
forall a b. (a -> b) -> a -> b
$
           (WitnessSigningData
 -> ExceptT ReadWitnessSigningDataError IO SomeWitness)
-> [WitnessSigningData]
-> ExceptT ReadWitnessSigningDataError IO [SomeWitness]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM WitnessSigningData
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
readWitnessSigningData [WitnessSigningData]
witSigningData

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

  -- Byron witnesses require the network ID. This can either be provided
  -- directly or derived from a provided Byron address.
  [KeyWitness era]
byronWitnesses <- (ShelleyBootstrapWitnessError -> ShelleyTxCmdError)
-> ExceptT ShelleyBootstrapWitnessError IO [KeyWitness era]
-> ExceptT ShelleyTxCmdError IO [KeyWitness era]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyBootstrapWitnessError -> ShelleyTxCmdError
ShelleyTxCmdBootstrapWitnessError
    (ExceptT ShelleyBootstrapWitnessError IO [KeyWitness era]
 -> ExceptT ShelleyTxCmdError IO [KeyWitness era])
-> (Either ShelleyBootstrapWitnessError [KeyWitness era]
    -> ExceptT ShelleyBootstrapWitnessError IO [KeyWitness era])
-> Either ShelleyBootstrapWitnessError [KeyWitness era]
-> ExceptT ShelleyTxCmdError IO [KeyWitness era]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either ShelleyBootstrapWitnessError [KeyWitness era]
-> ExceptT ShelleyBootstrapWitnessError IO [KeyWitness era]
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
    (Either ShelleyBootstrapWitnessError [KeyWitness era]
 -> ExceptT ShelleyTxCmdError IO [KeyWitness era])
-> Either ShelleyBootstrapWitnessError [KeyWitness era]
-> ExceptT ShelleyTxCmdError IO [KeyWitness era]
forall a b. (a -> b) -> a -> b
$ Maybe NetworkId
-> TxBody era
-> [ShelleyBootstrapWitnessSigningKeyData]
-> Either ShelleyBootstrapWitnessError [KeyWitness era]
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 = (ShelleyWitnessSigningKey -> KeyWitness era)
-> [ShelleyWitnessSigningKey] -> [KeyWitness era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
forall era.
IsShelleyBasedEra era =>
TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
makeShelleyKeyWitness TxBody era
txbody) [ShelleyWitnessSigningKey]
sksShelley
      tx :: Tx era
tx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction ([KeyWitness era]
byronWitnesses [KeyWitness era] -> [KeyWitness era] -> [KeyWitness era]
forall a. [a] -> [a] -> [a]
++ [KeyWitness era]
shelleyKeyWitnesses) TxBody era
txbody

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


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


runTxSubmit
  :: AnyConsensusModeParams
  -> NetworkId
  -> FilePath
  -> ExceptT ShelleyTxCmdError IO ()
runTxSubmit :: AnyConsensusModeParams
-> NetworkId -> String -> ExceptT ShelleyTxCmdError IO ()
runTxSubmit (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network String
txFile = do
    SocketPath String
sockPath <- (EnvSocketError -> ShelleyTxCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyTxCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyTxCmdError
ShelleyTxCmdSocketEnvError ExceptT EnvSocketError IO SocketPath
readEnvSocketPath

    InAnyCardanoEra CardanoEra era
era Tx era
tx <- String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra Tx)
readFileTx String
txFile
    let cMode :: AnyConsensusMode
cMode = ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode (ConsensusMode mode -> AnyConsensusMode)
-> ConsensusMode mode -> AnyConsensusMode
forall a b. (a -> b) -> a -> b
$ ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
    EraInMode era mode
eraInMode <- ShelleyTxCmdError
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyTxCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe
                   (Maybe String
-> AnyConsensusMode -> AnyCardanoEra -> ShelleyTxCmdError
ShelleyTxCmdEraConsensusModeMismatch (String -> Maybe String
forall a. a -> Maybe a
Just String
txFile) AnyConsensusMode
cMode (CardanoEra era -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era))
                   (CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era (ConsensusMode mode -> Maybe (EraInMode era mode))
-> ConsensusMode mode -> Maybe (EraInMode era mode)
forall a b. (a -> b) -> a -> b
$ ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams)
    let txInMode :: TxInMode mode
txInMode = Tx era -> EraInMode era mode -> TxInMode mode
forall era mode. Tx era -> EraInMode era mode -> TxInMode mode
TxInMode Tx era
tx EraInMode era mode
eraInMode
        localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = LocalNodeConnectInfo :: forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo
                              { localConsensusModeParams :: ConsensusModeParams mode
localConsensusModeParams = ConsensusModeParams mode
cModeParams
                              , localNodeNetworkId :: NetworkId
localNodeNetworkId = NetworkId
network
                              , localNodeSocketPath :: String
localNodeSocketPath = String
sockPath
                              }

    SubmitResult (TxValidationErrorInMode mode)
res <- IO (SubmitResult (TxValidationErrorInMode mode))
-> ExceptT
     ShelleyTxCmdError IO (SubmitResult (TxValidationErrorInMode mode))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SubmitResult (TxValidationErrorInMode mode))
 -> ExceptT
      ShelleyTxCmdError IO (SubmitResult (TxValidationErrorInMode mode)))
-> IO (SubmitResult (TxValidationErrorInMode mode))
-> ExceptT
     ShelleyTxCmdError IO (SubmitResult (TxValidationErrorInMode mode))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode
-> TxInMode mode
-> IO (SubmitResult (TxValidationErrorInMode mode))
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 -> IO () -> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyTxCmdError IO ())
-> IO () -> ExceptT ShelleyTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
putTextLn Text
"Transaction successfully submitted."
      Net.Tx.SubmitFail TxValidationErrorInMode mode
reason ->
        case TxValidationErrorInMode mode
reason of
          TxValidationErrorInMode TxValidationError era
err EraInMode era mode
_eraInMode -> ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO ())
-> (String -> ShelleyTxCmdError)
-> String
-> ExceptT ShelleyTxCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ShelleyTxCmdError
ShelleyTxCmdTxSubmitError (Text -> ShelleyTxCmdError)
-> (String -> Text) -> String -> ShelleyTxCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack (String -> ExceptT ShelleyTxCmdError IO ())
-> String -> ExceptT ShelleyTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ TxValidationError era -> String
forall a b. (Show a, ConvertText String b) => a -> b
show TxValidationError era
err
          TxValidationEraMismatch EraMismatch
mismatchErr -> ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO ())
-> ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO ()
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 String
txbodyFile) Maybe NetworkId
nw ProtocolParamsSourceSpec
protocolParamsSourceSpec
                     (TxInCount Int
nInputs) (TxOutCount Int
nOutputs)
                     (TxShelleyWitnessCount Int
nShelleyKeyWitnesses)
                     (TxByronWitnessCount Int
nByronKeyWitnesses) = do
    InAnyShelleyBasedEra ShelleyBasedEra era
_era TxBody era
txbody <-
          --TODO: in principle we should be able to support Byron era txs too
          Text
-> InAnyCardanoEra TxBody
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra TxBody)
forall (a :: * -> *).
Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
"calculate-min-fee for Byron era transactions"
      (InAnyCardanoEra TxBody
 -> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra TxBody))
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra TxBody)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
readFileTxBody String
txbodyFile

    ProtocolParameters
pparams <- ProtocolParamsSourceSpec
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
readProtocolParametersSourceSpec ProtocolParamsSourceSpec
protocolParamsSourceSpec

    let tx :: Tx era
tx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody era
txbody
        Lovelace Integer
fee = NetworkId
-> Natural
-> Natural
-> Tx era
-> Int
-> Int
-> Int
-> Int
-> Lovelace
forall era.
IsShelleyBasedEra era =>
NetworkId
-> Natural
-> Natural
-> Tx era
-> Int
-> Int
-> Int
-> Int
-> Lovelace
estimateTransactionFee
                             (NetworkId -> Maybe NetworkId -> NetworkId
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

    IO () -> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyTxCmdError IO ())
-> IO () -> ExceptT ShelleyTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (Integer -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Integer
fee :: String) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Lovelace"

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

runTxCalculateMinValue
  :: ProtocolParamsSourceSpec
  -> Value
  -> ExceptT ShelleyTxCmdError IO ()
runTxCalculateMinValue :: ProtocolParamsSourceSpec
-> Value -> ExceptT ShelleyTxCmdError IO ()
runTxCalculateMinValue ProtocolParamsSourceSpec
protocolParamsSourceSpec Value
value = do
  ProtocolParameters
pp <- ProtocolParamsSourceSpec
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
readProtocolParametersSourceSpec ProtocolParamsSourceSpec
protocolParamsSourceSpec

  let minValues :: Lovelace
minValues =
        case ProtocolParameters -> Maybe Lovelace
protocolParamMinUTxOValue ProtocolParameters
pp of
          Maybe Lovelace
Nothing -> Text -> Lovelace
forall a. HasCallStack => Text -> a
panic Text
"TODO alonzo: runTxCalculateMinValue using new protocol params"
          --TODO alonzo: there is a new formula for the min amount of ada in
          -- a tx output, which uses a new param protocolParamUTxOCostPerWord
          Just Lovelace
minUTxOValue -> Value -> Lovelace -> Lovelace
calcMinimumDeposit Value
value Lovelace
minUTxOValue

  IO () -> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyTxCmdError IO ())
-> IO () -> ExceptT ShelleyTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Lovelace -> IO ()
forall a. Show a => a -> IO ()
IO.print Lovelace
minValues

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

readProtocolParametersSourceSpec :: ProtocolParamsSourceSpec
                                 -> ExceptT ShelleyTxCmdError IO
                                            ProtocolParameters
readProtocolParametersSourceSpec :: ProtocolParamsSourceSpec
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
readProtocolParametersSourceSpec (ParamsFromGenesis (GenesisFile String
f)) =
    PParams StandardShelley -> ProtocolParameters
forall ledgerera. PParams ledgerera -> ProtocolParameters
fromShelleyPParams (PParams StandardShelley -> ProtocolParameters)
-> (ShelleyGenesis StandardShelley -> PParams StandardShelley)
-> ShelleyGenesis StandardShelley
-> ProtocolParameters
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyGenesis StandardShelley -> PParams StandardShelley
forall era. ShelleyGenesis era -> PParams era
sgProtocolParams (ShelleyGenesis StandardShelley -> ProtocolParameters)
-> ExceptT ShelleyTxCmdError IO (ShelleyGenesis StandardShelley)
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (ShelleyGenesisCmdError -> ShelleyTxCmdError)
-> ExceptT
     ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
-> ExceptT ShelleyTxCmdError IO (ShelleyGenesis StandardShelley)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyGenesisCmdError -> ShelleyTxCmdError
ShelleyTxCmdGenesisCmdError
        (String
-> (ShelleyGenesis StandardShelley
    -> ShelleyGenesis StandardShelley)
-> ExceptT
     ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
readShelleyGenesis String
f ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
forall (cat :: * -> * -> *) a. Category cat => cat a a
identity)
readProtocolParametersSourceSpec (ParamsFromFile ProtocolParamsFile
f) =
    ProtocolParamsFile
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
readProtocolParameters ProtocolParamsFile
f

--TODO: eliminate this and get only the necessary params, and get them in a more
-- helpful way rather than requiring them as a local file.
readProtocolParameters :: ProtocolParamsFile
                       -> ExceptT ShelleyTxCmdError IO ProtocolParameters
readProtocolParameters :: ProtocolParamsFile
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
readProtocolParameters (ProtocolParamsFile String
fpath) = do
  ByteString
pparams <- (IOException -> ShelleyTxCmdError)
-> IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyTxCmdError
ShelleyTxCmdReadFileError (FileError () -> ShelleyTxCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyTxCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath) (IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString)
-> IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
LBS.readFile String
fpath
  (String -> ShelleyTxCmdError)
-> ExceptT String IO ProtocolParameters
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> Text -> ShelleyTxCmdError
ShelleyTxCmdAesonDecodeProtocolParamsError String
fpath (Text -> ShelleyTxCmdError)
-> (String -> Text) -> String -> ShelleyTxCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack) (ExceptT String IO ProtocolParameters
 -> ExceptT ShelleyTxCmdError IO ProtocolParameters)
-> (Either String ProtocolParameters
    -> ExceptT String IO ProtocolParameters)
-> Either String ProtocolParameters
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either String ProtocolParameters
-> ExceptT String IO ProtocolParameters
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either String ProtocolParameters
 -> ExceptT ShelleyTxCmdError IO ProtocolParameters)
-> Either String ProtocolParameters
-> ExceptT ShelleyTxCmdError IO ProtocolParameters
forall a b. (a -> b) -> a -> b
$
    ByteString -> Either String ProtocolParameters
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
pparams


-- ----------------------------------------------------------------------------
-- Witness handling
--

data SomeWitness
  = AByronSigningKey           (SigningKey ByronKey) (Maybe (Address ByronAddr))
  | APaymentSigningKey         (SigningKey PaymentKey)
  | APaymentExtendedSigningKey (SigningKey PaymentExtendedKey)
  | AStakeSigningKey           (SigningKey StakeKey)
  | AStakeExtendedSigningKey   (SigningKey StakeExtendedKey)
  | AStakePoolSigningKey       (SigningKey StakePoolKey)
  | AGenesisSigningKey         (SigningKey GenesisKey)
  | AGenesisExtendedSigningKey (SigningKey GenesisExtendedKey)
  | AGenesisDelegateSigningKey (SigningKey GenesisDelegateKey)
  | AGenesisDelegateExtendedSigningKey
                               (SigningKey GenesisDelegateExtendedKey)
  | AGenesisUTxOSigningKey     (SigningKey GenesisUTxOKey)


-- | Error reading the data required to construct a key witness.
data ReadWitnessSigningDataError
  = ReadWitnessSigningDataSigningKeyDecodeError !(FileError InputDecodeError)
  | ReadWitnessSigningDataScriptError !(FileError JsonDecodeError)
  | ReadWitnessSigningDataSigningKeyAndAddressMismatch
  -- ^ A Byron address was specified alongside a non-Byron signing key.
  deriving Int -> ReadWitnessSigningDataError -> ShowS
[ReadWitnessSigningDataError] -> ShowS
ReadWitnessSigningDataError -> String
(Int -> ReadWitnessSigningDataError -> ShowS)
-> (ReadWitnessSigningDataError -> String)
-> ([ReadWitnessSigningDataError] -> ShowS)
-> Show ReadWitnessSigningDataError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadWitnessSigningDataError] -> ShowS
$cshowList :: [ReadWitnessSigningDataError] -> ShowS
show :: ReadWitnessSigningDataError -> String
$cshow :: ReadWitnessSigningDataError -> String
showsPrec :: Int -> ReadWitnessSigningDataError -> ShowS
$cshowsPrec :: Int -> ReadWitnessSigningDataError -> ShowS
Show

-- | Render an error message for a 'ReadWitnessSigningDataError'.
renderReadWitnessSigningDataError :: ReadWitnessSigningDataError -> Text
renderReadWitnessSigningDataError :: ReadWitnessSigningDataError -> Text
renderReadWitnessSigningDataError ReadWitnessSigningDataError
err =
  case ReadWitnessSigningDataError
err of
    ReadWitnessSigningDataSigningKeyDecodeError FileError InputDecodeError
fileErr ->
      Text
"Error reading signing key: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (FileError InputDecodeError -> String
forall e. Error e => e -> String
displayError FileError InputDecodeError
fileErr)
    ReadWitnessSigningDataScriptError FileError JsonDecodeError
fileErr ->
      Text
"Error reading script: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (FileError JsonDecodeError -> String
forall e. Error e => e -> String
displayError FileError JsonDecodeError
fileErr)
    ReadWitnessSigningDataError
ReadWitnessSigningDataSigningKeyAndAddressMismatch ->
      Text
"Only a Byron signing key may be accompanied by a Byron address."

readWitnessSigningData
  :: WitnessSigningData
  -> ExceptT ReadWitnessSigningDataError IO SomeWitness
readWitnessSigningData :: WitnessSigningData
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
readWitnessSigningData (KeyWitnessSigningData SigningKeyFile
skFile Maybe (Address ByronAddr)
mbByronAddr) = do
    SomeWitness
res <- (FileError InputDecodeError -> ReadWitnessSigningDataError)
-> ExceptT (FileError InputDecodeError) IO SomeWitness
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ReadWitnessSigningDataError
ReadWitnessSigningDataSigningKeyDecodeError
      (ExceptT (FileError InputDecodeError) IO SomeWitness
 -> ExceptT ReadWitnessSigningDataError IO SomeWitness)
-> (IO (Either (FileError InputDecodeError) SomeWitness)
    -> ExceptT (FileError InputDecodeError) IO SomeWitness)
-> IO (Either (FileError InputDecodeError) SomeWitness)
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError InputDecodeError) SomeWitness)
-> ExceptT (FileError InputDecodeError) IO SomeWitness
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError InputDecodeError) SomeWitness)
 -> ExceptT ReadWitnessSigningDataError IO SomeWitness)
-> IO (Either (FileError InputDecodeError) SomeWitness)
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
forall a b. (a -> b) -> a -> b
$ [FromSomeType SerialiseAsBech32 SomeWitness]
-> [FromSomeType HasTextEnvelope SomeWitness]
-> SigningKeyFile
-> IO (Either (FileError InputDecodeError) SomeWitness)
forall b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> SigningKeyFile
-> IO (Either (FileError InputDecodeError) b)
readSigningKeyFileAnyOf [FromSomeType SerialiseAsBech32 SomeWitness]
bech32FileTypes [FromSomeType HasTextEnvelope SomeWitness]
textEnvFileTypes SigningKeyFile
skFile
    case (SomeWitness
res, Maybe (Address ByronAddr)
mbByronAddr) of
      (AByronSigningKey SigningKey ByronKey
_ Maybe (Address ByronAddr)
_, Just Address ByronAddr
_) -> SomeWitness -> ExceptT ReadWitnessSigningDataError IO SomeWitness
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeWitness
res
      (AByronSigningKey SigningKey ByronKey
_ Maybe (Address ByronAddr)
_, Maybe (Address ByronAddr)
Nothing) -> SomeWitness -> ExceptT ReadWitnessSigningDataError IO SomeWitness
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeWitness
res
      (SomeWitness
_, Maybe (Address ByronAddr)
Nothing) -> SomeWitness -> ExceptT ReadWitnessSigningDataError IO SomeWitness
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeWitness
res
      (SomeWitness
_, Just Address ByronAddr
_) ->
        -- A Byron address should only be specified along with a Byron signing key.
        ReadWitnessSigningDataError
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ReadWitnessSigningDataError
ReadWitnessSigningDataSigningKeyAndAddressMismatch
  where
    textEnvFileTypes :: [FromSomeType HasTextEnvelope SomeWitness]
textEnvFileTypes =
      [ AsType (SigningKey ByronKey)
-> (SigningKey ByronKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType ByronKey -> AsType (SigningKey ByronKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType ByronKey
AsByronKey)
                          (SigningKey ByronKey -> Maybe (Address ByronAddr) -> SomeWitness
`AByronSigningKey` Maybe (Address ByronAddr)
mbByronAddr)
      , AsType (SigningKey PaymentKey)
-> (SigningKey PaymentKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PaymentKey -> AsType (SigningKey PaymentKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey)
                          SigningKey PaymentKey -> SomeWitness
APaymentSigningKey
      , AsType (SigningKey PaymentExtendedKey)
-> (SigningKey PaymentExtendedKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PaymentExtendedKey -> AsType (SigningKey PaymentExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentExtendedKey
AsPaymentExtendedKey)
                          SigningKey PaymentExtendedKey -> SomeWitness
APaymentExtendedSigningKey
      , AsType (SigningKey StakeKey)
-> (SigningKey StakeKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakeKey -> AsType (SigningKey StakeKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeKey
AsStakeKey)
                          SigningKey StakeKey -> SomeWitness
AStakeSigningKey
      , AsType (SigningKey StakeExtendedKey)
-> (SigningKey StakeExtendedKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakeExtendedKey -> AsType (SigningKey StakeExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeExtendedKey
AsStakeExtendedKey)
                          SigningKey StakeExtendedKey -> SomeWitness
AStakeExtendedSigningKey
      , AsType (SigningKey StakePoolKey)
-> (SigningKey StakePoolKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolKey -> AsType (SigningKey StakePoolKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolKey
AsStakePoolKey)
                          SigningKey StakePoolKey -> SomeWitness
AStakePoolSigningKey
      , AsType (SigningKey GenesisKey)
-> (SigningKey GenesisKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisKey -> AsType (SigningKey GenesisKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisKey
AsGenesisKey)
                          SigningKey GenesisKey -> SomeWitness
AGenesisSigningKey
      , AsType (SigningKey GenesisExtendedKey)
-> (SigningKey GenesisExtendedKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisExtendedKey -> AsType (SigningKey GenesisExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisExtendedKey
AsGenesisExtendedKey)
                          SigningKey GenesisExtendedKey -> SomeWitness
AGenesisExtendedSigningKey
      , AsType (SigningKey GenesisDelegateKey)
-> (SigningKey GenesisDelegateKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisDelegateKey -> AsType (SigningKey GenesisDelegateKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey)
                          SigningKey GenesisDelegateKey -> SomeWitness
AGenesisDelegateSigningKey
      , AsType (SigningKey GenesisDelegateExtendedKey)
-> (SigningKey GenesisDelegateExtendedKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisDelegateExtendedKey
-> AsType (SigningKey GenesisDelegateExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateExtendedKey
AsGenesisDelegateExtendedKey)
                          SigningKey GenesisDelegateExtendedKey -> SomeWitness
AGenesisDelegateExtendedSigningKey
      , AsType (SigningKey GenesisUTxOKey)
-> (SigningKey GenesisUTxOKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisUTxOKey -> AsType (SigningKey GenesisUTxOKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
                          SigningKey GenesisUTxOKey -> SomeWitness
AGenesisUTxOSigningKey
      ]

    bech32FileTypes :: [FromSomeType SerialiseAsBech32 SomeWitness]
bech32FileTypes =
      [ AsType (SigningKey PaymentKey)
-> (SigningKey PaymentKey -> SomeWitness)
-> FromSomeType SerialiseAsBech32 SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PaymentKey -> AsType (SigningKey PaymentKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey)
                          SigningKey PaymentKey -> SomeWitness
APaymentSigningKey
      , AsType (SigningKey PaymentExtendedKey)
-> (SigningKey PaymentExtendedKey -> SomeWitness)
-> FromSomeType SerialiseAsBech32 SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PaymentExtendedKey -> AsType (SigningKey PaymentExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentExtendedKey
AsPaymentExtendedKey)
                          SigningKey PaymentExtendedKey -> SomeWitness
APaymentExtendedSigningKey
      , AsType (SigningKey StakeKey)
-> (SigningKey StakeKey -> SomeWitness)
-> FromSomeType SerialiseAsBech32 SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakeKey -> AsType (SigningKey StakeKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeKey
AsStakeKey)
                          SigningKey StakeKey -> SomeWitness
AStakeSigningKey
      , AsType (SigningKey StakeExtendedKey)
-> (SigningKey StakeExtendedKey -> SomeWitness)
-> FromSomeType SerialiseAsBech32 SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakeExtendedKey -> AsType (SigningKey StakeExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeExtendedKey
AsStakeExtendedKey)
                          SigningKey StakeExtendedKey -> SomeWitness
AStakeExtendedSigningKey
      , AsType (SigningKey StakePoolKey)
-> (SigningKey StakePoolKey -> SomeWitness)
-> FromSomeType SerialiseAsBech32 SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolKey -> AsType (SigningKey StakePoolKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolKey
AsStakePoolKey)
                          SigningKey StakePoolKey -> SomeWitness
AStakePoolSigningKey
      ]

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

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


-- | Some kind of Byron or Shelley witness.
data ByronOrShelleyWitness
  = AByronWitness !ShelleyBootstrapWitnessSigningKeyData
  | AShelleyKeyWitness !ShelleyWitnessSigningKey

categoriseSomeWitness :: SomeWitness -> ByronOrShelleyWitness
categoriseSomeWitness :: SomeWitness -> ByronOrShelleyWitness
categoriseSomeWitness SomeWitness
swsk =
  case SomeWitness
swsk of
    AByronSigningKey           SigningKey ByronKey
sk Maybe (Address ByronAddr)
addr -> ShelleyBootstrapWitnessSigningKeyData -> ByronOrShelleyWitness
AByronWitness (SigningKey ByronKey
-> Maybe (Address ByronAddr)
-> ShelleyBootstrapWitnessSigningKeyData
ShelleyBootstrapWitnessSigningKeyData SigningKey ByronKey
sk Maybe (Address ByronAddr)
addr)
    APaymentSigningKey         SigningKey PaymentKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey PaymentKey -> ShelleyWitnessSigningKey
WitnessPaymentKey         SigningKey PaymentKey
sk)
    APaymentExtendedSigningKey SigningKey PaymentExtendedKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey PaymentExtendedKey -> ShelleyWitnessSigningKey
WitnessPaymentExtendedKey SigningKey PaymentExtendedKey
sk)
    AStakeSigningKey           SigningKey StakeKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey StakeKey -> ShelleyWitnessSigningKey
WitnessStakeKey           SigningKey StakeKey
sk)
    AStakeExtendedSigningKey   SigningKey StakeExtendedKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey StakeExtendedKey -> ShelleyWitnessSigningKey
WitnessStakeExtendedKey   SigningKey StakeExtendedKey
sk)
    AStakePoolSigningKey       SigningKey StakePoolKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey StakePoolKey -> ShelleyWitnessSigningKey
WitnessStakePoolKey       SigningKey StakePoolKey
sk)
    AGenesisSigningKey         SigningKey GenesisKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisKey -> ShelleyWitnessSigningKey
WitnessGenesisKey SigningKey GenesisKey
sk)
    AGenesisExtendedSigningKey SigningKey GenesisExtendedKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisExtendedKey -> ShelleyWitnessSigningKey
WitnessGenesisExtendedKey SigningKey GenesisExtendedKey
sk)
    AGenesisDelegateSigningKey SigningKey GenesisDelegateKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisDelegateKey -> ShelleyWitnessSigningKey
WitnessGenesisDelegateKey SigningKey GenesisDelegateKey
sk)
    AGenesisDelegateExtendedSigningKey SigningKey GenesisDelegateExtendedKey
sk
                                       -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisDelegateExtendedKey -> ShelleyWitnessSigningKey
WitnessGenesisDelegateExtendedKey SigningKey GenesisDelegateExtendedKey
sk)
    AGenesisUTxOSigningKey     SigningKey GenesisUTxOKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisUTxOKey -> ShelleyWitnessSigningKey
WitnessGenesisUTxOKey     SigningKey GenesisUTxOKey
sk)

-- | Data required for constructing a Shelley bootstrap witness.
data ShelleyBootstrapWitnessSigningKeyData
  = ShelleyBootstrapWitnessSigningKeyData
      !(SigningKey ByronKey)
      -- ^ Byron signing key.
      !(Maybe (Address ByronAddr))
      -- ^ An optionally specified Byron address.
      --
      -- If specified, both the network ID and derivation path are extracted
      -- from the address and used in the construction of the Byron witness.

-- | 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 -> String
(Int -> ShelleyBootstrapWitnessError -> ShowS)
-> (ShelleyBootstrapWitnessError -> String)
-> ([ShelleyBootstrapWitnessError] -> ShowS)
-> Show ShelleyBootstrapWitnessError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyBootstrapWitnessError] -> ShowS
$cshowList :: [ShelleyBootstrapWitnessError] -> ShowS
show :: ShelleyBootstrapWitnessError -> String
$cshow :: ShelleyBootstrapWitnessError -> String
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 "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"network ID. Either provide a network ID or provide a Byron "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"address with each Byron signing key (network IDs can be derived "
    Text -> Text -> Text
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 :: Maybe NetworkId
-> TxBody era
-> ShelleyBootstrapWitnessSigningKeyData
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness Maybe NetworkId
Nothing TxBody era
_ (ShelleyBootstrapWitnessSigningKeyData SigningKey ByronKey
_ Maybe (Address ByronAddr)
Nothing) =
  ShelleyBootstrapWitnessError
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
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) =
  KeyWitness era
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
forall a b. b -> Either a b
Right (KeyWitness era
 -> Either ShelleyBootstrapWitnessError (KeyWitness era))
-> KeyWitness era
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ WitnessNetworkIdOrByronAddress
-> TxBody era -> SigningKey ByronKey -> KeyWitness era
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)) =
  KeyWitness era
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
forall a b. b -> Either a b
Right (KeyWitness era
 -> Either ShelleyBootstrapWitnessError (KeyWitness era))
-> KeyWitness era
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ WitnessNetworkIdOrByronAddress
-> TxBody era -> SigningKey ByronKey -> KeyWitness era
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 :: Maybe NetworkId
-> TxBody era
-> [ShelleyBootstrapWitnessSigningKeyData]
-> Either ShelleyBootstrapWitnessError [KeyWitness era]
mkShelleyBootstrapWitnesses Maybe NetworkId
mnw TxBody era
txBody =
  (ShelleyBootstrapWitnessSigningKeyData
 -> Either ShelleyBootstrapWitnessError (KeyWitness era))
-> [ShelleyBootstrapWitnessSigningKeyData]
-> Either ShelleyBootstrapWitnessError [KeyWitness era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe NetworkId
-> TxBody era
-> ShelleyBootstrapWitnessSigningKeyData
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
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
    ScriptData
d <- ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO ScriptData
readScriptDataOrFile ScriptDataOrFile
scriptDataOrFile
    IO () -> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyTxCmdError IO ())
-> IO () -> ExceptT ShelleyTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (ScriptData -> Hash ScriptData
hashScriptData ScriptData
d)

runTxGetTxId :: InputTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxGetTxId :: InputTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxGetTxId InputTxFile
txfile = do
    InAnyCardanoEra CardanoEra era
_era TxBody era
txbody <-
      case InputTxFile
txfile of
        InputTxBodyFile (TxBodyFile String
txbodyFile) -> String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
readFileTxBody String
txbodyFile
        InputTxFile (TxFile String
txFile) -> do
          InAnyCardanoEra CardanoEra era
era Tx era
tx <- String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra Tx)
readFileTx String
txFile
          InAnyCardanoEra TxBody
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
forall (m :: * -> *) a. Monad m => a -> m a
return (InAnyCardanoEra TxBody
 -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody))
-> (TxBody era -> InAnyCardanoEra TxBody)
-> TxBody era
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CardanoEra era -> TxBody era -> InAnyCardanoEra TxBody
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
era (TxBody era
 -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody))
-> TxBody era
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
forall a b. (a -> b) -> a -> b
$ Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx

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

runTxView :: InputTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxView :: InputTxFile -> ExceptT ShelleyTxCmdError IO ()
runTxView InputTxFile
txfile = do
  InAnyCardanoEra CardanoEra era
era TxBody era
txbody <-
    case InputTxFile
txfile of
      InputTxBodyFile (TxBodyFile String
txbodyFile) -> String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
readFileTxBody String
txbodyFile
      InputTxFile (TxFile String
txFile) -> do
        InAnyCardanoEra CardanoEra era
era Tx era
tx <- String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra Tx)
readFileTx String
txFile
        InAnyCardanoEra TxBody
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
forall (m :: * -> *) a. Monad m => a -> m a
return (InAnyCardanoEra TxBody
 -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody))
-> (TxBody era -> InAnyCardanoEra TxBody)
-> TxBody era
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CardanoEra era -> TxBody era -> InAnyCardanoEra TxBody
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
era (TxBody era
 -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody))
-> TxBody era
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
forall a b. (a -> b) -> a -> b
$ Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx
  IO () -> ExceptT ShelleyTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyTxCmdError IO ())
-> IO () -> ExceptT ShelleyTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStr (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> TxBody era -> ByteString
forall era. CardanoEra era -> TxBody era -> ByteString
friendlyTxBodyBS CardanoEra era
era TxBody era
txbody


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

runTxCreateWitness
  :: TxBodyFile
  -> WitnessSigningData
  -> Maybe NetworkId
  -> OutputFile
  -> ExceptT ShelleyTxCmdError IO ()
runTxCreateWitness :: TxBodyFile
-> WitnessSigningData
-> Maybe NetworkId
-> OutputFile
-> ExceptT ShelleyTxCmdError IO ()
runTxCreateWitness (TxBodyFile String
txbodyFile) WitnessSigningData
witSignData Maybe NetworkId
mbNw (OutputFile String
oFile) = do

  InAnyShelleyBasedEra ShelleyBasedEra era
_era TxBody era
txbody <-
        --TODO: in principle we should be able to support Byron era txs too
        Text
-> InAnyCardanoEra TxBody
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra TxBody)
forall (a :: * -> *).
Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
"witness for Byron era transactions"
    (InAnyCardanoEra TxBody
 -> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra TxBody))
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra TxBody)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
readFileTxBody String
txbodyFile
  -- We use the era of the tx we read to determine the era we use for the rest:

  SomeWitness
someWit <- (ReadWitnessSigningDataError -> ShelleyTxCmdError)
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
-> ExceptT ShelleyTxCmdError IO SomeWitness
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ReadWitnessSigningDataError -> ShelleyTxCmdError
ShelleyTxCmdReadWitnessSigningDataError
    (ExceptT ReadWitnessSigningDataError IO SomeWitness
 -> ExceptT ShelleyTxCmdError IO SomeWitness)
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
-> ExceptT ShelleyTxCmdError IO SomeWitness
forall a b. (a -> b) -> a -> b
$ WitnessSigningData
-> ExceptT ReadWitnessSigningDataError IO 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 ->
        (ShelleyBootstrapWitnessError -> ShelleyTxCmdError)
-> ExceptT ShelleyBootstrapWitnessError IO (KeyWitness era)
-> ExceptT ShelleyTxCmdError IO (KeyWitness era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyBootstrapWitnessError -> ShelleyTxCmdError
ShelleyTxCmdBootstrapWitnessError
          (ExceptT ShelleyBootstrapWitnessError IO (KeyWitness era)
 -> ExceptT ShelleyTxCmdError IO (KeyWitness era))
-> (Either ShelleyBootstrapWitnessError (KeyWitness era)
    -> ExceptT ShelleyBootstrapWitnessError IO (KeyWitness era))
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
-> ExceptT ShelleyTxCmdError IO (KeyWitness era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either ShelleyBootstrapWitnessError (KeyWitness era)
-> ExceptT ShelleyBootstrapWitnessError IO (KeyWitness era)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
          (Either ShelleyBootstrapWitnessError (KeyWitness era)
 -> ExceptT ShelleyTxCmdError IO (KeyWitness era))
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
-> ExceptT ShelleyTxCmdError IO (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ Maybe NetworkId
-> TxBody era
-> ShelleyBootstrapWitnessSigningKeyData
-> Either ShelleyBootstrapWitnessError (KeyWitness era)
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 ->
        KeyWitness era -> ExceptT ShelleyTxCmdError IO (KeyWitness era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyWitness era -> ExceptT ShelleyTxCmdError IO (KeyWitness era))
-> KeyWitness era -> ExceptT ShelleyTxCmdError IO (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
forall era.
IsShelleyBasedEra era =>
TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
makeShelleyKeyWitness TxBody era
txbody ShelleyWitnessSigningKey
skShelley

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


runTxSignWitness
  :: TxBodyFile
  -> [WitnessFile]
  -> OutputFile
  -> ExceptT ShelleyTxCmdError IO ()
runTxSignWitness :: TxBodyFile
-> [WitnessFile] -> OutputFile -> ExceptT ShelleyTxCmdError IO ()
runTxSignWitness (TxBodyFile String
txbodyFile) [WitnessFile]
witnessFiles (OutputFile String
oFp) = do
    InAnyCardanoEra CardanoEra era
era TxBody era
txbody  <- String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
readFileTxBody String
txbodyFile
    InAnyShelleyBasedEra ShelleyBasedEra era
_ TxBody era
_ <-
          --TODO: in principle we should be able to support Byron era txs too
          Text
-> InAnyCardanoEra TxBody
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra TxBody)
forall (a :: * -> *).
Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
"sign for Byron era transactions"
                                 (CardanoEra era -> TxBody era -> InAnyCardanoEra TxBody
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
era TxBody era
txbody)

    [KeyWitness era]
witnesses <-
      [ExceptT ShelleyTxCmdError IO (KeyWitness era)]
-> ExceptT ShelleyTxCmdError IO [KeyWitness era]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ do InAnyCardanoEra CardanoEra era
era' KeyWitness era
witness <- String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra KeyWitness)
readFileWitness String
file
             case CardanoEra era -> CardanoEra era -> Maybe (era :~: era)
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   -> ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO (KeyWitness era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyTxCmdError
 -> ExceptT ShelleyTxCmdError IO (KeyWitness era))
-> ShelleyTxCmdError
-> ExceptT ShelleyTxCmdError IO (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> AnyCardanoEra -> WitnessFile -> ShelleyTxCmdError
ShelleyTxCmdWitnessEraMismatch
                                     (CardanoEra era -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era)
                                     (CardanoEra era -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era')
                                     WitnessFile
witnessFile
               Just era :~: era
Refl -> KeyWitness era -> ExceptT ShelleyTxCmdError IO (KeyWitness era)
forall (m :: * -> *) a. Monad m => a -> m a
return KeyWitness era
witness
        | witnessFile :: WitnessFile
witnessFile@(WitnessFile String
file) <- [WitnessFile]
witnessFiles ]

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


-- ----------------------------------------------------------------------------
-- Reading files in any era
--

readFileWitness :: FilePath
                -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra KeyWitness)
readFileWitness :: String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra KeyWitness)
readFileWitness = (forall era. AsType era -> AsType (KeyWitness era))
-> String
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra KeyWitness)
forall (thing :: * -> *).
(HasTextEnvelope (thing ByronEra),
 HasTextEnvelope (thing ShelleyEra),
 HasTextEnvelope (thing AllegraEra),
 HasTextEnvelope (thing MaryEra),
 HasTextEnvelope (thing AlonzoEra)) =>
(forall era. AsType era -> AsType (thing era))
-> String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra thing)
readFileInAnyCardanoEra forall era. AsType era -> AsType (KeyWitness era)
AsKeyWitness


readFileTxBody :: FilePath
               -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
readFileTxBody :: String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
readFileTxBody = (forall era. AsType era -> AsType (TxBody era))
-> String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra TxBody)
forall (thing :: * -> *).
(HasTextEnvelope (thing ByronEra),
 HasTextEnvelope (thing ShelleyEra),
 HasTextEnvelope (thing AllegraEra),
 HasTextEnvelope (thing MaryEra),
 HasTextEnvelope (thing AlonzoEra)) =>
(forall era. AsType era -> AsType (thing era))
-> String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra thing)
readFileInAnyCardanoEra forall era. AsType era -> AsType (TxBody era)
AsTxBody


readFileTx :: FilePath -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra Tx)
readFileTx :: String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra Tx)
readFileTx = (forall era. AsType era -> AsType (Tx era))
-> String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra Tx)
forall (thing :: * -> *).
(HasTextEnvelope (thing ByronEra),
 HasTextEnvelope (thing ShelleyEra),
 HasTextEnvelope (thing AllegraEra),
 HasTextEnvelope (thing MaryEra),
 HasTextEnvelope (thing AlonzoEra)) =>
(forall era. AsType era -> AsType (thing era))
-> String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra thing)
readFileInAnyCardanoEra forall era. AsType era -> AsType (Tx era)
AsTx


readFileInAnyCardanoEra
  :: ( HasTextEnvelope (thing ByronEra)
     , HasTextEnvelope (thing ShelleyEra)
     , HasTextEnvelope (thing AllegraEra)
     , HasTextEnvelope (thing MaryEra)
     , HasTextEnvelope (thing AlonzoEra)
     )
  => (forall era. AsType era -> AsType (thing era))
  -> FilePath
  -> ExceptT ShelleyTxCmdError IO
            (InAnyCardanoEra thing)
readFileInAnyCardanoEra :: (forall era. AsType era -> AsType (thing era))
-> String -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra thing)
readFileInAnyCardanoEra forall era. AsType era -> AsType (thing era)
asThing String
file =
    (FileError TextEnvelopeError -> ShelleyTxCmdError)
-> ExceptT (FileError TextEnvelopeError) IO (InAnyCardanoEra thing)
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra thing)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyTxCmdError
ShelleyTxCmdReadTextViewFileError
  (ExceptT (FileError TextEnvelopeError) IO (InAnyCardanoEra thing)
 -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra thing))
-> (IO
      (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing))
    -> ExceptT
         (FileError TextEnvelopeError) IO (InAnyCardanoEra thing))
-> IO
     (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing))
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra thing)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing))
-> ExceptT (FileError TextEnvelopeError) IO (InAnyCardanoEra thing)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
  (IO (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing))
 -> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra thing))
-> IO
     (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing))
-> ExceptT ShelleyTxCmdError IO (InAnyCardanoEra thing)
forall a b. (a -> b) -> a -> b
$ [FromSomeType HasTextEnvelope (InAnyCardanoEra thing)]
-> String
-> IO
     (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing))
forall b.
[FromSomeType HasTextEnvelope b]
-> String -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf
      [ AsType (thing ByronEra)
-> (thing ByronEra -> InAnyCardanoEra thing)
-> FromSomeType HasTextEnvelope (InAnyCardanoEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType ByronEra -> AsType (thing ByronEra)
forall era. AsType era -> AsType (thing era)
asThing AsType ByronEra
AsByronEra)   (CardanoEra ByronEra -> thing ByronEra -> InAnyCardanoEra thing
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra ByronEra
ByronEra)
      , AsType (thing ShelleyEra)
-> (thing ShelleyEra -> InAnyCardanoEra thing)
-> FromSomeType HasTextEnvelope (InAnyCardanoEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType ShelleyEra -> AsType (thing ShelleyEra)
forall era. AsType era -> AsType (thing era)
asThing AsType ShelleyEra
AsShelleyEra) (CardanoEra ShelleyEra -> thing ShelleyEra -> InAnyCardanoEra thing
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra ShelleyEra
ShelleyEra)
      , AsType (thing AllegraEra)
-> (thing AllegraEra -> InAnyCardanoEra thing)
-> FromSomeType HasTextEnvelope (InAnyCardanoEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType AllegraEra -> AsType (thing AllegraEra)
forall era. AsType era -> AsType (thing era)
asThing AsType AllegraEra
AsAllegraEra) (CardanoEra AllegraEra -> thing AllegraEra -> InAnyCardanoEra thing
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra AllegraEra
AllegraEra)
      , AsType (thing MaryEra)
-> (thing MaryEra -> InAnyCardanoEra thing)
-> FromSomeType HasTextEnvelope (InAnyCardanoEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType MaryEra -> AsType (thing MaryEra)
forall era. AsType era -> AsType (thing era)
asThing AsType MaryEra
AsMaryEra)    (CardanoEra MaryEra -> thing MaryEra -> InAnyCardanoEra thing
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra MaryEra
MaryEra)
      , AsType (thing AlonzoEra)
-> (thing AlonzoEra -> InAnyCardanoEra thing)
-> FromSomeType HasTextEnvelope (InAnyCardanoEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType AlonzoEra -> AsType (thing AlonzoEra)
forall era. AsType era -> AsType (thing era)
asThing AsType AlonzoEra
AsAlonzoEra)  (CardanoEra AlonzoEra -> thing AlonzoEra -> InAnyCardanoEra thing
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra AlonzoEra
AlonzoEra)
      ]
      String
file

-- | Constrain the era to be Shelley based. Fail for the Byron era.
--
onlyInShelleyBasedEras :: Text
                       -> InAnyCardanoEra a
                       -> ExceptT ShelleyTxCmdError IO
                                  (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras :: Text
-> InAnyCardanoEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
onlyInShelleyBasedEras Text
notImplMsg (InAnyCardanoEra CardanoEra era
era a era
x) =
    case CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era of
      CardanoEraStyle era
LegacyByronEra       -> ShelleyTxCmdError
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (Text -> ShelleyTxCmdError
ShelleyTxCmdNotImplemented Text
notImplMsg)
      ShelleyBasedEra ShelleyBasedEra era
era' -> InAnyShelleyBasedEra a
-> ExceptT ShelleyTxCmdError IO (InAnyShelleyBasedEra a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ShelleyBasedEra era -> a era -> InAnyShelleyBasedEra a
forall era (thing :: * -> *).
IsShelleyBasedEra era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra era
era' a era
x)


-- ----------------------------------------------------------------------------
-- Reading other files
--

validateScriptSupportedInEra :: CardanoEra era
                             -> ScriptInAnyLang
                             -> ExceptT ShelleyTxCmdError IO (ScriptInEra era)
validateScriptSupportedInEra :: CardanoEra era
-> ScriptInAnyLang
-> ExceptT ShelleyTxCmdError IO (ScriptInEra era)
validateScriptSupportedInEra CardanoEra era
era script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) =
    case CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
forall era.
CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra CardanoEra era
era ScriptInAnyLang
script of
      Maybe (ScriptInEra era)
Nothing -> ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO (ScriptInEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyTxCmdError
 -> ExceptT ShelleyTxCmdError IO (ScriptInEra era))
-> ShelleyTxCmdError
-> ExceptT ShelleyTxCmdError IO (ScriptInEra era)
forall a b. (a -> b) -> a -> b
$ AnyScriptLanguage -> AnyCardanoEra -> ShelleyTxCmdError
ShelleyTxCmdScriptLanguageNotSupportedInEra
                          (ScriptLanguage lang -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang) (CardanoEra era -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era)
      Just ScriptInEra era
script' -> ScriptInEra era -> ExceptT ShelleyTxCmdError IO (ScriptInEra era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptInEra era
script'


-- ----------------------------------------------------------------------------
-- Transaction metadata
--

readFileTxMetadata :: TxMetadataJsonSchema -> MetadataFile
                   -> ExceptT ShelleyTxCmdError IO TxMetadata
readFileTxMetadata :: TxMetadataJsonSchema
-> MetadataFile -> ExceptT ShelleyTxCmdError IO TxMetadata
readFileTxMetadata TxMetadataJsonSchema
mapping (MetadataFileJSON String
fp) = do
    ByteString
bs <- (IOException -> ShelleyTxCmdError)
-> IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyTxCmdError
ShelleyTxCmdReadFileError (FileError () -> ShelleyTxCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyTxCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fp) (IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString)
-> IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
          String -> IO ByteString
LBS.readFile String
fp
    Value
v  <- (String -> ShelleyTxCmdError)
-> ExceptT String IO Value -> ExceptT ShelleyTxCmdError IO Value
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> String -> ShelleyTxCmdError
ShelleyTxCmdMetadataJsonParseError String
fp) (ExceptT String IO Value -> ExceptT ShelleyTxCmdError IO Value)
-> ExceptT String IO Value -> ExceptT ShelleyTxCmdError IO Value
forall a b. (a -> b) -> a -> b
$
          Either String Value -> ExceptT String IO Value
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either String Value -> ExceptT String IO Value)
-> Either String Value -> ExceptT String IO Value
forall a b. (a -> b) -> a -> b
$
            ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
bs
    TxMetadata
txMetadata <- (TxMetadataJsonError -> ShelleyTxCmdError)
-> ExceptT TxMetadataJsonError IO TxMetadata
-> ExceptT ShelleyTxCmdError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> TxMetadataJsonError -> ShelleyTxCmdError
ShelleyTxCmdMetadataConversionError String
fp) (ExceptT TxMetadataJsonError IO TxMetadata
 -> ExceptT ShelleyTxCmdError IO TxMetadata)
-> ExceptT TxMetadataJsonError IO TxMetadata
-> ExceptT ShelleyTxCmdError IO TxMetadata
forall a b. (a -> b) -> a -> b
$ Either TxMetadataJsonError TxMetadata
-> ExceptT TxMetadataJsonError IO TxMetadata
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TxMetadataJsonError TxMetadata
 -> ExceptT TxMetadataJsonError IO TxMetadata)
-> Either TxMetadataJsonError TxMetadata
-> ExceptT TxMetadataJsonError IO TxMetadata
forall a b. (a -> b) -> a -> b
$
      TxMetadataJsonSchema
-> Value -> Either TxMetadataJsonError TxMetadata
metadataFromJson TxMetadataJsonSchema
mapping Value
v
    ([(Word64, TxMetadataRangeError)] -> ShelleyTxCmdError)
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
-> ExceptT ShelleyTxCmdError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> [(Word64, TxMetadataRangeError)] -> ShelleyTxCmdError
ShelleyTxCmdMetaValidationError String
fp) (ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
 -> ExceptT ShelleyTxCmdError IO TxMetadata)
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
-> ExceptT ShelleyTxCmdError IO TxMetadata
forall a b. (a -> b) -> a -> b
$ Either [(Word64, TxMetadataRangeError)] TxMetadata
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either [(Word64, TxMetadataRangeError)] TxMetadata
 -> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata)
-> Either [(Word64, TxMetadataRangeError)] TxMetadata
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
forall a b. (a -> b) -> a -> b
$ do
        TxMetadata -> Either [(Word64, TxMetadataRangeError)] ()
validateTxMetadata TxMetadata
txMetadata
        TxMetadata -> Either [(Word64, TxMetadataRangeError)] TxMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return TxMetadata
txMetadata

readFileTxMetadata TxMetadataJsonSchema
_ (MetadataFileCBOR String
fp) = do
    ByteString
bs <- (IOException -> ShelleyTxCmdError)
-> IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyTxCmdError
ShelleyTxCmdReadFileError (FileError () -> ShelleyTxCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyTxCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fp) (IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString)
-> IO ByteString -> ExceptT ShelleyTxCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
          String -> IO ByteString
BS.readFile String
fp
    TxMetadata
txMetadata <- (DecoderError -> ShelleyTxCmdError)
-> ExceptT DecoderError IO TxMetadata
-> ExceptT ShelleyTxCmdError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> DecoderError -> ShelleyTxCmdError
ShelleyTxCmdMetaDecodeError String
fp) (ExceptT DecoderError IO TxMetadata
 -> ExceptT ShelleyTxCmdError IO TxMetadata)
-> ExceptT DecoderError IO TxMetadata
-> ExceptT ShelleyTxCmdError IO TxMetadata
forall a b. (a -> b) -> a -> b
$ Either DecoderError TxMetadata
-> ExceptT DecoderError IO TxMetadata
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either DecoderError TxMetadata
 -> ExceptT DecoderError IO TxMetadata)
-> Either DecoderError TxMetadata
-> ExceptT DecoderError IO TxMetadata
forall a b. (a -> b) -> a -> b
$
      AsType TxMetadata -> ByteString -> Either DecoderError TxMetadata
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType TxMetadata
AsTxMetadata ByteString
bs
    ([(Word64, TxMetadataRangeError)] -> ShelleyTxCmdError)
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
-> ExceptT ShelleyTxCmdError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> [(Word64, TxMetadataRangeError)] -> ShelleyTxCmdError
ShelleyTxCmdMetaValidationError String
fp) (ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
 -> ExceptT ShelleyTxCmdError IO TxMetadata)
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
-> ExceptT ShelleyTxCmdError IO TxMetadata
forall a b. (a -> b) -> a -> b
$ Either [(Word64, TxMetadataRangeError)] TxMetadata
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either [(Word64, TxMetadataRangeError)] TxMetadata
 -> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata)
-> Either [(Word64, TxMetadataRangeError)] TxMetadata
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
forall a b. (a -> b) -> a -> b
$ do
        TxMetadata -> Either [(Word64, TxMetadataRangeError)] ()
validateTxMetadata TxMetadata
txMetadata
        TxMetadata -> Either [(Word64, TxMetadataRangeError)] TxMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return TxMetadata
txMetadata

executeQuery
  :: forall result era mode. CardanoEra era
  -> ConsensusModeParams mode
  -> LocalNodeConnectInfo mode
  -> QueryInMode mode (Either EraMismatch result)
  -> ExceptT ShelleyTxCmdError IO result
executeQuery :: CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyTxCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeP LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode mode (Either EraMismatch result)
q = do
  EraInMode era mode
eraInMode <- CardanoEra era
-> ConsensusMode mode
-> ExceptT ShelleyTxCmdError IO (EraInMode era mode)
forall era mode.
CardanoEra era
-> ConsensusMode mode
-> ExceptT ShelleyTxCmdError IO (EraInMode era mode)
calcEraInMode CardanoEra era
era (ConsensusMode mode
 -> ExceptT ShelleyTxCmdError IO (EraInMode era mode))
-> ConsensusMode mode
-> ExceptT ShelleyTxCmdError IO (EraInMode era mode)
forall a b. (a -> b) -> a -> b
$ ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeP
  case EraInMode era mode
eraInMode of
    EraInMode era mode
ByronEraInByronMode -> ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO result
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ShelleyTxCmdError
ShelleyTxCmdByronEraQuery
    EraInMode era mode
_ -> IO (Either AcquireFailure (Either EraMismatch result))
-> ExceptT
     ShelleyTxCmdError
     IO
     (Either AcquireFailure (Either EraMismatch result))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either AcquireFailure (Either EraMismatch result))
execQuery ExceptT
  ShelleyTxCmdError
  IO
  (Either AcquireFailure (Either EraMismatch result))
-> (Either AcquireFailure (Either EraMismatch result)
    -> ExceptT ShelleyTxCmdError IO result)
-> ExceptT ShelleyTxCmdError IO result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either AcquireFailure (Either EraMismatch result)
-> ExceptT ShelleyTxCmdError IO result
forall a.
Either AcquireFailure (Either EraMismatch a)
-> ExceptT ShelleyTxCmdError IO a
queryResult
 where
   execQuery :: IO (Either AcquireFailure (Either EraMismatch result))
   execQuery :: IO (Either AcquireFailure (Either EraMismatch result))
execQuery = LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode (Either EraMismatch result)
-> IO (Either AcquireFailure (Either EraMismatch result))
forall mode result.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode result
-> IO (Either AcquireFailure result)
queryNodeLocalState LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing QueryInMode mode (Either EraMismatch result)
q


queryResult
  :: Either AcquireFailure (Either EraMismatch a)
  -> ExceptT ShelleyTxCmdError IO a
queryResult :: Either AcquireFailure (Either EraMismatch a)
-> ExceptT ShelleyTxCmdError IO a
queryResult Either AcquireFailure (Either EraMismatch a)
eAcq =
  case Either AcquireFailure (Either EraMismatch a)
eAcq of
    Left AcquireFailure
acqFailure -> ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO a
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO a)
-> ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO a
forall a b. (a -> b) -> a -> b
$ AcquireFailure -> ShelleyTxCmdError
ShelleyTxCmdAcquireFailure AcquireFailure
acqFailure
    Right Either EraMismatch a
eResult ->
      case Either EraMismatch a
eResult of
        Left EraMismatch
err -> ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO a
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyTxCmdError -> ExceptT ShelleyTxCmdError IO a)
-> (ShelleyQueryCmdLocalStateQueryError -> ShelleyTxCmdError)
-> ShelleyQueryCmdLocalStateQueryError
-> ExceptT ShelleyTxCmdError IO a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyQueryCmdLocalStateQueryError -> ShelleyTxCmdError
ShelleyTxCmdLocalStateQueryError (ShelleyQueryCmdLocalStateQueryError
 -> ExceptT ShelleyTxCmdError IO a)
-> ShelleyQueryCmdLocalStateQueryError
-> ExceptT ShelleyTxCmdError IO a
forall a b. (a -> b) -> a -> b
$ EraMismatch -> ShelleyQueryCmdLocalStateQueryError
EraMismatchError EraMismatch
err
        Right a
result -> a -> ExceptT ShelleyTxCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

calcEraInMode
  :: CardanoEra era
  -> ConsensusMode mode
  -> ExceptT ShelleyTxCmdError IO (EraInMode era mode)
calcEraInMode :: CardanoEra era
-> ConsensusMode mode
-> ExceptT ShelleyTxCmdError IO (EraInMode era mode)
calcEraInMode CardanoEra era
era ConsensusMode mode
mode=
  ShelleyTxCmdError
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyTxCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyCardanoEra -> ShelleyTxCmdError
ShelleyTxCmdEraConsensusModeMismatchQuery (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
mode) (CardanoEra era -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era))
                   (Maybe (EraInMode era mode)
 -> ExceptT ShelleyTxCmdError IO (EraInMode era mode))
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyTxCmdError IO (EraInMode era mode)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
mode