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

-- | Runners for Dijkstra sub-transactions: the @sub-transaction@
-- command group, and reading signed sub-transactions for embedding in a
-- top-level transaction.
module Cardano.CLI.EraBased.Transaction.SubTransaction.Run
  ( runSubTransactionCmds
  , runSubTransactionBuildRawCmd
  , runSubTransactionSignCmd
  , runSubTransactionTxIdCmd
  , readSignedSubTransactions
  , validateCanonicalSubTransactions
  )
where

import Cardano.Api
import Cardano.Api.Experimental (obtainCommonConstraints)
import Cardano.Api.Experimental qualified as Exp
import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp
import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus
import Cardano.Api.Experimental.Tx qualified as Exp
import Cardano.Api.Ledger qualified as L

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.Genesis.Internal.Common (readProtocolParameters)
import Cardano.CLI.EraBased.Script.Certificate.Read
import Cardano.CLI.EraBased.Script.Mint.Read
import Cardano.CLI.EraBased.Script.Proposal.Read
import Cardano.CLI.EraBased.Script.Read.Common (readScriptDataOrFile)
import Cardano.CLI.EraBased.Script.Spend.Read
import Cardano.CLI.EraBased.Script.Vote.Read
import Cardano.CLI.EraBased.Script.Withdrawal.Read
import Cardano.CLI.EraBased.Transaction.Internal.Common
import Cardano.CLI.EraBased.Transaction.SubTransaction.Command qualified as Cmd
import Cardano.CLI.Json.Encode qualified as Json
import Cardano.CLI.Read
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.TxCmdError
import Cardano.CLI.Type.Error.TxValidationError
import Cardano.CLI.Type.Key (readVerificationKeyOrHashOrTextEnvFile)
import Cardano.Ledger.Core qualified as L (fromNativeScript)
import Cardano.Ledger.Dijkstra.Scripts qualified as L
import Cardano.Ledger.Dijkstra.TxBody qualified as L
import Cardano.Ledger.Hashes (DataHash, originalBytes)
import Cardano.Ledger.Keys (coerceKeyRole)
import Cardano.Ledger.Plutus.Language qualified as L

import RIO hiding (toList)

import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Foldable qualified as Foldable
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.OSet.Strict (OSet)
import Data.OSet.Strict qualified as OSet
import Data.Set qualified as Set
import Vary qualified

runSubTransactionCmds :: Cmd.SubTransactionCmds -> CIO e ()
runSubTransactionCmds :: forall e. SubTransactionCmds -> CIO e ()
runSubTransactionCmds = \case
  Cmd.SubTransactionBuildRawCmd SubTransactionBuildRawCmdArgs
args -> SubTransactionBuildRawCmdArgs -> CIO e ()
forall e. SubTransactionBuildRawCmdArgs -> CIO e ()
runSubTransactionBuildRawCmd SubTransactionBuildRawCmdArgs
args
  Cmd.SubTransactionSignCmd SubTransactionSignCmdArgs
args -> SubTransactionSignCmdArgs -> CIO e ()
forall e. SubTransactionSignCmdArgs -> CIO e ()
runSubTransactionSignCmd SubTransactionSignCmdArgs
args
  Cmd.SubTransactionTxIdCmd SubTransactionTxIdCmdArgs
args -> SubTransactionTxIdCmdArgs -> CIO e ()
forall e. SubTransactionTxIdCmdArgs -> CIO e ()
runSubTransactionTxIdCmd SubTransactionTxIdCmdArgs
args

-- | Read the signed sub-transactions named on the command line, checking that
-- none is given twice (the ledger keys them by id, so a duplicate would
-- silently collapse).
readSignedSubTransactions
  :: [SignedSubTxFile In]
  -> CIO e [Exp.SignedSubTx]
readSignedSubTransactions :: forall e. [SignedSubTxFile 'In] -> CIO e [SignedSubTx]
readSignedSubTransactions [SignedSubTxFile 'In]
subTransactionFiles = do
  signedSubTxs <- [SignedSubTxFile 'In]
-> (SignedSubTxFile 'In -> RIO e SignedSubTx)
-> RIO e [SignedSubTx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SignedSubTxFile 'In]
subTransactionFiles ((SignedSubTxFile 'In -> RIO e SignedSubTx) -> RIO e [SignedSubTx])
-> (SignedSubTxFile 'In -> RIO e SignedSubTx)
-> RIO e [SignedSubTx]
forall a b. (a -> b) -> a -> b
$ \(File FilePath
subTxPath) -> do
    subTxFile <- IO FileOrPipe -> RIO e FileOrPipe
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> RIO e FileOrPipe)
-> IO FileOrPipe -> RIO e FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
subTxPath
    fromEitherIOCli $ first TxCmdTextEnvError <$> readFileSignedSubTx subTxFile
  case [i | (i : _ : _) <- List.group (List.sort (map Exp.getSignedSubTxId signedSubTxs))] of
    TxId
duplicateId : [TxId]
_ -> TxCmdError -> RIO e [SignedSubTx]
forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError (TxCmdError -> RIO e [SignedSubTx])
-> TxCmdError -> RIO e [SignedSubTx]
forall a b. (a -> b) -> a -> b
$ TxId -> TxCmdError
TxCmdDuplicateSubTransaction TxId
duplicateId
    [] -> [SignedSubTx] -> RIO e [SignedSubTx]
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SignedSubTx]
signedSubTxs

runSubTransactionBuildRawCmd
  :: Cmd.SubTransactionBuildRawCmdArgs
  -> CIO e ()
runSubTransactionBuildRawCmd :: forall e. SubTransactionBuildRawCmdArgs -> CIO e ()
runSubTransactionBuildRawCmd
  Cmd.SubTransactionBuildRawCmdArgs
    { [(TxIn, Maybe AnySpendScript)]
txIns :: [(TxIn, Maybe AnySpendScript)]
txIns :: SubTransactionBuildRawCmdArgs -> [(TxIn, Maybe AnySpendScript)]
txIns
    , [TxIn]
readOnlyRefIns :: [TxIn]
readOnlyRefIns :: SubTransactionBuildRawCmdArgs -> [TxIn]
readOnlyRefIns
    , [TxOutAnyEra]
txouts :: [TxOutAnyEra]
txouts :: SubTransactionBuildRawCmdArgs -> [TxOutAnyEra]
txouts
    , Maybe (MultiAsset, [AnyMintScript])
mMintedAssets :: Maybe (MultiAsset, [AnyMintScript])
mMintedAssets :: SubTransactionBuildRawCmdArgs
-> Maybe (MultiAsset, [AnyMintScript])
mMintedAssets
    , Maybe SlotNo
mValidityLowerBound :: Maybe SlotNo
mValidityLowerBound :: SubTransactionBuildRawCmdArgs -> Maybe SlotNo
mValidityLowerBound
    , Maybe SlotNo
mValidityUpperBound :: Maybe SlotNo
mValidityUpperBound :: SubTransactionBuildRawCmdArgs -> Maybe SlotNo
mValidityUpperBound
    , [(CertificateFile, Maybe AnyNonAssetScript)]
certificates :: [(CertificateFile, Maybe AnyNonAssetScript)]
certificates :: SubTransactionBuildRawCmdArgs
-> [(CertificateFile, Maybe AnyNonAssetScript)]
certificates
    , [(StakeAddress, Coin, Maybe AnyNonAssetScript)]
withdrawals :: [(StakeAddress, Coin, Maybe AnyNonAssetScript)]
withdrawals :: SubTransactionBuildRawCmdArgs
-> [(StakeAddress, Coin, Maybe AnyNonAssetScript)]
withdrawals
    , TxMetadataJsonSchema
metadataSchema :: TxMetadataJsonSchema
metadataSchema :: SubTransactionBuildRawCmdArgs -> TxMetadataJsonSchema
metadataSchema
    , [ScriptFile]
scriptFiles :: [ScriptFile]
scriptFiles :: SubTransactionBuildRawCmdArgs -> [ScriptFile]
scriptFiles
    , [MetadataFile]
metadataFiles :: [MetadataFile]
metadataFiles :: SubTransactionBuildRawCmdArgs -> [MetadataFile]
metadataFiles
    , Maybe ProtocolParamsFile
mProtocolParamsFile :: Maybe ProtocolParamsFile
mProtocolParamsFile :: SubTransactionBuildRawCmdArgs -> Maybe ProtocolParamsFile
mProtocolParamsFile
    , [(VoteFile 'In, Maybe AnyNonAssetScript)]
voteFiles :: [(VoteFile 'In, Maybe AnyNonAssetScript)]
voteFiles :: SubTransactionBuildRawCmdArgs
-> [(VoteFile 'In, Maybe AnyNonAssetScript)]
voteFiles
    , [(ProposalFile 'In, Maybe AnyNonAssetScript)]
proposalFiles :: [(ProposalFile 'In, Maybe AnyNonAssetScript)]
proposalFiles :: SubTransactionBuildRawCmdArgs
-> [(ProposalFile 'In, Maybe AnyNonAssetScript)]
proposalFiles
    , Maybe TxCurrentTreasuryValue
mCurrentTreasuryValue :: Maybe TxCurrentTreasuryValue
mCurrentTreasuryValue :: SubTransactionBuildRawCmdArgs -> Maybe TxCurrentTreasuryValue
mCurrentTreasuryValue
    , Maybe TxTreasuryDonation
mTreasuryDonation :: Maybe TxTreasuryDonation
mTreasuryDonation :: SubTransactionBuildRawCmdArgs -> Maybe TxTreasuryDonation
mTreasuryDonation
    , [Guard]
guards :: [Guard]
guards :: SubTransactionBuildRawCmdArgs -> [Guard]
guards
    , [TopLevelGuard]
topLevelGuards :: [TopLevelGuard]
topLevelGuards :: SubTransactionBuildRawCmdArgs -> [TopLevelGuard]
topLevelGuards
    , TxCborFormat
isCborOutCanonical :: TxCborFormat
isCborOutCanonical :: SubTransactionBuildRawCmdArgs -> TxCborFormat
isCborOutCanonical
    , UnsignedSubTxFile 'Out
outFile :: UnsignedSubTxFile 'Out
outFile :: SubTransactionBuildRawCmdArgs -> UnsignedSubTxFile 'Out
outFile
    } = do
    txInsAndMaybeScriptWits <-
      [(TxIn, Maybe AnySpendScript)]
-> CIO e [(TxIn, AnyWitness (LedgerEra DijkstraEra))]
forall era e.
IsEra era =>
[(TxIn, Maybe AnySpendScript)]
-> CIO e [(TxIn, AnyWitness (LedgerEra era))]
readSpendScriptWitnesses [(TxIn, Maybe AnySpendScript)]
txIns

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

    withdrawalsAndMaybeScriptWits <-
      mapM readWithdrawalScriptWitness withdrawals
    txMetadata <-
      readTxMetadata (convert eon) metadataSchema metadataFiles

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

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

    pparams <- forM mProtocolParamsFile $ \ProtocolParamsFile
ppf ->
      ExceptT ProtocolParamsError IO (PParams (LedgerEra DijkstraEra))
-> RIO e (PParams (LedgerEra DijkstraEra))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ProtocolParamsFile
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra DijkstraEra))
forall era.
IsEra era =>
ProtocolParamsFile
-> ExceptT ProtocolParamsError IO (PParams (LedgerEra era))
readProtocolParameters ProtocolParamsFile
ppf)

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

    votingProceduresAndMaybeScriptWits <-
      conwayEraOnwardsConstraints (convert eon) $
        readVotingProceduresFiles voteFiles

    proposals <-
      readTxGovernanceActions @Exp.DijkstraEra proposalFiles

    certsAndMaybeScriptWits <-
      sequence
        [ (,mSwit) <$> fromEitherIOCli (readFileTextEnvelope (File certFile))
        | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits
        ]

    guardWitnesses <- mapM readGuard guards
    let guardCredentials = [Credential Guard
credential | (Credential Guard
credential, Maybe (AlonzoScript DijkstraEra)
_, Maybe (Data DijkstraEra, ExUnits)
_) <- [(Credential Guard, Maybe (AlonzoScript DijkstraEra),
  Maybe (Data DijkstraEra, ExUnits))]
guardWitnesses]
        duplicates = [Credential Guard
credential | Credential Guard
credential : Credential Guard
_ : [Credential Guard]
_ <- [Credential Guard] -> [[Credential Guard]]
forall a. Eq a => [a] -> [[a]]
List.group ([Credential Guard] -> [Credential Guard]
forall a. Ord a => [a] -> [a]
List.sort [Credential Guard]
guardCredentials)]
    unless (null duplicates) $ throwCliError $ TxCmdDuplicateGuards duplicates

    topLevelGuardEntries <- mapM readTopLevelGuard topLevelGuards
    let duplicateTopLevelGuards =
          [ Credential Guard
credential
          | Credential Guard
credential : Credential Guard
_ : [Credential Guard]
_ <- [Credential Guard] -> [[Credential Guard]]
forall a. Eq a => [a] -> [[a]]
List.group ([Credential Guard] -> [Credential Guard]
forall a. Ord a => [a] -> [a]
List.sort (((Credential Guard, StrictMaybe (Data DijkstraEra))
 -> Credential Guard)
-> [(Credential Guard, StrictMaybe (Data DijkstraEra))]
-> [Credential Guard]
forall a b. (a -> b) -> [a] -> [b]
map (Credential Guard, StrictMaybe (Data DijkstraEra))
-> Credential Guard
forall a b. (a, b) -> a
fst [(Credential Guard, StrictMaybe (Data DijkstraEra))]
topLevelGuardEntries))
          ]
    unless (null duplicateTopLevelGuards) $
      throwCliError $
        TxCmdDuplicateTopLevelGuards duplicateTopLevelGuards
    let requiredTopLevelGuards = [(Credential Guard, StrictMaybe (Data DijkstraEra))]
-> Map (Credential Guard) (StrictMaybe (Data DijkstraEra))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential Guard, StrictMaybe (Data DijkstraEra))]
topLevelGuardEntries

    subTx :: Exp.SubTxBodyContent (Exp.LedgerEra Exp.DijkstraEra) <-
      fromEitherCli $
        constructSubTx
          pparams
          txInsAndMaybeScriptWits
          readOnlyRefIns
          txOuts
          mValidityLowerBound
          mValidityUpperBound
          valuesWithScriptWits
          certsAndMaybeScriptWits
          withdrawalsAndMaybeScriptWits
          txAuxScripts
          txMetadata
          votingProceduresAndMaybeScriptWits
          proposals
          mCurrentTreasuryValue
          mTreasuryDonation
          supplementalDatums
          (OSet.fromList guardCredentials)
          requiredTopLevelGuards

    unsigned <-
      fromEitherCli $ first TxCmdMakeUnsignedTxError $ Exp.makeUnsignedSubTx subTx
    unsignedSubTx <- fromEitherCli $ addGuardWitnesses pparams guardWitnesses unsigned

    outputSubTx <-
      if isCborOutCanonical == TxCborCanonical
        then fromEitherCli $ do
          validateCanonicalSubTx unsignedSubTx
          cbor <- first TxCmdSubTxCborError $ canonicaliseCborBs (serialiseToCBOR unsignedSubTx)
          first TxCmdSubTxCborError $ deserialiseFromCBOR Exp.AsUnsignedSubTx cbor
        else pure unsignedSubTx
    fromEitherIOCli $ writeFileTextEnvelope outFile Nothing outputSubTx
   where
    eon :: Exp.Era Exp.DijkstraEra
    eon :: Era DijkstraEra
eon = Era DijkstraEra
Exp.DijkstraEra

type GuardWitness =
  ( L.Credential L.Guard
  , Maybe (L.Script (Exp.LedgerEra Exp.DijkstraEra))
  , Maybe (L.Data (Exp.LedgerEra Exp.DijkstraEra), L.ExUnits)
  )

-- | A file identifies the script language; a bare hash may refer to a script
-- supplied elsewhere, whose language cannot always be checked offline.
readGuard :: Cmd.Guard -> CIO e GuardWitness
readGuard :: forall e. Guard -> CIO e GuardWitness
readGuard = \case
  Cmd.KeyGuard VerificationKeyOrHashOrFile PaymentKey
key -> do
    PaymentKeyHash keyHash <- VerificationKeyOrHashOrFile PaymentKey -> CIO e (Hash PaymentKey)
forall keyrole e.
Key keyrole =>
VerificationKeyOrHashOrFile keyrole -> CIO e (Hash keyrole)
readVerificationKeyOrHashOrTextEnvFile VerificationKeyOrHashOrFile PaymentKey
key
    pure (L.KeyHashObj (coerceKeyRole keyHash), Nothing, Nothing)
  Cmd.ScriptGuard GuardScript
source Maybe (ScriptDataOrFile, ExecutionUnits)
mRedeemer -> do
    (credential, script) <- case GuardScript
source of
      Cmd.GuardScriptHash (ScriptHash ScriptHash
scriptHash) -> (Credential Guard, Maybe (AlonzoScript DijkstraEra))
-> RIO e (Credential Guard, Maybe (AlonzoScript DijkstraEra))
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptHash -> Credential Guard
forall (kr :: KeyRole). ScriptHash -> Credential kr
L.ScriptHashObj ScriptHash
scriptHash, Maybe (AlonzoScript DijkstraEra)
forall a. Maybe a
Nothing)
      Cmd.GuardScriptFile (File FilePath
path) -> do
        ledgerScript <- (Language -> TxCmdError)
-> FilePath -> CIO e (Script (LedgerEra DijkstraEra))
forall e.
(Language -> TxCmdError)
-> FilePath -> CIO e (Script (LedgerEra DijkstraEra))
readGuardScriptFile Language -> TxCmdError
TxCmdSubTxUnsupportedPlutusLanguage FilePath
path
        pure (L.ScriptHashObj (L.hashScript ledgerScript), Just ledgerScript)
    forM_ script $ \AlonzoScript DijkstraEra
s -> Either TxCmdError () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either TxCmdError () -> RIO e ())
-> Either TxCmdError () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Credential Guard
-> Script (LedgerEra DijkstraEra) -> Bool -> Either TxCmdError ()
validateGuardRedeemer Credential Guard
credential Script (LedgerEra DijkstraEra)
AlonzoScript DijkstraEra
s (Maybe (ScriptDataOrFile, ExecutionUnits) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ScriptDataOrFile, ExecutionUnits)
mRedeemer)
    redeemer <- forM mRedeemer $ \(ScriptDataOrFile
redeemerData, ExecutionUnits
units) -> do
      value <- ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT ScriptDataError IO HashableScriptData
 -> RIO e HashableScriptData)
-> ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall a b. (a -> b) -> a -> b
$ ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData
forall (m :: * -> *).
MonadIO m =>
ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData
readScriptDataOrFile ScriptDataOrFile
redeemerData
      pure (toAlonzoData value, toAlonzoExUnits units)
    pure (credential, script, redeemer)

-- | Both guard forms accept native scripts or Plutus V4 scripts.
readGuardScriptFile
  :: (L.Language -> TxCmdError)
  -> FilePath
  -> CIO e (L.Script (Exp.LedgerEra Exp.DijkstraEra))
readGuardScriptFile :: forall e.
(Language -> TxCmdError)
-> FilePath -> CIO e (Script (LedgerEra DijkstraEra))
readGuardScriptFile Language -> TxCmdError
languageError FilePath
path = do
  script <- forall (m :: * -> *) era.
(MonadIO m, IsEra era) =>
FilePath -> m (AnyScript (LedgerEra era))
readAnyScript @_ @Exp.DijkstraEra FilePath
path
  case script of
    Exp.AnySimpleScript (Exp.SimpleScript NativeScript DijkstraEra
native) -> AlonzoScript DijkstraEra -> RIO e (AlonzoScript DijkstraEra)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlonzoScript DijkstraEra -> RIO e (AlonzoScript DijkstraEra))
-> AlonzoScript DijkstraEra -> RIO e (AlonzoScript DijkstraEra)
forall a b. (a -> b) -> a -> b
$ NativeScript DijkstraEra -> Script DijkstraEra
forall era. EraScript era => NativeScript era -> Script era
L.fromNativeScript NativeScript DijkstraEra
native
    Exp.AnyPlutusScript PlutusScriptInEra lang DijkstraEra
plutus -> do
      let language :: Language
language = PlutusScriptInEra lang DijkstraEra -> Language
forall (lang :: Language) era.
PlutusLanguage lang =>
PlutusScriptInEra lang era -> Language
Exp.Plutus.plutusScriptInEraLanguage PlutusScriptInEra lang DijkstraEra
plutus
      Bool -> RIO e () -> RIO e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Language
language Language -> Language -> Bool
forall a. Eq a => a -> a -> Bool
== Language
L.PlutusV4) (RIO e () -> RIO e ()) -> RIO e () -> RIO e ()
forall a b. (a -> b) -> a -> b
$
        TxCmdError -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError (TxCmdError -> RIO e ()) -> TxCmdError -> RIO e ()
forall a b. (a -> b) -> a -> b
$
          Language -> TxCmdError
languageError Language
language
      AlonzoScript DijkstraEra -> RIO e (AlonzoScript DijkstraEra)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlonzoScript DijkstraEra -> RIO e (AlonzoScript DijkstraEra))
-> AlonzoScript DijkstraEra -> RIO e (AlonzoScript DijkstraEra)
forall a b. (a -> b) -> a -> b
$ PlutusScriptInEra lang DijkstraEra -> Script DijkstraEra
forall (lang :: Language) era.
PlutusScriptInEra lang era -> Script era
Exp.Plutus.plutusScriptInEraToScript PlutusScriptInEra lang DijkstraEra
plutus

validateGuardRedeemer
  :: L.Credential L.Guard
  -> L.Script (Exp.LedgerEra Exp.DijkstraEra)
  -> Bool
  -> Either TxCmdError ()
validateGuardRedeemer :: Credential Guard
-> Script (LedgerEra DijkstraEra) -> Bool -> Either TxCmdError ()
validateGuardRedeemer Credential Guard
credential Script (LedgerEra DijkstraEra)
script Bool
hasRedeemer
  | Maybe (NativeScript DijkstraEra) -> Bool
forall a. Maybe a -> Bool
isJust (Script DijkstraEra -> Maybe (NativeScript DijkstraEra)
forall era. EraScript era => Script era -> Maybe (NativeScript era)
L.getNativeScript Script (LedgerEra DijkstraEra)
Script DijkstraEra
script) =
      Bool -> Either TxCmdError () -> Either TxCmdError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasRedeemer (Either TxCmdError () -> Either TxCmdError ())
-> Either TxCmdError () -> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ TxCmdError -> Either TxCmdError ()
forall a b. a -> Either a b
Left (TxCmdError -> Either TxCmdError ())
-> TxCmdError -> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ Credential Guard -> TxCmdError
TxCmdNativeGuardWithRedeemer Credential Guard
credential
  | Bool
otherwise =
      Bool -> Either TxCmdError () -> Either TxCmdError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasRedeemer (Either TxCmdError () -> Either TxCmdError ())
-> Either TxCmdError () -> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ TxCmdError -> Either TxCmdError ()
forall a b. a -> Either a b
Left (TxCmdError -> Either TxCmdError ())
-> TxCmdError -> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ Credential Guard -> TxCmdError
TxCmdPlutusGuardMissingRedeemer Credential Guard
credential

-- | The API currently collects witnesses for the six pre-Dijkstra purposes.
-- Add guarding witnesses before canonicalisation/signing and update the script
-- integrity hash to cover the complete redeemer set. Guard indices include key
-- and native-script guards, and preserve the body's OSet order.
addGuardWitnesses
  :: Maybe (L.PParams (Exp.LedgerEra Exp.DijkstraEra))
  -> [GuardWitness]
  -> Exp.UnsignedSubTx
  -> Either TxCmdError Exp.UnsignedSubTx
addGuardWitnesses :: Maybe (PParams (LedgerEra DijkstraEra))
-> [GuardWitness]
-> UnsignedSubTx
-> Either TxCmdError UnsignedSubTx
addGuardWitnesses Maybe (PParams (LedgerEra DijkstraEra))
pparams [GuardWitness]
guards (Exp.UnsignedSubTx Tx SubTx (LedgerEra DijkstraEra)
tx) = do
  let scripts :: Map ScriptHash (AlonzoScript DijkstraEra)
scripts =
        [(ScriptHash, AlonzoScript DijkstraEra)]
-> Map ScriptHash (AlonzoScript DijkstraEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Script DijkstraEra -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
L.hashScript Script DijkstraEra
AlonzoScript DijkstraEra
script, AlonzoScript DijkstraEra
script) | (Credential Guard
_, Just AlonzoScript DijkstraEra
script, Maybe (Data DijkstraEra, ExUnits)
_) <- [GuardWitness]
[(Credential Guard, Maybe (AlonzoScript DijkstraEra),
  Maybe (Data DijkstraEra, ExUnits))]
guards]
          Map ScriptHash (AlonzoScript DijkstraEra)
-> Map ScriptHash (AlonzoScript DijkstraEra)
-> Map ScriptHash (AlonzoScript DijkstraEra)
forall a. Semigroup a => a -> a -> a
<> Tx SubTx (LedgerEra DijkstraEra)
Tx SubTx DijkstraEra
tx Tx SubTx DijkstraEra
-> Getting
     (Map ScriptHash (AlonzoScript DijkstraEra))
     (Tx SubTx DijkstraEra)
     (Map ScriptHash (AlonzoScript DijkstraEra))
-> Map ScriptHash (AlonzoScript DijkstraEra)
forall s a. s -> Getting a s a -> a
^. (TxWits DijkstraEra
 -> Const
      (Map ScriptHash (AlonzoScript DijkstraEra)) (TxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const
     (Map ScriptHash (AlonzoScript DijkstraEra)) (Tx SubTx DijkstraEra)
(AlonzoTxWits DijkstraEra
 -> Const
      (Map ScriptHash (AlonzoScript DijkstraEra))
      (AlonzoTxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const
     (Map ScriptHash (AlonzoScript DijkstraEra)) (Tx SubTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxWits DijkstraEra)
L.witsTxL ((AlonzoTxWits DijkstraEra
  -> Const
       (Map ScriptHash (AlonzoScript DijkstraEra))
       (AlonzoTxWits DijkstraEra))
 -> Tx SubTx DijkstraEra
 -> Const
      (Map ScriptHash (AlonzoScript DijkstraEra)) (Tx SubTx DijkstraEra))
-> ((Map ScriptHash (AlonzoScript DijkstraEra)
     -> Const
          (Map ScriptHash (AlonzoScript DijkstraEra))
          (Map ScriptHash (AlonzoScript DijkstraEra)))
    -> AlonzoTxWits DijkstraEra
    -> Const
         (Map ScriptHash (AlonzoScript DijkstraEra))
         (AlonzoTxWits DijkstraEra))
-> Getting
     (Map ScriptHash (AlonzoScript DijkstraEra))
     (Tx SubTx DijkstraEra)
     (Map ScriptHash (AlonzoScript DijkstraEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script DijkstraEra)
 -> Const
      (Map ScriptHash (AlonzoScript DijkstraEra))
      (Map ScriptHash (Script DijkstraEra)))
-> TxWits DijkstraEra
-> Const
     (Map ScriptHash (AlonzoScript DijkstraEra)) (TxWits DijkstraEra)
(Map ScriptHash (AlonzoScript DijkstraEra)
 -> Const
      (Map ScriptHash (AlonzoScript DijkstraEra))
      (Map ScriptHash (AlonzoScript DijkstraEra)))
-> AlonzoTxWits DijkstraEra
-> Const
     (Map ScriptHash (AlonzoScript DijkstraEra))
     (AlonzoTxWits DijkstraEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits DijkstraEra) (Map ScriptHash (Script DijkstraEra))
L.scriptTxWitsL
      guardRedeemers :: Map (PlutusPurpose AsIx DijkstraEra) (Data DijkstraEra, ExUnits)
guardRedeemers =
        [(PlutusPurpose AsIx DijkstraEra, (Data DijkstraEra, ExUnits))]
-> Map (PlutusPurpose AsIx DijkstraEra) (Data DijkstraEra, ExUnits)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (AsIx Word32 ScriptHash -> PlutusPurpose AsIx DijkstraEra
forall era (f :: * -> * -> *).
DijkstraEraScript era =>
f Word32 ScriptHash -> PlutusPurpose f era
L.GuardingPurpose (Word32 -> AsIx Word32 ScriptHash
forall ix it. ix -> AsIx ix it
L.AsIx Word32
index), (Data DijkstraEra, ExUnits)
redeemer)
          | (Word32
index, (Credential Guard
_, Maybe (AlonzoScript DijkstraEra)
_, Just (Data DijkstraEra, ExUnits)
redeemer)) <- [Word32]
-> [(Credential Guard, Maybe (AlonzoScript DijkstraEra),
     Maybe (Data DijkstraEra, ExUnits))]
-> [(Word32,
     (Credential Guard, Maybe (AlonzoScript DijkstraEra),
      Maybe (Data DijkstraEra, ExUnits)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] [GuardWitness]
[(Credential Guard, Maybe (AlonzoScript DijkstraEra),
  Maybe (Data DijkstraEra, ExUnits))]
guards
          ]
  [(Credential Guard, Maybe (AlonzoScript DijkstraEra),
  Maybe (Data DijkstraEra, ExUnits))]
-> ((Credential Guard, Maybe (AlonzoScript DijkstraEra),
     Maybe (Data DijkstraEra, ExUnits))
    -> Either TxCmdError ())
-> Either TxCmdError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GuardWitness]
[(Credential Guard, Maybe (AlonzoScript DijkstraEra),
  Maybe (Data DijkstraEra, ExUnits))]
guards (((Credential Guard, Maybe (AlonzoScript DijkstraEra),
   Maybe (Data DijkstraEra, ExUnits))
  -> Either TxCmdError ())
 -> Either TxCmdError ())
-> ((Credential Guard, Maybe (AlonzoScript DijkstraEra),
     Maybe (Data DijkstraEra, ExUnits))
    -> Either TxCmdError ())
-> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ \(Credential Guard
credential, Maybe (AlonzoScript DijkstraEra)
_, Maybe (Data DijkstraEra, ExUnits)
redeemer) -> case Credential Guard
credential of
    L.KeyHashObj KeyHash Guard
_ -> () -> Either TxCmdError ()
forall a. a -> Either TxCmdError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    L.ScriptHashObj ScriptHash
scriptHash ->
      Maybe (AlonzoScript DijkstraEra)
-> (AlonzoScript DijkstraEra -> Either TxCmdError ())
-> Either TxCmdError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ScriptHash
-> Map ScriptHash (AlonzoScript DijkstraEra)
-> Maybe (AlonzoScript DijkstraEra)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash
scriptHash Map ScriptHash (AlonzoScript DijkstraEra)
scripts) ((AlonzoScript DijkstraEra -> Either TxCmdError ())
 -> Either TxCmdError ())
-> (AlonzoScript DijkstraEra -> Either TxCmdError ())
-> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ \AlonzoScript DijkstraEra
script ->
        Credential Guard
-> Script (LedgerEra DijkstraEra) -> Bool -> Either TxCmdError ()
validateGuardRedeemer Credential Guard
credential Script (LedgerEra DijkstraEra)
AlonzoScript DijkstraEra
script (Maybe (Data DijkstraEra, ExUnits) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Data DijkstraEra, ExUnits)
redeemer)
  let redeemers :: Redeemers DijkstraEra
redeemers = Tx SubTx (LedgerEra DijkstraEra)
Tx SubTx DijkstraEra
tx Tx SubTx DijkstraEra
-> Getting
     (Redeemers DijkstraEra)
     (Tx SubTx DijkstraEra)
     (Redeemers DijkstraEra)
-> Redeemers DijkstraEra
forall s a. s -> Getting a s a -> a
^. (TxWits DijkstraEra
 -> Const (Redeemers DijkstraEra) (TxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const (Redeemers DijkstraEra) (Tx SubTx DijkstraEra)
(AlonzoTxWits DijkstraEra
 -> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const (Redeemers DijkstraEra) (Tx SubTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxWits DijkstraEra)
L.witsTxL ((AlonzoTxWits DijkstraEra
  -> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra))
 -> Tx SubTx DijkstraEra
 -> Const (Redeemers DijkstraEra) (Tx SubTx DijkstraEra))
-> ((Redeemers DijkstraEra
     -> Const (Redeemers DijkstraEra) (Redeemers DijkstraEra))
    -> AlonzoTxWits DijkstraEra
    -> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra))
-> Getting
     (Redeemers DijkstraEra)
     (Tx SubTx DijkstraEra)
     (Redeemers DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers DijkstraEra
 -> Const (Redeemers DijkstraEra) (Redeemers DijkstraEra))
-> TxWits DijkstraEra
-> Const (Redeemers DijkstraEra) (TxWits DijkstraEra)
(Redeemers DijkstraEra
 -> Const (Redeemers DijkstraEra) (Redeemers DijkstraEra))
-> AlonzoTxWits DijkstraEra
-> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits DijkstraEra) (Redeemers DijkstraEra)
L.rdmrsTxWitsL Redeemers DijkstraEra
-> Redeemers DijkstraEra -> Redeemers DijkstraEra
forall a. Semigroup a => a -> a -> a
<> Map (PlutusPurpose AsIx DijkstraEra) (Data DijkstraEra, ExUnits)
-> Redeemers DijkstraEra
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
L.Redeemers Map (PlutusPurpose AsIx DijkstraEra) (Data DijkstraEra, ExUnits)
guardRedeemers
      witnesses :: AlonzoTxWits DijkstraEra
witnesses =
        Tx SubTx (LedgerEra DijkstraEra)
Tx SubTx DijkstraEra
tx
          Tx SubTx DijkstraEra
-> Getting
     (AlonzoTxWits DijkstraEra)
     (Tx SubTx DijkstraEra)
     (AlonzoTxWits DijkstraEra)
-> AlonzoTxWits DijkstraEra
forall s a. s -> Getting a s a -> a
^. (TxWits DijkstraEra
 -> Const (AlonzoTxWits DijkstraEra) (TxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const (AlonzoTxWits DijkstraEra) (Tx SubTx DijkstraEra)
Getting
  (AlonzoTxWits DijkstraEra)
  (Tx SubTx DijkstraEra)
  (AlonzoTxWits DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxWits DijkstraEra)
L.witsTxL
            AlonzoTxWits DijkstraEra
-> (AlonzoTxWits DijkstraEra -> AlonzoTxWits DijkstraEra)
-> AlonzoTxWits DijkstraEra
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script DijkstraEra)
 -> Identity (Map ScriptHash (Script DijkstraEra)))
-> TxWits DijkstraEra -> Identity (TxWits DijkstraEra)
(Map ScriptHash (Script DijkstraEra)
 -> Identity (Map ScriptHash (AlonzoScript DijkstraEra)))
-> AlonzoTxWits DijkstraEra -> Identity (AlonzoTxWits DijkstraEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits DijkstraEra) (Map ScriptHash (Script DijkstraEra))
L.scriptTxWitsL
          ((Map ScriptHash (Script DijkstraEra)
  -> Identity (Map ScriptHash (AlonzoScript DijkstraEra)))
 -> AlonzoTxWits DijkstraEra -> Identity (AlonzoTxWits DijkstraEra))
-> Map ScriptHash (AlonzoScript DijkstraEra)
-> AlonzoTxWits DijkstraEra
-> AlonzoTxWits DijkstraEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map ScriptHash (AlonzoScript DijkstraEra)
scripts
            AlonzoTxWits DijkstraEra
-> (AlonzoTxWits DijkstraEra -> AlonzoTxWits DijkstraEra)
-> AlonzoTxWits DijkstraEra
forall a b. a -> (a -> b) -> b
& (Redeemers DijkstraEra -> Identity (Redeemers DijkstraEra))
-> TxWits DijkstraEra -> Identity (TxWits DijkstraEra)
(Redeemers DijkstraEra -> Identity (Redeemers DijkstraEra))
-> AlonzoTxWits DijkstraEra -> Identity (AlonzoTxWits DijkstraEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits DijkstraEra) (Redeemers DijkstraEra)
L.rdmrsTxWitsL
          ((Redeemers DijkstraEra -> Identity (Redeemers DijkstraEra))
 -> AlonzoTxWits DijkstraEra -> Identity (AlonzoTxWits DijkstraEra))
-> Redeemers DijkstraEra
-> AlonzoTxWits DijkstraEra
-> AlonzoTxWits DijkstraEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers DijkstraEra
redeemers
      witnessed :: Tx SubTx DijkstraEra
witnessed = Tx SubTx (LedgerEra DijkstraEra)
Tx SubTx DijkstraEra
tx Tx SubTx DijkstraEra
-> (Tx SubTx DijkstraEra -> Tx SubTx DijkstraEra)
-> Tx SubTx DijkstraEra
forall a b. a -> (a -> b) -> b
& (TxWits DijkstraEra -> Identity (TxWits DijkstraEra))
-> Tx SubTx DijkstraEra -> Identity (Tx SubTx DijkstraEra)
(AlonzoTxWits DijkstraEra -> Identity (AlonzoTxWits DijkstraEra))
-> Tx SubTx DijkstraEra -> Identity (Tx SubTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxWits DijkstraEra)
L.witsTxL ((AlonzoTxWits DijkstraEra -> Identity (AlonzoTxWits DijkstraEra))
 -> Tx SubTx DijkstraEra -> Identity (Tx SubTx DijkstraEra))
-> AlonzoTxWits DijkstraEra
-> Tx SubTx DijkstraEra
-> Tx SubTx DijkstraEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AlonzoTxWits DijkstraEra
witnesses
  if Map (PlutusPurpose AsIx DijkstraEra) (Data DijkstraEra, ExUnits)
-> Bool
forall k a. Map k a -> Bool
Map.null Map (PlutusPurpose AsIx DijkstraEra) (Data DijkstraEra, ExUnits)
guardRedeemers
    then UnsignedSubTx -> Either TxCmdError UnsignedSubTx
forall a. a -> Either TxCmdError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnsignedSubTx -> Either TxCmdError UnsignedSubTx)
-> UnsignedSubTx -> Either TxCmdError UnsignedSubTx
forall a b. (a -> b) -> a -> b
$ Tx SubTx (LedgerEra DijkstraEra) -> UnsignedSubTx
Exp.UnsignedSubTx Tx SubTx (LedgerEra DijkstraEra)
Tx SubTx DijkstraEra
witnessed
    else do
      pp <- Either TxCmdError (PParams DijkstraEra)
-> (PParams DijkstraEra -> Either TxCmdError (PParams DijkstraEra))
-> Maybe (PParams DijkstraEra)
-> Either TxCmdError (PParams DijkstraEra)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TxCmdError -> Either TxCmdError (PParams DijkstraEra)
forall a b. a -> Either a b
Left (TxCmdError -> Either TxCmdError (PParams DijkstraEra))
-> TxCmdError -> Either TxCmdError (PParams DijkstraEra)
forall a b. (a -> b) -> a -> b
$ MakeUnsignedTxError -> TxCmdError
TxCmdMakeUnsignedTxError MakeUnsignedTxError
Exp.MakeUnsignedTxMissingProtocolParams) PParams DijkstraEra -> Either TxCmdError (PParams DijkstraEra)
forall a b. b -> Either a b
Right Maybe (PParams (LedgerEra DijkstraEra))
Maybe (PParams DijkstraEra)
pparams
      -- All executed Plutus scripts in a sub-transaction must be V4.
      let integrity =
            BuildTxWith BuildTx (Maybe (LedgerProtocolParameters DijkstraEra))
-> Set Language
-> TxBodyScriptData DijkstraEra
-> StrictMaybe ScriptIntegrityHash
forall era.
BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))
-> Set Language
-> TxBodyScriptData era
-> StrictMaybe ScriptIntegrityHash
getScriptIntegrityHash
              (Maybe (LedgerProtocolParameters DijkstraEra)
-> BuildTxWith
     BuildTx (Maybe (LedgerProtocolParameters DijkstraEra))
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Maybe (LedgerProtocolParameters DijkstraEra)
 -> BuildTxWith
      BuildTx (Maybe (LedgerProtocolParameters DijkstraEra)))
-> Maybe (LedgerProtocolParameters DijkstraEra)
-> BuildTxWith
     BuildTx (Maybe (LedgerProtocolParameters DijkstraEra))
forall a b. (a -> b) -> a -> b
$ LedgerProtocolParameters DijkstraEra
-> Maybe (LedgerProtocolParameters DijkstraEra)
forall a. a -> Maybe a
Just (LedgerProtocolParameters DijkstraEra
 -> Maybe (LedgerProtocolParameters DijkstraEra))
-> LedgerProtocolParameters DijkstraEra
-> Maybe (LedgerProtocolParameters DijkstraEra)
forall a b. (a -> b) -> a -> b
$ PParams (ShelleyLedgerEra DijkstraEra)
-> LedgerProtocolParameters DijkstraEra
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters PParams (ShelleyLedgerEra DijkstraEra)
PParams DijkstraEra
pp)
              (Language -> Set Language
forall a. a -> Set a
Set.singleton Language
L.PlutusV4)
              ( AlonzoEraOnwards DijkstraEra
-> TxDats (ShelleyLedgerEra DijkstraEra)
-> Redeemers (ShelleyLedgerEra DijkstraEra)
-> TxBodyScriptData DijkstraEra
forall era.
AlonzoEraOnwardsConstraints era =>
AlonzoEraOnwards era
-> TxDats (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
-> TxBodyScriptData era
TxBodyScriptData
                  AlonzoEraOnwards DijkstraEra
AlonzoEraOnwardsDijkstra
                  (Tx SubTx DijkstraEra
witnessed Tx SubTx DijkstraEra
-> Getting
     (TxDats DijkstraEra) (Tx SubTx DijkstraEra) (TxDats DijkstraEra)
-> TxDats DijkstraEra
forall s a. s -> Getting a s a -> a
^. (TxWits DijkstraEra
 -> Const (TxDats DijkstraEra) (TxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const (TxDats DijkstraEra) (Tx SubTx DijkstraEra)
(AlonzoTxWits DijkstraEra
 -> Const (TxDats DijkstraEra) (AlonzoTxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const (TxDats DijkstraEra) (Tx SubTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxWits DijkstraEra)
L.witsTxL ((AlonzoTxWits DijkstraEra
  -> Const (TxDats DijkstraEra) (AlonzoTxWits DijkstraEra))
 -> Tx SubTx DijkstraEra
 -> Const (TxDats DijkstraEra) (Tx SubTx DijkstraEra))
-> ((TxDats DijkstraEra
     -> Const (TxDats DijkstraEra) (TxDats DijkstraEra))
    -> AlonzoTxWits DijkstraEra
    -> Const (TxDats DijkstraEra) (AlonzoTxWits DijkstraEra))
-> Getting
     (TxDats DijkstraEra) (Tx SubTx DijkstraEra) (TxDats DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats DijkstraEra
 -> Const (TxDats DijkstraEra) (TxDats DijkstraEra))
-> TxWits DijkstraEra
-> Const (TxDats DijkstraEra) (TxWits DijkstraEra)
(TxDats DijkstraEra
 -> Const (TxDats DijkstraEra) (TxDats DijkstraEra))
-> AlonzoTxWits DijkstraEra
-> Const (TxDats DijkstraEra) (AlonzoTxWits DijkstraEra)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits DijkstraEra) (TxDats DijkstraEra)
L.datsTxWitsL)
                  (Tx SubTx DijkstraEra
witnessed Tx SubTx DijkstraEra
-> Getting
     (Redeemers DijkstraEra)
     (Tx SubTx DijkstraEra)
     (Redeemers DijkstraEra)
-> Redeemers DijkstraEra
forall s a. s -> Getting a s a -> a
^. (TxWits DijkstraEra
 -> Const (Redeemers DijkstraEra) (TxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const (Redeemers DijkstraEra) (Tx SubTx DijkstraEra)
(AlonzoTxWits DijkstraEra
 -> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const (Redeemers DijkstraEra) (Tx SubTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxWits DijkstraEra)
L.witsTxL ((AlonzoTxWits DijkstraEra
  -> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra))
 -> Tx SubTx DijkstraEra
 -> Const (Redeemers DijkstraEra) (Tx SubTx DijkstraEra))
-> ((Redeemers DijkstraEra
     -> Const (Redeemers DijkstraEra) (Redeemers DijkstraEra))
    -> AlonzoTxWits DijkstraEra
    -> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra))
-> Getting
     (Redeemers DijkstraEra)
     (Tx SubTx DijkstraEra)
     (Redeemers DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers DijkstraEra
 -> Const (Redeemers DijkstraEra) (Redeemers DijkstraEra))
-> TxWits DijkstraEra
-> Const (Redeemers DijkstraEra) (TxWits DijkstraEra)
(Redeemers DijkstraEra
 -> Const (Redeemers DijkstraEra) (Redeemers DijkstraEra))
-> AlonzoTxWits DijkstraEra
-> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits DijkstraEra) (Redeemers DijkstraEra)
L.rdmrsTxWitsL)
              )
      pure $ Exp.UnsignedSubTx $ witnessed & L.bodyTxL . L.scriptIntegrityHashTxBodyL .~ integrity

-- | Record a requirement on the enclosing transaction without adding a witness.
-- File inputs permit local datum validation; hashes leave it to the ledger.
readTopLevelGuard
  :: Cmd.TopLevelGuard
  -> CIO e (L.Credential L.Guard, L.StrictMaybe (L.Data (Exp.LedgerEra Exp.DijkstraEra)))
readTopLevelGuard :: forall e.
TopLevelGuard
-> CIO
     e (Credential Guard, StrictMaybe (Data (LedgerEra DijkstraEra)))
readTopLevelGuard = \case
  Cmd.TopLevelKeyGuard VerificationKeyOrHashOrFile PaymentKey
key -> do
    PaymentKeyHash keyHash <- VerificationKeyOrHashOrFile PaymentKey -> CIO e (Hash PaymentKey)
forall keyrole e.
Key keyrole =>
VerificationKeyOrHashOrFile keyrole -> CIO e (Hash keyrole)
readVerificationKeyOrHashOrTextEnvFile VerificationKeyOrHashOrFile PaymentKey
key
    pure (L.KeyHashObj (coerceKeyRole keyHash), L.SNothing)
  Cmd.TopLevelScriptGuard GuardScript
source Maybe ScriptDataOrFile
mDatum -> do
    scriptHash <- case GuardScript
source of
      Cmd.GuardScriptHash (ScriptHash ScriptHash
hash) -> ScriptHash -> RIO e ScriptHash
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptHash
hash
      Cmd.GuardScriptFile (File FilePath
path) -> do
        script <- (Language -> TxCmdError)
-> FilePath -> CIO e (Script (LedgerEra DijkstraEra))
forall e.
(Language -> TxCmdError)
-> FilePath -> CIO e (Script (LedgerEra DijkstraEra))
readGuardScriptFile (FilePath -> Language -> TxCmdError
TxCmdTopLevelGuardUnsupportedPlutusLanguage FilePath
path) FilePath
path
        if isJust (L.getNativeScript script)
          then when (isJust mDatum) $ throwCliError $ TxCmdTopLevelGuardUnexpectedDatum path
          else when (isNothing mDatum) $ throwCliError $ TxCmdTopLevelGuardMissingDatum path
        pure $ L.hashScript script
    datum <- forM mDatum $ \ScriptDataOrFile
d -> HashableScriptData -> Data DijkstraEra
forall ledgerera.
Era ledgerera =>
HashableScriptData -> Data ledgerera
toAlonzoData (HashableScriptData -> Data DijkstraEra)
-> RIO e HashableScriptData -> RIO e (Data DijkstraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT ScriptDataError IO HashableScriptData
-> RIO e HashableScriptData
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData
forall (m :: * -> *).
MonadIO m =>
ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData
readScriptDataOrFile ScriptDataOrFile
d)
    pure (L.ScriptHashObj scriptHash, maybe L.SNothing L.SJust datum)

-- | The sub-transaction analogue of 'constructTxBodyContent'. It shares the
-- value preparation but builds a 'Exp.SubTxBodyContent', which has no fee,
-- collateral, required signers or script validity, and adds guards.
constructSubTx
  :: forall era
   . Exp.IsEra era
  => Maybe (L.PParams (Exp.LedgerEra era))
  -> [(TxIn, Exp.AnyWitness (Exp.LedgerEra era))]
  -- ^ TxIn with potential script witness
  -> [TxIn]
  -- ^ Read only reference inputs
  -> [Exp.TxOut (Exp.LedgerEra era)]
  -> Maybe SlotNo
  -- ^ Lower bound
  -> Maybe SlotNo
  -- ^ Upper bound
  -> (L.MultiAsset, [(PolicyId, Exp.AnyScriptWitness (Exp.LedgerEra era))])
  -- ^ Multi-Asset value(s)
  -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))]
  -- ^ Certificate with potential script witness
  -> [(StakeAddress, Lovelace, Exp.AnyWitness (Exp.LedgerEra era))]
  -- ^ Withdrawals
  -> TxAuxScripts era
  -> TxMetadataInEra era
  -> [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))]
  -> [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))]
  -> Maybe TxCurrentTreasuryValue
  -> Maybe TxTreasuryDonation
  -> Map.Map DataHash (L.Data (Exp.LedgerEra era))
  -- ^ Supplemental datums
  -> OSet (L.Credential L.Guard)
  -- ^ Guards
  -> Map.Map (L.Credential L.Guard) (L.StrictMaybe (L.Data (Exp.LedgerEra era)))
  -- ^ Required top-level guards
  -> Either TxCmdError (Exp.SubTxBodyContent (Exp.LedgerEra era))
constructSubTx :: forall era.
IsEra era =>
Maybe (PParams (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [TxIn]
-> [TxOut (LedgerEra era)]
-> Maybe SlotNo
-> Maybe SlotNo
-> (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [(StakeAddress, Coin, AnyWitness (LedgerEra era))]
-> TxAuxScripts era
-> TxMetadataInEra era
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> Maybe TxCurrentTreasuryValue
-> Maybe TxTreasuryDonation
-> Map DataHash (Data (LedgerEra era))
-> OSet (Credential Guard)
-> Map (Credential Guard) (StrictMaybe (Data (LedgerEra era)))
-> Either TxCmdError (SubTxBodyContent (LedgerEra era))
constructSubTx
  Maybe (PParams (LedgerEra era))
mPparams
  [(TxIn, AnyWitness (LedgerEra era))]
inputsAndMaybeScriptWits
  [TxIn]
readOnlyRefIns
  [TxOut (LedgerEra era)]
txouts
  Maybe SlotNo
mLowerBound
  Maybe SlotNo
mUpperBound
  (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
valuesWithScriptWits
  [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
  [(StakeAddress, Coin, AnyWitness (LedgerEra era))]
withdrawals
  TxAuxScripts era
txAuxScripts
  TxMetadataInEra era
txMetadata
  [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProcedures
  [(Proposal era, AnyWitness (LedgerEra era))]
proposals
  Maybe TxCurrentTreasuryValue
mCurrentTreasury
  Maybe TxTreasuryDonation
mTreasuryDonation
  Map DataHash (Data (LedgerEra era))
suppDatums
  OSet (Credential Guard)
guards
  Map (Credential Guard) (StrictMaybe (Data (LedgerEra era)))
requiredTopLevelGuards =
    do
      -- Only executed Plutus witnesses are restricted. Auxiliary scripts and
      -- reference scripts stored in outputs are not executed by this body.
      let witnesses :: [AnyWitness (LedgerEra era)]
witnesses =
            ((TxIn, AnyWitness (LedgerEra era)) -> AnyWitness (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, AnyWitness (LedgerEra era)) -> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(TxIn, AnyWitness (LedgerEra era))]
inputsAndMaybeScriptWits
              [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)] -> [AnyWitness (LedgerEra era)]
forall a. [a] -> [a] -> [a]
++ ((Certificate (LedgerEra era), AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits
              [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)] -> [AnyWitness (LedgerEra era)]
forall a. [a] -> [a] -> [a]
++ ((StakeAddress, Coin, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(StakeAddress, Coin, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (\(StakeAddress
_, Coin
_, AnyWitness (LedgerEra era)
witness) -> AnyWitness (LedgerEra era)
witness) [(StakeAddress, Coin, AnyWitness (LedgerEra era))]
withdrawals
              [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)] -> [AnyWitness (LedgerEra era)]
forall a. [a] -> [a] -> [a]
++ ((VotingProcedures era, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (VotingProcedures era, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProcedures
              [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)] -> [AnyWitness (LedgerEra era)]
forall a. [a] -> [a] -> [a]
++ ((Proposal era, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Proposal era, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(Proposal era, AnyWitness (LedgerEra era))]
proposals
          languages :: [Language]
languages =
            (AnyWitness (LedgerEra era) -> Maybe Language)
-> [AnyWitness (LedgerEra era)] -> [Language]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnyWitness (LedgerEra era) -> Maybe Language
forall era. AnyWitness era -> Maybe Language
Exp.getAnyWitnessPlutusLanguage [AnyWitness (LedgerEra era)]
witnesses
              [Language] -> [Language] -> [Language]
forall a. [a] -> [a] -> [a]
++ [ AnyPlutusScriptWitness lang purpose (LedgerEra era) -> Language
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> Language
Exp.getAnyPlutusScriptWitnessLanguage AnyPlutusScriptWitness lang purpose (LedgerEra era)
witness
                 | (PolicyId
_, Exp.AnyScriptWitnessPlutus AnyPlutusScriptWitness lang purpose (LedgerEra era)
witness) <- (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
-> [(PolicyId, AnyScriptWitness (LedgerEra era))]
forall a b. (a, b) -> b
snd (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
valuesWithScriptWits
                 ]
      [Language]
-> (Language -> Either TxCmdError ()) -> Either TxCmdError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Language]
languages ((Language -> Either TxCmdError ()) -> Either TxCmdError ())
-> (Language -> Either TxCmdError ()) -> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ \Language
language ->
        Bool -> Either TxCmdError () -> Either TxCmdError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Language
language Language -> Language -> Bool
forall a. Eq a => a -> a -> Bool
== Language
L.PlutusV4) (Either TxCmdError () -> Either TxCmdError ())
-> Either TxCmdError () -> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$
          TxCmdError -> Either TxCmdError ()
forall a b. a -> Either a b
Left (TxCmdError -> Either TxCmdError ())
-> TxCmdError -> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$
            Language -> TxCmdError
TxCmdSubTxUnsupportedPlutusLanguage Language
language

      let allReferenceInputs :: [TxIn]
allReferenceInputs =
            [AnyWitness (LedgerEra era)]
-> [AnyScriptWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
forall era.
[AnyWitness (LedgerEra era)]
-> [AnyScriptWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [AnyWitness (LedgerEra era)]
-> [TxIn]
-> [TxIn]
getAllReferenceInputs
              (((TxIn, AnyWitness (LedgerEra era)) -> AnyWitness (LedgerEra era))
-> [(TxIn, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, AnyWitness (LedgerEra era)) -> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(TxIn, AnyWitness (LedgerEra era))]
inputsAndMaybeScriptWits)
              (((PolicyId, AnyScriptWitness (LedgerEra era))
 -> AnyScriptWitness (LedgerEra era))
-> [(PolicyId, AnyScriptWitness (LedgerEra era))]
-> [AnyScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (PolicyId, AnyScriptWitness (LedgerEra era))
-> AnyScriptWitness (LedgerEra era)
forall a b. (a, b) -> b
snd ([(PolicyId, AnyScriptWitness (LedgerEra era))]
 -> [AnyScriptWitness (LedgerEra era)])
-> [(PolicyId, AnyScriptWitness (LedgerEra era))]
-> [AnyScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
-> [(PolicyId, AnyScriptWitness (LedgerEra era))]
forall a b. (a, b) -> b
snd (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
valuesWithScriptWits)
              (((Certificate (LedgerEra era), AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
certsAndMaybeScriptWits)
              (((StakeAddress, Coin, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(StakeAddress, Coin, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (\(StakeAddress
_, Coin
_, AnyWitness (LedgerEra era)
mSwit) -> AnyWitness (LedgerEra era)
mSwit) [(StakeAddress, Coin, AnyWitness (LedgerEra era))]
withdrawals)
              (((VotingProcedures era, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(VotingProcedures era, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (VotingProcedures era, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(VotingProcedures era, AnyWitness (LedgerEra era))]
votingProcedures)
              (((Proposal era, AnyWitness (LedgerEra era))
 -> AnyWitness (LedgerEra era))
-> [(Proposal era, AnyWitness (LedgerEra era))]
-> [AnyWitness (LedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Proposal era, AnyWitness (LedgerEra era))
-> AnyWitness (LedgerEra era)
forall a b. (a, b) -> b
snd [(Proposal era, AnyWitness (LedgerEra era))]
proposals)
              [TxIn]
readOnlyRefIns
          refInputs :: TxInsReference (LedgerEra era)
refInputs = [TxIn]
-> Set (Datum CtxTx (LedgerEra era))
-> TxInsReference (LedgerEra era)
forall era. [TxIn] -> Set (Datum CtxTx era) -> TxInsReference era
Exp.TxInsReference [TxIn]
allReferenceInputs Set (Datum CtxTx (LedgerEra era))
forall a. Set a
Set.empty
          auxScripts :: [SimpleScript (LedgerEra era)]
auxScripts = case TxAuxScripts era
txAuxScripts of
            TxAuxScripts era
TxAuxScriptsNone -> []
            TxAuxScripts AllegraEraOnwards era
_ [ScriptInEra era]
scripts -> (ScriptInEra era -> Maybe (SimpleScript (LedgerEra era)))
-> [ScriptInEra era] -> [SimpleScript (LedgerEra era)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ScriptInEra era -> Maybe (SimpleScript (LedgerEra era))
forall era.
IsEra era =>
ScriptInEra era -> Maybe (SimpleScript (LedgerEra era))
scriptInEraToSimpleScript [ScriptInEra era]
scripts
          expTxMetadata :: TxMetadata
expTxMetadata = case TxMetadataInEra era
txMetadata of
            TxMetadataInEra era
TxMetadataNone -> Map Word64 TxMetadataValue -> TxMetadata
TxMetadata Map Word64 TxMetadataValue
forall a. Monoid a => a
mempty
            TxMetadataInEra ShelleyBasedEra era
_ TxMetadata
mDat -> TxMetadata
mDat

      validatedMintValue <- (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
-> Either TxCmdError (TxMintValue (LedgerEra era))
forall era.
(MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
-> Either TxCmdError (TxMintValue (LedgerEra era))
createTxMintValue (MultiAsset, [(PolicyId, AnyScriptWitness (LedgerEra era))])
valuesWithScriptWits
      validatedVotingProcedures <-
        first (TxCmdVotingError . TxVotingError) $
          Exp.mkTxVotingProcedures (convertVotingProcedures votingProcedures)
      let txProposals = [(Era era
-> (EraCommonConstraints era => ProposalProcedure (LedgerEra era))
-> ProposalProcedure (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) ProposalProcedure (ShelleyLedgerEra era)
ProposalProcedure (LedgerEra era)
EraCommonConstraints era => ProposalProcedure (LedgerEra era)
p, AnyWitness (LedgerEra era)
w) | (Proposal ProposalProcedure (ShelleyLedgerEra era)
p, AnyWitness (LedgerEra era)
w) <- [(Proposal era, AnyWitness (LedgerEra era))]
proposals]
      return
        ( Exp.defaultSubTxBodyContent
            & Exp.setTxIns inputsAndMaybeScriptWits
            & Exp.setTxInsReference refInputs
            & Exp.setTxOuts txouts
            & maybe id Exp.setTxValidityLowerBound mLowerBound
            & maybe id Exp.setTxValidityUpperBound mUpperBound
            & Exp.setTxMetadata expTxMetadata
            & Exp.setTxAuxScripts auxScripts
            & Exp.setTxWithdrawals (convertWithdrawals withdrawals)
            & maybe id (Exp.setTxProtocolParams . Exp.obtainCommonConstraints (Exp.useEra @era)) mPparams
            & Exp.setTxCertificates
              (Exp.mkTxCertificates Exp.useEra certsAndMaybeScriptWits)
            & Exp.setTxMintValue validatedMintValue
            & Exp.setTxVotingProcedures validatedVotingProcedures
            & Exp.setTxProposalProcedures (Exp.mkTxProposalProcedures txProposals)
            & maybe id Exp.setTxCurrentTreasuryValue (unTxCurrentTreasuryValue <$> mCurrentTreasury)
            & maybe id Exp.setTxTreasuryDonation (unTxTreasuryDonation <$> mTreasuryDonation)
            & Exp.setTxSupplementalDatums suppDatums
            & Exp.setTxGuards guards
            & Exp.setTxRequiredTopLevelGuards requiredTopLevelGuards
        )

runSubTransactionSignCmd
  :: Cmd.SubTransactionSignCmdArgs
  -> CIO e ()
runSubTransactionSignCmd :: forall e. SubTransactionSignCmdArgs -> CIO e ()
runSubTransactionSignCmd
  Cmd.SubTransactionSignCmdArgs
    { subTxFile :: SubTransactionSignCmdArgs -> UnsignedSubTxFile 'In
subTxFile = File FilePath
subTxFilePath
    , [WitnessSigningData]
witnessSigningData :: [WitnessSigningData]
witnessSigningData :: SubTransactionSignCmdArgs -> [WitnessSigningData]
witnessSigningData
    , SignedSubTxFile 'Out
outFile :: SignedSubTxFile 'Out
outFile :: SubTransactionSignCmdArgs -> SignedSubTxFile 'Out
outFile
    } = do
    sks <- [WitnessSigningData]
-> (WitnessSigningData -> RIO e SomeSigningWitness)
-> RIO e [SomeSigningWitness]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [WitnessSigningData]
witnessSigningData ((WitnessSigningData -> RIO e SomeSigningWitness)
 -> RIO e [SomeSigningWitness])
-> (WitnessSigningData -> RIO e SomeSigningWitness)
-> RIO e [SomeSigningWitness]
forall a b. (a -> b) -> a -> b
$ \WitnessSigningData
d ->
      IO (Either TxCmdError SomeSigningWitness)
-> RIO e SomeSigningWitness
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either TxCmdError SomeSigningWitness)
 -> RIO e SomeSigningWitness)
-> IO (Either TxCmdError SomeSigningWitness)
-> RIO e SomeSigningWitness
forall a b. (a -> b) -> a -> b
$ (ReadWitnessSigningDataError -> TxCmdError)
-> Either ReadWitnessSigningDataError SomeSigningWitness
-> Either TxCmdError SomeSigningWitness
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ReadWitnessSigningDataError -> TxCmdError
TxCmdReadWitnessSigningDataError (Either ReadWitnessSigningDataError SomeSigningWitness
 -> Either TxCmdError SomeSigningWitness)
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
-> IO (Either TxCmdError SomeSigningWitness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WitnessSigningData
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
readWitnessSigningData WitnessSigningData
d

    let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeSigningWitness sks

    -- A bootstrap witness needs a top-level body to sign, see 'mkShelleyBootstrapWitness'.
    unless (null sksByron) $
      throwCliError TxCmdSubTxByronWitnessUnsupported

    subTxFile <- liftIO $ fileOrPipe subTxFilePath
    unsigned <-
      fromEitherIOCli $ first TxCmdTextEnvError <$> readFileUnsignedSubTx subTxFile

    let keyWits = (ShelleyWitnessSigningKey -> WitVKey Witness)
-> [ShelleyWitnessSigningKey] -> [WitVKey Witness]
forall a b. (a -> b) -> [a] -> [b]
map (UnsignedSubTx -> ShelleyWitnessSigningKey -> WitVKey Witness
Exp.makeSubTxKeyWitness UnsignedSubTx
unsigned) [ShelleyWitnessSigningKey]
sksShelley
        signed = [BootstrapWitness]
-> [WitVKey Witness] -> UnsignedSubTx -> SignedSubTx
Exp.signSubTx [] [WitVKey Witness]
keyWits UnsignedSubTx
unsigned

    fromEitherIOCli $ writeFileTextEnvelope outFile Nothing signed

runSubTransactionTxIdCmd
  :: Cmd.SubTransactionTxIdCmdArgs
  -> CIO e ()
runSubTransactionTxIdCmd :: forall e. SubTransactionTxIdCmdArgs -> CIO e ()
runSubTransactionTxIdCmd
  Cmd.SubTransactionTxIdCmdArgs
    { InputSubTxFile
inputSubTxFile :: InputSubTxFile
inputSubTxFile :: SubTransactionTxIdCmdArgs -> InputSubTxFile
inputSubTxFile
    , Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: SubTransactionTxIdCmdArgs
-> Vary '[FormatJson, FormatText, FormatYaml]
outputFormat
    } = do
    subTxId <-
      case InputSubTxFile
inputSubTxFile of
        InputUnsignedSubTxFile (File FilePath
path) -> do
          file <- IO FileOrPipe -> RIO e FileOrPipe
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> RIO e FileOrPipe)
-> IO FileOrPipe -> RIO e FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
path
          unsigned <-
            fromEitherIOCli $ first TxCmdTextEnvError <$> readFileUnsignedSubTx file
          pure $ Exp.getUnsignedSubTxId unsigned
        InputSignedSubTxFile (File FilePath
path) -> do
          file <- IO FileOrPipe -> RIO e FileOrPipe
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> RIO e FileOrPipe)
-> IO FileOrPipe -> RIO e FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe FilePath
path
          signed <-
            fromEitherIOCli $ first TxCmdTextEnvError <$> readFileSignedSubTx file
          pure $ Exp.getSignedSubTxId signed

    liftIO $
      outputFormat
        & ( id
              . Vary.on (\FormatJson
FormatJson -> ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ TxSubmissionResult -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson (TxSubmissionResult -> ByteString)
-> TxSubmissionResult -> ByteString
forall a b. (a -> b) -> a -> b
$ TxId -> TxSubmissionResult
TxSubmissionResult TxId
subTxId)
              . Vary.on (\FormatText
FormatText -> ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ TxId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex TxId
subTxId)
              . Vary.on (\FormatYaml
FormatYaml -> ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ TxSubmissionResult -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml (TxSubmissionResult -> ByteString)
-> TxSubmissionResult -> ByteString
forall a b. (a -> b) -> a -> b
$ TxId -> TxSubmissionResult
TxSubmissionResult TxId
subTxId)
              $ Vary.exhaustiveCase
          )

-- | Canonicalisation must preserve the bytes behind hashes already stored in
-- the sub-transaction body. Datums may also be referenced by existing UTxOs.
validateCanonicalSubTx :: Exp.UnsignedSubTx -> Either TxCmdError ()
validateCanonicalSubTx :: UnsignedSubTx -> Either TxCmdError ()
validateCanonicalSubTx unsigned :: UnsignedSubTx
unsigned@(Exp.UnsignedSubTx Tx SubTx (LedgerEra DijkstraEra)
tx) = do
  StrictMaybe (AlonzoTxAuxData DijkstraEra)
-> (AlonzoTxAuxData DijkstraEra -> Either TxCmdError ())
-> Either TxCmdError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Tx SubTx (LedgerEra DijkstraEra)
Tx SubTx DijkstraEra
tx Tx SubTx DijkstraEra
-> Getting
     (StrictMaybe (AlonzoTxAuxData DijkstraEra))
     (Tx SubTx DijkstraEra)
     (StrictMaybe (AlonzoTxAuxData DijkstraEra))
-> StrictMaybe (AlonzoTxAuxData DijkstraEra)
forall s a. s -> Getting a s a -> a
^. (StrictMaybe (TxAuxData DijkstraEra)
 -> Const
      (StrictMaybe (AlonzoTxAuxData DijkstraEra))
      (StrictMaybe (TxAuxData DijkstraEra)))
-> Tx SubTx DijkstraEra
-> Const
     (StrictMaybe (AlonzoTxAuxData DijkstraEra)) (Tx SubTx DijkstraEra)
Getting
  (StrictMaybe (AlonzoTxAuxData DijkstraEra))
  (Tx SubTx DijkstraEra)
  (StrictMaybe (AlonzoTxAuxData DijkstraEra))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (StrictMaybe (TxAuxData DijkstraEra))
L.auxDataTxL) ((AlonzoTxAuxData DijkstraEra -> Either TxCmdError ())
 -> Either TxCmdError ())
-> (AlonzoTxAuxData DijkstraEra -> Either TxCmdError ())
-> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ \AlonzoTxAuxData DijkstraEra
aux ->
    Text -> ByteString -> Either TxCmdError ()
check Text
"auxiliary data (metadata and auxiliary scripts)" (AlonzoTxAuxData DijkstraEra -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes AlonzoTxAuxData DijkstraEra
aux)
  Text -> ByteString -> Either TxCmdError ()
check Text
"redeemers" (ByteString -> Either TxCmdError ())
-> ByteString -> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ Redeemers DijkstraEra -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (Tx SubTx (LedgerEra DijkstraEra)
Tx SubTx DijkstraEra
tx Tx SubTx DijkstraEra
-> Getting
     (Redeemers DijkstraEra)
     (Tx SubTx DijkstraEra)
     (Redeemers DijkstraEra)
-> Redeemers DijkstraEra
forall s a. s -> Getting a s a -> a
^. (TxWits DijkstraEra
 -> Const (Redeemers DijkstraEra) (TxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const (Redeemers DijkstraEra) (Tx SubTx DijkstraEra)
(AlonzoTxWits DijkstraEra
 -> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const (Redeemers DijkstraEra) (Tx SubTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxWits DijkstraEra)
L.witsTxL ((AlonzoTxWits DijkstraEra
  -> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra))
 -> Tx SubTx DijkstraEra
 -> Const (Redeemers DijkstraEra) (Tx SubTx DijkstraEra))
-> ((Redeemers DijkstraEra
     -> Const (Redeemers DijkstraEra) (Redeemers DijkstraEra))
    -> AlonzoTxWits DijkstraEra
    -> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra))
-> Getting
     (Redeemers DijkstraEra)
     (Tx SubTx DijkstraEra)
     (Redeemers DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers DijkstraEra
 -> Const (Redeemers DijkstraEra) (Redeemers DijkstraEra))
-> TxWits DijkstraEra
-> Const (Redeemers DijkstraEra) (TxWits DijkstraEra)
(Redeemers DijkstraEra
 -> Const (Redeemers DijkstraEra) (Redeemers DijkstraEra))
-> AlonzoTxWits DijkstraEra
-> Const (Redeemers DijkstraEra) (AlonzoTxWits DijkstraEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits DijkstraEra) (Redeemers DijkstraEra)
L.rdmrsTxWitsL)
  Text -> ByteString -> Either TxCmdError ()
check Text
"datums" (ByteString -> Either TxCmdError ())
-> ByteString -> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ TxDats DijkstraEra -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (Tx SubTx (LedgerEra DijkstraEra)
Tx SubTx DijkstraEra
tx Tx SubTx DijkstraEra
-> Getting
     (TxDats DijkstraEra) (Tx SubTx DijkstraEra) (TxDats DijkstraEra)
-> TxDats DijkstraEra
forall s a. s -> Getting a s a -> a
^. (TxWits DijkstraEra
 -> Const (TxDats DijkstraEra) (TxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const (TxDats DijkstraEra) (Tx SubTx DijkstraEra)
(AlonzoTxWits DijkstraEra
 -> Const (TxDats DijkstraEra) (AlonzoTxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const (TxDats DijkstraEra) (Tx SubTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxWits DijkstraEra)
L.witsTxL ((AlonzoTxWits DijkstraEra
  -> Const (TxDats DijkstraEra) (AlonzoTxWits DijkstraEra))
 -> Tx SubTx DijkstraEra
 -> Const (TxDats DijkstraEra) (Tx SubTx DijkstraEra))
-> ((TxDats DijkstraEra
     -> Const (TxDats DijkstraEra) (TxDats DijkstraEra))
    -> AlonzoTxWits DijkstraEra
    -> Const (TxDats DijkstraEra) (AlonzoTxWits DijkstraEra))
-> Getting
     (TxDats DijkstraEra) (Tx SubTx DijkstraEra) (TxDats DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats DijkstraEra
 -> Const (TxDats DijkstraEra) (TxDats DijkstraEra))
-> TxWits DijkstraEra
-> Const (TxDats DijkstraEra) (TxWits DijkstraEra)
(TxDats DijkstraEra
 -> Const (TxDats DijkstraEra) (TxDats DijkstraEra))
-> AlonzoTxWits DijkstraEra
-> Const (TxDats DijkstraEra) (AlonzoTxWits DijkstraEra)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits DijkstraEra) (TxDats DijkstraEra)
L.datsTxWitsL)
  Map ScriptHash (Script DijkstraEra)
-> (Script DijkstraEra -> Either TxCmdError ())
-> Either TxCmdError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Tx SubTx (LedgerEra DijkstraEra)
Tx SubTx DijkstraEra
tx Tx SubTx DijkstraEra
-> Getting
     (Map ScriptHash (Script DijkstraEra))
     (Tx SubTx DijkstraEra)
     (Map ScriptHash (Script DijkstraEra))
-> Map ScriptHash (Script DijkstraEra)
forall s a. s -> Getting a s a -> a
^. (TxWits DijkstraEra
 -> Const
      (Map ScriptHash (Script DijkstraEra)) (TxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const
     (Map ScriptHash (Script DijkstraEra)) (Tx SubTx DijkstraEra)
(AlonzoTxWits DijkstraEra
 -> Const
      (Map ScriptHash (Script DijkstraEra)) (AlonzoTxWits DijkstraEra))
-> Tx SubTx DijkstraEra
-> Const
     (Map ScriptHash (Script DijkstraEra)) (Tx SubTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxWits DijkstraEra)
L.witsTxL ((AlonzoTxWits DijkstraEra
  -> Const
       (Map ScriptHash (Script DijkstraEra)) (AlonzoTxWits DijkstraEra))
 -> Tx SubTx DijkstraEra
 -> Const
      (Map ScriptHash (Script DijkstraEra)) (Tx SubTx DijkstraEra))
-> ((Map ScriptHash (Script DijkstraEra)
     -> Const
          (Map ScriptHash (Script DijkstraEra))
          (Map ScriptHash (Script DijkstraEra)))
    -> AlonzoTxWits DijkstraEra
    -> Const
         (Map ScriptHash (Script DijkstraEra)) (AlonzoTxWits DijkstraEra))
-> Getting
     (Map ScriptHash (Script DijkstraEra))
     (Tx SubTx DijkstraEra)
     (Map ScriptHash (Script DijkstraEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script DijkstraEra)
 -> Const
      (Map ScriptHash (Script DijkstraEra))
      (Map ScriptHash (Script DijkstraEra)))
-> TxWits DijkstraEra
-> Const (Map ScriptHash (Script DijkstraEra)) (TxWits DijkstraEra)
(Map ScriptHash (Script DijkstraEra)
 -> Const
      (Map ScriptHash (Script DijkstraEra))
      (Map ScriptHash (Script DijkstraEra)))
-> AlonzoTxWits DijkstraEra
-> Const
     (Map ScriptHash (Script DijkstraEra)) (AlonzoTxWits DijkstraEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits DijkstraEra) (Map ScriptHash (Script DijkstraEra))
L.scriptTxWitsL) ((Script DijkstraEra -> Either TxCmdError ())
 -> Either TxCmdError ())
-> (Script DijkstraEra -> Either TxCmdError ())
-> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ \Script DijkstraEra
script ->
    -- Plutus scripts are opaque byte strings; native script structures can
    -- be rewritten, changing the script hashes used by credentials/policies.
    Bool -> Either TxCmdError () -> Either TxCmdError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (DijkstraNativeScript DijkstraEra) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (DijkstraNativeScript DijkstraEra) -> Bool)
-> Maybe (DijkstraNativeScript DijkstraEra) -> Bool
forall a b. (a -> b) -> a -> b
$ Script DijkstraEra -> Maybe (NativeScript DijkstraEra)
forall era. EraScript era => Script era -> Maybe (NativeScript era)
L.getNativeScript Script DijkstraEra
script) (Either TxCmdError () -> Either TxCmdError ())
-> Either TxCmdError () -> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$
      Text -> ByteString -> Either TxCmdError ()
check Text
"native script" (Script DijkstraEra -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes Script DijkstraEra
script)
 where
  check :: Text -> ByteString -> Either TxCmdError ()
check Text
component ByteString
bytes = do
    canonical <- (DecoderError -> TxCmdError)
-> Either DecoderError ByteString -> Either TxCmdError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> TxCmdError
TxCmdSubTxCborError (Either DecoderError ByteString -> Either TxCmdError ByteString)
-> Either DecoderError ByteString -> Either TxCmdError ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DecoderError ByteString
canonicaliseCborBs ByteString
bytes
    unless (bytes == canonical) $
      Left $
        TxCmdNonCanonicalSubTxComponent (Exp.getUnsignedSubTxId unsigned) component

-- | Canonicalising an outer transaction must preserve both the signed body and
-- the hashed payloads of every embedded sub-transaction.
validateCanonicalSubTransactions
  :: TxCborFormat
  -> ShelleyBasedEra era
  -> Tx era
  -> Either TxCmdError ()
validateCanonicalSubTransactions :: forall era.
TxCborFormat
-> ShelleyBasedEra era -> Tx era -> Either TxCmdError ()
validateCanonicalSubTransactions TxCborFormat
TxCborNotCanonical ShelleyBasedEra era
_ Tx era
_ = () -> Either TxCmdError ()
forall a b. b -> Either a b
Right ()
validateCanonicalSubTransactions TxCborFormat
TxCborCanonical ShelleyBasedEra era
sbe (ShelleyTx ShelleyBasedEra era
_ Tx TopTx (ShelleyLedgerEra era)
tx) =
  case ShelleyBasedEra era
sbe of
    ShelleyBasedEra era
ShelleyBasedEraDijkstra ->
      [Tx SubTx DijkstraEra]
-> (Tx SubTx DijkstraEra -> Either TxCmdError ())
-> Either TxCmdError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (OMap TxId (Tx SubTx DijkstraEra) -> [Tx SubTx DijkstraEra]
forall a. OMap TxId a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Tx TopTx (ShelleyLedgerEra era)
Tx TopTx DijkstraEra
tx Tx TopTx DijkstraEra
-> Getting
     (OMap TxId (Tx SubTx DijkstraEra))
     (Tx TopTx DijkstraEra)
     (OMap TxId (Tx SubTx DijkstraEra))
-> OMap TxId (Tx SubTx DijkstraEra)
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx DijkstraEra
 -> Const
      (OMap TxId (Tx SubTx DijkstraEra)) (TxBody TopTx DijkstraEra))
-> Tx TopTx DijkstraEra
-> Const (OMap TxId (Tx SubTx DijkstraEra)) (Tx TopTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxBody l DijkstraEra)
L.bodyTxL ((TxBody TopTx DijkstraEra
  -> Const
       (OMap TxId (Tx SubTx DijkstraEra)) (TxBody TopTx DijkstraEra))
 -> Tx TopTx DijkstraEra
 -> Const (OMap TxId (Tx SubTx DijkstraEra)) (Tx TopTx DijkstraEra))
-> ((OMap TxId (Tx SubTx DijkstraEra)
     -> Const
          (OMap TxId (Tx SubTx DijkstraEra))
          (OMap TxId (Tx SubTx DijkstraEra)))
    -> TxBody TopTx DijkstraEra
    -> Const
         (OMap TxId (Tx SubTx DijkstraEra)) (TxBody TopTx DijkstraEra))
-> Getting
     (OMap TxId (Tx SubTx DijkstraEra))
     (Tx TopTx DijkstraEra)
     (OMap TxId (Tx SubTx DijkstraEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OMap TxId (Tx SubTx DijkstraEra)
 -> Const
      (OMap TxId (Tx SubTx DijkstraEra))
      (OMap TxId (Tx SubTx DijkstraEra)))
-> TxBody TopTx DijkstraEra
-> Const
     (OMap TxId (Tx SubTx DijkstraEra)) (TxBody TopTx DijkstraEra)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx DijkstraEra) (OMap TxId (Tx SubTx DijkstraEra))
L.subTransactionsTxBodyL)) ((Tx SubTx DijkstraEra -> Either TxCmdError ())
 -> Either TxCmdError ())
-> (Tx SubTx DijkstraEra -> Either TxCmdError ())
-> Either TxCmdError ()
forall a b. (a -> b) -> a -> b
$ \Tx SubTx DijkstraEra
subTx -> do
        let bodyBytes :: ByteString
bodyBytes = TxBody SubTx DijkstraEra -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (Tx SubTx DijkstraEra
subTx Tx SubTx DijkstraEra
-> Getting
     (TxBody SubTx DijkstraEra)
     (Tx SubTx DijkstraEra)
     (TxBody SubTx DijkstraEra)
-> TxBody SubTx DijkstraEra
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody SubTx DijkstraEra)
  (Tx SubTx DijkstraEra)
  (TxBody SubTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxBody l DijkstraEra)
L.bodyTxL)
        canonicalBytes <- (DecoderError -> TxCmdError)
-> Either DecoderError ByteString -> Either TxCmdError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> TxCmdError
TxCmdSubTxCborError (Either DecoderError ByteString -> Either TxCmdError ByteString)
-> Either DecoderError ByteString -> Either TxCmdError ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DecoderError ByteString
canonicaliseCborBs ByteString
bodyBytes
        unless (bodyBytes == canonicalBytes) $
          Left $
            TxCmdNonCanonicalSubTransaction (Exp.getSignedSubTxId (Exp.SignedSubTx subTx))
        validateCanonicalSubTx $ Exp.UnsignedSubTx subTx
    ShelleyBasedEra era
_ -> () -> Either TxCmdError ()
forall a b. b -> Either a b
Right ()