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

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

module Bcc.CLI.Sophie.Run.Transaction
  ( SophieTxCmdError
  , renderSophieTxCmdError
  , runTransactionCmd
  ) where

import           Bcc.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           Data.List (intersect, (\\))
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.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither,
                   hoistMaybe, left, newExceptT)

import           Bcc.Api
import           Bcc.Api.Cole hiding (SomeColeSigningKey (..))
import           Bcc.Api.Sophie
import           Shardagnostic.Consensus.Sophie.Eras (StandardEvie, StandardJen, StandardSophie)

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

--TODO: following import needed for orphan Eq Script instance
import           Bcc.Ledger.SophieMA.TxBody ()
import           Sophie.Spec.Ledger.Scripts ()

import           Bcc.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
import           Bcc.CLI.Run.Friendly (friendlyTxBodyBS)
import           Bcc.CLI.Sophie.Key (InputDecodeError, readSigningKeyFileAnyOf)
import           Bcc.CLI.Sophie.Parsers
import           Bcc.CLI.Sophie.Run.Genesis (SophieGenesisCmdError (..), readSophieGenesis,
                   renderSophieGenesisCmdError)
import           Bcc.CLI.Sophie.Run.Query (SophieQueryCmdLocalStateQueryError (..),
                   renderLocalStateQueryError)
import           Bcc.CLI.Sophie.Script
import           Bcc.CLI.Types
import           Shardagnostic.Consensus.Cole.Ledger (ColeBlock)
import           Shardagnostic.Consensus.Bcc.Block (EraMismatch (..))
import           Shardagnostic.Consensus.Ledger.SupportsMempool (ApplyTxErr)
import           Shardagnostic.Consensus.Sophie.Ledger (SophieBlock)
import           Shardagnostic.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..))
import qualified Shardagnostic.Network.Protocol.LocalTxSubmission.Client as Net.Tx

import qualified System.IO as IO

{- HLINT ignore "Use let" -}

data SophieTxCmdError
  = SophieTxCmdAesonDecodeProtocolParamsError !FilePath !Text
  | SophieTxCmdReadFileError !(FileError ())
  | SophieTxCmdScriptFileError (FileError ScriptDecodeError)
  | SophieTxCmdReadTextViewFileError !(FileError TextEnvelopeError)
  | SophieTxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError
  | SophieTxCmdWriteFileError !(FileError ())
  | SophieTxCmdEraConsensusModeMismatch
      !(Maybe FilePath)
      !AnyConsensusMode
      !AnyBccEra
      -- ^ Era
  | SophieTxCmdMetadataJsonParseError !FilePath !String
  | SophieTxCmdMetadataConversionError !FilePath !TxMetadataJsonError
  | SophieTxCmdMetaValidationError !FilePath ![(Word64, TxMetadataRangeError)]
  | SophieTxCmdScriptDataJsonParseError  !FilePath !String
  | SophieTxCmdScriptDataConversionError !FilePath !ScriptDataJsonError
  | SophieTxCmdScriptDataValidationError !FilePath !ScriptDataRangeError
  | SophieTxCmdMetaDecodeError !FilePath !CBOR.DecoderError
  | SophieTxCmdBootstrapWitnessError !SophieBootstrapWitnessError
  | SophieTxCmdSocketEnvError !EnvSocketError
  | SophieTxCmdTxSubmitError !Text
  | SophieTxCmdTxSubmitErrorCole !(ApplyTxErr ColeBlock)
  | SophieTxCmdTxSubmitErrorSophie !(ApplyTxErr (SophieBlock StandardSophie))
  | SophieTxCmdTxSubmitErrorEvie !(ApplyTxErr (SophieBlock StandardEvie))
  | SophieTxCmdTxSubmitErrorJen !(ApplyTxErr (SophieBlock StandardJen))
  | SophieTxCmdTxSubmitErrorEraMismatch !EraMismatch
  | SophieTxCmdTxFeatureMismatch !AnyBccEra !TxFeature
  | SophieTxCmdTxBodyError !TxBodyError
  | SophieTxCmdNotImplemented !Text
  | SophieTxCmdWitnessEraMismatch !AnyBccEra !AnyBccEra !WitnessFile
  | SophieTxCmdScriptLanguageNotSupportedInEra !AnyScriptLanguage !AnyBccEra
  | SophieTxCmdScriptExpectedSimple !FilePath !AnyScriptLanguage
  | SophieTxCmdScriptExpectedZerepoch !FilePath !AnyScriptLanguage
  | SophieTxCmdGenesisCmdError !SophieGenesisCmdError
  | SophieTxCmdPolicyIdsMissing ![PolicyId]
  | SophieTxCmdPolicyIdsExcess  ![PolicyId]
  | SophieTxCmdAcquireFailure !AcquireFailure
  | SophieTxCmdUnsupportedMode !AnyConsensusMode
  | SophieTxCmdColeEra
  | SophieTxCmdEraConsensusModeMismatchTxBalance
      !TxBodyFile
      !AnyConsensusMode
      !AnyBccEra
  | SophieTxCmdBalanceTxBody !TxBodyErrorAutoBalance
  | SophieTxCmdEraConsensusModeMismatchQuery !AnyConsensusMode !AnyBccEra
  | SophieTxCmdColeEraQuery
  | SophieTxCmdLocalStateQueryError !SophieQueryCmdLocalStateQueryError
  | SophieTxCmdExpectedKeyLockedTxIn ![TxIn]
  | SophieTxCmdTxInsDoNotExist ![TxIn]
  | SophieTxCmdMinimumUTxOErr !MinimumUTxOError
  | SophieTxCmdPParamsErr !ProtocolParametersError
  deriving Int -> SophieTxCmdError -> ShowS
[SophieTxCmdError] -> ShowS
SophieTxCmdError -> String
(Int -> SophieTxCmdError -> ShowS)
-> (SophieTxCmdError -> String)
-> ([SophieTxCmdError] -> ShowS)
-> Show SophieTxCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SophieTxCmdError] -> ShowS
$cshowList :: [SophieTxCmdError] -> ShowS
show :: SophieTxCmdError -> String
$cshow :: SophieTxCmdError -> String
showsPrec :: Int -> SophieTxCmdError -> ShowS
$cshowsPrec :: Int -> SophieTxCmdError -> ShowS
Show


renderSophieTxCmdError :: SophieTxCmdError -> Text
renderSophieTxCmdError :: SophieTxCmdError -> Text
renderSophieTxCmdError SophieTxCmdError
err =
  case SophieTxCmdError
err of
    SophieTxCmdReadFileError FileError ()
fileErr -> String -> Text
Text.pack (FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fileErr)
    SophieTxCmdReadTextViewFileError FileError TextEnvelopeError
fileErr -> String -> Text
Text.pack (FileError TextEnvelopeError -> String
forall e. Error e => e -> String
displayError FileError TextEnvelopeError
fileErr)
    SophieTxCmdScriptFileError FileError ScriptDecodeError
fileErr -> String -> Text
Text.pack (FileError ScriptDecodeError -> String
forall e. Error e => e -> String
displayError FileError ScriptDecodeError
fileErr)
    SophieTxCmdReadWitnessSigningDataError ReadWitnessSigningDataError
witSignDataErr ->
      ReadWitnessSigningDataError -> Text
renderReadWitnessSigningDataError ReadWitnessSigningDataError
witSignDataErr
    SophieTxCmdWriteFileError FileError ()
fileErr -> String -> Text
Text.pack (FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fileErr)
    SophieTxCmdMetadataJsonParseError 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
    SophieTxCmdMetadataConversionError 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)
    SophieTxCmdMetaDecodeError 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
    SophieTxCmdMetaValidationError 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 ]

    SophieTxCmdScriptDataJsonParseError  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
    SophieTxCmdScriptDataConversionError 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)
    SophieTxCmdScriptDataValidationError 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)

    SophieTxCmdSocketEnvError EnvSocketError
envSockErr -> EnvSocketError -> Text
renderEnvSocketError EnvSocketError
envSockErr
    SophieTxCmdAesonDecodeProtocolParamsError 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
    SophieTxCmdTxSubmitError Text
res -> Text
"Error while submitting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
res
    SophieTxCmdTxSubmitErrorCole ApplyTxErr ColeBlock
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 ColeBlock
res)
    SophieTxCmdTxSubmitErrorSophie ApplyTxErr (SophieBlock StandardSophie)
res ->
      Text
"Error while submitting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ApplyTxError StandardSophie -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ApplyTxErr (SophieBlock StandardSophie)
ApplyTxError StandardSophie
res)
    SophieTxCmdTxSubmitErrorEvie ApplyTxErr (SophieBlock StandardEvie)
res ->
      Text
"Error while submitting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ApplyTxError StandardEvie -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ApplyTxErr (SophieBlock StandardEvie)
ApplyTxError StandardEvie
res)
    SophieTxCmdTxSubmitErrorJen ApplyTxErr (SophieBlock StandardJen)
res ->
      Text
"Error while submitting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ApplyTxError StandardJen -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ApplyTxErr (SophieBlock StandardJen)
ApplyTxError StandardJen
res)
    SophieTxCmdTxSubmitErrorEraMismatch 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."
    SophieTxCmdBootstrapWitnessError SophieBootstrapWitnessError
sbwErr ->
      SophieBootstrapWitnessError -> Text
renderSophieBootstrapWitnessError SophieBootstrapWitnessError
sbwErr

    SophieTxCmdTxFeatureMismatch AnyBccEra
era TxFeature
TxFeatureImplicitFees ->
      Text
"An explicit transaction fee must be specified for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      AnyBccEra -> Text
renderEra AnyBccEra
era Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" era transactions."

    SophieTxCmdTxFeatureMismatch (AnyBccEra BccEra era
SophieEra)
                                  TxFeature
TxFeatureValidityNoUpperBound ->
      Text
"A TTL must be specified for Sophie era transactions."

    SophieTxCmdTxFeatureMismatch AnyBccEra
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
<> AnyBccEra -> Text
renderEra AnyBccEra
era Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
" era transactions."

    SophieTxCmdTxBodyError 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')

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

    SophieTxCmdWitnessEraMismatch AnyBccEra
era AnyBccEra
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
<> AnyBccEra -> Text
renderEra AnyBccEra
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
<> AnyBccEra -> Text
renderEra AnyBccEra
era' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" era."

    SophieTxCmdScriptLanguageNotSupportedInEra (AnyScriptLanguage ScriptLanguage lang
lang) AnyBccEra
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
<>
      AnyBccEra -> Text
renderEra AnyBccEra
era Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" era."

    SophieTxCmdScriptExpectedSimple 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 Zerepoch 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."

    SophieTxCmdScriptExpectedZerepoch 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 Zerepoch 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
"."

    SophieTxCmdEraConsensusModeMismatch Maybe String
fp AnyConsensusMode
mode AnyBccEra
era ->
       Text
"Submitting " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AnyBccEra -> Text
renderEra AnyBccEra
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."
    SophieTxCmdGenesisCmdError SophieGenesisCmdError
e -> SophieGenesisCmdError -> Text
renderSophieGenesisCmdError SophieGenesisCmdError
e
    SophieTxCmdPolicyIdsMissing [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)

    SophieTxCmdPolicyIdsExcess [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)
    SophieTxCmdAcquireFailure 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
    SophieTxCmdUnsupportedMode AnyConsensusMode
mode -> Text
"Unsupported mode: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AnyConsensusMode -> Text
renderMode AnyConsensusMode
mode
    SophieTxCmdError
SophieTxCmdColeEra -> Text
"This query cannot be used for the Cole era"
    SophieTxCmdEraConsensusModeMismatchTxBalance TxBodyFile
fp AnyConsensusMode
mode AnyBccEra
era ->
       Text
"Cannot balance " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AnyBccEra -> Text
renderEra AnyBccEra
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."
    SophieTxCmdEraConsensusModeMismatchQuery (AnyConsensusMode ConsensusMode mode
cMode) (AnyBccEra BccEra 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
<> BccEra era -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show BccEra era
era
    SophieTxCmdError
SophieTxCmdColeEraQuery -> Text
"Query not available in Cole era"
    SophieTxCmdLocalStateQueryError SophieQueryCmdLocalStateQueryError
err' -> SophieQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError SophieQueryCmdLocalStateQueryError
err'
    SophieTxCmdBalanceTxBody 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'
    SophieTxCmdExpectedKeyLockedTxIn [TxIn]
txins ->
      Text
"Expected key witnessed collateral tx inputs but got script witnessed tx inputs: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Char -> Text
Text.singleton Char
'\n' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text -> [Text] -> Text
Text.intercalate (Char -> Text
Text.singleton Char
'\n') ((TxIn -> Text) -> [TxIn] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map TxIn -> Text
renderTxIn [TxIn]
txins)
    SophieTxCmdTxInsDoNotExist [TxIn]
txins ->
      Text
"The following tx input(s) were not present in the UTxO: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Char -> Text
Text.singleton Char
'\n' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text -> [Text] -> Text
Text.intercalate (Char -> Text
Text.singleton Char
'\n') ((TxIn -> Text) -> [TxIn] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map TxIn -> Text
renderTxIn [TxIn]
txins)
    SophieTxCmdMinimumUTxOErr MinimumUTxOError
err' -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ MinimumUTxOError -> String
forall e. Error e => e -> String
displayError MinimumUTxOError
err'
    SophieTxCmdPParamsErr ProtocolParametersError
err' -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ProtocolParametersError -> String
forall e. Error e => e -> String
displayError ProtocolParametersError
err'

renderEra :: AnyBccEra -> Text
renderEra :: AnyBccEra -> Text
renderEra (AnyBccEra BccEra era
ColeEra)   = Text
"Cole"
renderEra (AnyBccEra BccEra era
SophieEra) = Text
"Sophie"
renderEra (AnyBccEra BccEra era
EvieEra) = Text
"Evie"
renderEra (AnyBccEra BccEra era
JenEra)    = Text
"Jen"
renderEra (AnyBccEra BccEra era
AurumEra)  = Text
"Aurum"

renderFeature :: TxFeature -> Text
renderFeature :: TxFeature -> Text
renderFeature TxFeature
TxFeatureSophieAddresses     = Text
"Sophie 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
TxFeatureSophieKeys          = Text
"Sophie keys"
renderFeature TxFeature
TxFeatureCollateral           = Text
"Collateral inputs"
renderFeature TxFeature
TxFeatureProtocolParameters   = Text
"Protocol parameters"
renderFeature TxFeature
TxFeatureTxOutDatum           = Text
"Transaction output datums"
renderFeature TxFeature
TxFeatureScriptValidity       = Text
"Script validity"
renderFeature TxFeature
TxFeatureExtraKeyWits         = Text
"Required signers"

runTransactionCmd :: TransactionCmd -> ExceptT SophieTxCmdError IO ()
runTransactionCmd :: TransactionCmd -> ExceptT SophieTxCmdError IO ()
runTransactionCmd TransactionCmd
cmd =
  case TransactionCmd
cmd of
    TxBuild AnyBccEra
era AnyConsensusModeParams
consensusModeParams NetworkId
nid Maybe ScriptValidity
mScriptValidity Maybe Word
mOverrideWits [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [WitnessSigningData]
reqSigners
            [TxIn]
txinsc [TxOutAnyEra]
txouts TxOutChangeAddress
changeAddr Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue Maybe SlotNo
mLowBound Maybe SlotNo
mUpperBound [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certs [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls TxMetadataJsonSchema
metadataSchema
            [ScriptFile]
scriptFiles [MetadataFile]
metadataFiles Maybe ProtocolParamsSourceSpec
mpparams Maybe UpdateProposalFile
mUpProp TxBodyFile
out ->
      AnyBccEra
-> AnyConsensusModeParams
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [TxOutAnyEra]
-> TxOutChangeAddress
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> Maybe SlotNo
-> Maybe SlotNo
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> [WitnessSigningData]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBodyFile
-> Maybe Word
-> ExceptT SophieTxCmdError IO ()
runTxBuild AnyBccEra
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, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls [WitnessSigningData]
reqSigners TxMetadataJsonSchema
metadataSchema [ScriptFile]
scriptFiles
                 [MetadataFile]
metadataFiles Maybe ProtocolParamsSourceSpec
mpparams Maybe UpdateProposalFile
mUpProp TxBodyFile
out Maybe Word
mOverrideWits
    TxBuildRaw AnyBccEra
era Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
txinsc [WitnessSigningData]
reqSigners [TxOutAnyEra]
txouts Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue Maybe SlotNo
mLowBound Maybe SlotNo
mUpperBound
               Maybe Entropic
fee [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certs [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls TxMetadataJsonSchema
metadataSchema [ScriptFile]
scriptFiles
               [MetadataFile]
metadataFiles Maybe ProtocolParamsSourceSpec
mpparams Maybe UpdateProposalFile
mUpProp TxBodyFile
out ->
      AnyBccEra
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [TxOutAnyEra]
-> Maybe SlotNo
-> Maybe SlotNo
-> Maybe Entropic
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> [WitnessSigningData]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBodyFile
-> ExceptT SophieTxCmdError IO ()
runTxBuildRaw AnyBccEra
era Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins [TxIn]
txinsc [TxOutAnyEra]
txouts Maybe SlotNo
mLowBound Maybe SlotNo
mUpperBound
                    Maybe Entropic
fee Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certs [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
wdrls [WitnessSigningData]
reqSigners 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 SophieTxCmdError IO ()
runTxSign TxBodyFile
txinfile [WitnessSigningData]
skfiles Maybe NetworkId
network TxFile
txoutfile
    TxSubmit AnyConsensusModeParams
anyConensusModeParams NetworkId
network String
txFp ->
      AnyConsensusModeParams
-> NetworkId -> String -> ExceptT SophieTxCmdError IO ()
runTxSubmit AnyConsensusModeParams
anyConensusModeParams NetworkId
network String
txFp
    TxCalculateMinFee TxBodyFile
txbody Maybe NetworkId
mnw ProtocolParamsSourceSpec
pGenesisOrParamsFile TxInCount
nInputs TxOutCount
nOutputs
                      TxSophieWitnessCount
nSophieKeyWitnesses TxColeWitnessCount
nColeKeyWitnesses ->
      TxBodyFile
-> Maybe NetworkId
-> ProtocolParamsSourceSpec
-> TxInCount
-> TxOutCount
-> TxSophieWitnessCount
-> TxColeWitnessCount
-> ExceptT SophieTxCmdError IO ()
runTxCalculateMinFee TxBodyFile
txbody Maybe NetworkId
mnw ProtocolParamsSourceSpec
pGenesisOrParamsFile TxInCount
nInputs TxOutCount
nOutputs
                           TxSophieWitnessCount
nSophieKeyWitnesses TxColeWitnessCount
nColeKeyWitnesses
    TxCalculateMinRequiredUTxO AnyBccEra
era ProtocolParamsSourceSpec
pParamSpec TxOutAnyEra
txOuts -> AnyBccEra
-> ProtocolParamsSourceSpec
-> TxOutAnyEra
-> ExceptT SophieTxCmdError IO ()
runTxCalculateMinRequiredUTxO AnyBccEra
era ProtocolParamsSourceSpec
pParamSpec TxOutAnyEra
txOuts
    TxHashScriptData ScriptDataOrFile
scriptDataOrFile -> ScriptDataOrFile -> ExceptT SophieTxCmdError IO ()
runTxHashScriptData ScriptDataOrFile
scriptDataOrFile
    TxGetTxId InputTxFile
txinfile -> InputTxFile -> ExceptT SophieTxCmdError IO ()
runTxGetTxId InputTxFile
txinfile
    TxView InputTxFile
txinfile -> InputTxFile -> ExceptT SophieTxCmdError IO ()
runTxView InputTxFile
txinfile
    TxMintedPolicyId ScriptFile
sFile -> ScriptFile -> ExceptT SophieTxCmdError IO ()
runTxCreatePolicyId ScriptFile
sFile
    TxCreateWitness TxBodyFile
txBodyfile WitnessSigningData
witSignData Maybe NetworkId
mbNw OutputFile
outFile ->
      TxBodyFile
-> WitnessSigningData
-> Maybe NetworkId
-> OutputFile
-> ExceptT SophieTxCmdError IO ()
runTxCreateWitness TxBodyFile
txBodyfile WitnessSigningData
witSignData Maybe NetworkId
mbNw OutputFile
outFile
    TxAssembleTxBodyWitness TxBodyFile
txBodyFile [WitnessFile]
witnessFile OutputFile
outFile ->
      TxBodyFile
-> [WitnessFile] -> OutputFile -> ExceptT SophieTxCmdError IO ()
runTxSignWitness TxBodyFile
txBodyFile [WitnessFile]
witnessFile OutputFile
outFile

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

runTxBuildRaw
  :: AnyBccEra
  -> 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 Entropic
  -- ^ Tx fee
  -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
  -- ^ Multi-Asset value(s)
  -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> [WitnessSigningData]
  -- ^ Required signers
  -> TxMetadataJsonSchema
  -> [ScriptFile]
  -> [MetadataFile]
  -> Maybe ProtocolParamsSourceSpec
  -> Maybe UpdateProposalFile
  -> TxBodyFile
  -> ExceptT SophieTxCmdError IO ()
runTxBuildRaw :: AnyBccEra
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [TxOutAnyEra]
-> Maybe SlotNo
-> Maybe SlotNo
-> Maybe Entropic
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> [WitnessSigningData]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBodyFile
-> ExceptT SophieTxCmdError IO ()
runTxBuildRaw (AnyBccEra BccEra era
era)
              Maybe ScriptValidity
mScriptValidity [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
inputsAndScripts [TxIn]
inputsCollateral [TxOutAnyEra]
txouts
              Maybe SlotNo
mLowerBound Maybe SlotNo
mUpperBound
              Maybe Entropic
mFee Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue
              [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals [WitnessSigningData]
reqSigners
              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
-> 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
-> 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
 -> TxScriptValidity era
 -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxIns BuildTx era)
-> ExceptT
     SophieTxCmdError
     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
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BccEra era
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT SophieTxCmdError IO (TxIns BuildTx era)
forall era.
BccEra era
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT
     SophieTxCmdError
     IO
     [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns  BccEra era
era [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
inputsAndScripts
        ExceptT
  SophieTxCmdError
  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
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxInsCollateral era)
-> ExceptT
     SophieTxCmdError
     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
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [TxIn] -> ExceptT SophieTxCmdError IO (TxInsCollateral era)
forall era.
BccEra era
-> [TxIn] -> ExceptT SophieTxCmdError IO (TxInsCollateral era)
validateTxInsCollateral
                           BccEra era
era [TxIn]
inputsCollateral
        ExceptT
  SophieTxCmdError
  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
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO [TxOut era]
-> ExceptT
     SophieTxCmdError
     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
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [TxOutAnyEra] -> ExceptT SophieTxCmdError IO [TxOut era]
forall era.
BccEra era
-> [TxOutAnyEra] -> ExceptT SophieTxCmdError IO [TxOut era]
validateTxOuts BccEra era
era [TxOutAnyEra]
txouts
        ExceptT
  SophieTxCmdError
  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
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxFee era)
-> ExceptT
     SophieTxCmdError
     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
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe Entropic -> ExceptT SophieTxCmdError IO (TxFee era)
forall era.
BccEra era
-> Maybe Entropic -> ExceptT SophieTxCmdError IO (TxFee era)
validateTxFee  BccEra era
era Maybe Entropic
mFee
        ExceptT
  SophieTxCmdError
  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
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxValidityLowerBound era, TxValidityUpperBound era)
-> ExceptT
     SophieTxCmdError
     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
      -> 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 SophieTxCmdError IO (TxValidityLowerBound era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxValidityUpperBound era
      -> (TxValidityLowerBound era, TxValidityUpperBound era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BccEra era
-> Maybe SlotNo
-> ExceptT SophieTxCmdError IO (TxValidityLowerBound era)
forall era.
BccEra era
-> Maybe SlotNo
-> ExceptT SophieTxCmdError IO (TxValidityLowerBound era)
validateTxValidityLowerBound BccEra era
era Maybe SlotNo
mLowerBound
                 ExceptT
  SophieTxCmdError
  IO
  (TxValidityUpperBound era
   -> (TxValidityLowerBound era, TxValidityUpperBound era))
-> ExceptT SophieTxCmdError IO (TxValidityUpperBound era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxValidityLowerBound era, TxValidityUpperBound era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe SlotNo
-> ExceptT SophieTxCmdError IO (TxValidityUpperBound era)
forall era.
BccEra era
-> Maybe SlotNo
-> ExceptT SophieTxCmdError IO (TxValidityUpperBound era)
validateTxValidityUpperBound BccEra era
era Maybe SlotNo
mUpperBound)
        ExceptT
  SophieTxCmdError
  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
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxMetadataInEra era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> ExceptT SophieTxCmdError IO (TxMetadataInEra era)
forall era.
BccEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> ExceptT SophieTxCmdError IO (TxMetadataInEra era)
validateTxMetadataInEra  BccEra era
era TxMetadataJsonSchema
metadataSchema [MetadataFile]
metadataFiles
        ExceptT
  SophieTxCmdError
  IO
  (TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxAuxScripts era)
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [ScriptFile] -> ExceptT SophieTxCmdError IO (TxAuxScripts era)
forall era.
BccEra era
-> [ScriptFile] -> ExceptT SophieTxCmdError IO (TxAuxScripts era)
validateTxAuxScripts     BccEra era
era [ScriptFile]
scriptFiles
        ExceptT
  SophieTxCmdError
  IO
  (BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT
     SophieTxCmdError IO (BuildTxWith BuildTx (TxExtraScriptData era))
-> ExceptT
     SophieTxCmdError
     IO
     (TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BuildTxWith BuildTx (TxExtraScriptData era)
-> ExceptT
     SophieTxCmdError 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 aurum: support this
        ExceptT
  SophieTxCmdError
  IO
  (TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [WitnessSigningData]
-> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
forall era.
BccEra era
-> [WitnessSigningData]
-> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
validateRequiredSigners  BccEra era
era [WitnessSigningData]
reqSigners
        ExceptT
  SophieTxCmdError
  IO
  (BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
-> ExceptT
     SophieTxCmdError
     IO
     (TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe ProtocolParamsSourceSpec
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
forall era.
BccEra era
-> Maybe ProtocolParamsSourceSpec
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters BccEra era
era Maybe ProtocolParamsSourceSpec
mpparams
        ExceptT
  SophieTxCmdError
  IO
  (TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxWithdrawals BuildTx era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT SophieTxCmdError IO (TxWithdrawals BuildTx era)
forall era.
BccEra era
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT SophieTxCmdError IO (TxWithdrawals BuildTx era)
validateTxWithdrawals    BccEra era
era [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals
        ExceptT
  SophieTxCmdError
  IO
  (TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxCertificates BuildTx era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT SophieTxCmdError IO (TxCertificates BuildTx era)
forall era.
BccEra era
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT SophieTxCmdError IO (TxCertificates BuildTx era)
validateTxCertificates   BccEra era
era [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles
        ExceptT
  SophieTxCmdError
  IO
  (TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxUpdateProposal era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxMintValue BuildTx era
      -> TxScriptValidity era -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe UpdateProposalFile
-> ExceptT SophieTxCmdError IO (TxUpdateProposal era)
forall era.
BccEra era
-> Maybe UpdateProposalFile
-> ExceptT SophieTxCmdError IO (TxUpdateProposal era)
validateTxUpdateProposal BccEra era
era Maybe UpdateProposalFile
mUpdatePropFile
        ExceptT
  SophieTxCmdError
  IO
  (TxMintValue BuildTx era
   -> TxScriptValidity era -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxMintValue BuildTx era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxScriptValidity era -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT SophieTxCmdError IO (TxMintValue BuildTx era)
forall era.
BccEra era
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT SophieTxCmdError IO (TxMintValue BuildTx era)
validateTxMintValue      BccEra era
era Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue
        ExceptT
  SophieTxCmdError
  IO
  (TxScriptValidity era -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxScriptValidity era)
-> ExceptT SophieTxCmdError IO (TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe ScriptValidity
-> ExceptT SophieTxCmdError IO (TxScriptValidity era)
forall era.
BccEra era
-> Maybe ScriptValidity
-> ExceptT SophieTxCmdError IO (TxScriptValidity era)
validateTxScriptValidity BccEra era
era Maybe ScriptValidity
mScriptValidity

    TxBody era
txBody <-
      (TxBodyError -> SophieTxCmdError)
-> ExceptT TxBodyError IO (TxBody era)
-> ExceptT SophieTxCmdError IO (TxBody era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT TxBodyError -> SophieTxCmdError
SophieTxCmdTxBodyError (ExceptT TxBodyError IO (TxBody era)
 -> ExceptT SophieTxCmdError IO (TxBody era))
-> (Either TxBodyError (TxBody era)
    -> ExceptT TxBodyError IO (TxBody era))
-> Either TxBodyError (TxBody era)
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO (TxBody era))
-> Either TxBodyError (TxBody era)
-> ExceptT SophieTxCmdError IO (TxBody era)
forall a b. (a -> b) -> a -> b
$
        TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
forall era.
IsBccEra era =>
TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
makeTransactionBody TxBodyContent BuildTx era
txBodyContent

    (FileError () -> SophieTxCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> SophieTxCmdError
SophieTxCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT SophieTxCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT SophieTxCmdError 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
  :: AnyBccEra
  -> 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, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> [WitnessSigningData]
  -- ^ Required signers
  -> TxMetadataJsonSchema
  -> [ScriptFile]
  -> [MetadataFile]
  -> Maybe ProtocolParamsSourceSpec
  -> Maybe UpdateProposalFile
  -> TxBodyFile
  -> Maybe Word
  -> ExceptT SophieTxCmdError IO ()
runTxBuild :: AnyBccEra
-> AnyConsensusModeParams
-> NetworkId
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [TxOutAnyEra]
-> TxOutChangeAddress
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> Maybe SlotNo
-> Maybe SlotNo
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> [WitnessSigningData]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBodyFile
-> Maybe Word
-> ExceptT SophieTxCmdError IO ()
runTxBuild (AnyBccEra BccEra 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, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals [WitnessSigningData]
reqSigners
           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 -> SophieTxCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieTxCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieTxCmdError
SophieTxCmdSocketEnvError 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 Entropic
dummyFee = Entropic -> Maybe Entropic
forall a. a -> Maybe a
Just (Entropic -> Maybe Entropic) -> Entropic -> Maybe Entropic
forall a b. (a -> b) -> a -> b
$ Integer -> Entropic
Entropic Integer
0
      onlyInputs :: [TxIn]
onlyInputs = [TxIn
input | (TxIn
input,Maybe (ScriptWitnessFiles WitCtxTxIn)
_) <- [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins]

  case (ConsensusMode mode
consensusMode, BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era) of
    (ConsensusMode mode
BccMode, SophieBasedEra SophieBasedEra 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
-> 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
-> 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
 -> TxScriptValidity era
 -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxIns BuildTx era)
-> ExceptT
     SophieTxCmdError
     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
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BccEra era
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT SophieTxCmdError IO (TxIns BuildTx era)
forall era.
BccEra era
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT
     SophieTxCmdError
     IO
     [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns               BccEra era
era [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
txins
          ExceptT
  SophieTxCmdError
  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
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxInsCollateral era)
-> ExceptT
     SophieTxCmdError
     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
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [TxIn] -> ExceptT SophieTxCmdError IO (TxInsCollateral era)
forall era.
BccEra era
-> [TxIn] -> ExceptT SophieTxCmdError IO (TxInsCollateral era)
validateTxInsCollateral     BccEra era
era [TxIn]
txinsc
          ExceptT
  SophieTxCmdError
  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
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO [TxOut era]
-> ExceptT
     SophieTxCmdError
     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
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [TxOutAnyEra] -> ExceptT SophieTxCmdError IO [TxOut era]
forall era.
BccEra era
-> [TxOutAnyEra] -> ExceptT SophieTxCmdError IO [TxOut era]
validateTxOuts              BccEra era
era [TxOutAnyEra]
txouts
          ExceptT
  SophieTxCmdError
  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
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxFee era)
-> ExceptT
     SophieTxCmdError
     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
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe Entropic -> ExceptT SophieTxCmdError IO (TxFee era)
forall era.
BccEra era
-> Maybe Entropic -> ExceptT SophieTxCmdError IO (TxFee era)
validateTxFee               BccEra era
era Maybe Entropic
dummyFee
          ExceptT
  SophieTxCmdError
  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
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxValidityLowerBound era, TxValidityUpperBound era)
-> ExceptT
     SophieTxCmdError
     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
      -> 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 SophieTxCmdError IO (TxValidityLowerBound era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxValidityUpperBound era
      -> (TxValidityLowerBound era, TxValidityUpperBound era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BccEra era
-> Maybe SlotNo
-> ExceptT SophieTxCmdError IO (TxValidityLowerBound era)
forall era.
BccEra era
-> Maybe SlotNo
-> ExceptT SophieTxCmdError IO (TxValidityLowerBound era)
validateTxValidityLowerBound BccEra era
era Maybe SlotNo
mLowerBound
                   ExceptT
  SophieTxCmdError
  IO
  (TxValidityUpperBound era
   -> (TxValidityLowerBound era, TxValidityUpperBound era))
-> ExceptT SophieTxCmdError IO (TxValidityUpperBound era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxValidityLowerBound era, TxValidityUpperBound era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe SlotNo
-> ExceptT SophieTxCmdError IO (TxValidityUpperBound era)
forall era.
BccEra era
-> Maybe SlotNo
-> ExceptT SophieTxCmdError IO (TxValidityUpperBound era)
validateTxValidityUpperBound BccEra era
era Maybe SlotNo
mUpperBound)
          ExceptT
  SophieTxCmdError
  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
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxMetadataInEra era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxAuxScripts era
      -> BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> ExceptT SophieTxCmdError IO (TxMetadataInEra era)
forall era.
BccEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> ExceptT SophieTxCmdError IO (TxMetadataInEra era)
validateTxMetadataInEra     BccEra era
era TxMetadataJsonSchema
metadataSchema [MetadataFile]
metadataFiles
          ExceptT
  SophieTxCmdError
  IO
  (TxAuxScripts era
   -> BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxAuxScripts era)
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (TxExtraScriptData era)
      -> TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [ScriptFile] -> ExceptT SophieTxCmdError IO (TxAuxScripts era)
forall era.
BccEra era
-> [ScriptFile] -> ExceptT SophieTxCmdError IO (TxAuxScripts era)
validateTxAuxScripts        BccEra era
era [ScriptFile]
scriptFiles
          ExceptT
  SophieTxCmdError
  IO
  (BuildTxWith BuildTx (TxExtraScriptData era)
   -> TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT
     SophieTxCmdError IO (BuildTxWith BuildTx (TxExtraScriptData era))
-> ExceptT
     SophieTxCmdError
     IO
     (TxExtraKeyWitnesses era
      -> BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BuildTxWith BuildTx (TxExtraScriptData era)
-> ExceptT
     SophieTxCmdError 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 aurum: support this
          ExceptT
  SophieTxCmdError
  IO
  (TxExtraKeyWitnesses era
   -> BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters)
      -> TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [WitnessSigningData]
-> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
forall era.
BccEra era
-> [WitnessSigningData]
-> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
validateRequiredSigners     BccEra era
era [WitnessSigningData]
reqSigners
          ExceptT
  SophieTxCmdError
  IO
  (BuildTxWith BuildTx (Maybe ProtocolParameters)
   -> TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
-> ExceptT
     SophieTxCmdError
     IO
     (TxWithdrawals BuildTx era
      -> TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe ProtocolParamsSourceSpec
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
forall era.
BccEra era
-> Maybe ProtocolParamsSourceSpec
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters  BccEra era
era Maybe ProtocolParamsSourceSpec
mpparams
          ExceptT
  SophieTxCmdError
  IO
  (TxWithdrawals BuildTx era
   -> TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxWithdrawals BuildTx era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxCertificates BuildTx era
      -> TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT SophieTxCmdError IO (TxWithdrawals BuildTx era)
forall era.
BccEra era
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT SophieTxCmdError IO (TxWithdrawals BuildTx era)
validateTxWithdrawals       BccEra era
era [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals
          ExceptT
  SophieTxCmdError
  IO
  (TxCertificates BuildTx era
   -> TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxCertificates BuildTx era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxUpdateProposal era
      -> TxMintValue BuildTx era
      -> TxScriptValidity era
      -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT SophieTxCmdError IO (TxCertificates BuildTx era)
forall era.
BccEra era
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT SophieTxCmdError IO (TxCertificates BuildTx era)
validateTxCertificates      BccEra era
era [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles
          ExceptT
  SophieTxCmdError
  IO
  (TxUpdateProposal era
   -> TxMintValue BuildTx era
   -> TxScriptValidity era
   -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxUpdateProposal era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxMintValue BuildTx era
      -> TxScriptValidity era -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe UpdateProposalFile
-> ExceptT SophieTxCmdError IO (TxUpdateProposal era)
forall era.
BccEra era
-> Maybe UpdateProposalFile
-> ExceptT SophieTxCmdError IO (TxUpdateProposal era)
validateTxUpdateProposal    BccEra era
era Maybe UpdateProposalFile
mUpdatePropFile
          ExceptT
  SophieTxCmdError
  IO
  (TxMintValue BuildTx era
   -> TxScriptValidity era -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxMintValue BuildTx era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxScriptValidity era -> TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT SophieTxCmdError IO (TxMintValue BuildTx era)
forall era.
BccEra era
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT SophieTxCmdError IO (TxMintValue BuildTx era)
validateTxMintValue         BccEra era
era Maybe (Value, [ScriptWitnessFiles WitCtxMint])
mValue
          ExceptT
  SophieTxCmdError
  IO
  (TxScriptValidity era -> TxBodyContent BuildTx era)
-> ExceptT SophieTxCmdError IO (TxScriptValidity era)
-> ExceptT SophieTxCmdError IO (TxBodyContent BuildTx era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era
-> Maybe ScriptValidity
-> ExceptT SophieTxCmdError IO (TxScriptValidity era)
forall era.
BccEra era
-> Maybe ScriptValidity
-> ExceptT SophieTxCmdError IO (TxScriptValidity era)
validateTxScriptValidity    BccEra era
era Maybe ScriptValidity
mScriptValidity

      EraInMode era BccMode
eInMode <- case BccEra era
-> ConsensusMode BccMode -> Maybe (EraInMode era BccMode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra era
era ConsensusMode BccMode
BccMode of
                   Just EraInMode era BccMode
result -> EraInMode era BccMode
-> ExceptT SophieTxCmdError IO (EraInMode era BccMode)
forall (m :: * -> *) a. Monad m => a -> m a
return EraInMode era BccMode
result
                   Maybe (EraInMode era BccMode)
Nothing ->
                     SophieTxCmdError
-> ExceptT SophieTxCmdError IO (EraInMode era BccMode)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (TxBodyFile -> AnyConsensusMode -> AnyBccEra -> SophieTxCmdError
SophieTxCmdEraConsensusModeMismatchTxBalance TxBodyFile
outBody
                            (ConsensusMode BccMode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode BccMode
BccMode) (BccEra era -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra era
era))

      (UTxO era
utxo, ProtocolParameters
pparams, EraHistory BccMode
eraHistory, SystemStart
systemStart, Set PoolId
stakePools) <-
        IO
  (Either
     SophieTxCmdError
     (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
      Set PoolId))
-> ExceptT
     SophieTxCmdError
     IO
     (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
      Set PoolId)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      SophieTxCmdError
      (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
       Set PoolId))
 -> ExceptT
      SophieTxCmdError
      IO
      (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
       Set PoolId))
-> (IO
      (Either
         AcquireFailure
         (Either
            SophieTxCmdError
            (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
             Set PoolId)))
    -> IO
         (Either
            SophieTxCmdError
            (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
             Set PoolId)))
-> IO
     (Either
        AcquireFailure
        (Either
           SophieTxCmdError
           (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
            Set PoolId)))
-> ExceptT
     SophieTxCmdError
     IO
     (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
      Set PoolId)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Either
   AcquireFailure
   (Either
      SophieTxCmdError
      (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
       Set PoolId))
 -> Either
      SophieTxCmdError
      (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
       Set PoolId))
-> IO
     (Either
        AcquireFailure
        (Either
           SophieTxCmdError
           (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
            Set PoolId)))
-> IO
     (Either
        SophieTxCmdError
        (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
         Set PoolId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either
  SophieTxCmdError
  (Either
     SophieTxCmdError
     (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
      Set PoolId))
-> Either
     SophieTxCmdError
     (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
      Set PoolId)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either
   SophieTxCmdError
   (Either
      SophieTxCmdError
      (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
       Set PoolId))
 -> Either
      SophieTxCmdError
      (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
       Set PoolId))
-> (Either
      AcquireFailure
      (Either
         SophieTxCmdError
         (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
          Set PoolId))
    -> Either
         SophieTxCmdError
         (Either
            SophieTxCmdError
            (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
             Set PoolId)))
-> Either
     AcquireFailure
     (Either
        SophieTxCmdError
        (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
         Set PoolId))
-> Either
     SophieTxCmdError
     (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
      Set PoolId)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (AcquireFailure -> SophieTxCmdError)
-> Either
     AcquireFailure
     (Either
        SophieTxCmdError
        (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
         Set PoolId))
-> Either
     SophieTxCmdError
     (Either
        SophieTxCmdError
        (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
         Set PoolId))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AcquireFailure -> SophieTxCmdError
SophieTxCmdAcquireFailure) (IO
   (Either
      AcquireFailure
      (Either
         SophieTxCmdError
         (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
          Set PoolId)))
 -> ExceptT
      SophieTxCmdError
      IO
      (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
       Set PoolId))
-> IO
     (Either
        AcquireFailure
        (Either
           SophieTxCmdError
           (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
            Set PoolId)))
-> ExceptT
     SophieTxCmdError
     IO
     (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
      Set PoolId)
forall a b. (a -> b) -> a -> b
$
          LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
    -> LocalStateQueryExpr
         (BlockInMode mode)
         ChainPoint
         (QueryInMode mode)
         ()
         IO
         (Either
            SophieTxCmdError
            (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
             Set PoolId)))
-> IO
     (Either
        AcquireFailure
        (Either
           SophieTxCmdError
           (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
            Set PoolId)))
forall mode a.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
    -> LocalStateQueryExpr
         (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a)
-> IO (Either AcquireFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing ((NodeToClientVersion
  -> LocalStateQueryExpr
       (BlockInMode mode)
       ChainPoint
       (QueryInMode mode)
       ()
       IO
       (Either
          SophieTxCmdError
          (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
           Set PoolId)))
 -> IO
      (Either
         AcquireFailure
         (Either
            SophieTxCmdError
            (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
             Set PoolId))))
-> (NodeToClientVersion
    -> LocalStateQueryExpr
         (BlockInMode mode)
         ChainPoint
         (QueryInMode mode)
         ()
         IO
         (Either
            SophieTxCmdError
            (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
             Set PoolId)))
-> IO
     (Either
        AcquireFailure
        (Either
           SophieTxCmdError
           (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
            Set PoolId)))
forall a b. (a -> b) -> a -> b
$ \NodeToClientVersion
_ntcVersion -> ExceptT
  SophieTxCmdError
  (LocalStateQueryExpr
     (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
  (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
   Set PoolId)
-> LocalStateQueryExpr
     (BlockInMode mode)
     ChainPoint
     (QueryInMode mode)
     ()
     IO
     (Either
        SophieTxCmdError
        (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
         Set PoolId))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   SophieTxCmdError
   (LocalStateQueryExpr
      (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
   (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
    Set PoolId)
 -> LocalStateQueryExpr
      (BlockInMode mode)
      ChainPoint
      (QueryInMode mode)
      ()
      IO
      (Either
         SophieTxCmdError
         (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
          Set PoolId)))
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
      Set PoolId)
-> LocalStateQueryExpr
     (BlockInMode mode)
     ChainPoint
     (QueryInMode mode)
     ()
     IO
     (Either
        SophieTxCmdError
        (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
         Set PoolId))
forall a b. (a -> b) -> a -> b
$ do
            Bool
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     ()
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TxIn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxIn]
txinsc) (ExceptT
   SophieTxCmdError
   (LocalStateQueryExpr
      (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
   ()
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
      ())
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     ()
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     ()
forall a b. (a -> b) -> a -> b
$ do
              UTxO era
collateralUtxo <- (EraMismatch -> SophieTxCmdError)
-> ExceptT
     EraMismatch
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (UTxO era)
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (UTxO era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EraMismatch -> SophieTxCmdError
SophieTxCmdTxSubmitErrorEraMismatch (ExceptT
   EraMismatch
   (LocalStateQueryExpr
      (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
   (UTxO era)
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
      (UTxO era))
-> (QueryInMode BccMode (Either EraMismatch (UTxO era))
    -> ExceptT
         EraMismatch
         (LocalStateQueryExpr
            (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
         (UTxO era))
-> QueryInMode BccMode (Either EraMismatch (UTxO era))
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (UTxO era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LocalStateQueryExpr
  (BlockInMode BccMode)
  ChainPoint
  (QueryInMode BccMode)
  ()
  IO
  (Either EraMismatch (UTxO era))
-> ExceptT
     EraMismatch
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (UTxO era)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (LocalStateQueryExpr
   (BlockInMode BccMode)
   ChainPoint
   (QueryInMode BccMode)
   ()
   IO
   (Either EraMismatch (UTxO era))
 -> ExceptT
      EraMismatch
      (LocalStateQueryExpr
         (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
      (UTxO era))
-> (QueryInMode BccMode (Either EraMismatch (UTxO era))
    -> LocalStateQueryExpr
         (BlockInMode BccMode)
         ChainPoint
         (QueryInMode BccMode)
         ()
         IO
         (Either EraMismatch (UTxO era)))
-> QueryInMode BccMode (Either EraMismatch (UTxO era))
-> ExceptT
     EraMismatch
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (UTxO era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. QueryInMode BccMode (Either EraMismatch (UTxO era))
-> LocalStateQueryExpr
     (BlockInMode BccMode)
     ChainPoint
     (QueryInMode BccMode)
     ()
     IO
     (Either EraMismatch (UTxO era))
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr
                (QueryInMode BccMode (Either EraMismatch (UTxO era))
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
      (UTxO era))
-> QueryInMode BccMode (Either EraMismatch (UTxO era))
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     (UTxO era)
forall a b. (a -> b) -> a -> b
$ EraInMode era BccMode
-> QueryInEra era (UTxO era)
-> QueryInMode BccMode (Either EraMismatch (UTxO era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era BccMode
eInMode
                (QueryInEra era (UTxO era)
 -> QueryInMode BccMode (Either EraMismatch (UTxO era)))
-> QueryInEra era (UTxO era)
-> QueryInMode BccMode (Either EraMismatch (UTxO era))
forall a b. (a -> b) -> a -> b
$ SophieBasedEra era
-> QueryInSophieBasedEra era (UTxO era)
-> QueryInEra era (UTxO era)
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe (QueryUTxOFilter -> QueryInSophieBasedEra era (UTxO era)
forall era. QueryUTxOFilter -> QueryInSophieBasedEra era (UTxO era)
QueryUTxO (QueryUTxOFilter -> QueryInSophieBasedEra era (UTxO era))
-> (Set TxIn -> QueryUTxOFilter)
-> Set TxIn
-> QueryInSophieBasedEra 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 -> QueryInSophieBasedEra era (UTxO era))
-> Set TxIn -> QueryInSophieBasedEra era (UTxO era)
forall a b. (a -> b) -> a -> b
$ [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxIn]
txinsc)
              [TxIn]
-> UTxO era
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     ()
forall (m :: * -> *) era.
Monad m =>
[TxIn] -> UTxO era -> ExceptT SophieTxCmdError m ()
txinsExist [TxIn]
txinsc UTxO era
collateralUtxo
              UTxO era
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     ()
forall (m :: * -> *) era.
Monad m =>
UTxO era -> ExceptT SophieTxCmdError m ()
notScriptLockedTxIns UTxO era
collateralUtxo

            UTxO era
utxo <- (EraMismatch -> SophieTxCmdError)
-> ExceptT
     EraMismatch
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (UTxO era)
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (UTxO era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EraMismatch -> SophieTxCmdError
SophieTxCmdTxSubmitErrorEraMismatch (ExceptT
   EraMismatch
   (LocalStateQueryExpr
      (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
   (UTxO era)
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
      (UTxO era))
-> (QueryInMode BccMode (Either EraMismatch (UTxO era))
    -> ExceptT
         EraMismatch
         (LocalStateQueryExpr
            (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
         (UTxO era))
-> QueryInMode BccMode (Either EraMismatch (UTxO era))
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (UTxO era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LocalStateQueryExpr
  (BlockInMode BccMode)
  ChainPoint
  (QueryInMode BccMode)
  ()
  IO
  (Either EraMismatch (UTxO era))
-> ExceptT
     EraMismatch
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (UTxO era)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (LocalStateQueryExpr
   (BlockInMode BccMode)
   ChainPoint
   (QueryInMode BccMode)
   ()
   IO
   (Either EraMismatch (UTxO era))
 -> ExceptT
      EraMismatch
      (LocalStateQueryExpr
         (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
      (UTxO era))
-> (QueryInMode BccMode (Either EraMismatch (UTxO era))
    -> LocalStateQueryExpr
         (BlockInMode BccMode)
         ChainPoint
         (QueryInMode BccMode)
         ()
         IO
         (Either EraMismatch (UTxO era)))
-> QueryInMode BccMode (Either EraMismatch (UTxO era))
-> ExceptT
     EraMismatch
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (UTxO era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. QueryInMode BccMode (Either EraMismatch (UTxO era))
-> LocalStateQueryExpr
     (BlockInMode BccMode)
     ChainPoint
     (QueryInMode BccMode)
     ()
     IO
     (Either EraMismatch (UTxO era))
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr
              (QueryInMode BccMode (Either EraMismatch (UTxO era))
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
      (UTxO era))
-> QueryInMode BccMode (Either EraMismatch (UTxO era))
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     (UTxO era)
forall a b. (a -> b) -> a -> b
$ EraInMode era BccMode
-> QueryInEra era (UTxO era)
-> QueryInMode BccMode (Either EraMismatch (UTxO era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era BccMode
eInMode (QueryInEra era (UTxO era)
 -> QueryInMode BccMode (Either EraMismatch (UTxO era)))
-> QueryInEra era (UTxO era)
-> QueryInMode BccMode (Either EraMismatch (UTxO era))
forall a b. (a -> b) -> a -> b
$ SophieBasedEra era
-> QueryInSophieBasedEra era (UTxO era)
-> QueryInEra era (UTxO era)
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe
              (QueryInSophieBasedEra era (UTxO era) -> QueryInEra era (UTxO era))
-> QueryInSophieBasedEra era (UTxO era)
-> QueryInEra era (UTxO era)
forall a b. (a -> b) -> a -> b
$ QueryUTxOFilter -> QueryInSophieBasedEra era (UTxO era)
forall era. QueryUTxOFilter -> QueryInSophieBasedEra era (UTxO era)
QueryUTxO (Set TxIn -> QueryUTxOFilter
QueryUTxOByTxIn ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxIn]
onlyInputs))

            [TxIn]
-> UTxO era
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     ()
forall (m :: * -> *) era.
Monad m =>
[TxIn] -> UTxO era -> ExceptT SophieTxCmdError m ()
txinsExist [TxIn]
onlyInputs UTxO era
utxo

            ProtocolParameters
pparams <- (EraMismatch -> SophieTxCmdError)
-> ExceptT
     EraMismatch
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     ProtocolParameters
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     ProtocolParameters
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EraMismatch -> SophieTxCmdError
SophieTxCmdTxSubmitErrorEraMismatch (ExceptT
   EraMismatch
   (LocalStateQueryExpr
      (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
   ProtocolParameters
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
      ProtocolParameters)
-> (QueryInMode BccMode (Either EraMismatch ProtocolParameters)
    -> ExceptT
         EraMismatch
         (LocalStateQueryExpr
            (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
         ProtocolParameters)
-> QueryInMode BccMode (Either EraMismatch ProtocolParameters)
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     ProtocolParameters
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LocalStateQueryExpr
  (BlockInMode BccMode)
  ChainPoint
  (QueryInMode BccMode)
  ()
  IO
  (Either EraMismatch ProtocolParameters)
-> ExceptT
     EraMismatch
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     ProtocolParameters
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (LocalStateQueryExpr
   (BlockInMode BccMode)
   ChainPoint
   (QueryInMode BccMode)
   ()
   IO
   (Either EraMismatch ProtocolParameters)
 -> ExceptT
      EraMismatch
      (LocalStateQueryExpr
         (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
      ProtocolParameters)
-> (QueryInMode BccMode (Either EraMismatch ProtocolParameters)
    -> LocalStateQueryExpr
         (BlockInMode BccMode)
         ChainPoint
         (QueryInMode BccMode)
         ()
         IO
         (Either EraMismatch ProtocolParameters))
-> QueryInMode BccMode (Either EraMismatch ProtocolParameters)
-> ExceptT
     EraMismatch
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     ProtocolParameters
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. QueryInMode BccMode (Either EraMismatch ProtocolParameters)
-> LocalStateQueryExpr
     (BlockInMode BccMode)
     ChainPoint
     (QueryInMode BccMode)
     ()
     IO
     (Either EraMismatch ProtocolParameters)
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr
              (QueryInMode BccMode (Either EraMismatch ProtocolParameters)
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
      ProtocolParameters)
-> QueryInMode BccMode (Either EraMismatch ProtocolParameters)
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     ProtocolParameters
forall a b. (a -> b) -> a -> b
$ EraInMode era BccMode
-> QueryInEra era ProtocolParameters
-> QueryInMode BccMode (Either EraMismatch ProtocolParameters)
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era BccMode
eInMode (QueryInEra era ProtocolParameters
 -> QueryInMode BccMode (Either EraMismatch ProtocolParameters))
-> QueryInEra era ProtocolParameters
-> QueryInMode BccMode (Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ SophieBasedEra era
-> QueryInSophieBasedEra era ProtocolParameters
-> QueryInEra era ProtocolParameters
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe QueryInSophieBasedEra era ProtocolParameters
forall era. QueryInSophieBasedEra era ProtocolParameters
QueryProtocolParameters

            EraHistory BccMode
eraHistory <- LocalStateQueryExpr
  (BlockInMode BccMode)
  ChainPoint
  (QueryInMode BccMode)
  ()
  IO
  (EraHistory BccMode)
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (EraHistory BccMode)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalStateQueryExpr
   (BlockInMode BccMode)
   ChainPoint
   (QueryInMode BccMode)
   ()
   IO
   (EraHistory BccMode)
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
      (EraHistory BccMode))
-> (QueryInMode BccMode (EraHistory BccMode)
    -> LocalStateQueryExpr
         (BlockInMode BccMode)
         ChainPoint
         (QueryInMode BccMode)
         ()
         IO
         (EraHistory BccMode))
-> QueryInMode BccMode (EraHistory BccMode)
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (EraHistory BccMode)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. QueryInMode BccMode (EraHistory BccMode)
-> LocalStateQueryExpr
     (BlockInMode BccMode)
     ChainPoint
     (QueryInMode BccMode)
     ()
     IO
     (EraHistory BccMode)
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (QueryInMode BccMode (EraHistory BccMode)
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
      (EraHistory BccMode))
-> QueryInMode BccMode (EraHistory BccMode)
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     (EraHistory BccMode)
forall a b. (a -> b) -> a -> b
$ ConsensusModeIsMultiEra BccMode
-> QueryInMode BccMode (EraHistory BccMode)
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode (EraHistory mode)
QueryEraHistory ConsensusModeIsMultiEra BccMode
BccModeIsMultiEra

            SystemStart
systemStart <- LocalStateQueryExpr
  (BlockInMode mode) ChainPoint (QueryInMode mode) () IO SystemStart
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     SystemStart
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalStateQueryExpr
   (BlockInMode mode) ChainPoint (QueryInMode mode) () IO SystemStart
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
      SystemStart)
-> LocalStateQueryExpr
     (BlockInMode mode) ChainPoint (QueryInMode mode) () IO SystemStart
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     SystemStart
forall a b. (a -> b) -> a -> b
$ QueryInMode mode SystemStart
-> LocalStateQueryExpr
     (BlockInMode mode) ChainPoint (QueryInMode mode) () IO SystemStart
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr QueryInMode mode SystemStart
forall mode. QueryInMode mode SystemStart
QuerySystemStart


            Set PoolId
stakePools <- (EraMismatch -> SophieTxCmdError)
-> ExceptT
     EraMismatch
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (Set PoolId)
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (Set PoolId)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EraMismatch -> SophieTxCmdError
SophieTxCmdTxSubmitErrorEraMismatch (ExceptT
   EraMismatch
   (LocalStateQueryExpr
      (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
   (Set PoolId)
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
      (Set PoolId))
-> (LocalStateQueryExpr
      (BlockInMode BccMode)
      ChainPoint
      (QueryInMode BccMode)
      ()
      IO
      (Either EraMismatch (Set PoolId))
    -> ExceptT
         EraMismatch
         (LocalStateQueryExpr
            (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
         (Set PoolId))
-> LocalStateQueryExpr
     (BlockInMode BccMode)
     ChainPoint
     (QueryInMode BccMode)
     ()
     IO
     (Either EraMismatch (Set PoolId))
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (Set PoolId)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LocalStateQueryExpr
  (BlockInMode BccMode)
  ChainPoint
  (QueryInMode BccMode)
  ()
  IO
  (Either EraMismatch (Set PoolId))
-> ExceptT
     EraMismatch
     (LocalStateQueryExpr
        (BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
     (Set PoolId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (LocalStateQueryExpr
   (BlockInMode BccMode)
   ChainPoint
   (QueryInMode BccMode)
   ()
   IO
   (Either EraMismatch (Set PoolId))
 -> ExceptT
      SophieTxCmdError
      (LocalStateQueryExpr
         (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
      (Set PoolId))
-> LocalStateQueryExpr
     (BlockInMode BccMode)
     ChainPoint
     (QueryInMode BccMode)
     ()
     IO
     (Either EraMismatch (Set PoolId))
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     (Set PoolId)
forall a b. (a -> b) -> a -> b
$
              QueryInMode BccMode (Either EraMismatch (Set PoolId))
-> LocalStateQueryExpr
     (BlockInMode BccMode)
     ChainPoint
     (QueryInMode BccMode)
     ()
     IO
     (Either EraMismatch (Set PoolId))
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (QueryInMode BccMode (Either EraMismatch (Set PoolId))
 -> LocalStateQueryExpr
      (BlockInMode BccMode)
      ChainPoint
      (QueryInMode BccMode)
      ()
      IO
      (Either EraMismatch (Set PoolId)))
-> (QueryInSophieBasedEra era (Set PoolId)
    -> QueryInMode BccMode (Either EraMismatch (Set PoolId)))
-> QueryInSophieBasedEra era (Set PoolId)
-> LocalStateQueryExpr
     (BlockInMode BccMode)
     ChainPoint
     (QueryInMode BccMode)
     ()
     IO
     (Either EraMismatch (Set PoolId))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EraInMode era BccMode
-> QueryInEra era (Set PoolId)
-> QueryInMode BccMode (Either EraMismatch (Set PoolId))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era BccMode
eInMode (QueryInEra era (Set PoolId)
 -> QueryInMode BccMode (Either EraMismatch (Set PoolId)))
-> (QueryInSophieBasedEra era (Set PoolId)
    -> QueryInEra era (Set PoolId))
-> QueryInSophieBasedEra era (Set PoolId)
-> QueryInMode BccMode (Either EraMismatch (Set PoolId))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SophieBasedEra era
-> QueryInSophieBasedEra era (Set PoolId)
-> QueryInEra era (Set PoolId)
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe (QueryInSophieBasedEra era (Set PoolId)
 -> LocalStateQueryExpr
      (BlockInMode BccMode)
      ChainPoint
      (QueryInMode BccMode)
      ()
      IO
      (Either EraMismatch (Set PoolId)))
-> QueryInSophieBasedEra era (Set PoolId)
-> LocalStateQueryExpr
     (BlockInMode BccMode)
     ChainPoint
     (QueryInMode BccMode)
     ()
     IO
     (Either EraMismatch (Set PoolId))
forall a b. (a -> b) -> a -> b
$ QueryInSophieBasedEra era (Set PoolId)
forall era. QueryInSophieBasedEra era (Set PoolId)
QueryStakePools

            (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
 Set PoolId)
-> ExceptT
     SophieTxCmdError
     (LocalStateQueryExpr
        (BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
     (UTxO era, ProtocolParameters, EraHistory BccMode, SystemStart,
      Set PoolId)
forall (m :: * -> *) a. Monad m => a -> m a
return (UTxO era
utxo, ProtocolParameters
pparams, EraHistory BccMode
eraHistory, SystemStart
systemStart, Set PoolId
stakePools)

      let cAddr :: AddressInEra era
cAddr = case BccEra era -> AddressAny -> Maybe (AddressInEra era)
forall era. BccEra era -> AddressAny -> Maybe (AddressInEra era)
anyAddressInEra BccEra 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: Cole 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

      (BalancedTxBody TxBody era
balancedTxBody TxOut era
_ Entropic
fee) <-
        (TxBodyErrorAutoBalance -> SophieTxCmdError)
-> ExceptT TxBodyErrorAutoBalance IO (BalancedTxBody era)
-> ExceptT SophieTxCmdError IO (BalancedTxBody era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT TxBodyErrorAutoBalance -> SophieTxCmdError
SophieTxCmdBalanceTxBody
          (ExceptT TxBodyErrorAutoBalance IO (BalancedTxBody era)
 -> ExceptT SophieTxCmdError IO (BalancedTxBody era))
-> (Either TxBodyErrorAutoBalance (BalancedTxBody era)
    -> ExceptT TxBodyErrorAutoBalance IO (BalancedTxBody era))
-> Either TxBodyErrorAutoBalance (BalancedTxBody era)
-> ExceptT SophieTxCmdError IO (BalancedTxBody 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 (BalancedTxBody era)
-> ExceptT TxBodyErrorAutoBalance IO (BalancedTxBody era)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
          (Either TxBodyErrorAutoBalance (BalancedTxBody era)
 -> ExceptT SophieTxCmdError IO (BalancedTxBody era))
-> Either TxBodyErrorAutoBalance (BalancedTxBody era)
-> ExceptT SophieTxCmdError IO (BalancedTxBody era)
forall a b. (a -> b) -> a -> b
$ EraInMode era BccMode
-> SystemStart
-> EraHistory BccMode
-> ProtocolParameters
-> Set PoolId
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either TxBodyErrorAutoBalance (BalancedTxBody era)
forall era mode.
IsSophieBasedEra era =>
EraInMode era mode
-> SystemStart
-> EraHistory mode
-> ProtocolParameters
-> Set PoolId
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either TxBodyErrorAutoBalance (BalancedTxBody era)
makeTransactionBodyAutoBalance EraInMode era BccMode
eInMode SystemStart
systemStart EraHistory BccMode
eraHistory
                                           ProtocolParameters
pparams Set PoolId
stakePools UTxO era
utxo TxBodyContent BuildTx era
txBodyContent
                                           AddressInEra era
cAddr Maybe Word
mOverrideWits

      String -> ExceptT SophieTxCmdError IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> ExceptT SophieTxCmdError IO ())
-> String -> ExceptT SophieTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
"Estimated transaction fee: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Entropic -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Entropic
fee :: String)

      (FileError () -> SophieTxCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> SophieTxCmdError
SophieTxCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT SophieTxCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT SophieTxCmdError 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
BccMode, BccEraStyle era
LegacyColeEra) -> SophieTxCmdError -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left SophieTxCmdError
SophieTxCmdColeEra

    (ConsensusMode mode
wrongMode, BccEraStyle era
_) -> SophieTxCmdError -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (AnyConsensusMode -> SophieTxCmdError
SophieTxCmdUnsupportedMode (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
wrongMode))
  where
    txinsExist :: Monad m => [TxIn] -> UTxO era -> ExceptT SophieTxCmdError m ()
    txinsExist :: [TxIn] -> UTxO era -> ExceptT SophieTxCmdError m ()
txinsExist [TxIn]
ins (UTxO Map TxIn (TxOut era)
utxo)
      | Map TxIn (TxOut era) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map TxIn (TxOut era)
utxo = SophieTxCmdError -> ExceptT SophieTxCmdError m ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieTxCmdError -> ExceptT SophieTxCmdError m ())
-> SophieTxCmdError -> ExceptT SophieTxCmdError m ()
forall a b. (a -> b) -> a -> b
$ [TxIn] -> SophieTxCmdError
SophieTxCmdTxInsDoNotExist [TxIn]
ins
      | Bool
otherwise = do
          let utxoIns :: [TxIn]
utxoIns = Map TxIn (TxOut era) -> [TxIn]
forall k a. Map k a -> [k]
Map.keys Map TxIn (TxOut era)
utxo
              occursInUtxo :: [TxIn]
occursInUtxo = [ TxIn
txin | TxIn
txin <- [TxIn]
ins, TxIn
txin TxIn -> [TxIn] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TxIn]
utxoIns ]
          if [TxIn] -> Int
forall a. HasLength a => a -> Int
length [TxIn]
occursInUtxo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [TxIn] -> Int
forall a. HasLength a => a -> Int
length [TxIn]
ins
          then () -> ExceptT SophieTxCmdError m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else SophieTxCmdError -> ExceptT SophieTxCmdError m ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieTxCmdError -> ExceptT SophieTxCmdError m ())
-> ([TxIn] -> SophieTxCmdError)
-> [TxIn]
-> ExceptT SophieTxCmdError m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [TxIn] -> SophieTxCmdError
SophieTxCmdTxInsDoNotExist ([TxIn] -> ExceptT SophieTxCmdError m ())
-> [TxIn] -> ExceptT SophieTxCmdError m ()
forall a b. (a -> b) -> a -> b
$ [TxIn]
ins [TxIn] -> [TxIn] -> [TxIn]
forall a. Eq a => [a] -> [a] -> [a]
\\ [TxIn]
ins [TxIn] -> [TxIn] -> [TxIn]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [TxIn]
occursInUtxo

    notScriptLockedTxIns :: Monad m => UTxO era -> ExceptT SophieTxCmdError m ()
    notScriptLockedTxIns :: UTxO era -> ExceptT SophieTxCmdError m ()
notScriptLockedTxIns (UTxO Map TxIn (TxOut era)
utxo) = do
      let scriptLockedTxIns :: [(TxIn, TxOut era)]
scriptLockedTxIns =
            ((TxIn, TxOut era) -> Bool)
-> [(TxIn, TxOut era)] -> [(TxIn, TxOut era)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(TxIn
_, TxOut AddressInEra era
aInEra TxOutValue era
_ TxOutDatumHash era
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ AddressInEra era -> Bool
forall era. AddressInEra era -> Bool
isKeyAddress AddressInEra era
aInEra ) ([(TxIn, TxOut era)] -> [(TxIn, TxOut era)])
-> [(TxIn, TxOut era)] -> [(TxIn, TxOut era)]
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut era) -> [(TxIn, TxOut era)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map TxIn (TxOut era)
utxo
      if [(TxIn, TxOut era)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TxIn, TxOut era)]
scriptLockedTxIns
      then () -> ExceptT SophieTxCmdError m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else SophieTxCmdError -> ExceptT SophieTxCmdError m ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieTxCmdError -> ExceptT SophieTxCmdError m ())
-> ([TxIn] -> SophieTxCmdError)
-> [TxIn]
-> ExceptT SophieTxCmdError m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [TxIn] -> SophieTxCmdError
SophieTxCmdExpectedKeyLockedTxIn ([TxIn] -> ExceptT SophieTxCmdError m ())
-> [TxIn] -> ExceptT SophieTxCmdError m ()
forall a b. (a -> b) -> a -> b
$ ((TxIn, TxOut era) -> TxIn) -> [(TxIn, TxOut era)] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TxIn, TxOut era) -> TxIn
forall a b. (a, b) -> a
fst [(TxIn, TxOut era)]
scriptLockedTxIns

-- ----------------------------------------------------------------------------
-- 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 = TxFeatureSophieAddresses
               | TxFeatureExplicitFees
               | TxFeatureImplicitFees
               | TxFeatureValidityLowerBound
               | TxFeatureValidityUpperBound
               | TxFeatureValidityNoUpperBound
               | TxFeatureTxMetadata
               | TxFeatureAuxScripts
               | TxFeatureWithdrawals
               | TxFeatureCertificates
               | TxFeatureMintValue
               | TxFeatureMultiAssetOutputs
               | TxFeatureScriptWitnesses
               | TxFeatureSophieKeys
               | TxFeatureCollateral
               | TxFeatureProtocolParameters
               | TxFeatureTxOutDatum
               | TxFeatureScriptValidity
               | TxFeatureExtraKeyWits
  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 :: BccEra era
                  -> TxFeature
                  -> ExceptT SophieTxCmdError IO a
txFeatureMismatch :: BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
feature =
    SophieTxCmdError -> ExceptT SophieTxCmdError IO a
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (AnyBccEra -> TxFeature -> SophieTxCmdError
SophieTxCmdTxFeatureMismatch (BccEra era -> AnyBccEra
forall era. BccEra era -> AnyBccEra
anyBccEra BccEra era
era) TxFeature
feature)

validateTxIns
  :: forall era.
     BccEra era
  -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
  -> ExceptT SophieTxCmdError IO
             [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns :: BccEra era
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT
     SophieTxCmdError
     IO
     [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns BccEra era
era = ((TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
 -> ExceptT
      SophieTxCmdError
      IO
      (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)))
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT
     SophieTxCmdError
     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
     SophieTxCmdError
     IO
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
convert
 where
   convert
     :: (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
     -> ExceptT SophieTxCmdError IO
                (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
   convert :: (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
-> ExceptT
     SophieTxCmdError
     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 <- BccEra era
-> ScriptWitnessFiles WitCtxTxIn
-> ExceptT SophieTxCmdError IO (ScriptWitness WitCtxTxIn era)
forall era witctx.
BccEra era
-> ScriptWitnessFiles witctx
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
createScriptWitness BccEra era
era ScriptWitnessFiles WitCtxTxIn
scriptWitnessFiles
         (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> ExceptT
     SophieTxCmdError
     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
     SophieTxCmdError
     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 :: BccEra era
                        -> [TxIn]
                        -> ExceptT SophieTxCmdError IO (TxInsCollateral era)
validateTxInsCollateral :: BccEra era
-> [TxIn] -> ExceptT SophieTxCmdError IO (TxInsCollateral era)
validateTxInsCollateral BccEra era
_   []    = TxInsCollateral era
-> ExceptT SophieTxCmdError IO (TxInsCollateral era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxInsCollateral era
forall era. TxInsCollateral era
TxInsCollateralNone
validateTxInsCollateral BccEra era
era [TxIn]
txins =
    case BccEra era -> Maybe (CollateralSupportedInEra era)
forall era. BccEra era -> Maybe (CollateralSupportedInEra era)
collateralSupportedInEra BccEra era
era of
      Maybe (CollateralSupportedInEra era)
Nothing -> BccEra era
-> TxFeature -> ExceptT SophieTxCmdError IO (TxInsCollateral era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureCollateral
      Just CollateralSupportedInEra era
supported -> TxInsCollateral era
-> ExceptT SophieTxCmdError 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.
                  BccEra era
               -> [TxOutAnyEra]
               -> ExceptT SophieTxCmdError IO [TxOut era]
validateTxOuts :: BccEra era
-> [TxOutAnyEra] -> ExceptT SophieTxCmdError IO [TxOut era]
validateTxOuts BccEra era
era = (TxOutAnyEra -> ExceptT SophieTxCmdError IO (TxOut era))
-> [TxOutAnyEra] -> ExceptT SophieTxCmdError IO [TxOut era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (BccEra era
-> TxOutAnyEra -> ExceptT SophieTxCmdError IO (TxOut era)
forall era.
BccEra era
-> TxOutAnyEra -> ExceptT SophieTxCmdError IO (TxOut era)
toTxOutInAnyEra BccEra era
era)

toAddressInAnyEra
  :: BccEra era
  -> AddressAny
  -> ExceptT SophieTxCmdError IO (AddressInEra era)
toAddressInAnyEra :: BccEra era
-> AddressAny -> ExceptT SophieTxCmdError IO (AddressInEra era)
toAddressInAnyEra BccEra era
era AddressAny
addrAny =
  case AddressAny
addrAny of
    AddressCole   Address ColeAddr
bAddr -> AddressInEra era -> ExceptT SophieTxCmdError IO (AddressInEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return (AddressTypeInEra ColeAddr era
-> Address ColeAddr -> AddressInEra era
forall addrtype era.
AddressTypeInEra addrtype era
-> Address addrtype -> AddressInEra era
AddressInEra AddressTypeInEra ColeAddr era
forall era. AddressTypeInEra ColeAddr era
ColeAddressInAnyEra Address ColeAddr
bAddr)
    AddressSophie Address SophieAddr
sAddr ->
      case BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era of
        BccEraStyle era
LegacyColeEra -> BccEra era
-> TxFeature -> ExceptT SophieTxCmdError IO (AddressInEra era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureSophieAddresses
        SophieBasedEra SophieBasedEra era
era' ->
          AddressInEra era -> ExceptT SophieTxCmdError IO (AddressInEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return (AddressTypeInEra SophieAddr era
-> Address SophieAddr -> AddressInEra era
forall addrtype era.
AddressTypeInEra addrtype era
-> Address addrtype -> AddressInEra era
AddressInEra (SophieBasedEra era -> AddressTypeInEra SophieAddr era
forall era. SophieBasedEra era -> AddressTypeInEra SophieAddr era
SophieAddressInEra SophieBasedEra era
era') Address SophieAddr
sAddr)

toTxOutValueInAnyEra
  :: BccEra era
  -> Value
  -> ExceptT SophieTxCmdError IO (TxOutValue era)
toTxOutValueInAnyEra :: BccEra era -> Value -> ExceptT SophieTxCmdError IO (TxOutValue era)
toTxOutValueInAnyEra BccEra era
era Value
val =
  case BccEra era
-> Either
     (OnlyBccSupportedInEra era) (MultiAssetSupportedInEra era)
forall era.
BccEra era
-> Either
     (OnlyBccSupportedInEra era) (MultiAssetSupportedInEra era)
multiAssetSupportedInEra BccEra era
era of
    Left OnlyBccSupportedInEra era
adaOnlyInEra ->
      case Value -> Maybe Entropic
valueToEntropic Value
val of
        Just Entropic
l  -> TxOutValue era -> ExceptT SophieTxCmdError IO (TxOutValue era)
forall (m :: * -> *) a. Monad m => a -> m a
return (OnlyBccSupportedInEra era -> Entropic -> TxOutValue era
forall era. OnlyBccSupportedInEra era -> Entropic -> TxOutValue era
TxOutBccOnly OnlyBccSupportedInEra era
adaOnlyInEra Entropic
l)
        Maybe Entropic
Nothing -> BccEra era
-> TxFeature -> ExceptT SophieTxCmdError IO (TxOutValue era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureMultiAssetOutputs
    Right MultiAssetSupportedInEra era
multiAssetInEra -> TxOutValue era -> ExceptT SophieTxCmdError 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)

toTxOutInAnyEra :: BccEra era
                -> TxOutAnyEra
                -> ExceptT SophieTxCmdError IO (TxOut era)
toTxOutInAnyEra :: BccEra era
-> TxOutAnyEra -> ExceptT SophieTxCmdError IO (TxOut era)
toTxOutInAnyEra BccEra era
era (TxOutAnyEra AddressAny
addr Value
val Maybe (Hash ScriptData)
mDatumHash) =
  case (BccEra era -> Maybe (ScriptDataSupportedInEra era)
forall era. BccEra era -> Maybe (ScriptDataSupportedInEra era)
scriptDataSupportedInEra BccEra 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 SophieTxCmdError IO (AddressInEra era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxOutValue era -> TxOutDatumHash era -> TxOut era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BccEra era
-> AddressAny -> ExceptT SophieTxCmdError IO (AddressInEra era)
forall era.
BccEra era
-> AddressAny -> ExceptT SophieTxCmdError IO (AddressInEra era)
toAddressInAnyEra BccEra era
era AddressAny
addr
            ExceptT
  SophieTxCmdError
  IO
  (TxOutValue era -> TxOutDatumHash era -> TxOut era)
-> ExceptT SophieTxCmdError IO (TxOutValue era)
-> ExceptT SophieTxCmdError IO (TxOutDatumHash era -> TxOut era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era -> Value -> ExceptT SophieTxCmdError IO (TxOutValue era)
forall era.
BccEra era -> Value -> ExceptT SophieTxCmdError IO (TxOutValue era)
toTxOutValueInAnyEra BccEra era
era Value
val
            ExceptT SophieTxCmdError IO (TxOutDatumHash era -> TxOut era)
-> ExceptT SophieTxCmdError IO (TxOutDatumHash era)
-> ExceptT SophieTxCmdError IO (TxOut era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxOutDatumHash era
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO (AddressInEra era)
-> ExceptT
     SophieTxCmdError
     IO
     (TxOutValue era -> TxOutDatumHash era -> TxOut era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BccEra era
-> AddressAny -> ExceptT SophieTxCmdError IO (AddressInEra era)
forall era.
BccEra era
-> AddressAny -> ExceptT SophieTxCmdError IO (AddressInEra era)
toAddressInAnyEra BccEra era
era AddressAny
addr
            ExceptT
  SophieTxCmdError
  IO
  (TxOutValue era -> TxOutDatumHash era -> TxOut era)
-> ExceptT SophieTxCmdError IO (TxOutValue era)
-> ExceptT SophieTxCmdError IO (TxOutDatumHash era -> TxOut era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BccEra era -> Value -> ExceptT SophieTxCmdError IO (TxOutValue era)
forall era.
BccEra era -> Value -> ExceptT SophieTxCmdError IO (TxOutValue era)
toTxOutValueInAnyEra BccEra era
era Value
val
            ExceptT SophieTxCmdError IO (TxOutDatumHash era -> TxOut era)
-> ExceptT SophieTxCmdError IO (TxOutDatumHash era)
-> ExceptT SophieTxCmdError IO (TxOut era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxOutDatumHash era
-> ExceptT SophieTxCmdError 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
_) ->
      BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO (TxOut era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureTxOutDatum

validateTxFee :: BccEra era
              -> Maybe Entropic
              -> ExceptT SophieTxCmdError IO (TxFee era)
validateTxFee :: BccEra era
-> Maybe Entropic -> ExceptT SophieTxCmdError IO (TxFee era)
validateTxFee BccEra era
era Maybe Entropic
mfee =
    case (BccEra era
-> Either (TxFeesImplicitInEra era) (TxFeesExplicitInEra era)
forall era.
BccEra era
-> Either (TxFeesImplicitInEra era) (TxFeesExplicitInEra era)
txFeesExplicitInEra BccEra era
era, Maybe Entropic
mfee) of
      (Left  TxFeesImplicitInEra era
implicit, Maybe Entropic
Nothing)  -> TxFee era -> ExceptT SophieTxCmdError 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 Entropic
fee) -> TxFee era -> ExceptT SophieTxCmdError IO (TxFee era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxFeesExplicitInEra era -> Entropic -> TxFee era
forall era. TxFeesExplicitInEra era -> Entropic -> TxFee era
TxFeeExplicit TxFeesExplicitInEra era
explicit Entropic
fee)

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


validateTxValidityLowerBound :: BccEra era
                             -> Maybe SlotNo
                             -> ExceptT SophieTxCmdError IO
                                        (TxValidityLowerBound era)
validateTxValidityLowerBound :: BccEra era
-> Maybe SlotNo
-> ExceptT SophieTxCmdError IO (TxValidityLowerBound era)
validateTxValidityLowerBound BccEra era
_ Maybe SlotNo
Nothing = TxValidityLowerBound era
-> ExceptT SophieTxCmdError IO (TxValidityLowerBound era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxValidityLowerBound era
forall era. TxValidityLowerBound era
TxValidityNoLowerBound
validateTxValidityLowerBound BccEra era
era (Just SlotNo
slot) =
    case BccEra era -> Maybe (ValidityLowerBoundSupportedInEra era)
forall era.
BccEra era -> Maybe (ValidityLowerBoundSupportedInEra era)
validityLowerBoundSupportedInEra BccEra era
era of
      Maybe (ValidityLowerBoundSupportedInEra era)
Nothing -> BccEra era
-> TxFeature
-> ExceptT SophieTxCmdError IO (TxValidityLowerBound era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureValidityLowerBound
      Just ValidityLowerBoundSupportedInEra era
supported -> TxValidityLowerBound era
-> ExceptT SophieTxCmdError 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 :: BccEra era
                             -> Maybe SlotNo
                             -> ExceptT SophieTxCmdError IO
                                        (TxValidityUpperBound era)
validateTxValidityUpperBound :: BccEra era
-> Maybe SlotNo
-> ExceptT SophieTxCmdError IO (TxValidityUpperBound era)
validateTxValidityUpperBound BccEra era
era Maybe SlotNo
Nothing =
    case BccEra era -> Maybe (ValidityNoUpperBoundSupportedInEra era)
forall era.
BccEra era -> Maybe (ValidityNoUpperBoundSupportedInEra era)
validityNoUpperBoundSupportedInEra BccEra era
era of
      Maybe (ValidityNoUpperBoundSupportedInEra era)
Nothing -> BccEra era
-> TxFeature
-> ExceptT SophieTxCmdError IO (TxValidityUpperBound era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureValidityNoUpperBound
      Just ValidityNoUpperBoundSupportedInEra era
supported -> TxValidityUpperBound era
-> ExceptT SophieTxCmdError 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 BccEra era
era (Just SlotNo
slot) =
    case BccEra era -> Maybe (ValidityUpperBoundSupportedInEra era)
forall era.
BccEra era -> Maybe (ValidityUpperBoundSupportedInEra era)
validityUpperBoundSupportedInEra BccEra era
era of
      Maybe (ValidityUpperBoundSupportedInEra era)
Nothing -> BccEra era
-> TxFeature
-> ExceptT SophieTxCmdError IO (TxValidityUpperBound era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureValidityUpperBound
      Just ValidityUpperBoundSupportedInEra era
supported -> TxValidityUpperBound era
-> ExceptT SophieTxCmdError 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 :: BccEra era
                        -> TxMetadataJsonSchema
                        -> [MetadataFile]
                        -> ExceptT SophieTxCmdError IO (TxMetadataInEra era)
validateTxMetadataInEra :: BccEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> ExceptT SophieTxCmdError IO (TxMetadataInEra era)
validateTxMetadataInEra BccEra era
_ TxMetadataJsonSchema
_ [] = TxMetadataInEra era
-> ExceptT SophieTxCmdError IO (TxMetadataInEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxMetadataInEra era
forall era. TxMetadataInEra era
TxMetadataNone
validateTxMetadataInEra BccEra era
era TxMetadataJsonSchema
schema [MetadataFile]
files =
    case BccEra era -> Maybe (TxMetadataSupportedInEra era)
forall era. BccEra era -> Maybe (TxMetadataSupportedInEra era)
txMetadataSupportedInEra BccEra era
era of
      Maybe (TxMetadataSupportedInEra era)
Nothing -> BccEra era
-> TxFeature -> ExceptT SophieTxCmdError IO (TxMetadataInEra era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureTxMetadata
      Just TxMetadataSupportedInEra era
supported -> do
        TxMetadata
metadata <- [TxMetadata] -> TxMetadata
forall a. Monoid a => [a] -> a
mconcat ([TxMetadata] -> TxMetadata)
-> ExceptT SophieTxCmdError IO [TxMetadata]
-> ExceptT SophieTxCmdError IO TxMetadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MetadataFile -> ExceptT SophieTxCmdError IO TxMetadata)
-> [MetadataFile] -> ExceptT SophieTxCmdError IO [TxMetadata]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TxMetadataJsonSchema
-> MetadataFile -> ExceptT SophieTxCmdError IO TxMetadata
readFileTxMetadata TxMetadataJsonSchema
schema) [MetadataFile]
files
        TxMetadataInEra era
-> ExceptT SophieTxCmdError 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 :: BccEra era
                     -> [ScriptFile]
                     -> ExceptT SophieTxCmdError IO (TxAuxScripts era)
validateTxAuxScripts :: BccEra era
-> [ScriptFile] -> ExceptT SophieTxCmdError IO (TxAuxScripts era)
validateTxAuxScripts BccEra era
_ [] = TxAuxScripts era -> ExceptT SophieTxCmdError IO (TxAuxScripts era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxAuxScripts era
forall era. TxAuxScripts era
TxAuxScriptsNone
validateTxAuxScripts BccEra era
era [ScriptFile]
files =
  case BccEra era -> Maybe (AuxScriptsSupportedInEra era)
forall era. BccEra era -> Maybe (AuxScriptsSupportedInEra era)
auxScriptsSupportedInEra BccEra era
era of
    Maybe (AuxScriptsSupportedInEra era)
Nothing -> BccEra era
-> TxFeature -> ExceptT SophieTxCmdError IO (TxAuxScripts era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureAuxScripts
    Just AuxScriptsSupportedInEra era
supported -> do
      [ScriptInEra era]
scripts <- [ExceptT SophieTxCmdError IO (ScriptInEra era)]
-> ExceptT SophieTxCmdError IO [ScriptInEra era]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ do ScriptInAnyLang
script <- (FileError ScriptDecodeError -> SophieTxCmdError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT SophieTxCmdError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> SophieTxCmdError
SophieTxCmdScriptFileError (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
 -> ExceptT SophieTxCmdError IO ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT SophieTxCmdError IO ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
                         String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang String
file
             BccEra era
-> ScriptInAnyLang -> ExceptT SophieTxCmdError IO (ScriptInEra era)
forall era.
BccEra era
-> ScriptInAnyLang -> ExceptT SophieTxCmdError IO (ScriptInEra era)
validateScriptSupportedInEra BccEra era
era ScriptInAnyLang
script
        | ScriptFile String
file <- [ScriptFile]
files ]
      TxAuxScripts era -> ExceptT SophieTxCmdError IO (TxAuxScripts era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxAuxScripts era
 -> ExceptT SophieTxCmdError IO (TxAuxScripts era))
-> TxAuxScripts era
-> ExceptT SophieTxCmdError 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

validateRequiredSigners :: BccEra era
                        -> [WitnessSigningData]
                        -> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
validateRequiredSigners :: BccEra era
-> [WitnessSigningData]
-> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
validateRequiredSigners BccEra era
_ [] = TxExtraKeyWitnesses era
-> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxExtraKeyWitnesses era
forall era. TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone
validateRequiredSigners BccEra era
era [WitnessSigningData]
reqSigs =
  case BccEra era -> Maybe (TxExtraKeyWitnessesSupportedInEra era)
forall era.
BccEra era -> Maybe (TxExtraKeyWitnessesSupportedInEra era)
extraKeyWitnessesSupportedInEra BccEra era
era of
    Maybe (TxExtraKeyWitnessesSupportedInEra era)
Nothing -> BccEra era
-> TxFeature
-> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureExtraKeyWits
    Just TxExtraKeyWitnessesSupportedInEra era
supported -> do
      [SomeWitness]
keyWits <- (ReadWitnessSigningDataError -> SophieTxCmdError)
-> ExceptT ReadWitnessSigningDataError IO [SomeWitness]
-> ExceptT SophieTxCmdError IO [SomeWitness]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ReadWitnessSigningDataError -> SophieTxCmdError
SophieTxCmdReadWitnessSigningDataError
                   (ExceptT ReadWitnessSigningDataError IO [SomeWitness]
 -> ExceptT SophieTxCmdError IO [SomeWitness])
-> ExceptT ReadWitnessSigningDataError IO [SomeWitness]
-> ExceptT SophieTxCmdError 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]
reqSigs
      let ([SophieBootstrapWitnessSigningKeyData]
_sksCole, [SophieWitnessSigningKey]
sksSophie) = [ColeOrSophieWitness]
-> ([SophieBootstrapWitnessSigningKeyData],
    [SophieWitnessSigningKey])
partitionSomeWitnesses ([ColeOrSophieWitness]
 -> ([SophieBootstrapWitnessSigningKeyData],
     [SophieWitnessSigningKey]))
-> [ColeOrSophieWitness]
-> ([SophieBootstrapWitnessSigningKeyData],
    [SophieWitnessSigningKey])
forall a b. (a -> b) -> a -> b
$ (SomeWitness -> ColeOrSophieWitness)
-> [SomeWitness] -> [ColeOrSophieWitness]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SomeWitness -> ColeOrSophieWitness
categoriseSomeWitness [SomeWitness]
keyWits
          sophieSigningKeys :: [SophieSigningKey]
sophieSigningKeys = (SophieWitnessSigningKey -> SophieSigningKey)
-> [SophieWitnessSigningKey] -> [SophieSigningKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SophieWitnessSigningKey -> SophieSigningKey
toSophieSigningKey [SophieWitnessSigningKey]
sksSophie
          paymentKeyHashes :: [Hash PaymentKey]
paymentKeyHashes = (SigningKey PaymentKey -> Hash PaymentKey)
-> [SigningKey PaymentKey] -> [Hash PaymentKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey PaymentKey -> Hash PaymentKey)
-> (SigningKey PaymentKey -> VerificationKey PaymentKey)
-> SigningKey PaymentKey
-> Hash PaymentKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey) ([SigningKey PaymentKey] -> [Hash PaymentKey])
-> [SigningKey PaymentKey] -> [Hash PaymentKey]
forall a b. (a -> b) -> a -> b
$ (SophieSigningKey -> Maybe (SigningKey PaymentKey))
-> [SophieSigningKey] -> [SigningKey PaymentKey]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SophieSigningKey -> Maybe (SigningKey PaymentKey)
excludeExtendedKeys [SophieSigningKey]
sophieSigningKeys
      TxExtraKeyWitnesses era
-> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxExtraKeyWitnesses era
 -> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era))
-> TxExtraKeyWitnesses era
-> ExceptT SophieTxCmdError IO (TxExtraKeyWitnesses era)
forall a b. (a -> b) -> a -> b
$ TxExtraKeyWitnessesSupportedInEra era
-> [Hash PaymentKey] -> TxExtraKeyWitnesses era
forall era.
TxExtraKeyWitnessesSupportedInEra era
-> [Hash PaymentKey] -> TxExtraKeyWitnesses era
TxExtraKeyWitnesses TxExtraKeyWitnessesSupportedInEra era
supported [Hash PaymentKey]
paymentKeyHashes
 where
  excludeExtendedKeys :: SophieSigningKey -> Maybe (SigningKey PaymentKey)
  excludeExtendedKeys :: SophieSigningKey -> Maybe (SigningKey PaymentKey)
excludeExtendedKeys (SophieExtendedSigningKey XPrv
_) = Maybe (SigningKey PaymentKey)
forall a. Maybe a
Nothing
  excludeExtendedKeys (SophieNormalSigningKey SignKeyDSIGN StandardCrypto
sk) = SigningKey PaymentKey -> Maybe (SigningKey PaymentKey)
forall a. a -> Maybe a
Just (SigningKey PaymentKey -> Maybe (SigningKey PaymentKey))
-> SigningKey PaymentKey -> Maybe (SigningKey PaymentKey)
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN StandardCrypto -> SigningKey PaymentKey
PaymentSigningKey SignKeyDSIGN StandardCrypto
sk

validateTxWithdrawals
  :: forall era.
     BccEra era
  -> [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> ExceptT SophieTxCmdError IO (TxWithdrawals BuildTx era)
validateTxWithdrawals :: BccEra era
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT SophieTxCmdError IO (TxWithdrawals BuildTx era)
validateTxWithdrawals BccEra era
_ [] = TxWithdrawals BuildTx era
-> ExceptT SophieTxCmdError IO (TxWithdrawals BuildTx era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxWithdrawals BuildTx era
forall build era. TxWithdrawals build era
TxWithdrawalsNone
validateTxWithdrawals BccEra era
era [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals =
  case BccEra era -> Maybe (WithdrawalsSupportedInEra era)
forall era. BccEra era -> Maybe (WithdrawalsSupportedInEra era)
withdrawalsSupportedInEra BccEra era
era of
    Maybe (WithdrawalsSupportedInEra era)
Nothing -> BccEra era
-> TxFeature
-> ExceptT SophieTxCmdError IO (TxWithdrawals BuildTx era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureWithdrawals
    Just WithdrawalsSupportedInEra era
supported -> do
      [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
convWithdrawals <- ((StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))
 -> ExceptT
      SophieTxCmdError
      IO
      (StakeAddress, Entropic,
       BuildTxWith BuildTx (Witness WitCtxStake era)))
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT
     SophieTxCmdError
     IO
     [(StakeAddress, Entropic,
       BuildTxWith BuildTx (Witness WitCtxStake era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))
-> ExceptT
     SophieTxCmdError
     IO
     (StakeAddress, Entropic,
      BuildTxWith BuildTx (Witness WitCtxStake era))
convert [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
withdrawals
      TxWithdrawals BuildTx era
-> ExceptT SophieTxCmdError IO (TxWithdrawals BuildTx era)
forall (m :: * -> *) a. Monad m => a -> m a
return (WithdrawalsSupportedInEra era
-> [(StakeAddress, Entropic,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
-> TxWithdrawals BuildTx era
forall era build.
WithdrawalsSupportedInEra era
-> [(StakeAddress, Entropic,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
TxWithdrawals WithdrawalsSupportedInEra era
supported [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
convWithdrawals)
 where
  convert
    :: (StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))
    -> ExceptT SophieTxCmdError IO
              (StakeAddress,
               Entropic,
               BuildTxWith BuildTx (Witness WitCtxStake era))
  convert :: (StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))
-> ExceptT
     SophieTxCmdError
     IO
     (StakeAddress, Entropic,
      BuildTxWith BuildTx (Witness WitCtxStake era))
convert (StakeAddress
sAddr, Entropic
ll, Maybe (ScriptWitnessFiles WitCtxStake)
mScriptWitnessFiles) =
    case Maybe (ScriptWitnessFiles WitCtxStake)
mScriptWitnessFiles of
      Just ScriptWitnessFiles WitCtxStake
scriptWitnessFiles -> do
        ScriptWitness WitCtxStake era
sWit <- BccEra era
-> ScriptWitnessFiles WitCtxStake
-> ExceptT SophieTxCmdError IO (ScriptWitness WitCtxStake era)
forall era witctx.
BccEra era
-> ScriptWitnessFiles witctx
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
createScriptWitness BccEra era
era ScriptWitnessFiles WitCtxStake
scriptWitnessFiles
        (StakeAddress, Entropic,
 BuildTxWith BuildTx (Witness WitCtxStake era))
-> ExceptT
     SophieTxCmdError
     IO
     (StakeAddress, Entropic,
      BuildTxWith BuildTx (Witness WitCtxStake era))
forall (m :: * -> *) a. Monad m => a -> m a
return ( StakeAddress
sAddr
               , Entropic
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, Entropic,
 BuildTxWith BuildTx (Witness WitCtxStake era))
-> ExceptT
     SophieTxCmdError
     IO
     (StakeAddress, Entropic,
      BuildTxWith BuildTx (Witness WitCtxStake era))
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeAddress
sAddr,Entropic
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.
     BccEra era
  -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> ExceptT SophieTxCmdError IO (TxCertificates BuildTx era)
validateTxCertificates :: BccEra era
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT SophieTxCmdError IO (TxCertificates BuildTx era)
validateTxCertificates BccEra era
era [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles =
  case BccEra era -> Maybe (CertificatesSupportedInEra era)
forall era. BccEra era -> Maybe (CertificatesSupportedInEra era)
certificatesSupportedInEra BccEra 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 SophieTxCmdError 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      -> BccEra era
-> TxFeature
-> ExceptT SophieTxCmdError IO (TxCertificates BuildTx era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureCertificates
    Just CertificatesSupportedInEra era
supported -> do
      [Certificate]
certs <- [ExceptT SophieTxCmdError IO Certificate]
-> ExceptT SophieTxCmdError IO [Certificate]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                 [ (FileError TextEnvelopeError -> SophieTxCmdError)
-> ExceptT (FileError TextEnvelopeError) IO Certificate
-> ExceptT SophieTxCmdError IO Certificate
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> SophieTxCmdError
SophieTxCmdReadTextViewFileError (ExceptT (FileError TextEnvelopeError) IO Certificate
 -> ExceptT SophieTxCmdError IO Certificate)
-> (IO (Either (FileError TextEnvelopeError) Certificate)
    -> ExceptT (FileError TextEnvelopeError) IO Certificate)
-> IO (Either (FileError TextEnvelopeError) Certificate)
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO Certificate)
-> IO (Either (FileError TextEnvelopeError) Certificate)
-> ExceptT SophieTxCmdError 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
     SophieTxCmdError
     IO
     [Maybe (StakeCredential, Witness WitCtxStake era)]
-> ExceptT
     SophieTxCmdError IO (Map StakeCredential (Witness WitCtxStake era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
 -> ExceptT
      SophieTxCmdError
      IO
      (Maybe (StakeCredential, Witness WitCtxStake era)))
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT
     SophieTxCmdError
     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
     SophieTxCmdError
     IO
     (Maybe (StakeCredential, Witness WitCtxStake era))
convert [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
certFiles
      TxCertificates BuildTx era
-> ExceptT SophieTxCmdError IO (TxCertificates BuildTx era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxCertificates BuildTx era
 -> ExceptT SophieTxCmdError IO (TxCertificates BuildTx era))
-> TxCertificates BuildTx era
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO (Maybe StakeCredential)
   deriveStakeCredentialWitness :: CertificateFile
-> ExceptT SophieTxCmdError IO (Maybe StakeCredential)
deriveStakeCredentialWitness (CertificateFile String
certFile) = do
     Certificate
cert <- (FileError TextEnvelopeError -> SophieTxCmdError)
-> ExceptT (FileError TextEnvelopeError) IO Certificate
-> ExceptT SophieTxCmdError IO Certificate
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> SophieTxCmdError
SophieTxCmdReadTextViewFileError (ExceptT (FileError TextEnvelopeError) IO Certificate
 -> ExceptT SophieTxCmdError IO Certificate)
-> (IO (Either (FileError TextEnvelopeError) Certificate)
    -> ExceptT (FileError TextEnvelopeError) IO Certificate)
-> IO (Either (FileError TextEnvelopeError) Certificate)
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO Certificate)
-> IO (Either (FileError TextEnvelopeError) Certificate)
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO (Maybe StakeCredential)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe StakeCredential
 -> ExceptT SophieTxCmdError IO (Maybe StakeCredential))
-> Maybe StakeCredential
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO (Maybe StakeCredential)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe StakeCredential
 -> ExceptT SophieTxCmdError IO (Maybe StakeCredential))
-> Maybe StakeCredential
-> ExceptT SophieTxCmdError 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 SophieTxCmdError 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 SophieTxCmdError IO
                (Maybe (StakeCredential, Witness WitCtxStake era))
   convert :: (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
-> ExceptT
     SophieTxCmdError
     IO
     (Maybe (StakeCredential, Witness WitCtxStake era))
convert (CertificateFile
cert, Maybe (ScriptWitnessFiles WitCtxStake)
mScriptWitnessFiles) = do
     Maybe StakeCredential
mStakeCred <- CertificateFile
-> ExceptT SophieTxCmdError IO (Maybe StakeCredential)
deriveStakeCredentialWitness CertificateFile
cert
     case Maybe StakeCredential
mStakeCred of
       Maybe StakeCredential
Nothing -> Maybe (StakeCredential, Witness WitCtxStake era)
-> ExceptT
     SophieTxCmdError
     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 <- BccEra era
-> ScriptWitnessFiles WitCtxStake
-> ExceptT SophieTxCmdError IO (ScriptWitness WitCtxStake era)
forall era witctx.
BccEra era
-> ScriptWitnessFiles witctx
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
createScriptWitness BccEra era
era ScriptWitnessFiles WitCtxStake
scriptWitnessFiles
            Maybe (StakeCredential, Witness WitCtxStake era)
-> ExceptT
     SophieTxCmdError
     IO
     (Maybe (StakeCredential, Witness WitCtxStake era))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (StakeCredential, Witness WitCtxStake era)
 -> ExceptT
      SophieTxCmdError
      IO
      (Maybe (StakeCredential, Witness WitCtxStake era)))
-> Maybe (StakeCredential, Witness WitCtxStake era)
-> ExceptT
     SophieTxCmdError
     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
     SophieTxCmdError
     IO
     (Maybe (StakeCredential, Witness WitCtxStake era))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (StakeCredential, Witness WitCtxStake era)
 -> ExceptT
      SophieTxCmdError
      IO
      (Maybe (StakeCredential, Witness WitCtxStake era)))
-> Maybe (StakeCredential, Witness WitCtxStake era)
-> ExceptT
     SophieTxCmdError
     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
  :: BccEra era
  -> Maybe ProtocolParamsSourceSpec
  -> ExceptT SophieTxCmdError IO
            (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters :: BccEra era
-> Maybe ProtocolParamsSourceSpec
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters BccEra era
_ Maybe ProtocolParamsSourceSpec
Nothing = BuildTxWith BuildTx (Maybe ProtocolParameters)
-> ExceptT
     SophieTxCmdError
     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 BccEra era
era (Just ProtocolParamsSourceSpec
pparamsspec) =
    case BccEra era -> Maybe (ScriptDataSupportedInEra era)
forall era. BccEra era -> Maybe (ScriptDataSupportedInEra era)
scriptDataSupportedInEra BccEra era
era of
      Maybe (ScriptDataSupportedInEra era)
Nothing -> BccEra era
-> TxFeature
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra 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 SophieTxCmdError IO ProtocolParameters
-> ExceptT
     SophieTxCmdError
     IO
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   ProtocolParamsSourceSpec
-> ExceptT SophieTxCmdError IO ProtocolParameters
readProtocolParametersSourceSpec ProtocolParamsSourceSpec
pparamsspec

validateTxUpdateProposal :: BccEra era
                         -> Maybe UpdateProposalFile
                         -> ExceptT SophieTxCmdError IO (TxUpdateProposal era)
validateTxUpdateProposal :: BccEra era
-> Maybe UpdateProposalFile
-> ExceptT SophieTxCmdError IO (TxUpdateProposal era)
validateTxUpdateProposal BccEra era
_ Maybe UpdateProposalFile
Nothing = TxUpdateProposal era
-> ExceptT SophieTxCmdError IO (TxUpdateProposal era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxUpdateProposal era
forall era. TxUpdateProposal era
TxUpdateProposalNone
validateTxUpdateProposal BccEra era
era (Just (UpdateProposalFile String
file)) =
    case BccEra era -> Maybe (UpdateProposalSupportedInEra era)
forall era. BccEra era -> Maybe (UpdateProposalSupportedInEra era)
updateProposalSupportedInEra BccEra era
era of
      Maybe (UpdateProposalSupportedInEra era)
Nothing -> BccEra era
-> TxFeature -> ExceptT SophieTxCmdError IO (TxUpdateProposal era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureCertificates
      Just UpdateProposalSupportedInEra era
supported -> do
         UpdateProposal
prop <- (FileError TextEnvelopeError -> SophieTxCmdError)
-> ExceptT (FileError TextEnvelopeError) IO UpdateProposal
-> ExceptT SophieTxCmdError IO UpdateProposal
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> SophieTxCmdError
SophieTxCmdReadTextViewFileError (ExceptT (FileError TextEnvelopeError) IO UpdateProposal
 -> ExceptT SophieTxCmdError IO UpdateProposal)
-> ExceptT (FileError TextEnvelopeError) IO UpdateProposal
-> ExceptT SophieTxCmdError 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 SophieTxCmdError 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.
     BccEra era
  -> Maybe ScriptValidity
  -> ExceptT SophieTxCmdError IO (TxScriptValidity era)
validateTxScriptValidity :: BccEra era
-> Maybe ScriptValidity
-> ExceptT SophieTxCmdError IO (TxScriptValidity era)
validateTxScriptValidity BccEra era
_ Maybe ScriptValidity
Nothing = TxScriptValidity era
-> ExceptT SophieTxCmdError IO (TxScriptValidity era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxScriptValidity era
forall era. TxScriptValidity era
TxScriptValidityNone
validateTxScriptValidity BccEra era
era (Just ScriptValidity
scriptValidity) =
  case BccEra era -> Maybe (TxScriptValiditySupportedInEra era)
forall era.
BccEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInBccEra BccEra era
era of
    Maybe (TxScriptValiditySupportedInEra era)
Nothing -> BccEra era
-> TxFeature -> ExceptT SophieTxCmdError IO (TxScriptValidity era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra era
era TxFeature
TxFeatureScriptValidity
    Just TxScriptValiditySupportedInEra era
supported -> TxScriptValidity era
-> ExceptT SophieTxCmdError IO (TxScriptValidity era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxScriptValidity era
 -> ExceptT SophieTxCmdError IO (TxScriptValidity era))
-> TxScriptValidity era
-> ExceptT SophieTxCmdError IO (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.
                       BccEra era
                    -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
                    -> ExceptT SophieTxCmdError IO (TxMintValue BuildTx era)
validateTxMintValue :: BccEra era
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT SophieTxCmdError IO (TxMintValue BuildTx era)
validateTxMintValue BccEra era
_ Maybe (Value, [ScriptWitnessFiles WitCtxMint])
Nothing = TxMintValue BuildTx era
-> ExceptT SophieTxCmdError IO (TxMintValue BuildTx era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxMintValue BuildTx era
forall build era. TxMintValue build era
TxMintNone
validateTxMintValue BccEra era
era (Just (Value
val, [ScriptWitnessFiles WitCtxMint]
scriptWitnessFiles)) =
    case BccEra era
-> Either
     (OnlyBccSupportedInEra era) (MultiAssetSupportedInEra era)
forall era.
BccEra era
-> Either
     (OnlyBccSupportedInEra era) (MultiAssetSupportedInEra era)
multiAssetSupportedInEra BccEra era
era of
      Left OnlyBccSupportedInEra era
_ -> BccEra era
-> TxFeature
-> ExceptT SophieTxCmdError IO (TxMintValue BuildTx era)
forall era a.
BccEra era -> TxFeature -> ExceptT SophieTxCmdError IO a
txFeatureMismatch BccEra 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 SophieTxCmdError IO (ScriptWitness WitCtxMint era))
-> [ScriptWitnessFiles WitCtxMint]
-> ExceptT SophieTxCmdError IO [ScriptWitness WitCtxMint era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (BccEra era
-> ScriptWitnessFiles WitCtxMint
-> ExceptT SophieTxCmdError IO (ScriptWitness WitCtxMint era)
forall era witctx.
BccEra era
-> ScriptWitnessFiles witctx
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
createScriptWitness BccEra 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 SophieTxCmdError IO ()
forall (m :: * -> *).
Monad m =>
Set PolicyId -> Set PolicyId -> ExceptT SophieTxCmdError m ()
validateAllWitnessesProvided   Set PolicyId
witnessesNeededSet Set PolicyId
witnessesProvidedSet
        Set PolicyId -> Set PolicyId -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *).
Monad m =>
Set PolicyId -> Set PolicyId -> ExceptT SophieTxCmdError m ()
validateNoUnnecessaryWitnesses Set PolicyId
witnessesNeededSet Set PolicyId
witnessesProvidedSet

        TxMintValue BuildTx era
-> ExceptT SophieTxCmdError 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 SophieTxCmdError m ()
validateAllWitnessesProvided Set PolicyId
witnessesNeeded Set PolicyId
witnessesProvided
      | [PolicyId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PolicyId]
witnessesMissing = () -> ExceptT SophieTxCmdError m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = SophieTxCmdError -> ExceptT SophieTxCmdError m ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ([PolicyId] -> SophieTxCmdError
SophieTxCmdPolicyIdsMissing [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 SophieTxCmdError m ()
validateNoUnnecessaryWitnesses Set PolicyId
witnessesNeeded Set PolicyId
witnessesProvided
      | [PolicyId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PolicyId]
witnessesExtra = () -> ExceptT SophieTxCmdError m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = SophieTxCmdError -> ExceptT SophieTxCmdError m ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ([PolicyId] -> SophieTxCmdError
SophieTxCmdPolicyIdsExcess [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
  :: BccEra era
  -> ScriptWitnessFiles witctx
  -> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
createScriptWitness :: BccEra era
-> ScriptWitnessFiles witctx
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
createScriptWitness BccEra era
era (SimpleScriptWitnessFile (ScriptFile String
scriptFile)) = do
    script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) <- (FileError ScriptDecodeError -> SophieTxCmdError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT SophieTxCmdError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> SophieTxCmdError
SophieTxCmdScriptFileError (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
 -> ExceptT SophieTxCmdError IO ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT SophieTxCmdError 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'   <- BccEra era
-> ScriptInAnyLang -> ExceptT SophieTxCmdError IO (ScriptInEra era)
forall era.
BccEra era
-> ScriptInAnyLang -> ExceptT SophieTxCmdError IO (ScriptInEra era)
validateScriptSupportedInEra BccEra era
era ScriptInAnyLang
script
    case Script lang
script' of
      SimpleScript SimpleScriptVersion lang
version SimpleScript lang
sscript ->
        ScriptWitness witctx era
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptWitness witctx era
 -> ExceptT SophieTxCmdError IO (ScriptWitness witctx era))
-> ScriptWitness witctx era
-> ExceptT SophieTxCmdError 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 zerepoch script, then we must fail.
      ZerepochScript{} ->
        SophieTxCmdError
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieTxCmdError
 -> ExceptT SophieTxCmdError IO (ScriptWitness witctx era))
-> SophieTxCmdError
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$ String -> AnyScriptLanguage -> SophieTxCmdError
SophieTxCmdScriptExpectedSimple
                 String
scriptFile
                 (ScriptLanguage lang -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang)

createScriptWitness BccEra era
era (ZerepochScriptWitnessFiles
                          (ScriptFile String
scriptFile)
                          ScriptDatumOrFile witctx
datumOrFile
                          ScriptDataOrFile
redeemerOrFile
                          ExecutionUnits
execUnits) = do
    script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) <- (FileError ScriptDecodeError -> SophieTxCmdError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT SophieTxCmdError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> SophieTxCmdError
SophieTxCmdScriptFileError (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
 -> ExceptT SophieTxCmdError IO ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT SophieTxCmdError 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'   <- BccEra era
-> ScriptInAnyLang -> ExceptT SophieTxCmdError IO (ScriptInEra era)
forall era.
BccEra era
-> ScriptInAnyLang -> ExceptT SophieTxCmdError IO (ScriptInEra era)
validateScriptSupportedInEra BccEra era
era ScriptInAnyLang
script
    case Script lang
script' of
      ZerepochScript ZerepochScriptVersion lang
version ZerepochScript lang
pscript -> do
        ScriptDatum witctx
datum    <- ScriptDatumOrFile witctx
-> ExceptT SophieTxCmdError IO (ScriptDatum witctx)
forall witctx.
ScriptDatumOrFile witctx
-> ExceptT SophieTxCmdError IO (ScriptDatum witctx)
readScriptDatumOrFile    ScriptDatumOrFile witctx
datumOrFile
        ScriptData
redeemer <- ScriptDataOrFile -> ExceptT SophieTxCmdError IO ScriptData
readScriptRedeemerOrFile ScriptDataOrFile
redeemerOrFile
        ScriptWitness witctx era
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptWitness witctx era
 -> ExceptT SophieTxCmdError IO (ScriptWitness witctx era))
-> ScriptWitness witctx era
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra lang era
-> ZerepochScriptVersion lang
-> ZerepochScript lang
-> ScriptDatum witctx
-> ScriptData
-> ExecutionUnits
-> ScriptWitness witctx era
forall lang era witctx.
ScriptLanguageInEra lang era
-> ZerepochScriptVersion lang
-> ZerepochScript lang
-> ScriptDatum witctx
-> ScriptData
-> ExecutionUnits
-> ScriptWitness witctx era
ZerepochScriptWitness
                   ScriptLanguageInEra lang era
langInEra ZerepochScriptVersion lang
version ZerepochScript lang
pscript
                   ScriptDatum witctx
datum
                   ScriptData
redeemer
                   ExecutionUnits
execUnits

      -- If the supplied cli flags were for a zerepoch 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{} ->
        SophieTxCmdError
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieTxCmdError
 -> ExceptT SophieTxCmdError IO (ScriptWitness witctx era))
-> SophieTxCmdError
-> ExceptT SophieTxCmdError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$ String -> AnyScriptLanguage -> SophieTxCmdError
SophieTxCmdScriptExpectedZerepoch
                 String
scriptFile
                 (ScriptLanguage lang -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang)


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

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

readScriptDataOrFile :: ScriptDataOrFile
                     -> ExceptT SophieTxCmdError IO ScriptData
readScriptDataOrFile :: ScriptDataOrFile -> ExceptT SophieTxCmdError IO ScriptData
readScriptDataOrFile (ScriptDataValue ScriptData
d) = ScriptData -> ExceptT SophieTxCmdError IO ScriptData
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptData
d
readScriptDataOrFile (ScriptDataFile String
fp) = do
    ByteString
bs <- (IOException -> SophieTxCmdError)
-> IO ByteString -> ExceptT SophieTxCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieTxCmdError
SophieTxCmdReadFileError (FileError () -> SophieTxCmdError)
-> (IOException -> FileError ()) -> IOException -> SophieTxCmdError
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 SophieTxCmdError IO ByteString)
-> IO ByteString -> ExceptT SophieTxCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
            String -> IO ByteString
LBS.readFile String
fp
    Value
v  <- (String -> SophieTxCmdError)
-> ExceptT String IO Value -> ExceptT SophieTxCmdError IO Value
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> String -> SophieTxCmdError
SophieTxCmdScriptDataJsonParseError String
fp) (ExceptT String IO Value -> ExceptT SophieTxCmdError IO Value)
-> ExceptT String IO Value -> ExceptT SophieTxCmdError 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 -> SophieTxCmdError)
-> ExceptT ScriptDataJsonError IO ScriptData
-> ExceptT SophieTxCmdError IO ScriptData
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> ScriptDataJsonError -> SophieTxCmdError
SophieTxCmdScriptDataConversionError String
fp) (ExceptT ScriptDataJsonError IO ScriptData
 -> ExceptT SophieTxCmdError IO ScriptData)
-> ExceptT ScriptDataJsonError IO ScriptData
-> ExceptT SophieTxCmdError 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 -> SophieTxCmdError)
-> ExceptT ScriptDataRangeError IO ()
-> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> ScriptDataRangeError -> SophieTxCmdError
SophieTxCmdScriptDataValidationError String
fp) (ExceptT ScriptDataRangeError IO ()
 -> ExceptT SophieTxCmdError IO ())
-> ExceptT ScriptDataRangeError IO ()
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ScriptData
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptData
sd


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

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

  [SomeWitness]
sks <- (ReadWitnessSigningDataError -> SophieTxCmdError)
-> ExceptT ReadWitnessSigningDataError IO [SomeWitness]
-> ExceptT SophieTxCmdError IO [SomeWitness]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ReadWitnessSigningDataError -> SophieTxCmdError
SophieTxCmdReadWitnessSigningDataError (ExceptT ReadWitnessSigningDataError IO [SomeWitness]
 -> ExceptT SophieTxCmdError IO [SomeWitness])
-> ExceptT ReadWitnessSigningDataError IO [SomeWitness]
-> ExceptT SophieTxCmdError 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 ([SophieBootstrapWitnessSigningKeyData]
sksCole, [SophieWitnessSigningKey]
sksSophie) = [ColeOrSophieWitness]
-> ([SophieBootstrapWitnessSigningKeyData],
    [SophieWitnessSigningKey])
partitionSomeWitnesses ([ColeOrSophieWitness]
 -> ([SophieBootstrapWitnessSigningKeyData],
     [SophieWitnessSigningKey]))
-> [ColeOrSophieWitness]
-> ([SophieBootstrapWitnessSigningKeyData],
    [SophieWitnessSigningKey])
forall a b. (a -> b) -> a -> b
$ (SomeWitness -> ColeOrSophieWitness)
-> [SomeWitness] -> [ColeOrSophieWitness]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SomeWitness -> ColeOrSophieWitness
categoriseSomeWitness [SomeWitness]
sks

  -- Cole witnesses require the network ID. This can either be provided
  -- directly or derived from a provided Cole address.
  [KeyWitness era]
coleWitnesses <- (SophieBootstrapWitnessError -> SophieTxCmdError)
-> ExceptT SophieBootstrapWitnessError IO [KeyWitness era]
-> ExceptT SophieTxCmdError IO [KeyWitness era]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieBootstrapWitnessError -> SophieTxCmdError
SophieTxCmdBootstrapWitnessError
    (ExceptT SophieBootstrapWitnessError IO [KeyWitness era]
 -> ExceptT SophieTxCmdError IO [KeyWitness era])
-> (Either SophieBootstrapWitnessError [KeyWitness era]
    -> ExceptT SophieBootstrapWitnessError IO [KeyWitness era])
-> Either SophieBootstrapWitnessError [KeyWitness era]
-> ExceptT SophieTxCmdError 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 SophieBootstrapWitnessError [KeyWitness era]
-> ExceptT SophieBootstrapWitnessError IO [KeyWitness era]
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
    (Either SophieBootstrapWitnessError [KeyWitness era]
 -> ExceptT SophieTxCmdError IO [KeyWitness era])
-> Either SophieBootstrapWitnessError [KeyWitness era]
-> ExceptT SophieTxCmdError IO [KeyWitness era]
forall a b. (a -> b) -> a -> b
$ Maybe NetworkId
-> TxBody era
-> [SophieBootstrapWitnessSigningKeyData]
-> Either SophieBootstrapWitnessError [KeyWitness era]
forall era.
IsSophieBasedEra era =>
Maybe NetworkId
-> TxBody era
-> [SophieBootstrapWitnessSigningKeyData]
-> Either SophieBootstrapWitnessError [KeyWitness era]
mkSophieBootstrapWitnesses Maybe NetworkId
mnw TxBody era
txbody [SophieBootstrapWitnessSigningKeyData]
sksCole

  let sophieKeyWitnesses :: [KeyWitness era]
sophieKeyWitnesses = (SophieWitnessSigningKey -> KeyWitness era)
-> [SophieWitnessSigningKey] -> [KeyWitness era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TxBody era -> SophieWitnessSigningKey -> KeyWitness era
forall era.
IsSophieBasedEra era =>
TxBody era -> SophieWitnessSigningKey -> KeyWitness era
makeSophieKeyWitness TxBody era
txbody) [SophieWitnessSigningKey]
sksSophie
      tx :: Tx era
tx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction ([KeyWitness era]
coleWitnesses [KeyWitness era] -> [KeyWitness era] -> [KeyWitness era]
forall a. [a] -> [a] -> [a]
++ [KeyWitness era]
sophieKeyWitnesses) TxBody era
txbody

  (FileError () -> SophieTxCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> SophieTxCmdError
SophieTxCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT SophieTxCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ()
runTxSubmit :: AnyConsensusModeParams
-> NetworkId -> String -> ExceptT SophieTxCmdError IO ()
runTxSubmit (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network String
txFile = do
    SocketPath String
sockPath <- (EnvSocketError -> SophieTxCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieTxCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieTxCmdError
SophieTxCmdSocketEnvError ExceptT EnvSocketError IO SocketPath
readEnvSocketPath

    InAnyBccEra BccEra era
era Tx era
tx <- String -> ExceptT SophieTxCmdError IO (InAnyBccEra 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 <- SophieTxCmdError
-> Maybe (EraInMode era mode)
-> ExceptT SophieTxCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe
                   (Maybe String -> AnyConsensusMode -> AnyBccEra -> SophieTxCmdError
SophieTxCmdEraConsensusModeMismatch (String -> Maybe String
forall a. a -> Maybe a
Just String
txFile) AnyConsensusMode
cMode (BccEra era -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra era
era))
                   (BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra 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
     SophieTxCmdError IO (SubmitResult (TxValidationErrorInMode mode))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SubmitResult (TxValidationErrorInMode mode))
 -> ExceptT
      SophieTxCmdError IO (SubmitResult (TxValidationErrorInMode mode)))
-> IO (SubmitResult (TxValidationErrorInMode mode))
-> ExceptT
     SophieTxCmdError 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 SophieTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieTxCmdError IO ())
-> IO () -> ExceptT SophieTxCmdError 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 -> SophieTxCmdError -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieTxCmdError -> ExceptT SophieTxCmdError IO ())
-> (String -> SophieTxCmdError)
-> String
-> ExceptT SophieTxCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> SophieTxCmdError
SophieTxCmdTxSubmitError (Text -> SophieTxCmdError)
-> (String -> Text) -> String -> SophieTxCmdError
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 SophieTxCmdError IO ())
-> String -> ExceptT SophieTxCmdError 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 -> SophieTxCmdError -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieTxCmdError -> ExceptT SophieTxCmdError IO ())
-> SophieTxCmdError -> ExceptT SophieTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ EraMismatch -> SophieTxCmdError
SophieTxCmdTxSubmitErrorEraMismatch EraMismatch
mismatchErr

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

runTxCalculateMinFee
  :: TxBodyFile
  -> Maybe NetworkId
  -> ProtocolParamsSourceSpec
  -> TxInCount
  -> TxOutCount
  -> TxSophieWitnessCount
  -> TxColeWitnessCount
  -> ExceptT SophieTxCmdError IO ()
runTxCalculateMinFee :: TxBodyFile
-> Maybe NetworkId
-> ProtocolParamsSourceSpec
-> TxInCount
-> TxOutCount
-> TxSophieWitnessCount
-> TxColeWitnessCount
-> ExceptT SophieTxCmdError IO ()
runTxCalculateMinFee (TxBodyFile String
txbodyFile) Maybe NetworkId
nw ProtocolParamsSourceSpec
protocolParamsSourceSpec
                     (TxInCount Int
nInputs) (TxOutCount Int
nOutputs)
                     (TxSophieWitnessCount Int
nSophieKeyWitnesses)
                     (TxColeWitnessCount Int
nColeKeyWitnesses) = do
    InAnySophieBasedEra SophieBasedEra era
_era TxBody era
txbody <-
          --TODO: in principle we should be able to support Cole era txs too
          Text
-> InAnyBccEra TxBody
-> ExceptT SophieTxCmdError IO (InAnySophieBasedEra TxBody)
forall (a :: * -> *).
Text
-> InAnyBccEra a
-> ExceptT SophieTxCmdError IO (InAnySophieBasedEra a)
onlyInSophieBasedEras Text
"calculate-min-fee for Cole era transactions"
      (InAnyBccEra TxBody
 -> ExceptT SophieTxCmdError IO (InAnySophieBasedEra TxBody))
-> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
-> ExceptT SophieTxCmdError IO (InAnySophieBasedEra TxBody)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
readFileTxBody String
txbodyFile

    ProtocolParameters
pparams <- ProtocolParamsSourceSpec
-> ExceptT SophieTxCmdError 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
        Entropic Integer
fee = NetworkId
-> Natural
-> Natural
-> Tx era
-> Int
-> Int
-> Int
-> Int
-> Entropic
forall era.
IsSophieBasedEra era =>
NetworkId
-> Natural
-> Natural
-> Tx era
-> Int
-> Int
-> Int
-> Int
-> Entropic
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
nColeKeyWitnesses Int
nSophieKeyWitnesses

    IO () -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieTxCmdError IO ())
-> IO () -> ExceptT SophieTxCmdError 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
" Entropic"

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

runTxCalculateMinRequiredUTxO
  :: AnyBccEra
  -> ProtocolParamsSourceSpec
  -> TxOutAnyEra
  -> ExceptT SophieTxCmdError IO ()
runTxCalculateMinRequiredUTxO :: AnyBccEra
-> ProtocolParamsSourceSpec
-> TxOutAnyEra
-> ExceptT SophieTxCmdError IO ()
runTxCalculateMinRequiredUTxO (AnyBccEra BccEra era
era) ProtocolParamsSourceSpec
protocolParamsSourceSpec TxOutAnyEra
txOut = do
  ProtocolParameters
pp <- ProtocolParamsSourceSpec
-> ExceptT SophieTxCmdError IO ProtocolParameters
readProtocolParametersSourceSpec ProtocolParamsSourceSpec
protocolParamsSourceSpec
  TxOut era
out <- BccEra era
-> TxOutAnyEra -> ExceptT SophieTxCmdError IO (TxOut era)
forall era.
BccEra era
-> TxOutAnyEra -> ExceptT SophieTxCmdError IO (TxOut era)
toTxOutInAnyEra BccEra era
era TxOutAnyEra
txOut
  case BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era of
    BccEraStyle era
LegacyColeEra -> String -> ExceptT SophieTxCmdError IO ()
forall a. HasCallStack => String -> a
error String
"runTxCalculateMinRequiredUTxO: Cole era not implemented yet"
    SophieBasedEra SophieBasedEra era
sbe -> do
      (ProtocolParametersError -> SophieTxCmdError)
-> ExceptT ProtocolParametersError IO ()
-> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ProtocolParametersError -> SophieTxCmdError
SophieTxCmdPParamsErr (ExceptT ProtocolParametersError IO ()
 -> ExceptT SophieTxCmdError IO ())
-> (Either ProtocolParametersError ()
    -> ExceptT ProtocolParametersError IO ())
-> Either ProtocolParametersError ()
-> ExceptT SophieTxCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either ProtocolParametersError ()
-> ExceptT ProtocolParametersError IO ()
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
        (Either ProtocolParametersError ()
 -> ExceptT SophieTxCmdError IO ())
-> Either ProtocolParametersError ()
-> ExceptT SophieTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ SophieBasedEra era
-> ProtocolParameters -> Either ProtocolParametersError ()
forall era.
IsBccEra era =>
SophieBasedEra era
-> ProtocolParameters -> Either ProtocolParametersError ()
checkProtocolParameters SophieBasedEra era
sbe ProtocolParameters
pp
      Value
minValue <- (MinimumUTxOError -> SophieTxCmdError)
-> ExceptT MinimumUTxOError IO Value
-> ExceptT SophieTxCmdError IO Value
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT MinimumUTxOError -> SophieTxCmdError
SophieTxCmdMinimumUTxOErr
                    (ExceptT MinimumUTxOError IO Value
 -> ExceptT SophieTxCmdError IO Value)
-> (Either MinimumUTxOError Value
    -> ExceptT MinimumUTxOError IO Value)
-> Either MinimumUTxOError Value
-> ExceptT SophieTxCmdError IO Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either MinimumUTxOError Value -> ExceptT MinimumUTxOError IO Value
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either MinimumUTxOError Value
 -> ExceptT SophieTxCmdError IO Value)
-> Either MinimumUTxOError Value
-> ExceptT SophieTxCmdError IO Value
forall a b. (a -> b) -> a -> b
$ SophieBasedEra era
-> TxOut era -> ProtocolParameters -> Either MinimumUTxOError Value
forall era.
SophieBasedEra era
-> TxOut era -> ProtocolParameters -> Either MinimumUTxOError Value
calculateMinimumUTxO SophieBasedEra era
sbe TxOut era
out ProtocolParameters
pp
      IO () -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieTxCmdError IO ())
-> (Entropic -> IO ())
-> Entropic
-> ExceptT SophieTxCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Entropic -> IO ()
forall a. Show a => a -> IO ()
IO.print (Entropic -> ExceptT SophieTxCmdError IO ())
-> Entropic -> ExceptT SophieTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Value -> Entropic
selectEntropic Value
minValue

runTxCreatePolicyId :: ScriptFile -> ExceptT SophieTxCmdError IO ()
runTxCreatePolicyId :: ScriptFile -> ExceptT SophieTxCmdError IO ()
runTxCreatePolicyId (ScriptFile String
sFile) = do
  ScriptInAnyLang ScriptLanguage lang
_ Script lang
script <- (FileError ScriptDecodeError -> SophieTxCmdError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT SophieTxCmdError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> SophieTxCmdError
SophieTxCmdScriptFileError (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
 -> ExceptT SophieTxCmdError IO ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT SophieTxCmdError IO ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
                                String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang String
sFile
  IO () -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieTxCmdError IO ())
-> (ScriptHash -> IO ())
-> ScriptHash
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ())
-> ScriptHash -> ExceptT SophieTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
script

readProtocolParametersSourceSpec :: ProtocolParamsSourceSpec
                                 -> ExceptT SophieTxCmdError IO
                                            ProtocolParameters
readProtocolParametersSourceSpec :: ProtocolParamsSourceSpec
-> ExceptT SophieTxCmdError IO ProtocolParameters
readProtocolParametersSourceSpec (ParamsFromGenesis (GenesisFile String
f)) =
    PParams StandardSophie -> ProtocolParameters
forall ledgerera. PParams ledgerera -> ProtocolParameters
fromSophiePParams (PParams StandardSophie -> ProtocolParameters)
-> (SophieGenesis StandardSophie -> PParams StandardSophie)
-> SophieGenesis StandardSophie
-> ProtocolParameters
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SophieGenesis StandardSophie -> PParams StandardSophie
forall era. SophieGenesis era -> PParams era
sgProtocolParams (SophieGenesis StandardSophie -> ProtocolParameters)
-> ExceptT SophieTxCmdError IO (SophieGenesis StandardSophie)
-> ExceptT SophieTxCmdError IO ProtocolParameters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (SophieGenesisCmdError -> SophieTxCmdError)
-> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
-> ExceptT SophieTxCmdError IO (SophieGenesis StandardSophie)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieGenesisCmdError -> SophieTxCmdError
SophieTxCmdGenesisCmdError
        (String
-> (SophieGenesis StandardSophie -> SophieGenesis StandardSophie)
-> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
readSophieGenesis String
f SophieGenesis StandardSophie -> SophieGenesis StandardSophie
forall (cat :: * -> * -> *) a. Category cat => cat a a
identity)
readProtocolParametersSourceSpec (ParamsFromFile ProtocolParamsFile
f) =
    ProtocolParamsFile
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ProtocolParameters
readProtocolParameters :: ProtocolParamsFile
-> ExceptT SophieTxCmdError IO ProtocolParameters
readProtocolParameters (ProtocolParamsFile String
fpath) = do
  ByteString
pparams <- (IOException -> SophieTxCmdError)
-> IO ByteString -> ExceptT SophieTxCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieTxCmdError
SophieTxCmdReadFileError (FileError () -> SophieTxCmdError)
-> (IOException -> FileError ()) -> IOException -> SophieTxCmdError
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 SophieTxCmdError IO ByteString)
-> IO ByteString -> ExceptT SophieTxCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
LBS.readFile String
fpath
  (String -> SophieTxCmdError)
-> ExceptT String IO ProtocolParameters
-> ExceptT SophieTxCmdError IO ProtocolParameters
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> Text -> SophieTxCmdError
SophieTxCmdAesonDecodeProtocolParamsError String
fpath (Text -> SophieTxCmdError)
-> (String -> Text) -> String -> SophieTxCmdError
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 SophieTxCmdError IO ProtocolParameters)
-> (Either String ProtocolParameters
    -> ExceptT String IO ProtocolParameters)
-> Either String ProtocolParameters
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ProtocolParameters)
-> Either String ProtocolParameters
-> ExceptT SophieTxCmdError 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
  = AColeSigningKey           (SigningKey ColeKey) (Maybe (Address ColeAddr))
  | 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)
  | AVestedSigningKey           (SigningKey VestedKey)
  | AVestedExtendedSigningKey   (SigningKey VestedExtendedKey)
  | AVestedDelegateSigningKey   (SigningKey VestedDelegateKey)
  | AVestedDelegateExtendedSigningKey
                               (SigningKey VestedDelegateExtendedKey)
  | AVestedUTxOSigningKey       (SigningKey VestedUTxOKey)


-- | Error reading the data required to construct a key witness.
data ReadWitnessSigningDataError
  = ReadWitnessSigningDataSigningKeyDecodeError !(FileError InputDecodeError)
  | ReadWitnessSigningDataScriptError !(FileError JsonDecodeError)
  | ReadWitnessSigningDataSigningKeyAndAddressMismatch
  -- ^ A Cole address was specified alongside a non-Cole 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 Cole signing key may be accompanied by a Cole address."

readWitnessSigningData
  :: WitnessSigningData
  -> ExceptT ReadWitnessSigningDataError IO SomeWitness
readWitnessSigningData :: WitnessSigningData
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
readWitnessSigningData (KeyWitnessSigningData SigningKeyFile
skFile Maybe (Address ColeAddr)
mbColeAddr) = 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 ColeAddr)
mbColeAddr) of
      (AColeSigningKey SigningKey ColeKey
_ Maybe (Address ColeAddr)
_, Just Address ColeAddr
_) -> SomeWitness -> ExceptT ReadWitnessSigningDataError IO SomeWitness
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeWitness
res
      (AColeSigningKey SigningKey ColeKey
_ Maybe (Address ColeAddr)
_, Maybe (Address ColeAddr)
Nothing) -> SomeWitness -> ExceptT ReadWitnessSigningDataError IO SomeWitness
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeWitness
res
      (SomeWitness
_, Maybe (Address ColeAddr)
Nothing) -> SomeWitness -> ExceptT ReadWitnessSigningDataError IO SomeWitness
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeWitness
res
      (SomeWitness
_, Just Address ColeAddr
_) ->
        -- A Cole address should only be specified along with a Cole 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 ColeKey)
-> (SigningKey ColeKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType ColeKey -> AsType (SigningKey ColeKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType ColeKey
AsColeKey)
                          (SigningKey ColeKey -> Maybe (Address ColeAddr) -> SomeWitness
`AColeSigningKey` Maybe (Address ColeAddr)
mbColeAddr)
      , 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
      , AsType (SigningKey VestedKey)
-> (SigningKey VestedKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType VestedKey -> AsType (SigningKey VestedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VestedKey
AsVestedKey)
                      SigningKey VestedKey -> SomeWitness
AVestedSigningKey
      , AsType (SigningKey VestedExtendedKey)
-> (SigningKey VestedExtendedKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType VestedExtendedKey -> AsType (SigningKey VestedExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VestedExtendedKey
AsVestedExtendedKey)
                      SigningKey VestedExtendedKey -> SomeWitness
AVestedExtendedSigningKey
      , AsType (SigningKey VestedDelegateKey)
-> (SigningKey VestedDelegateKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType VestedDelegateKey -> AsType (SigningKey VestedDelegateKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VestedDelegateKey
AsVestedDelegateKey)
                      SigningKey VestedDelegateKey -> SomeWitness
AVestedDelegateSigningKey
      , AsType (SigningKey VestedDelegateExtendedKey)
-> (SigningKey VestedDelegateExtendedKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType VestedDelegateExtendedKey
-> AsType (SigningKey VestedDelegateExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VestedDelegateExtendedKey
AsVestedDelegateExtendedKey)
                      SigningKey VestedDelegateExtendedKey -> SomeWitness
AVestedDelegateExtendedSigningKey
      , AsType (SigningKey VestedUTxOKey)
-> (SigningKey VestedUTxOKey -> SomeWitness)
-> FromSomeType HasTextEnvelope SomeWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType VestedUTxOKey -> AsType (SigningKey VestedUTxOKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VestedUTxOKey
AsVestedUTxOKey)
                      SigningKey VestedUTxOKey -> SomeWitness
AVestedUTxOSigningKey
      ]

    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
  :: [ColeOrSophieWitness]
  -> ( [SophieBootstrapWitnessSigningKeyData]
     , [SophieWitnessSigningKey]
     )
partitionSomeWitnesses :: [ColeOrSophieWitness]
-> ([SophieBootstrapWitnessSigningKeyData],
    [SophieWitnessSigningKey])
partitionSomeWitnesses = ([SophieBootstrapWitnessSigningKeyData], [SophieWitnessSigningKey])
-> ([SophieBootstrapWitnessSigningKeyData],
    [SophieWitnessSigningKey])
forall a a. ([a], [a]) -> ([a], [a])
reversePartitionedWits (([SophieBootstrapWitnessSigningKeyData],
  [SophieWitnessSigningKey])
 -> ([SophieBootstrapWitnessSigningKeyData],
     [SophieWitnessSigningKey]))
-> ([ColeOrSophieWitness]
    -> ([SophieBootstrapWitnessSigningKeyData],
        [SophieWitnessSigningKey]))
-> [ColeOrSophieWitness]
-> ([SophieBootstrapWitnessSigningKeyData],
    [SophieWitnessSigningKey])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (([SophieBootstrapWitnessSigningKeyData],
  [SophieWitnessSigningKey])
 -> ColeOrSophieWitness
 -> ([SophieBootstrapWitnessSigningKeyData],
     [SophieWitnessSigningKey]))
-> ([SophieBootstrapWitnessSigningKeyData],
    [SophieWitnessSigningKey])
-> [ColeOrSophieWitness]
-> ([SophieBootstrapWitnessSigningKeyData],
    [SophieWitnessSigningKey])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([SophieBootstrapWitnessSigningKeyData], [SophieWitnessSigningKey])
-> ColeOrSophieWitness
-> ([SophieBootstrapWitnessSigningKeyData],
    [SophieWitnessSigningKey])
go ([SophieBootstrapWitnessSigningKeyData], [SophieWitnessSigningKey])
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 :: ([SophieBootstrapWitnessSigningKeyData], [SophieWitnessSigningKey])
-> ColeOrSophieWitness
-> ([SophieBootstrapWitnessSigningKeyData],
    [SophieWitnessSigningKey])
go ([SophieBootstrapWitnessSigningKeyData]
coleAcc, [SophieWitnessSigningKey]
sophieKeyAcc) ColeOrSophieWitness
coleOrSophieWit =
      case ColeOrSophieWitness
coleOrSophieWit of
        AColeWitness SophieBootstrapWitnessSigningKeyData
coleWit ->
          (SophieBootstrapWitnessSigningKeyData
coleWitSophieBootstrapWitnessSigningKeyData
-> [SophieBootstrapWitnessSigningKeyData]
-> [SophieBootstrapWitnessSigningKeyData]
forall a. a -> [a] -> [a]
:[SophieBootstrapWitnessSigningKeyData]
coleAcc, [SophieWitnessSigningKey]
sophieKeyAcc)
        ASophieKeyWitness SophieWitnessSigningKey
sophieKeyWit ->
          ([SophieBootstrapWitnessSigningKeyData]
coleAcc, SophieWitnessSigningKey
sophieKeyWitSophieWitnessSigningKey
-> [SophieWitnessSigningKey] -> [SophieWitnessSigningKey]
forall a. a -> [a] -> [a]
:[SophieWitnessSigningKey]
sophieKeyAcc)


-- | Some kind of Cole or Sophie witness.
data ColeOrSophieWitness
  = AColeWitness !SophieBootstrapWitnessSigningKeyData
  | ASophieKeyWitness !SophieWitnessSigningKey

categoriseSomeWitness :: SomeWitness -> ColeOrSophieWitness
categoriseSomeWitness :: SomeWitness -> ColeOrSophieWitness
categoriseSomeWitness SomeWitness
swsk =
  case SomeWitness
swsk of
    AColeSigningKey         SigningKey ColeKey
sk Maybe (Address ColeAddr)
addr -> SophieBootstrapWitnessSigningKeyData -> ColeOrSophieWitness
AColeWitness (SigningKey ColeKey
-> Maybe (Address ColeAddr) -> SophieBootstrapWitnessSigningKeyData
SophieBootstrapWitnessSigningKeyData SigningKey ColeKey
sk Maybe (Address ColeAddr)
addr)
    APaymentSigningKey         SigningKey PaymentKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey PaymentKey -> SophieWitnessSigningKey
WitnessPaymentKey         SigningKey PaymentKey
sk)
    APaymentExtendedSigningKey SigningKey PaymentExtendedKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey PaymentExtendedKey -> SophieWitnessSigningKey
WitnessPaymentExtendedKey SigningKey PaymentExtendedKey
sk)
    AStakeSigningKey           SigningKey StakeKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey StakeKey -> SophieWitnessSigningKey
WitnessStakeKey           SigningKey StakeKey
sk)
    AStakeExtendedSigningKey   SigningKey StakeExtendedKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey StakeExtendedKey -> SophieWitnessSigningKey
WitnessStakeExtendedKey   SigningKey StakeExtendedKey
sk)
    AStakePoolSigningKey       SigningKey StakePoolKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey StakePoolKey -> SophieWitnessSigningKey
WitnessStakePoolKey       SigningKey StakePoolKey
sk)
    AGenesisSigningKey         SigningKey GenesisKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey GenesisKey -> SophieWitnessSigningKey
WitnessGenesisKey         SigningKey GenesisKey
sk)
    AGenesisExtendedSigningKey SigningKey GenesisExtendedKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey GenesisExtendedKey -> SophieWitnessSigningKey
WitnessGenesisExtendedKey SigningKey GenesisExtendedKey
sk)
    AGenesisDelegateSigningKey SigningKey GenesisDelegateKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey GenesisDelegateKey -> SophieWitnessSigningKey
WitnessGenesisDelegateKey SigningKey GenesisDelegateKey
sk)
    AGenesisDelegateExtendedSigningKey SigningKey GenesisDelegateExtendedKey
sk
                                       -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey GenesisDelegateExtendedKey -> SophieWitnessSigningKey
WitnessGenesisDelegateExtendedKey SigningKey GenesisDelegateExtendedKey
sk)
    AGenesisUTxOSigningKey     SigningKey GenesisUTxOKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey GenesisUTxOKey -> SophieWitnessSigningKey
WitnessGenesisUTxOKey       SigningKey GenesisUTxOKey
sk)
    AVestedSigningKey           SigningKey VestedKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey VestedKey -> SophieWitnessSigningKey
WitnessVestedKey           SigningKey VestedKey
sk)
    AVestedExtendedSigningKey   SigningKey VestedExtendedKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey VestedExtendedKey -> SophieWitnessSigningKey
WitnessVestedExtendedKey   SigningKey VestedExtendedKey
sk)
    AVestedDelegateSigningKey   SigningKey VestedDelegateKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey VestedDelegateKey -> SophieWitnessSigningKey
WitnessVestedDelegateKey   SigningKey VestedDelegateKey
sk)
    AVestedDelegateExtendedSigningKey SigningKey VestedDelegateExtendedKey
sk
                                       -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey VestedDelegateExtendedKey -> SophieWitnessSigningKey
WitnessVestedDelegateExtendedKey SigningKey VestedDelegateExtendedKey
sk)
    AVestedUTxOSigningKey       SigningKey VestedUTxOKey
sk      -> SophieWitnessSigningKey -> ColeOrSophieWitness
ASophieKeyWitness (SigningKey VestedUTxOKey -> SophieWitnessSigningKey
WitnessVestedUTxOKey       SigningKey VestedUTxOKey
sk)
-- | Data required for constructing a Sophie bootstrap witness.
data SophieBootstrapWitnessSigningKeyData
  = SophieBootstrapWitnessSigningKeyData
      !(SigningKey ColeKey)
      -- ^ Cole signing key.
      !(Maybe (Address ColeAddr))
      -- ^ An optionally specified Cole address.
      --
      -- If specified, both the network ID and derivation path are extracted
      -- from the address and used in the construction of the Cole witness.

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

-- | Render an error message for a 'SophieBootstrapWitnessError'.
renderSophieBootstrapWitnessError :: SophieBootstrapWitnessError -> Text
renderSophieBootstrapWitnessError :: SophieBootstrapWitnessError -> Text
renderSophieBootstrapWitnessError SophieBootstrapWitnessError
MissingNetworkIdOrColeAddressError =
  Text
"Transactions witnessed by a Cole 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 Cole "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"address with each Cole signing key (network IDs can be derived "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"from Cole addresses)."

-- | Construct a Sophie bootstrap witness (i.e. a Cole key witness in the
-- Sophie era).
mkSophieBootstrapWitness
  :: IsSophieBasedEra era
  => Maybe NetworkId
  -> TxBody era
  -> SophieBootstrapWitnessSigningKeyData
  -> Either SophieBootstrapWitnessError (KeyWitness era)
mkSophieBootstrapWitness :: Maybe NetworkId
-> TxBody era
-> SophieBootstrapWitnessSigningKeyData
-> Either SophieBootstrapWitnessError (KeyWitness era)
mkSophieBootstrapWitness Maybe NetworkId
Nothing TxBody era
_ (SophieBootstrapWitnessSigningKeyData SigningKey ColeKey
_ Maybe (Address ColeAddr)
Nothing) =
  SophieBootstrapWitnessError
-> Either SophieBootstrapWitnessError (KeyWitness era)
forall a b. a -> Either a b
Left SophieBootstrapWitnessError
MissingNetworkIdOrColeAddressError
mkSophieBootstrapWitness (Just NetworkId
nw) TxBody era
txBody (SophieBootstrapWitnessSigningKeyData SigningKey ColeKey
skey Maybe (Address ColeAddr)
Nothing) =
  KeyWitness era
-> Either SophieBootstrapWitnessError (KeyWitness era)
forall a b. b -> Either a b
Right (KeyWitness era
 -> Either SophieBootstrapWitnessError (KeyWitness era))
-> KeyWitness era
-> Either SophieBootstrapWitnessError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ WitnessNetworkIdOrColeAddress
-> TxBody era -> SigningKey ColeKey -> KeyWitness era
forall era.
IsSophieBasedEra era =>
WitnessNetworkIdOrColeAddress
-> TxBody era -> SigningKey ColeKey -> KeyWitness era
makeSophieBootstrapWitness (NetworkId -> WitnessNetworkIdOrColeAddress
WitnessNetworkId NetworkId
nw) TxBody era
txBody SigningKey ColeKey
skey
mkSophieBootstrapWitness Maybe NetworkId
_ TxBody era
txBody (SophieBootstrapWitnessSigningKeyData SigningKey ColeKey
skey (Just Address ColeAddr
addr)) =
  KeyWitness era
-> Either SophieBootstrapWitnessError (KeyWitness era)
forall a b. b -> Either a b
Right (KeyWitness era
 -> Either SophieBootstrapWitnessError (KeyWitness era))
-> KeyWitness era
-> Either SophieBootstrapWitnessError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ WitnessNetworkIdOrColeAddress
-> TxBody era -> SigningKey ColeKey -> KeyWitness era
forall era.
IsSophieBasedEra era =>
WitnessNetworkIdOrColeAddress
-> TxBody era -> SigningKey ColeKey -> KeyWitness era
makeSophieBootstrapWitness (Address ColeAddr -> WitnessNetworkIdOrColeAddress
WitnessColeAddress Address ColeAddr
addr) TxBody era
txBody SigningKey ColeKey
skey

-- | Attempt to construct Sophie bootstrap witnesses until an error is
-- encountered.
mkSophieBootstrapWitnesses
  :: IsSophieBasedEra era
  => Maybe NetworkId
  -> TxBody era
  -> [SophieBootstrapWitnessSigningKeyData]
  -> Either SophieBootstrapWitnessError [KeyWitness era]
mkSophieBootstrapWitnesses :: Maybe NetworkId
-> TxBody era
-> [SophieBootstrapWitnessSigningKeyData]
-> Either SophieBootstrapWitnessError [KeyWitness era]
mkSophieBootstrapWitnesses Maybe NetworkId
mnw TxBody era
txBody =
  (SophieBootstrapWitnessSigningKeyData
 -> Either SophieBootstrapWitnessError (KeyWitness era))
-> [SophieBootstrapWitnessSigningKeyData]
-> Either SophieBootstrapWitnessError [KeyWitness era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe NetworkId
-> TxBody era
-> SophieBootstrapWitnessSigningKeyData
-> Either SophieBootstrapWitnessError (KeyWitness era)
forall era.
IsSophieBasedEra era =>
Maybe NetworkId
-> TxBody era
-> SophieBootstrapWitnessSigningKeyData
-> Either SophieBootstrapWitnessError (KeyWitness era)
mkSophieBootstrapWitness Maybe NetworkId
mnw TxBody era
txBody)


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

runTxHashScriptData :: ScriptDataOrFile -> ExceptT SophieTxCmdError IO ()
runTxHashScriptData :: ScriptDataOrFile -> ExceptT SophieTxCmdError IO ()
runTxHashScriptData ScriptDataOrFile
scriptDataOrFile = do
    ScriptData
d <- ScriptDataOrFile -> ExceptT SophieTxCmdError IO ScriptData
readScriptDataOrFile ScriptDataOrFile
scriptDataOrFile
    IO () -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieTxCmdError IO ())
-> IO () -> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ()
runTxGetTxId :: InputTxFile -> ExceptT SophieTxCmdError IO ()
runTxGetTxId InputTxFile
txfile = do
    InAnyBccEra BccEra era
_era TxBody era
txbody <-
      case InputTxFile
txfile of
        InputTxBodyFile (TxBodyFile String
txbodyFile) -> String -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
readFileTxBody String
txbodyFile
        InputTxFile (TxFile String
txFile) -> do
          InAnyBccEra BccEra era
era Tx era
tx <- String -> ExceptT SophieTxCmdError IO (InAnyBccEra Tx)
readFileTx String
txFile
          InAnyBccEra TxBody
-> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
forall (m :: * -> *) a. Monad m => a -> m a
return (InAnyBccEra TxBody
 -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody))
-> (TxBody era -> InAnyBccEra TxBody)
-> TxBody era
-> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BccEra era -> TxBody era -> InAnyBccEra TxBody
forall era (thing :: * -> *).
IsBccEra era =>
BccEra era -> thing era -> InAnyBccEra thing
InAnyBccEra BccEra era
era (TxBody era -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody))
-> TxBody era -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
forall a b. (a -> b) -> a -> b
$ Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx

    IO () -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieTxCmdError IO ())
-> IO () -> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ()
runTxView :: InputTxFile -> ExceptT SophieTxCmdError IO ()
runTxView InputTxFile
txfile = do
  InAnyBccEra BccEra era
era TxBody era
txbody <-
    case InputTxFile
txfile of
      InputTxBodyFile (TxBodyFile String
txbodyFile) -> String -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
readFileTxBody String
txbodyFile
      InputTxFile (TxFile String
txFile) -> do
        InAnyBccEra BccEra era
era Tx era
tx <- String -> ExceptT SophieTxCmdError IO (InAnyBccEra Tx)
readFileTx String
txFile
        InAnyBccEra TxBody
-> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
forall (m :: * -> *) a. Monad m => a -> m a
return (InAnyBccEra TxBody
 -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody))
-> (TxBody era -> InAnyBccEra TxBody)
-> TxBody era
-> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BccEra era -> TxBody era -> InAnyBccEra TxBody
forall era (thing :: * -> *).
IsBccEra era =>
BccEra era -> thing era -> InAnyBccEra thing
InAnyBccEra BccEra era
era (TxBody era -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody))
-> TxBody era -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
forall a b. (a -> b) -> a -> b
$ Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx
  IO () -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieTxCmdError IO ())
-> IO () -> ExceptT SophieTxCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStr (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ BccEra era -> TxBody era -> ByteString
forall era. BccEra era -> TxBody era -> ByteString
friendlyTxBodyBS BccEra era
era TxBody era
txbody


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

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

  InAnySophieBasedEra SophieBasedEra era
_era TxBody era
txbody <-
        --TODO: in principle we should be able to support Cole era txs too
        Text
-> InAnyBccEra TxBody
-> ExceptT SophieTxCmdError IO (InAnySophieBasedEra TxBody)
forall (a :: * -> *).
Text
-> InAnyBccEra a
-> ExceptT SophieTxCmdError IO (InAnySophieBasedEra a)
onlyInSophieBasedEras Text
"witness for Cole era transactions"
    (InAnyBccEra TxBody
 -> ExceptT SophieTxCmdError IO (InAnySophieBasedEra TxBody))
-> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
-> ExceptT SophieTxCmdError IO (InAnySophieBasedEra TxBody)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> ExceptT SophieTxCmdError IO (InAnyBccEra 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 -> SophieTxCmdError)
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
-> ExceptT SophieTxCmdError IO SomeWitness
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ReadWitnessSigningDataError -> SophieTxCmdError
SophieTxCmdReadWitnessSigningDataError
    (ExceptT ReadWitnessSigningDataError IO SomeWitness
 -> ExceptT SophieTxCmdError IO SomeWitness)
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
-> ExceptT SophieTxCmdError IO SomeWitness
forall a b. (a -> b) -> a -> b
$ WitnessSigningData
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
readWitnessSigningData WitnessSigningData
witSignData

  KeyWitness era
witness <-
    case SomeWitness -> ColeOrSophieWitness
categoriseSomeWitness SomeWitness
someWit of
      -- Cole witnesses require the network ID. This can either be provided
      -- directly or derived from a provided Cole address.
      AColeWitness SophieBootstrapWitnessSigningKeyData
bootstrapWitData ->
        (SophieBootstrapWitnessError -> SophieTxCmdError)
-> ExceptT SophieBootstrapWitnessError IO (KeyWitness era)
-> ExceptT SophieTxCmdError IO (KeyWitness era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieBootstrapWitnessError -> SophieTxCmdError
SophieTxCmdBootstrapWitnessError
          (ExceptT SophieBootstrapWitnessError IO (KeyWitness era)
 -> ExceptT SophieTxCmdError IO (KeyWitness era))
-> (Either SophieBootstrapWitnessError (KeyWitness era)
    -> ExceptT SophieBootstrapWitnessError IO (KeyWitness era))
-> Either SophieBootstrapWitnessError (KeyWitness era)
-> ExceptT SophieTxCmdError 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 SophieBootstrapWitnessError (KeyWitness era)
-> ExceptT SophieBootstrapWitnessError IO (KeyWitness era)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
          (Either SophieBootstrapWitnessError (KeyWitness era)
 -> ExceptT SophieTxCmdError IO (KeyWitness era))
-> Either SophieBootstrapWitnessError (KeyWitness era)
-> ExceptT SophieTxCmdError IO (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ Maybe NetworkId
-> TxBody era
-> SophieBootstrapWitnessSigningKeyData
-> Either SophieBootstrapWitnessError (KeyWitness era)
forall era.
IsSophieBasedEra era =>
Maybe NetworkId
-> TxBody era
-> SophieBootstrapWitnessSigningKeyData
-> Either SophieBootstrapWitnessError (KeyWitness era)
mkSophieBootstrapWitness Maybe NetworkId
mbNw TxBody era
txbody SophieBootstrapWitnessSigningKeyData
bootstrapWitData
      ASophieKeyWitness SophieWitnessSigningKey
skSophie ->
        KeyWitness era -> ExceptT SophieTxCmdError IO (KeyWitness era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyWitness era -> ExceptT SophieTxCmdError IO (KeyWitness era))
-> KeyWitness era -> ExceptT SophieTxCmdError IO (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ TxBody era -> SophieWitnessSigningKey -> KeyWitness era
forall era.
IsSophieBasedEra era =>
TxBody era -> SophieWitnessSigningKey -> KeyWitness era
makeSophieKeyWitness TxBody era
txbody SophieWitnessSigningKey
skSophie

  (FileError () -> SophieTxCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> SophieTxCmdError
SophieTxCmdWriteFileError
    (ExceptT (FileError ()) IO () -> ExceptT SophieTxCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ()
runTxSignWitness :: TxBodyFile
-> [WitnessFile] -> OutputFile -> ExceptT SophieTxCmdError IO ()
runTxSignWitness (TxBodyFile String
txbodyFile) [WitnessFile]
witnessFiles (OutputFile String
oFp) = do
    InAnyBccEra BccEra era
era TxBody era
txbody  <- String -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
readFileTxBody String
txbodyFile
    InAnySophieBasedEra SophieBasedEra era
_ TxBody era
_ <-
          --TODO: in principle we should be able to support Cole era txs too
          Text
-> InAnyBccEra TxBody
-> ExceptT SophieTxCmdError IO (InAnySophieBasedEra TxBody)
forall (a :: * -> *).
Text
-> InAnyBccEra a
-> ExceptT SophieTxCmdError IO (InAnySophieBasedEra a)
onlyInSophieBasedEras Text
"sign for Cole era transactions"
                                 (BccEra era -> TxBody era -> InAnyBccEra TxBody
forall era (thing :: * -> *).
IsBccEra era =>
BccEra era -> thing era -> InAnyBccEra thing
InAnyBccEra BccEra era
era TxBody era
txbody)

    [KeyWitness era]
witnesses <-
      [ExceptT SophieTxCmdError IO (KeyWitness era)]
-> ExceptT SophieTxCmdError IO [KeyWitness era]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ do InAnyBccEra BccEra era
era' KeyWitness era
witness <- String -> ExceptT SophieTxCmdError IO (InAnyBccEra KeyWitness)
readFileWitness String
file
             case BccEra era -> BccEra era -> Maybe (era :~: era)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality BccEra era
era BccEra era
era' of
               Maybe (era :~: era)
Nothing   -> SophieTxCmdError -> ExceptT SophieTxCmdError IO (KeyWitness era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieTxCmdError -> ExceptT SophieTxCmdError IO (KeyWitness era))
-> SophieTxCmdError -> ExceptT SophieTxCmdError IO (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ AnyBccEra -> AnyBccEra -> WitnessFile -> SophieTxCmdError
SophieTxCmdWitnessEraMismatch
                                     (BccEra era -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra era
era)
                                     (BccEra era -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra era
era')
                                     WitnessFile
witnessFile
               Just era :~: era
Refl -> KeyWitness era -> ExceptT SophieTxCmdError 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 () -> SophieTxCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT SophieTxCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> SophieTxCmdError
SophieTxCmdWriteFileError
      (ExceptT (FileError ()) IO () -> ExceptT SophieTxCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophieTxCmdError 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 SophieTxCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT SophieTxCmdError 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 SophieTxCmdError IO (InAnyBccEra KeyWitness)
readFileWitness :: String -> ExceptT SophieTxCmdError IO (InAnyBccEra KeyWitness)
readFileWitness = (forall era. AsType era -> AsType (KeyWitness era))
-> String -> ExceptT SophieTxCmdError IO (InAnyBccEra KeyWitness)
forall (thing :: * -> *).
(HasTextEnvelope (thing ColeEra),
 HasTextEnvelope (thing SophieEra), HasTextEnvelope (thing EvieEra),
 HasTextEnvelope (thing JenEra),
 HasTextEnvelope (thing AurumEra)) =>
(forall era. AsType era -> AsType (thing era))
-> String -> ExceptT SophieTxCmdError IO (InAnyBccEra thing)
readFileInAnyBccEra forall era. AsType era -> AsType (KeyWitness era)
AsKeyWitness


readFileTxBody :: FilePath
               -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
readFileTxBody :: String -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
readFileTxBody = (forall era. AsType era -> AsType (TxBody era))
-> String -> ExceptT SophieTxCmdError IO (InAnyBccEra TxBody)
forall (thing :: * -> *).
(HasTextEnvelope (thing ColeEra),
 HasTextEnvelope (thing SophieEra), HasTextEnvelope (thing EvieEra),
 HasTextEnvelope (thing JenEra),
 HasTextEnvelope (thing AurumEra)) =>
(forall era. AsType era -> AsType (thing era))
-> String -> ExceptT SophieTxCmdError IO (InAnyBccEra thing)
readFileInAnyBccEra forall era. AsType era -> AsType (TxBody era)
AsTxBody


readFileTx :: FilePath -> ExceptT SophieTxCmdError IO (InAnyBccEra Tx)
readFileTx :: String -> ExceptT SophieTxCmdError IO (InAnyBccEra Tx)
readFileTx = (forall era. AsType era -> AsType (Tx era))
-> String -> ExceptT SophieTxCmdError IO (InAnyBccEra Tx)
forall (thing :: * -> *).
(HasTextEnvelope (thing ColeEra),
 HasTextEnvelope (thing SophieEra), HasTextEnvelope (thing EvieEra),
 HasTextEnvelope (thing JenEra),
 HasTextEnvelope (thing AurumEra)) =>
(forall era. AsType era -> AsType (thing era))
-> String -> ExceptT SophieTxCmdError IO (InAnyBccEra thing)
readFileInAnyBccEra forall era. AsType era -> AsType (Tx era)
AsTx


readFileInAnyBccEra
  :: ( HasTextEnvelope (thing ColeEra)
     , HasTextEnvelope (thing SophieEra)
     , HasTextEnvelope (thing EvieEra)
     , HasTextEnvelope (thing JenEra)
     , HasTextEnvelope (thing AurumEra)
     )
  => (forall era. AsType era -> AsType (thing era))
  -> FilePath
  -> ExceptT SophieTxCmdError IO
            (InAnyBccEra thing)
readFileInAnyBccEra :: (forall era. AsType era -> AsType (thing era))
-> String -> ExceptT SophieTxCmdError IO (InAnyBccEra thing)
readFileInAnyBccEra forall era. AsType era -> AsType (thing era)
asThing String
file =
    (FileError TextEnvelopeError -> SophieTxCmdError)
-> ExceptT (FileError TextEnvelopeError) IO (InAnyBccEra thing)
-> ExceptT SophieTxCmdError IO (InAnyBccEra thing)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> SophieTxCmdError
SophieTxCmdReadTextViewFileError
  (ExceptT (FileError TextEnvelopeError) IO (InAnyBccEra thing)
 -> ExceptT SophieTxCmdError IO (InAnyBccEra thing))
-> (IO (Either (FileError TextEnvelopeError) (InAnyBccEra thing))
    -> ExceptT (FileError TextEnvelopeError) IO (InAnyBccEra thing))
-> IO (Either (FileError TextEnvelopeError) (InAnyBccEra thing))
-> ExceptT SophieTxCmdError IO (InAnyBccEra 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) (InAnyBccEra thing))
-> ExceptT (FileError TextEnvelopeError) IO (InAnyBccEra thing)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
  (IO (Either (FileError TextEnvelopeError) (InAnyBccEra thing))
 -> ExceptT SophieTxCmdError IO (InAnyBccEra thing))
-> IO (Either (FileError TextEnvelopeError) (InAnyBccEra thing))
-> ExceptT SophieTxCmdError IO (InAnyBccEra thing)
forall a b. (a -> b) -> a -> b
$ [FromSomeType HasTextEnvelope (InAnyBccEra thing)]
-> String
-> IO (Either (FileError TextEnvelopeError) (InAnyBccEra thing))
forall b.
[FromSomeType HasTextEnvelope b]
-> String -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf
      [ AsType (thing ColeEra)
-> (thing ColeEra -> InAnyBccEra thing)
-> FromSomeType HasTextEnvelope (InAnyBccEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType ColeEra -> AsType (thing ColeEra)
forall era. AsType era -> AsType (thing era)
asThing AsType ColeEra
AsColeEra)   (BccEra ColeEra -> thing ColeEra -> InAnyBccEra thing
forall era (thing :: * -> *).
IsBccEra era =>
BccEra era -> thing era -> InAnyBccEra thing
InAnyBccEra BccEra ColeEra
ColeEra)
      , AsType (thing SophieEra)
-> (thing SophieEra -> InAnyBccEra thing)
-> FromSomeType HasTextEnvelope (InAnyBccEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType SophieEra -> AsType (thing SophieEra)
forall era. AsType era -> AsType (thing era)
asThing AsType SophieEra
AsSophieEra) (BccEra SophieEra -> thing SophieEra -> InAnyBccEra thing
forall era (thing :: * -> *).
IsBccEra era =>
BccEra era -> thing era -> InAnyBccEra thing
InAnyBccEra BccEra SophieEra
SophieEra)
      , AsType (thing EvieEra)
-> (thing EvieEra -> InAnyBccEra thing)
-> FromSomeType HasTextEnvelope (InAnyBccEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType EvieEra -> AsType (thing EvieEra)
forall era. AsType era -> AsType (thing era)
asThing AsType EvieEra
AsEvieEra) (BccEra EvieEra -> thing EvieEra -> InAnyBccEra thing
forall era (thing :: * -> *).
IsBccEra era =>
BccEra era -> thing era -> InAnyBccEra thing
InAnyBccEra BccEra EvieEra
EvieEra)
      , AsType (thing JenEra)
-> (thing JenEra -> InAnyBccEra thing)
-> FromSomeType HasTextEnvelope (InAnyBccEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType JenEra -> AsType (thing JenEra)
forall era. AsType era -> AsType (thing era)
asThing AsType JenEra
AsJenEra)    (BccEra JenEra -> thing JenEra -> InAnyBccEra thing
forall era (thing :: * -> *).
IsBccEra era =>
BccEra era -> thing era -> InAnyBccEra thing
InAnyBccEra BccEra JenEra
JenEra)
      , AsType (thing AurumEra)
-> (thing AurumEra -> InAnyBccEra thing)
-> FromSomeType HasTextEnvelope (InAnyBccEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType AurumEra -> AsType (thing AurumEra)
forall era. AsType era -> AsType (thing era)
asThing AsType AurumEra
AsAurumEra)  (BccEra AurumEra -> thing AurumEra -> InAnyBccEra thing
forall era (thing :: * -> *).
IsBccEra era =>
BccEra era -> thing era -> InAnyBccEra thing
InAnyBccEra BccEra AurumEra
AurumEra)
      ]
      String
file

-- | Constrain the era to be Sophie based. Fail for the Cole era.
--
onlyInSophieBasedEras :: Text
                       -> InAnyBccEra a
                       -> ExceptT SophieTxCmdError IO
                                  (InAnySophieBasedEra a)
onlyInSophieBasedEras :: Text
-> InAnyBccEra a
-> ExceptT SophieTxCmdError IO (InAnySophieBasedEra a)
onlyInSophieBasedEras Text
notImplMsg (InAnyBccEra BccEra era
era a era
x) =
    case BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era of
      BccEraStyle era
LegacyColeEra       -> SophieTxCmdError
-> ExceptT SophieTxCmdError IO (InAnySophieBasedEra a)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (Text -> SophieTxCmdError
SophieTxCmdNotImplemented Text
notImplMsg)
      SophieBasedEra SophieBasedEra era
era' -> InAnySophieBasedEra a
-> ExceptT SophieTxCmdError IO (InAnySophieBasedEra a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SophieBasedEra era -> a era -> InAnySophieBasedEra a
forall era (thing :: * -> *).
IsSophieBasedEra era =>
SophieBasedEra era -> thing era -> InAnySophieBasedEra thing
InAnySophieBasedEra SophieBasedEra era
era' a era
x)


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

validateScriptSupportedInEra :: BccEra era
                             -> ScriptInAnyLang
                             -> ExceptT SophieTxCmdError IO (ScriptInEra era)
validateScriptSupportedInEra :: BccEra era
-> ScriptInAnyLang -> ExceptT SophieTxCmdError IO (ScriptInEra era)
validateScriptSupportedInEra BccEra era
era script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) =
    case BccEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
forall era.
BccEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra BccEra era
era ScriptInAnyLang
script of
      Maybe (ScriptInEra era)
Nothing -> SophieTxCmdError -> ExceptT SophieTxCmdError IO (ScriptInEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieTxCmdError -> ExceptT SophieTxCmdError IO (ScriptInEra era))
-> SophieTxCmdError
-> ExceptT SophieTxCmdError IO (ScriptInEra era)
forall a b. (a -> b) -> a -> b
$ AnyScriptLanguage -> AnyBccEra -> SophieTxCmdError
SophieTxCmdScriptLanguageNotSupportedInEra
                          (ScriptLanguage lang -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang) (BccEra era -> AnyBccEra
forall era. BccEra era -> AnyBccEra
anyBccEra BccEra era
era)
      Just ScriptInEra era
script' -> ScriptInEra era -> ExceptT SophieTxCmdError IO (ScriptInEra era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptInEra era
script'


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

readFileTxMetadata :: TxMetadataJsonSchema -> MetadataFile
                   -> ExceptT SophieTxCmdError IO TxMetadata
readFileTxMetadata :: TxMetadataJsonSchema
-> MetadataFile -> ExceptT SophieTxCmdError IO TxMetadata
readFileTxMetadata TxMetadataJsonSchema
mapping (MetadataFileJSON String
fp) = do
    ByteString
bs <- (IOException -> SophieTxCmdError)
-> IO ByteString -> ExceptT SophieTxCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieTxCmdError
SophieTxCmdReadFileError (FileError () -> SophieTxCmdError)
-> (IOException -> FileError ()) -> IOException -> SophieTxCmdError
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 SophieTxCmdError IO ByteString)
-> IO ByteString -> ExceptT SophieTxCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
          String -> IO ByteString
LBS.readFile String
fp
    Value
v  <- (String -> SophieTxCmdError)
-> ExceptT String IO Value -> ExceptT SophieTxCmdError IO Value
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> String -> SophieTxCmdError
SophieTxCmdMetadataJsonParseError String
fp) (ExceptT String IO Value -> ExceptT SophieTxCmdError IO Value)
-> ExceptT String IO Value -> ExceptT SophieTxCmdError 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 -> SophieTxCmdError)
-> ExceptT TxMetadataJsonError IO TxMetadata
-> ExceptT SophieTxCmdError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> TxMetadataJsonError -> SophieTxCmdError
SophieTxCmdMetadataConversionError String
fp) (ExceptT TxMetadataJsonError IO TxMetadata
 -> ExceptT SophieTxCmdError IO TxMetadata)
-> ExceptT TxMetadataJsonError IO TxMetadata
-> ExceptT SophieTxCmdError 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)] -> SophieTxCmdError)
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
-> ExceptT SophieTxCmdError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> [(Word64, TxMetadataRangeError)] -> SophieTxCmdError
SophieTxCmdMetaValidationError String
fp) (ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
 -> ExceptT SophieTxCmdError IO TxMetadata)
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
-> ExceptT SophieTxCmdError 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 -> SophieTxCmdError)
-> IO ByteString -> ExceptT SophieTxCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieTxCmdError
SophieTxCmdReadFileError (FileError () -> SophieTxCmdError)
-> (IOException -> FileError ()) -> IOException -> SophieTxCmdError
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 SophieTxCmdError IO ByteString)
-> IO ByteString -> ExceptT SophieTxCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
          String -> IO ByteString
BS.readFile String
fp
    TxMetadata
txMetadata <- (DecoderError -> SophieTxCmdError)
-> ExceptT DecoderError IO TxMetadata
-> ExceptT SophieTxCmdError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> DecoderError -> SophieTxCmdError
SophieTxCmdMetaDecodeError String
fp) (ExceptT DecoderError IO TxMetadata
 -> ExceptT SophieTxCmdError IO TxMetadata)
-> ExceptT DecoderError IO TxMetadata
-> ExceptT SophieTxCmdError 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)] -> SophieTxCmdError)
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
-> ExceptT SophieTxCmdError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> [(Word64, TxMetadataRangeError)] -> SophieTxCmdError
SophieTxCmdMetaValidationError String
fp) (ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
 -> ExceptT SophieTxCmdError IO TxMetadata)
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
-> ExceptT SophieTxCmdError 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