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

-- | This module provides minimal transaction-building support across all
-- Shelley-based eras, aimed at internal testing (e.g. tx-generator). The
-- experimental API only covers the current and next era.
module Cardano.Api.Compatible.Tx
  ( AnyProtocolUpdate (..)
  , AnyVote (..)
  , CompatibleTxBodyContent (..)
  , CompatibleTxError (..)
  , defaultCompatibleTxBodyContent
  , createCompatibleTx
  , addWitnesses
  )
where

import Cardano.Api.Era
import Cardano.Api.Error (Error (..))
import Cardano.Api.Experimental.Era (obtainCommonConstraints)
import Cardano.Api.Experimental.Era qualified as Exp
import Cardano.Api.Experimental.Plutus
  ( Witnessable (..)
  , WitnessableItem (..)
  , getAnyWitnessRedeemerPointerMap
  , obtainAlonzoScriptPurposeConstraints
  )
import Cardano.Api.Experimental.Tx qualified as Exp
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
import Cardano.Api.Experimental.Tx.Internal.AnyWitness qualified as Exp
import Cardano.Api.Experimental.Tx.Internal.Certificate qualified as Exp
import Cardano.Api.Monad.Error ((?!))
import Cardano.Api.ProtocolParameters
import Cardano.Api.Tx.Internal.Body hiding
  ( convCertificates
  )
import Cardano.Api.Tx.Internal.Body.Lens qualified as A
import Cardano.Api.Tx.Internal.Sign
import Cardano.Api.Value.Internal

import Cardano.Ledger.Alonzo.Tx qualified as L
import Cardano.Ledger.Alonzo.TxWits qualified as Alonzo
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Core qualified as L
import Cardano.Ledger.TxIn qualified as L
import Cardano.Slotting.Slot (SlotNo)

import Data.List qualified as L
import Data.Map.Ordered.Strict qualified as OMap
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Maybe.Strict
import Data.Monoid
import Data.OSet.Strict (OSet)
import Data.Sequence.Strict qualified as Seq
import Data.Set (Set)
import Data.Set qualified as Set
import GHC.Exts
import Lens.Micro hiding (ix)

data AnyProtocolUpdate era where
  ProtocolUpdate
    :: ShelleyToBabbageEra era
    -> UpdateProposal era
    -> AnyProtocolUpdate era
  ProposalProcedures
    :: ConwayEraOnwards era
    -> Exp.TxProposalProcedures (ShelleyLedgerEra era)
    -> AnyProtocolUpdate era
  NoPParamsUpdate
    :: ShelleyBasedEra era
    -> AnyProtocolUpdate era

data AnyVote era where
  VotingProcedures
    :: ConwayEraOnwards era
    -> Exp.TxVotingProcedures (ShelleyLedgerEra era)
    -> AnyVote era
  NoVotes :: AnyVote era

-- | The content of a transaction 'createCompatibleTx' builds.
data CompatibleTxBodyContent era = CompatibleTxBodyContent
  { forall era.
CompatibleTxBodyContent era
-> [(TxIn, AnyWitness (ShelleyLedgerEra era))]
compatibleTxIns :: [(TxIn, Exp.AnyWitness (ShelleyLedgerEra era))]
  -- ^ Inputs with witnesses. Key-witnessed inputs must use 'Exp.AnyKeyWitnessPlaceholder', or redeemer pointers shift.
  , forall era.
CompatibleTxBodyContent era -> [TxOut (ShelleyLedgerEra era)]
compatibleTxOuts :: [Exp.TxOut (ShelleyLedgerEra era)]
  -- ^ Transaction outputs.
  , forall era.
CompatibleTxBodyContent era
-> Map DataHash (Data (ShelleyLedgerEra era))
compatibleTxSupplementalDatums :: Map L.DataHash (L.Data (ShelleyLedgerEra era))
  -- ^ Supplemental datums to include in the witness set.
  , forall era. CompatibleTxBodyContent era -> Lovelace
compatibleTxFee :: Lovelace
  -- ^ Fee.
  , forall era. CompatibleTxBodyContent era -> AnyProtocolUpdate era
compatibleTxProtocolUpdate :: AnyProtocolUpdate era
  -- ^ Era-appropriate protocol update: Shelley-Babbage proposal, Conway-onwards proposal procedure, or none.
  , forall era. CompatibleTxBodyContent era -> AnyVote era
compatibleTxVotingProcedures :: AnyVote era
  -- ^ Governance votes, Conway onwards; 'NoVotes' otherwise.
  , forall era.
CompatibleTxBodyContent era
-> TxCertificates (ShelleyLedgerEra era)
compatibleTxCertificates :: Exp.TxCertificates (ShelleyLedgerEra era)
  -- ^ Certificates, witnessed or not.
  , forall era. CompatibleTxBodyContent era -> [TxIn]
compatibleTxInsCollateral :: [TxIn]
  -- ^ Collateral inputs. Meaningful only Alonzo onwards; supply non-empty only when using plutus witnesses.
  , forall era.
CompatibleTxBodyContent era
-> Maybe (PParams (ShelleyLedgerEra era))
compatibleTxProtocolParams :: Maybe (L.PParams (ShelleyLedgerEra era))
  -- ^ Needed to compute the script integrity hash when plutus witnesses are present.
  -- 'Nothing' is only safe when there are none; see 'CompatibleTxMissingScriptIntegrityPParams'.
  , forall era. CompatibleTxBodyContent era -> TxMetadataInEra era
compatibleTxMetadata :: TxMetadataInEra era
  -- ^ Transaction metadata to embed, or 'TxMetadataNone' for none.
  , forall era. CompatibleTxBodyContent era -> Maybe SlotNo
compatibleTxValidityUpperBound :: Maybe SlotNo
  -- ^ Last slot the transaction can be included in, or 'Nothing' for unbounded.
  }

-- | 'CompatibleTxBodyContent' with everything empty: no inputs, outputs,
-- certificates, votes, protocol update, collateral, protocol parameters,
-- metadata or validity upper bound.
--
-- The 'ShelleyBasedEra' witness is only needed to build the default
-- 'NoPParamsUpdate'.
defaultCompatibleTxBodyContent :: ShelleyBasedEra era -> CompatibleTxBodyContent era
defaultCompatibleTxBodyContent :: forall era. ShelleyBasedEra era -> CompatibleTxBodyContent era
defaultCompatibleTxBodyContent ShelleyBasedEra era
sbe =
  CompatibleTxBodyContent
    { compatibleTxIns :: [(TxIn, AnyWitness (ShelleyLedgerEra era))]
compatibleTxIns = []
    , compatibleTxOuts :: [TxOut (ShelleyLedgerEra era)]
compatibleTxOuts = []
    , compatibleTxSupplementalDatums :: Map DataHash (Data (ShelleyLedgerEra era))
compatibleTxSupplementalDatums = Map DataHash (Data (ShelleyLedgerEra era))
forall a. Monoid a => a
mempty
    , compatibleTxFee :: Lovelace
compatibleTxFee = Lovelace
0
    , compatibleTxProtocolUpdate :: AnyProtocolUpdate era
compatibleTxProtocolUpdate = ShelleyBasedEra era -> AnyProtocolUpdate era
forall era. ShelleyBasedEra era -> AnyProtocolUpdate era
NoPParamsUpdate ShelleyBasedEra era
sbe
    , compatibleTxVotingProcedures :: AnyVote era
compatibleTxVotingProcedures = AnyVote era
forall era. AnyVote era
NoVotes
    , compatibleTxCertificates :: TxCertificates (ShelleyLedgerEra era)
compatibleTxCertificates = OMap
  (Certificate (ShelleyLedgerEra era))
  (Maybe (AnyWitness (ShelleyLedgerEra era)))
-> TxCertificates (ShelleyLedgerEra era)
forall era.
OMap (Certificate era) (Maybe (AnyWitness era))
-> TxCertificates era
Exp.TxCertificates OMap
  (Certificate (ShelleyLedgerEra era))
  (Maybe (AnyWitness (ShelleyLedgerEra era)))
forall k v. OMap k v
OMap.empty
    , compatibleTxInsCollateral :: [TxIn]
compatibleTxInsCollateral = []
    , compatibleTxProtocolParams :: Maybe (PParams (ShelleyLedgerEra era))
compatibleTxProtocolParams = Maybe (PParams (ShelleyLedgerEra era))
forall a. Maybe a
Nothing
    , compatibleTxMetadata :: TxMetadataInEra era
compatibleTxMetadata = TxMetadataInEra era
forall era. TxMetadataInEra era
TxMetadataNone
    , compatibleTxValidityUpperBound :: Maybe SlotNo
compatibleTxValidityUpperBound = Maybe SlotNo
forall a. Maybe a
Nothing
    }

-- | Errors that can occur while assembling a 'Tx' with 'createCompatibleTx'.
data CompatibleTxError
  = -- | Plutus script witnesses are present, but 'compatibleTxProtocolParams'
    -- is 'Nothing', so the ledger's required script integrity hash cannot
    -- be computed.
    CompatibleTxMissingScriptIntegrityPParams
  deriving Int -> CompatibleTxError -> ShowS
[CompatibleTxError] -> ShowS
CompatibleTxError -> String
(Int -> CompatibleTxError -> ShowS)
-> (CompatibleTxError -> String)
-> ([CompatibleTxError] -> ShowS)
-> Show CompatibleTxError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompatibleTxError -> ShowS
showsPrec :: Int -> CompatibleTxError -> ShowS
$cshow :: CompatibleTxError -> String
show :: CompatibleTxError -> String
$cshowList :: [CompatibleTxError] -> ShowS
showList :: [CompatibleTxError] -> ShowS
Show

instance Error CompatibleTxError where
  prettyError :: forall ann. CompatibleTxError -> Doc ann
prettyError CompatibleTxError
err =
    case CompatibleTxError
err of
      CompatibleTxError
CompatibleTxMissingScriptIntegrityPParams ->
        Doc ann
"Plutus script witnesses are present but no protocol parameters were supplied "
          Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"to compute the script integrity hash."

-- | Create a transaction in any shelley based era
createCompatibleTx
  :: forall era
   . ShelleyBasedEra era
  -> CompatibleTxBodyContent era
  -> Either CompatibleTxError (Tx era)
createCompatibleTx :: forall era.
ShelleyBasedEra era
-> CompatibleTxBodyContent era -> Either CompatibleTxError (Tx era)
createCompatibleTx ShelleyBasedEra era
sbe CompatibleTxBodyContent era
bodyContent =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Either CompatibleTxError (Tx era))
-> Either CompatibleTxError (Tx era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Either CompatibleTxError (Tx era))
 -> Either CompatibleTxError (Tx era))
-> (ShelleyBasedEraConstraints era =>
    Either CompatibleTxError (Tx era))
-> Either CompatibleTxError (Tx era)
forall a b. (a -> b) -> a -> b
$ do
    integrityHashUpdate <- Maybe
  (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
-> [AnyWitness (ShelleyLedgerEra era)]
-> Either
     CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era)))
setScriptIntegrityHash Maybe
  (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
sData [AnyWitness (ShelleyLedgerEra era)]
allWitnesses

    let txbody =
          ShelleyBasedEra era
-> Set TxIn
-> [TxOut (ShelleyLedgerEra era)]
-> Lovelace
-> TxBody TopTx (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era
-> Set TxIn
-> [TxOut (ShelleyLedgerEra era)]
-> Lovelace
-> TxBody TopTx (ShelleyLedgerEra era)
createCommonTxBody ShelleyBasedEra era
sbe Set TxIn
ledgerTxIns [TxOut (ShelleyLedgerEra era)]
outs Lovelace
txFee'
            TxBody TopTx (ShelleyLedgerEra era)
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& [Endo (TxBody TopTx (ShelleyLedgerEra era))]
-> TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era)
forall {t}. [Endo t] -> t -> t
appEndos
              [ Endo (TxBody TopTx (ShelleyLedgerEra era))
setCerts
              , Endo (TxBody TopTx (ShelleyLedgerEra era))
setRefInputs
              , Endo (TxBody TopTx (ShelleyLedgerEra era))
updateTxBody
              , Endo (TxBody TopTx (ShelleyLedgerEra era))
setCollateralIns
              , Endo (TxBody TopTx (ShelleyLedgerEra era))
setValidityUpperBound
              , Maybe (TxAuxData (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
setMetadataHash Maybe (TxAuxData (ShelleyLedgerEra era))
txAuxData
              , Endo (TxBody TopTx (ShelleyLedgerEra era))
integrityHashUpdate
              ]

        updateVotingProcedures =
          case AnyVote era
anyVote of
            AnyVote era
NoVotes -> Tx TopTx (ShelleyLedgerEra era) -> Tx TopTx (ShelleyLedgerEra era)
forall a. a -> a
id
            VotingProcedures ConwayEraOnwards era
conwayOnwards (Exp.TxVotingProcedures VotingProcedures (ShelleyLedgerEra era)
procedures Map Voter (AnyWitness (ShelleyLedgerEra era))
_) ->
              ConwayEraOnwards era
-> VotingProcedures (ShelleyLedgerEra era)
-> Tx TopTx (ShelleyLedgerEra era)
-> Tx TopTx (ShelleyLedgerEra era)
overwriteVotingProcedures ConwayEraOnwards era
conwayOnwards VotingProcedures (ShelleyLedgerEra era)
procedures

    pure
      . ShelleyTx sbe
      $ L.mkBasicTx txbody
        & L.witsTxL
          %~ setScriptWitnesses sData allWitnesses
        & updateVotingProcedures
        & L.auxDataTxL
          .~ maybeToStrictMaybe txAuxData
 where
  era :: CardanoEra era
era = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
sbe
  appEndos :: [Endo t] -> t -> t
appEndos = Endo t -> t -> t
forall a. Endo a -> a -> a
appEndo (Endo t -> t -> t) -> ([Endo t] -> Endo t) -> [Endo t] -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Endo t] -> Endo t
forall a. Monoid a => [a] -> a
mconcat

  -- Local synonyms for bodyContent's fields, used throughout below.
  ins :: [(TxIn, AnyWitness (ShelleyLedgerEra era))]
ins = CompatibleTxBodyContent era
-> [(TxIn, AnyWitness (ShelleyLedgerEra era))]
forall era.
CompatibleTxBodyContent era
-> [(TxIn, AnyWitness (ShelleyLedgerEra era))]
compatibleTxIns CompatibleTxBodyContent era
bodyContent
  outs :: [TxOut (ShelleyLedgerEra era)]
outs = CompatibleTxBodyContent era -> [TxOut (ShelleyLedgerEra era)]
forall era.
CompatibleTxBodyContent era -> [TxOut (ShelleyLedgerEra era)]
compatibleTxOuts CompatibleTxBodyContent era
bodyContent
  extraDatums :: Map DataHash (Data (ShelleyLedgerEra era))
extraDatums = CompatibleTxBodyContent era
-> Map DataHash (Data (ShelleyLedgerEra era))
forall era.
CompatibleTxBodyContent era
-> Map DataHash (Data (ShelleyLedgerEra era))
compatibleTxSupplementalDatums CompatibleTxBodyContent era
bodyContent
  txFee' :: Lovelace
txFee' = CompatibleTxBodyContent era -> Lovelace
forall era. CompatibleTxBodyContent era -> Lovelace
compatibleTxFee CompatibleTxBodyContent era
bodyContent
  anyProtocolUpdate :: AnyProtocolUpdate era
anyProtocolUpdate = CompatibleTxBodyContent era -> AnyProtocolUpdate era
forall era. CompatibleTxBodyContent era -> AnyProtocolUpdate era
compatibleTxProtocolUpdate CompatibleTxBodyContent era
bodyContent
  anyVote :: AnyVote era
anyVote = CompatibleTxBodyContent era -> AnyVote era
forall era. CompatibleTxBodyContent era -> AnyVote era
compatibleTxVotingProcedures CompatibleTxBodyContent era
bodyContent
  txCertificates' :: TxCertificates (ShelleyLedgerEra era)
txCertificates' = CompatibleTxBodyContent era
-> TxCertificates (ShelleyLedgerEra era)
forall era.
CompatibleTxBodyContent era
-> TxCertificates (ShelleyLedgerEra era)
compatibleTxCertificates CompatibleTxBodyContent era
bodyContent

  -- Order must stay OMap insertion order; the shared Witnessable-based
  -- indexing (via 'extractWitnessableProposals') preserves it.
  proposalWitnesses
    :: [(Witnessable ProposalItem (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))]
  proposalWitnesses :: [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
proposalWitnesses =
    case AnyProtocolUpdate era
anyProtocolUpdate of
      ProtocolUpdate{} -> []
      NoPParamsUpdate{} -> []
      ProposalProcedures ConwayEraOnwards era
conwayOnwards TxProposalProcedures (ShelleyLedgerEra era)
proposalProcedures ->
        Era era
-> (EraCommonConstraints era =>
    [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))])
-> [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints (ConwayEraOnwards era -> Era era
forall era. ConwayEraOnwards era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
conwayOnwards) ((EraCommonConstraints era =>
  [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
    AnyWitness (ShelleyLedgerEra era))])
 -> [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))])
-> (EraCommonConstraints era =>
    [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))])
-> [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
forall a b. (a -> b) -> a -> b
$
          Maybe (TxProposalProcedures (LedgerEra era))
-> [(Witnessable 'ProposalItem (LedgerEra era),
     AnyWitness (LedgerEra era))]
forall era.
IsEra era =>
Maybe (TxProposalProcedures (LedgerEra era))
-> [(Witnessable 'ProposalItem (LedgerEra era),
     AnyWitness (LedgerEra era))]
Exp.extractWitnessableProposals (Maybe (TxProposalProcedures (LedgerEra era))
 -> [(Witnessable 'ProposalItem (LedgerEra era),
      AnyWitness (LedgerEra era))])
-> Maybe (TxProposalProcedures (LedgerEra era))
-> [(Witnessable 'ProposalItem (LedgerEra era),
     AnyWitness (LedgerEra era))]
forall a b. (a -> b) -> a -> b
$
            TxProposalProcedures (LedgerEra era)
-> Maybe (TxProposalProcedures (LedgerEra era))
forall a. a -> Maybe a
Just TxProposalProcedures (ShelleyLedgerEra era)
TxProposalProcedures (LedgerEra era)
proposalProcedures

  updateTxBody :: Endo (L.TxBody L.TopTx (ShelleyLedgerEra era))
  updateTxBody :: Endo (TxBody TopTx (ShelleyLedgerEra era))
updateTxBody =
    case AnyProtocolUpdate era
anyProtocolUpdate of
      ProtocolUpdate ShelleyToBabbageEra era
shelleyToBabbageEra UpdateProposal era
updateProposal ->
        let ledgerPParamsUpdate :: Update (ShelleyLedgerEra era)
ledgerPParamsUpdate = ShelleyBasedEra era
-> UpdateProposal era -> Update (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era
-> UpdateProposal era -> Update (ShelleyLedgerEra era)
toLedgerUpdate ShelleyBasedEra era
sbe UpdateProposal era
updateProposal
         in ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
shelleyToBabbageEra ((ShelleyToBabbageEraConstraints era =>
  Endo (TxBody TopTx (ShelleyLedgerEra era)))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (ShelleyToBabbageEraConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
              (TxBody TopTx (ShelleyLedgerEra era)
 -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxBody TopTx (ShelleyLedgerEra era)
  -> TxBody TopTx (ShelleyLedgerEra era))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ \TxBody TopTx (ShelleyLedgerEra era)
txb ->
                TxBody TopTx (ShelleyLedgerEra era)
txb TxBody TopTx (ShelleyLedgerEra era)
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Update (ShelleyLedgerEra era))
 -> Identity (StrictMaybe (Update (ShelleyLedgerEra era))))
-> TxBody TopTx (ShelleyLedgerEra era)
-> Identity (TxBody TopTx (ShelleyLedgerEra era))
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe (Update era))
Lens'
  (TxBody TopTx (ShelleyLedgerEra era))
  (StrictMaybe (Update (ShelleyLedgerEra era)))
L.updateTxBodyL ((StrictMaybe (Update (ShelleyLedgerEra era))
  -> Identity (StrictMaybe (Update (ShelleyLedgerEra era))))
 -> TxBody TopTx (ShelleyLedgerEra era)
 -> Identity (TxBody TopTx (ShelleyLedgerEra era)))
-> StrictMaybe (Update (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Update (ShelleyLedgerEra era)
-> StrictMaybe (Update (ShelleyLedgerEra era))
forall a. a -> StrictMaybe a
SJust Update (ShelleyLedgerEra era)
ledgerPParamsUpdate
      NoPParamsUpdate ShelleyBasedEra era
_ -> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a. Monoid a => a
mempty
      ProposalProcedures ConwayEraOnwards era
conwayOnwards TxProposalProcedures (ShelleyLedgerEra era)
proposalProcedures ->
        ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Endo (TxBody TopTx (ShelleyLedgerEra era)))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
          let Exp.TxProposalProcedures OMap
  (ProposalProcedure (ShelleyLedgerEra era))
  (AnyWitness (ShelleyLedgerEra era))
propMap = TxProposalProcedures (ShelleyLedgerEra era)
proposalProcedures
              proposals :: OSet (L.ProposalProcedure (ShelleyLedgerEra era))
              proposals :: OSet (ProposalProcedure (ShelleyLedgerEra era))
proposals = [Item (OSet (ProposalProcedure (ShelleyLedgerEra era)))]
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
forall l. IsList l => [Item l] -> l
fromList ([Item (OSet (ProposalProcedure (ShelleyLedgerEra era)))]
 -> OSet (ProposalProcedure (ShelleyLedgerEra era)))
-> [Item (OSet (ProposalProcedure (ShelleyLedgerEra era)))]
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ (ProposalProcedure (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> Item (OSet (ProposalProcedure (ShelleyLedgerEra era)))
(ProposalProcedure (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> ProposalProcedure (ShelleyLedgerEra era)
forall a b. (a, b) -> a
fst ((ProposalProcedure (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))
 -> Item (OSet (ProposalProcedure (ShelleyLedgerEra era))))
-> [(ProposalProcedure (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [Item (OSet (ProposalProcedure (ShelleyLedgerEra era)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OMap
  (ProposalProcedure (ShelleyLedgerEra era))
  (AnyWitness (ShelleyLedgerEra era))
-> [Item
      (OMap
         (ProposalProcedure (ShelleyLedgerEra era))
         (AnyWitness (ShelleyLedgerEra era)))]
forall l. IsList l => l -> [Item l]
toList OMap
  (ProposalProcedure (ShelleyLedgerEra era))
  (AnyWitness (ShelleyLedgerEra era))
propMap
              -- append proposal reference inputs & set proposal procedures
              referenceInputs :: [TxIn]
referenceInputs =
                [ TxIn -> TxIn
toShelleyTxIn TxIn
txIn
                | (Witnessable 'ProposalItem (ShelleyLedgerEra era)
_, AnyWitness (ShelleyLedgerEra era)
wit) <- [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
proposalWitnesses
                , TxIn
txIn <- Maybe TxIn -> [TxIn]
forall a. Maybe a -> [a]
maybeToList (Maybe TxIn -> [TxIn]) -> Maybe TxIn -> [TxIn]
forall a b. (a -> b) -> a -> b
$ AnyWitness (ShelleyLedgerEra era) -> Maybe TxIn
forall era. AnyWitness era -> Maybe TxIn
getAnyWitnessReferenceInput AnyWitness (ShelleyLedgerEra era)
wit
                ]
           in Era era
-> (EraCommonConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (ConwayEraOnwards era -> Era era
forall era. ConwayEraOnwards era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
conwayOnwards) ((EraCommonConstraints era =>
  Endo (TxBody TopTx (ShelleyLedgerEra era)))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (EraCommonConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
                (TxBody TopTx (ShelleyLedgerEra era)
 -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxBody TopTx (ShelleyLedgerEra era)
  -> TxBody TopTx (ShelleyLedgerEra era))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
                  ((Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx (LedgerEra era)
-> Identity (TxBody TopTx (LedgerEra era))
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l (LedgerEra era)) (Set TxIn)
L.referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx (LedgerEra era)
 -> Identity (TxBody TopTx (LedgerEra era)))
-> (Set TxIn -> Set TxIn)
-> TxBody TopTx (LedgerEra era)
-> TxBody TopTx (LedgerEra era)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Set TxIn -> Set TxIn -> Set TxIn
forall a. Semigroup a => a -> a -> a
<> [Item (Set TxIn)] -> Set TxIn
forall l. IsList l => [Item l] -> l
fromList [Item (Set TxIn)]
[TxIn]
referenceInputs))
                    (TxBody TopTx (LedgerEra era)
 -> TxBody TopTx (ShelleyLedgerEra era))
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (LedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((OSet (ProposalProcedure (LedgerEra era))
 -> Identity (OSet (ProposalProcedure (LedgerEra era))))
-> TxBody TopTx (LedgerEra era)
-> Identity (TxBody TopTx (LedgerEra era))
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (OSet (ProposalProcedure era))
forall (l :: TxLevel).
Lens'
  (TxBody l (LedgerEra era))
  (OSet (ProposalProcedure (LedgerEra era)))
L.proposalProceduresTxBodyL ((OSet (ProposalProcedure (LedgerEra era))
  -> Identity (OSet (ProposalProcedure (LedgerEra era))))
 -> TxBody TopTx (LedgerEra era)
 -> Identity (TxBody TopTx (LedgerEra era)))
-> OSet (ProposalProcedure (LedgerEra era))
-> TxBody TopTx (LedgerEra era)
-> TxBody TopTx (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ OSet (ProposalProcedure (ShelleyLedgerEra era))
OSet (ProposalProcedure (LedgerEra era))
proposals)

  -- Flat witnesses from all four script-witnessable categories
  -- (certificates, proposals, votes, inputs), for
  -- 'setScriptIntegrityHash' and 'setScriptWitnesses' to collect
  -- datums, scripts and plutus languages from. Only the redeemer
  -- pointer map (built inside 'convScriptData'') needs per-category
  -- indexing.
  allWitnesses :: [AnyWitness (ShelleyLedgerEra era)]
  allWitnesses :: [AnyWitness (ShelleyLedgerEra era)]
allWitnesses =
    [AnyWitness (ShelleyLedgerEra era)]
witnessedCertWitnesses
      [AnyWitness (ShelleyLedgerEra era)]
-> [AnyWitness (ShelleyLedgerEra era)]
-> [AnyWitness (ShelleyLedgerEra era)]
forall a. Semigroup a => a -> a -> a
<> ((Witnessable 'ProposalItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))
 -> AnyWitness (ShelleyLedgerEra era))
-> [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [AnyWitness (ShelleyLedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Witnessable 'ProposalItem (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> AnyWitness (ShelleyLedgerEra era)
forall a b. (a, b) -> b
snd [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
proposalWitnesses
      [AnyWitness (ShelleyLedgerEra era)]
-> [AnyWitness (ShelleyLedgerEra era)]
-> [AnyWitness (ShelleyLedgerEra era)]
forall a. Semigroup a => a -> a -> a
<> ((Witnessable 'VoterItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))
 -> AnyWitness (ShelleyLedgerEra era))
-> [(Witnessable 'VoterItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [AnyWitness (ShelleyLedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Witnessable 'VoterItem (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> AnyWitness (ShelleyLedgerEra era)
forall a b. (a, b) -> b
snd [(Witnessable 'VoterItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
voteWitnesses
      [AnyWitness (ShelleyLedgerEra era)]
-> [AnyWitness (ShelleyLedgerEra era)]
-> [AnyWitness (ShelleyLedgerEra era)]
forall a. Semigroup a => a -> a -> a
<> ((TxIn, AnyWitness (ShelleyLedgerEra era))
 -> AnyWitness (ShelleyLedgerEra era))
-> [(TxIn, AnyWitness (ShelleyLedgerEra era))]
-> [AnyWitness (ShelleyLedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, AnyWitness (ShelleyLedgerEra era))
-> AnyWitness (ShelleyLedgerEra era)
forall a b. (a, b) -> b
snd [(TxIn, AnyWitness (ShelleyLedgerEra era))]
ins

  sData :: Maybe (L.TxDats (ShelleyLedgerEra era), L.Redeemers (ShelleyLedgerEra era))
  sData :: Maybe
  (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
sData = ShelleyBasedEra era
-> [(TxIn, AnyWitness (ShelleyLedgerEra era))]
-> TxCertificates (ShelleyLedgerEra era)
-> [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [(Witnessable 'VoterItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [AnyWitness (ShelleyLedgerEra era)]
-> Map DataHash (Data (ShelleyLedgerEra era))
-> Maybe
     (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
forall era.
ShelleyBasedEra era
-> [(TxIn, AnyWitness (ShelleyLedgerEra era))]
-> TxCertificates (ShelleyLedgerEra era)
-> [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [(Witnessable 'VoterItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [AnyWitness (ShelleyLedgerEra era)]
-> Map DataHash (Data (ShelleyLedgerEra era))
-> Maybe
     (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
convScriptData' ShelleyBasedEra era
sbe [(TxIn, AnyWitness (ShelleyLedgerEra era))]
ins TxCertificates (ShelleyLedgerEra era)
txCertificates' [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
proposalWitnesses [(Witnessable 'VoterItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
voteWitnesses [AnyWitness (ShelleyLedgerEra era)]
allWitnesses Map DataHash (Data (ShelleyLedgerEra era))
extraDatums

  txAuxData :: Maybe (L.TxAuxData (ShelleyLedgerEra era))
  txAuxData :: Maybe (TxAuxData (ShelleyLedgerEra era))
txAuxData = ShelleyBasedEra era
-> TxMetadataInEra era
-> TxAuxScripts era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
forall era.
ShelleyBasedEra era
-> TxMetadataInEra era
-> TxAuxScripts era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
toAuxiliaryData ShelleyBasedEra era
sbe (CompatibleTxBodyContent era -> TxMetadataInEra era
forall era. CompatibleTxBodyContent era -> TxMetadataInEra era
compatibleTxMetadata CompatibleTxBodyContent era
bodyContent) TxAuxScripts era
forall era. TxAuxScripts era
TxAuxScriptsNone

  -- The final set of ledger inputs, in ascending 'Ord' order ('Data.Set').
  -- This is the order the ledger serialises tx inputs in, and the order
  -- it resolves 'Spending' redeemer pointers against.
  --
  -- Spending redeemer pointers are indexed against this same order:
  -- 'witnessableTxIns' nubs duplicate (TxIn, witness) pairs, and the
  -- shared Witnessable indexing machinery sorts 'WitTxIn' entries by
  -- 'TxIn' ('compareWitnesses') to match this 'Set' order. Never index
  -- against the order 'ins' was supplied in.
  ledgerTxIns :: Set L.TxIn
  ledgerTxIns :: Set TxIn
ledgerTxIns = [Item (Set TxIn)] -> Set TxIn
forall l. IsList l => [Item l] -> l
fromList ([Item (Set TxIn)] -> Set TxIn) -> [Item (Set TxIn)] -> Set TxIn
forall a b. (a -> b) -> a -> b
$ ((TxIn, AnyWitness (ShelleyLedgerEra era)) -> Item (Set TxIn))
-> [(TxIn, AnyWitness (ShelleyLedgerEra era))] -> [Item (Set TxIn)]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn -> TxIn
toShelleyTxIn (TxIn -> TxIn)
-> ((TxIn, AnyWitness (ShelleyLedgerEra era)) -> TxIn)
-> (TxIn, AnyWitness (ShelleyLedgerEra era))
-> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, AnyWitness (ShelleyLedgerEra era)) -> TxIn
forall a b. (a, b) -> a
fst) [(TxIn, AnyWitness (ShelleyLedgerEra era))]
ins

  -- The witness of every witnessed certificate in 'txCertificates''.
  -- Unwitnessed certs contribute nothing here: no reference input, datum,
  -- script or language. They only matter for redeemer indexing, which
  -- 'convScriptData'' handles separately with a placeholder witness.
  witnessedCertWitnesses :: [AnyWitness (ShelleyLedgerEra era)]
  witnessedCertWitnesses :: [AnyWitness (ShelleyLedgerEra era)]
witnessedCertWitnesses =
    [AnyWitness (ShelleyLedgerEra era)
wit | (Certificate (ShelleyLedgerEra era)
_, Just AnyWitness (ShelleyLedgerEra era)
wit) <- OMap
  (Certificate (ShelleyLedgerEra era))
  (Maybe (AnyWitness (ShelleyLedgerEra era)))
-> [Item
      (OMap
         (Certificate (ShelleyLedgerEra era))
         (Maybe (AnyWitness (ShelleyLedgerEra era))))]
forall l. IsList l => l -> [Item l]
toList OMap
  (Certificate (ShelleyLedgerEra era))
  (Maybe (AnyWitness (ShelleyLedgerEra era)))
certsWits]
   where
    Exp.TxCertificates OMap
  (Certificate (ShelleyLedgerEra era))
  (Maybe (AnyWitness (ShelleyLedgerEra era)))
certsWits = TxCertificates (ShelleyLedgerEra era)
txCertificates'

  -- The witness of every vote in 'anyVote', witnessed or not (unwitnessed
  -- votes get 'AnyKeyWitnessPlaceholder'). Mirrors 'proposalWitnesses'.
  voteWitnesses
    :: [(Witnessable VoterItem (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))]
  voteWitnesses :: [(Witnessable 'VoterItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
voteWitnesses =
    case AnyVote era
anyVote of
      AnyVote era
NoVotes -> []
      VotingProcedures ConwayEraOnwards era
conwayOnwards TxVotingProcedures (ShelleyLedgerEra era)
votingProcedures ->
        Era era
-> (EraCommonConstraints era =>
    [(Witnessable 'VoterItem (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))])
-> [(Witnessable 'VoterItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints (ConwayEraOnwards era -> Era era
forall era. ConwayEraOnwards era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
conwayOnwards) ((EraCommonConstraints era =>
  [(Witnessable 'VoterItem (ShelleyLedgerEra era),
    AnyWitness (ShelleyLedgerEra era))])
 -> [(Witnessable 'VoterItem (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))])
-> (EraCommonConstraints era =>
    [(Witnessable 'VoterItem (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))])
-> [(Witnessable 'VoterItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
forall a b. (a -> b) -> a -> b
$
          Maybe (TxVotingProcedures (LedgerEra era))
-> [(Witnessable 'VoterItem (LedgerEra era),
     AnyWitness (LedgerEra era))]
forall era.
IsEra era =>
Maybe (TxVotingProcedures (LedgerEra era))
-> [(Witnessable 'VoterItem (LedgerEra era),
     AnyWitness (LedgerEra era))]
Exp.extractWitnessableVotes (Maybe (TxVotingProcedures (LedgerEra era))
 -> [(Witnessable 'VoterItem (LedgerEra era),
      AnyWitness (LedgerEra era))])
-> Maybe (TxVotingProcedures (LedgerEra era))
-> [(Witnessable 'VoterItem (LedgerEra era),
     AnyWitness (LedgerEra era))]
forall a b. (a -> b) -> a -> b
$
            TxVotingProcedures (LedgerEra era)
-> Maybe (TxVotingProcedures (LedgerEra era))
forall a. a -> Maybe a
Just TxVotingProcedures (ShelleyLedgerEra era)
TxVotingProcedures (LedgerEra era)
votingProcedures

  setCerts :: Endo (L.TxBody L.TopTx (ShelleyLedgerEra era))
  setCerts :: Endo (TxBody TopTx (ShelleyLedgerEra era))
setCerts =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Endo (TxBody TopTx (ShelleyLedgerEra era)))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
      (TxBody TopTx (ShelleyLedgerEra era)
 -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxBody TopTx (ShelleyLedgerEra era)
  -> TxBody TopTx (ShelleyLedgerEra era))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
        (StrictSeq (TxCert (ShelleyLedgerEra era))
 -> Identity (StrictSeq (TxCert (ShelleyLedgerEra era))))
-> TxBody TopTx (ShelleyLedgerEra era)
-> Identity (TxBody TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens'
  (TxBody l (ShelleyLedgerEra era))
  (StrictSeq (TxCert (ShelleyLedgerEra era)))
L.certsTxBodyL ((StrictSeq (TxCert (ShelleyLedgerEra era))
  -> Identity (StrictSeq (TxCert (ShelleyLedgerEra era))))
 -> TxBody TopTx (ShelleyLedgerEra era)
 -> Identity (TxBody TopTx (ShelleyLedgerEra era)))
-> StrictSeq (TxCert (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxCertificates (ShelleyLedgerEra era)
-> StrictSeq (TxCert (ShelleyLedgerEra era))
forall era.
TxCertificates (ShelleyLedgerEra era)
-> StrictSeq (TxCert (ShelleyLedgerEra era))
convCertificates TxCertificates (ShelleyLedgerEra era)
txCertificates'

  -- Uses '%~ (<>)', not '.~', so it does not clobber reference inputs
  -- already appended by 'updateTxBody' (the 'ProposalProcedures' case
  -- above). Reference inputs collected here come from witnessed
  -- certificates, witnessed votes and witnessed spending inputs.
  setRefInputs :: Endo (L.TxBody L.TopTx (ShelleyLedgerEra era))
  setRefInputs :: Endo (TxBody TopTx (ShelleyLedgerEra era))
setRefInputs = do
    let refInputs :: [TxIn]
refInputs =
          [ TxIn -> TxIn
toShelleyTxIn TxIn
refInput
          | AnyWitness (ShelleyLedgerEra era)
wit <- [AnyWitness (ShelleyLedgerEra era)]
witnessedCertWitnesses [AnyWitness (ShelleyLedgerEra era)]
-> [AnyWitness (ShelleyLedgerEra era)]
-> [AnyWitness (ShelleyLedgerEra era)]
forall a. Semigroup a => a -> a -> a
<> ((Witnessable 'VoterItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))
 -> AnyWitness (ShelleyLedgerEra era))
-> [(Witnessable 'VoterItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [AnyWitness (ShelleyLedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (Witnessable 'VoterItem (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> AnyWitness (ShelleyLedgerEra era)
forall a b. (a, b) -> b
snd [(Witnessable 'VoterItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
voteWitnesses [AnyWitness (ShelleyLedgerEra era)]
-> [AnyWitness (ShelleyLedgerEra era)]
-> [AnyWitness (ShelleyLedgerEra era)]
forall a. Semigroup a => a -> a -> a
<> ((TxIn, AnyWitness (ShelleyLedgerEra era))
 -> AnyWitness (ShelleyLedgerEra era))
-> [(TxIn, AnyWitness (ShelleyLedgerEra era))]
-> [AnyWitness (ShelleyLedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, AnyWitness (ShelleyLedgerEra era))
-> AnyWitness (ShelleyLedgerEra era)
forall a b. (a, b) -> b
snd [(TxIn, AnyWitness (ShelleyLedgerEra era))]
ins
          , TxIn
refInput <- Maybe TxIn -> [TxIn]
forall a. Maybe a -> [a]
maybeToList (Maybe TxIn -> [TxIn]) -> Maybe TxIn -> [TxIn]
forall a b. (a -> b) -> a -> b
$ AnyWitness (ShelleyLedgerEra era) -> Maybe TxIn
forall era. AnyWitness era -> Maybe TxIn
getAnyWitnessReferenceInput AnyWitness (ShelleyLedgerEra era)
wit
          ]

    CardanoEra era
-> (BabbageEraOnwards era
    -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall (eon :: * -> *) a era.
(Eon eon, Monoid a) =>
CardanoEra era -> (eon era -> a) -> a
monoidForEraInEon CardanoEra era
era ((BabbageEraOnwards era
  -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (BabbageEraOnwards era
    -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ \BabbageEraOnwards era
beo ->
      BabbageEraOnwards era
-> (BabbageEraOnwardsConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall era a.
BabbageEraOnwards era
-> (BabbageEraOnwardsConstraints era => a) -> a
babbageEraOnwardsConstraints BabbageEraOnwards era
beo ((BabbageEraOnwardsConstraints era =>
  Endo (TxBody TopTx (ShelleyLedgerEra era)))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (BabbageEraOnwardsConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
        (TxBody TopTx (ShelleyLedgerEra era)
 -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxBody TopTx (ShelleyLedgerEra era)
  -> TxBody TopTx (ShelleyLedgerEra era))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
          (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx (ShelleyLedgerEra era)
-> Identity (TxBody TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel).
Lens' (TxBody l (ShelleyLedgerEra era)) (Set TxIn)
L.referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx (ShelleyLedgerEra era)
 -> Identity (TxBody TopTx (ShelleyLedgerEra era)))
-> (Set TxIn -> Set TxIn)
-> TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Set TxIn -> Set TxIn -> Set TxIn
forall a. Semigroup a => a -> a -> a
<> [Item (Set TxIn)] -> Set TxIn
forall l. IsList l => [Item l] -> l
fromList [Item (Set TxIn)]
[TxIn]
refInputs)

  -- Alonzo onwards only; a no-op below that. The list is expected to be
  -- empty pre-Alonzo anyway, since collateral only matters for plutus
  -- spending.
  setCollateralIns :: Endo (L.TxBody L.TopTx (ShelleyLedgerEra era))
  setCollateralIns :: Endo (TxBody TopTx (ShelleyLedgerEra era))
setCollateralIns =
    CardanoEra era
-> (AlonzoEraOnwards era
    -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall (eon :: * -> *) a era.
(Eon eon, Monoid a) =>
CardanoEra era -> (eon era -> a) -> a
monoidForEraInEon CardanoEra era
era ((AlonzoEraOnwards era
  -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (AlonzoEraOnwards era
    -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ \AlonzoEraOnwards era
aeo ->
      AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeo ((AlonzoEraOnwardsConstraints era =>
  Endo (TxBody TopTx (ShelleyLedgerEra era)))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (AlonzoEraOnwardsConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
        (TxBody TopTx (ShelleyLedgerEra era)
 -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxBody TopTx (ShelleyLedgerEra era)
  -> TxBody TopTx (ShelleyLedgerEra era))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
          (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx (ShelleyLedgerEra era)
-> Identity (TxBody TopTx (ShelleyLedgerEra era))
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody TopTx era) (Set TxIn)
Lens' (TxBody TopTx (ShelleyLedgerEra era)) (Set TxIn)
L.collateralInputsTxBodyL
            ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx (ShelleyLedgerEra era)
 -> Identity (TxBody TopTx (ShelleyLedgerEra era)))
-> Set TxIn
-> TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ([Item (Set TxIn)] -> Set TxIn
[TxIn] -> Set TxIn
forall l. IsList l => [Item l] -> l
fromList ([TxIn] -> Set TxIn) -> ([TxIn] -> [TxIn]) -> [TxIn] -> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> TxIn) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> TxIn
toShelleyTxIn ([TxIn] -> Set TxIn) -> [TxIn] -> Set TxIn
forall a b. (a -> b) -> a -> b
$ CompatibleTxBodyContent era -> [TxIn]
forall era. CompatibleTxBodyContent era -> [TxIn]
compatibleTxInsCollateral CompatibleTxBodyContent era
bodyContent)

  -- Compatibility lens over 'ttlTxBodyL' (Shelley) and 'vldtTxBodyL'
  -- (Allegra onwards), preserving the validity interval's lower bound.
  setValidityUpperBound :: Endo (L.TxBody L.TopTx (ShelleyLedgerEra era))
  setValidityUpperBound :: Endo (TxBody TopTx (ShelleyLedgerEra era))
setValidityUpperBound =
    (TxBody TopTx (ShelleyLedgerEra era)
 -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxBody TopTx (ShelleyLedgerEra era)
  -> TxBody TopTx (ShelleyLedgerEra era))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ \TxBody TopTx (ShelleyLedgerEra era)
txb ->
      LedgerTxBody era -> TxBody TopTx (ShelleyLedgerEra era)
forall era. LedgerTxBody era -> TxBody TopTx (ShelleyLedgerEra era)
A.unTxBody (LedgerTxBody era -> TxBody TopTx (ShelleyLedgerEra era))
-> LedgerTxBody era -> TxBody TopTx (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
        TxBody TopTx (ShelleyLedgerEra era) -> LedgerTxBody era
forall era. TxBody TopTx (ShelleyLedgerEra era) -> LedgerTxBody era
A.LedgerTxBody TxBody TopTx (ShelleyLedgerEra era)
txb
          LedgerTxBody era
-> (LedgerTxBody era -> LedgerTxBody era) -> LedgerTxBody era
forall a b. a -> (a -> b) -> b
& ShelleyBasedEra era -> Lens' (LedgerTxBody era) (Maybe SlotNo)
forall era.
ShelleyBasedEra era -> Lens' (LedgerTxBody era) (Maybe SlotNo)
A.invalidHereAfterTxBodyL ShelleyBasedEra era
sbe
            ((Maybe SlotNo -> Identity (Maybe SlotNo))
 -> LedgerTxBody era -> Identity (LedgerTxBody era))
-> Maybe SlotNo -> LedgerTxBody era -> LedgerTxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CompatibleTxBodyContent era -> Maybe SlotNo
forall era. CompatibleTxBodyContent era -> Maybe SlotNo
compatibleTxValidityUpperBound CompatibleTxBodyContent era
bodyContent

  -- Only the body-side auxiliary data hash; the auxiliary data itself is
  -- set on the 'L.Tx' via 'L.auxDataTxL' in the main function body.
  setMetadataHash
    :: Maybe (L.TxAuxData (ShelleyLedgerEra era))
    -> Endo (L.TxBody L.TopTx (ShelleyLedgerEra era))
  setMetadataHash :: Maybe (TxAuxData (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
setMetadataHash Maybe (TxAuxData (ShelleyLedgerEra era))
auxData =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Endo (TxBody TopTx (ShelleyLedgerEra era)))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
    Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
      (TxBody TopTx (ShelleyLedgerEra era)
 -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxBody TopTx (ShelleyLedgerEra era)
  -> TxBody TopTx (ShelleyLedgerEra era))
 -> Endo (TxBody TopTx (ShelleyLedgerEra era)))
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
        (StrictMaybe TxAuxDataHash -> Identity (StrictMaybe TxAuxDataHash))
-> TxBody TopTx (ShelleyLedgerEra era)
-> Identity (TxBody TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictMaybe TxAuxDataHash)
forall (l :: TxLevel).
Lens' (TxBody l (ShelleyLedgerEra era)) (StrictMaybe TxAuxDataHash)
L.auxDataHashTxBodyL
          ((StrictMaybe TxAuxDataHash
  -> Identity (StrictMaybe TxAuxDataHash))
 -> TxBody TopTx (ShelleyLedgerEra era)
 -> Identity (TxBody TopTx (ShelleyLedgerEra era)))
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe TxAuxDataHash
-> (TxAuxData (ShelleyLedgerEra era) -> StrictMaybe TxAuxDataHash)
-> Maybe (TxAuxData (ShelleyLedgerEra era))
-> StrictMaybe TxAuxDataHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing (TxAuxDataHash -> StrictMaybe TxAuxDataHash
forall a. a -> StrictMaybe a
SJust (TxAuxDataHash -> StrictMaybe TxAuxDataHash)
-> (TxAuxData (ShelleyLedgerEra era) -> TxAuxDataHash)
-> TxAuxData (ShelleyLedgerEra era)
-> StrictMaybe TxAuxDataHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxAuxData (ShelleyLedgerEra era) -> TxAuxDataHash
forall era. EraTxAuxData era => TxAuxData era -> TxAuxDataHash
L.hashTxAuxData) Maybe (TxAuxData (ShelleyLedgerEra era))
auxData

  -- The hash is only computed when there is something for it to cover.
  -- Protocol parameters are only needed for language views, so a
  -- datums-only tx hashes without them.
  --
  -- Follows ledger's own script integrity hash computation; ledger has
  -- no reusable function for this (see
  -- 'Cardano.Api.Tx.Internal.Body.convPParamsToScriptIntegrityHash' for
  -- the legacy API's equivalent).
  setScriptIntegrityHash
    :: Maybe (L.TxDats (ShelleyLedgerEra era), L.Redeemers (ShelleyLedgerEra era))
    -> [AnyWitness (ShelleyLedgerEra era)]
    -> Either CompatibleTxError (Endo (L.TxBody L.TopTx (ShelleyLedgerEra era)))
  setScriptIntegrityHash :: Maybe
  (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
-> [AnyWitness (ShelleyLedgerEra era)]
-> Either
     CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era)))
setScriptIntegrityHash Maybe
  (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
scriptData [AnyWitness (ShelleyLedgerEra era)]
witnesses =
    CardanoEra era
-> (AlonzoEraOnwards era
    -> Either
         CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era))))
-> Either
     CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era)))
forall (eon :: * -> *) (f :: * -> *) a era.
(Eon eon, Applicative f, Monoid a) =>
CardanoEra era -> (eon era -> f a) -> f a
monoidForEraInEonA CardanoEra era
era ((AlonzoEraOnwards era
  -> Either
       CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era))))
 -> Either
      CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era))))
-> (AlonzoEraOnwards era
    -> Either
         CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era))))
-> Either
     CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$ \AlonzoEraOnwards era
aeo ->
      AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    Either
      CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era))))
-> Either
     CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era)))
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeo ((AlonzoEraOnwardsConstraints era =>
  Either
    CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era))))
 -> Either
      CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era))))
-> (AlonzoEraOnwardsConstraints era =>
    Either
      CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era))))
-> Either
     CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$ do
        let
          (TxDats (ShelleyLedgerEra era)
datums, Redeemers (ShelleyLedgerEra era)
redeemers) = (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
-> Maybe
     (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
-> (TxDats (ShelleyLedgerEra era),
    Redeemers (ShelleyLedgerEra era))
forall a. a -> Maybe a -> a
fromMaybe (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
forall a. Monoid a => a
mempty Maybe
  (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
scriptData

          languages :: Set L.Language
          languages :: Set Language
languages = [Item (Set Language)] -> Set Language
forall l. IsList l => [Item l] -> l
fromList ([Item (Set Language)] -> Set Language)
-> [Item (Set Language)] -> Set Language
forall a b. (a -> b) -> a -> b
$ (AnyWitness (ShelleyLedgerEra era) -> Maybe (Item (Set Language)))
-> [AnyWitness (ShelleyLedgerEra era)] -> [Item (Set Language)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnyWitness (ShelleyLedgerEra era) -> Maybe (Item (Set Language))
AnyWitness (ShelleyLedgerEra era) -> Maybe Language
forall era. AnyWitness era -> Maybe Language
getAnyWitnessPlutusLanguage [AnyWitness (ShelleyLedgerEra era)]
witnesses

          shouldCalculateHash :: Bool
shouldCalculateHash =
            Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
              Map
  (PlutusPurpose AsIx (ShelleyLedgerEra era))
  (Data (ShelleyLedgerEra era), ExUnits)
-> Bool
forall a. Map (PlutusPurpose AsIx (ShelleyLedgerEra era)) a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Redeemers (ShelleyLedgerEra era)
redeemers Redeemers (ShelleyLedgerEra era)
-> Getting
     (Map
        (PlutusPurpose AsIx (ShelleyLedgerEra era))
        (Data (ShelleyLedgerEra era), ExUnits))
     (Redeemers (ShelleyLedgerEra era))
     (Map
        (PlutusPurpose AsIx (ShelleyLedgerEra era))
        (Data (ShelleyLedgerEra era), ExUnits))
-> Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Data (ShelleyLedgerEra era), ExUnits)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Data (ShelleyLedgerEra era), ExUnits))
  (Redeemers (ShelleyLedgerEra era))
  (Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Data (ShelleyLedgerEra era), ExUnits))
forall era.
AlonzoEraScript era =>
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
Lens'
  (Redeemers (ShelleyLedgerEra era))
  (Map
     (PlutusPurpose AsIx (ShelleyLedgerEra era))
     (Data (ShelleyLedgerEra era), ExUnits))
L.unRedeemersL)
                Bool -> Bool -> Bool
&& Map DataHash (Data (ShelleyLedgerEra era)) -> Bool
forall a. Map DataHash a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TxDats (ShelleyLedgerEra era)
datums TxDats (ShelleyLedgerEra era)
-> Getting
     (Map DataHash (Data (ShelleyLedgerEra era)))
     (TxDats (ShelleyLedgerEra era))
     (Map DataHash (Data (ShelleyLedgerEra era)))
-> Map DataHash (Data (ShelleyLedgerEra era))
forall s a. s -> Getting a s a -> a
^. Getting
  (Map DataHash (Data (ShelleyLedgerEra era)))
  (TxDats (ShelleyLedgerEra era))
  (Map DataHash (Data (ShelleyLedgerEra era)))
forall era. Era era => Lens' (TxDats era) (Map DataHash (Data era))
Lens'
  (TxDats (ShelleyLedgerEra era))
  (Map DataHash (Data (ShelleyLedgerEra era)))
L.unTxDatsL)
                Bool -> Bool -> Bool
&& Set Language -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Language
languages

        if Bool -> Bool
not Bool
shouldCalculateHash
          then Endo (TxBody TopTx (ShelleyLedgerEra era))
-> Either
     CompatibleTxError (Endo (TxBody TopTx (ShelleyLedgerEra era)))
forall a. a -> Either CompatibleTxError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Endo (TxBody TopTx (ShelleyLedgerEra era))
forall a. Monoid a => a
mempty
          else do
            langViews <-
              if Set Language -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Language
languages
                then Set LangDepView -> Either CompatibleTxError (Set LangDepView)
forall a. a -> Either CompatibleTxError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set LangDepView
forall a. Set a
Set.empty
                else do
                  protocolParams <-
                    CompatibleTxBodyContent era
-> Maybe (PParams (ShelleyLedgerEra era))
forall era.
CompatibleTxBodyContent era
-> Maybe (PParams (ShelleyLedgerEra era))
compatibleTxProtocolParams CompatibleTxBodyContent era
bodyContent
                      Maybe (PParams (ShelleyLedgerEra era))
-> CompatibleTxError
-> Either CompatibleTxError (PParams (ShelleyLedgerEra era))
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! CompatibleTxError
CompatibleTxMissingScriptIntegrityPParams
                  pure $ Set.map (L.getLanguageView protocolParams) languages
            pure $
              Endo $
                L.scriptIntegrityHashTxBodyL
                  .~ SJust
                    ( L.hashScriptIntegrity $
                        L.ScriptIntegrity
                          redeemers
                          datums
                          langViews
                    )

  overwriteVotingProcedures
    :: ConwayEraOnwards era
    -> L.VotingProcedures (ShelleyLedgerEra era)
    -> L.Tx L.TopTx (ShelleyLedgerEra era)
    -> L.Tx L.TopTx (ShelleyLedgerEra era)
  overwriteVotingProcedures :: ConwayEraOnwards era
-> VotingProcedures (ShelleyLedgerEra era)
-> Tx TopTx (ShelleyLedgerEra era)
-> Tx TopTx (ShelleyLedgerEra era)
overwriteVotingProcedures ConwayEraOnwards era
conwayOnwards VotingProcedures (ShelleyLedgerEra era)
votingProcedures =
    Era era
-> (EraCommonConstraints era =>
    Tx TopTx (ShelleyLedgerEra era) -> Tx TopTx (ShelleyLedgerEra era))
-> Tx TopTx (ShelleyLedgerEra era)
-> Tx TopTx (ShelleyLedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (ConwayEraOnwards era -> Era era
forall era. ConwayEraOnwards era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
conwayOnwards) ((EraCommonConstraints era =>
  Tx TopTx (ShelleyLedgerEra era) -> Tx TopTx (ShelleyLedgerEra era))
 -> Tx TopTx (ShelleyLedgerEra era)
 -> Tx TopTx (ShelleyLedgerEra era))
-> (EraCommonConstraints era =>
    Tx TopTx (ShelleyLedgerEra era) -> Tx TopTx (ShelleyLedgerEra era))
-> Tx TopTx (ShelleyLedgerEra era)
-> Tx TopTx (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
      ((TxBody TopTx (LedgerEra era)
 -> Identity (TxBody TopTx (LedgerEra era)))
-> Tx TopTx (LedgerEra era) -> Identity (Tx TopTx (LedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l (LedgerEra era)) (TxBody l (LedgerEra era))
L.bodyTxL ((TxBody TopTx (LedgerEra era)
  -> Identity (TxBody TopTx (LedgerEra era)))
 -> Tx TopTx (LedgerEra era) -> Identity (Tx TopTx (LedgerEra era)))
-> ((VotingProcedures (LedgerEra era)
     -> Identity (VotingProcedures (LedgerEra era)))
    -> TxBody TopTx (LedgerEra era)
    -> Identity (TxBody TopTx (LedgerEra era)))
-> (VotingProcedures (LedgerEra era)
    -> Identity (VotingProcedures (LedgerEra era)))
-> Tx TopTx (LedgerEra era)
-> Identity (Tx TopTx (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VotingProcedures (LedgerEra era)
 -> Identity (VotingProcedures (LedgerEra era)))
-> TxBody TopTx (LedgerEra era)
-> Identity (TxBody TopTx (LedgerEra era))
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel).
Lens' (TxBody l (LedgerEra era)) (VotingProcedures (LedgerEra era))
L.votingProceduresTxBodyL) ((VotingProcedures (LedgerEra era)
  -> Identity (VotingProcedures (LedgerEra era)))
 -> Tx TopTx (LedgerEra era) -> Identity (Tx TopTx (LedgerEra era)))
-> VotingProcedures (LedgerEra era)
-> Tx TopTx (LedgerEra era)
-> Tx TopTx (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ VotingProcedures (ShelleyLedgerEra era)
VotingProcedures (LedgerEra era)
votingProcedures

  setScriptWitnesses
    :: Maybe (L.TxDats (ShelleyLedgerEra era), L.Redeemers (ShelleyLedgerEra era))
    -> [AnyWitness (ShelleyLedgerEra era)]
    -> L.TxWits (ShelleyLedgerEra era)
    -> L.TxWits (ShelleyLedgerEra era)
  setScriptWitnesses :: Maybe
  (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
-> [AnyWitness (ShelleyLedgerEra era)]
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
setScriptWitnesses Maybe
  (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
scriptData [AnyWitness (ShelleyLedgerEra era)]
scriptWitnesses = TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era)
plutusAdditions (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era)
simpleScriptAdditions
   where
    plutusAdditions :: L.TxWits (ShelleyLedgerEra era) -> L.TxWits (ShelleyLedgerEra era)
    plutusAdditions :: TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era)
plutusAdditions =
      CardanoEra era
-> (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> (AlonzoEraOnwards era
    -> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall (eon :: * -> *) era a.
Eon eon =>
CardanoEra era -> a -> (eon era -> a) -> a
forEraInEon CardanoEra era
era TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era)
forall a. a -> a
id ((AlonzoEraOnwards era
  -> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
 -> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> (AlonzoEraOnwards era
    -> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ \AlonzoEraOnwards era
aeo ->
        AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeo ((AlonzoEraOnwardsConstraints era =>
  TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
 -> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> (AlonzoEraOnwardsConstraints era =>
    TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
          AlonzoEraOnwards era
-> (AlonzoEraScript (ShelleyLedgerEra era) =>
    TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall era a.
AlonzoEraOnwards era
-> (AlonzoEraScript (ShelleyLedgerEra era) => a) -> a
obtainAlonzoScriptPurposeConstraints AlonzoEraOnwards era
aeo ((AlonzoEraScript (ShelleyLedgerEra era) =>
  TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
 -> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> (AlonzoEraScript (ShelleyLedgerEra era) =>
    TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
            let
              (TxDats (ShelleyLedgerEra era)
datums, Redeemers (ShelleyLedgerEra era)
redeemers) =
                (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
-> Maybe
     (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
-> (TxDats (ShelleyLedgerEra era),
    Redeemers (ShelleyLedgerEra era))
forall a. a -> Maybe a -> a
fromMaybe (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
forall a. Monoid a => a
mempty Maybe
  (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
scriptData
                  :: (L.TxDats (ShelleyLedgerEra era), L.Redeemers (ShelleyLedgerEra era))
              -- 'getAnyWitnessScript' covers both plutus and simple
              -- scripts. The simple ones overlap harmlessly (same
              -- hash, same script) with the allegra-onwards branch
              -- below, which is still needed for pre-Alonzo eras
              -- that this branch does not run in.
              plutusAndSimpleScripts :: [Script (ShelleyLedgerEra era)]
plutusAndSimpleScripts =
                (AnyWitness (ShelleyLedgerEra era)
 -> Maybe (Script (ShelleyLedgerEra era)))
-> [AnyWitness (ShelleyLedgerEra era)]
-> [Script (ShelleyLedgerEra era)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnyWitness (ShelleyLedgerEra era)
-> Maybe (Script (ShelleyLedgerEra era))
forall era. AnyWitness era -> Maybe (Script era)
getAnyWitnessScript [AnyWitness (ShelleyLedgerEra era)]
scriptWitnesses
             in
              ((TxDats (ShelleyLedgerEra era)
 -> Identity (TxDats (ShelleyLedgerEra era)))
-> TxWits (ShelleyLedgerEra era)
-> Identity (TxWits (ShelleyLedgerEra era))
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens'
  (TxWits (ShelleyLedgerEra era)) (TxDats (ShelleyLedgerEra era))
L.datsTxWitsL ((TxDats (ShelleyLedgerEra era)
  -> Identity (TxDats (ShelleyLedgerEra era)))
 -> TxWits (ShelleyLedgerEra era)
 -> Identity (TxWits (ShelleyLedgerEra era)))
-> TxDats (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxDats (ShelleyLedgerEra era)
datums)
                (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Redeemers (ShelleyLedgerEra era)
 -> Identity (Redeemers (ShelleyLedgerEra era)))
-> TxWits (ShelleyLedgerEra era)
-> Identity (TxWits (ShelleyLedgerEra era))
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens'
  (TxWits (ShelleyLedgerEra era)) (Redeemers (ShelleyLedgerEra era))
L.rdmrsTxWitsL ((Redeemers (ShelleyLedgerEra era)
  -> Identity (Redeemers (ShelleyLedgerEra era)))
 -> TxWits (ShelleyLedgerEra era)
 -> Identity (TxWits (ShelleyLedgerEra era)))
-> (Redeemers (ShelleyLedgerEra era)
    -> Redeemers (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Redeemers (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
forall a. Semigroup a => a -> a -> a
<> Redeemers (ShelleyLedgerEra era)
redeemers))
                (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( (Map ScriptHash (Script (ShelleyLedgerEra era))
 -> Identity (Map ScriptHash (Script (ShelleyLedgerEra era))))
-> TxWits (ShelleyLedgerEra era)
-> Identity (TxWits (ShelleyLedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens'
  (TxWits (ShelleyLedgerEra era))
  (Map ScriptHash (Script (ShelleyLedgerEra era)))
L.scriptTxWitsL
                      ((Map ScriptHash (Script (ShelleyLedgerEra era))
  -> Identity (Map ScriptHash (Script (ShelleyLedgerEra era))))
 -> TxWits (ShelleyLedgerEra era)
 -> Identity (TxWits (ShelleyLedgerEra era)))
-> (Map ScriptHash (Script (ShelleyLedgerEra era))
    -> Map ScriptHash (Script (ShelleyLedgerEra era)))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Map ScriptHash (Script (ShelleyLedgerEra era))
-> Map ScriptHash (Script (ShelleyLedgerEra era))
-> Map ScriptHash (Script (ShelleyLedgerEra era))
forall a. Semigroup a => a -> a -> a
<> [(ScriptHash, Script (ShelleyLedgerEra era))]
-> Map ScriptHash (Script (ShelleyLedgerEra era))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Script (ShelleyLedgerEra era) -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
L.hashScript Script (ShelleyLedgerEra era)
sw, Script (ShelleyLedgerEra era)
sw) | Script (ShelleyLedgerEra era)
sw <- [Script (ShelleyLedgerEra era)]
plutusAndSimpleScripts])
                  )

    simpleScriptAdditions :: L.TxWits (ShelleyLedgerEra era) -> L.TxWits (ShelleyLedgerEra era)
    simpleScriptAdditions :: TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era)
simpleScriptAdditions =
      CardanoEra era
-> (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> (AllegraEraOnwards era
    -> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall (eon :: * -> *) era a.
Eon eon =>
CardanoEra era -> a -> (eon era -> a) -> a
forEraInEon CardanoEra era
era TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era)
forall a. a -> a
id ((AllegraEraOnwards era
  -> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
 -> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> (AllegraEraOnwards era
    -> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ \AllegraEraOnwards era
aeo ->
        AllegraEraOnwards era
-> (AllegraEraOnwardsConstraints era =>
    TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall era a.
AllegraEraOnwards era
-> (AllegraEraOnwardsConstraints era => a) -> a
allegraEraOnwardsConstraints AllegraEraOnwards era
aeo ((AllegraEraOnwardsConstraints era =>
  TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
 -> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> (AllegraEraOnwardsConstraints era =>
    TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
          let ledgerScripts :: [Script (ShelleyLedgerEra era)]
ledgerScripts = ShelleyBasedEra era
-> [AnyWitness (ShelleyLedgerEra era)]
-> [Script (ShelleyLedgerEra era)]
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> [AnyWitness (ShelleyLedgerEra era)] -> [Script ledgerera]
convSimpleScripts ShelleyBasedEra era
sbe [AnyWitness (ShelleyLedgerEra era)]
scriptWitnesses
           in (Map ScriptHash (Script (ShelleyLedgerEra era))
 -> Identity (Map ScriptHash (Script (ShelleyLedgerEra era))))
-> TxWits (ShelleyLedgerEra era)
-> Identity (TxWits (ShelleyLedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens'
  (TxWits (ShelleyLedgerEra era))
  (Map ScriptHash (Script (ShelleyLedgerEra era)))
L.scriptTxWitsL
                ((Map ScriptHash (Script (ShelleyLedgerEra era))
  -> Identity (Map ScriptHash (Script (ShelleyLedgerEra era))))
 -> TxWits (ShelleyLedgerEra era)
 -> Identity (TxWits (ShelleyLedgerEra era)))
-> (Map ScriptHash (Script (ShelleyLedgerEra era))
    -> Map ScriptHash (Script (ShelleyLedgerEra era)))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( Map ScriptHash (Script (ShelleyLedgerEra era))
-> Map ScriptHash (Script (ShelleyLedgerEra era))
-> Map ScriptHash (Script (ShelleyLedgerEra era))
forall a. Semigroup a => a -> a -> a
<>
                       [(ScriptHash, Script (ShelleyLedgerEra era))]
-> Map ScriptHash (Script (ShelleyLedgerEra era))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                         [ (Script (ShelleyLedgerEra era) -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
L.hashScript Script (ShelleyLedgerEra era)
sw, Script (ShelleyLedgerEra era)
sw)
                         | Script (ShelleyLedgerEra era)
sw <- [Script (ShelleyLedgerEra era)]
ledgerScripts
                         ]
                   )

convSimpleScripts
  :: ShelleyLedgerEra era ~ ledgerera
  => ShelleyBasedEra era
  -> [Exp.AnyWitness (ShelleyLedgerEra era)]
  -> [L.Script ledgerera]
convSimpleScripts :: forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> [AnyWitness (ShelleyLedgerEra era)] -> [Script ledgerera]
convSimpleScripts ShelleyBasedEra era
sbe [AnyWitness (ShelleyLedgerEra era)]
scriptWitnesses =
  [Maybe (Script ledgerera)] -> [Script ledgerera]
forall a. [Maybe a] -> [a]
catMaybes
    [ ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Maybe (Script ledgerera))
-> Maybe (Script ledgerera)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Maybe (Script ledgerera))
 -> Maybe (Script ledgerera))
-> (ShelleyBasedEraConstraints era => Maybe (Script ledgerera))
-> Maybe (Script ledgerera)
forall a b. (a -> b) -> a -> b
$ AnyWitness ledgerera -> Maybe (Script ledgerera)
forall era. AnyWitness era -> Maybe (Script era)
Exp.getAnyWitnessSimpleScript AnyWitness ledgerera
anywit
    | AnyWitness ledgerera
anywit <- [AnyWitness ledgerera]
[AnyWitness (ShelleyLedgerEra era)]
scriptWitnesses
    ]

convCertificates
  :: Exp.TxCertificates (ShelleyLedgerEra era)
  -> Seq.StrictSeq (L.TxCert (ShelleyLedgerEra era))
convCertificates :: forall era.
TxCertificates (ShelleyLedgerEra era)
-> StrictSeq (TxCert (ShelleyLedgerEra era))
convCertificates (Exp.TxCertificates OMap
  (Certificate (ShelleyLedgerEra era))
  (Maybe (AnyWitness (ShelleyLedgerEra era)))
cs) =
  [Item (StrictSeq (TxCert (ShelleyLedgerEra era)))]
-> StrictSeq (TxCert (ShelleyLedgerEra era))
forall l. IsList l => [Item l] -> l
fromList ([Item (StrictSeq (TxCert (ShelleyLedgerEra era)))]
 -> StrictSeq (TxCert (ShelleyLedgerEra era)))
-> ([(Certificate (ShelleyLedgerEra era),
      Maybe (AnyWitness (ShelleyLedgerEra era)))]
    -> [Item (StrictSeq (TxCert (ShelleyLedgerEra era)))])
-> [(Certificate (ShelleyLedgerEra era),
     Maybe (AnyWitness (ShelleyLedgerEra era)))]
-> StrictSeq (TxCert (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Certificate (ShelleyLedgerEra era),
  Maybe (AnyWitness (ShelleyLedgerEra era)))
 -> Item (StrictSeq (TxCert (ShelleyLedgerEra era))))
-> [(Certificate (ShelleyLedgerEra era),
     Maybe (AnyWitness (ShelleyLedgerEra era)))]
-> [Item (StrictSeq (TxCert (ShelleyLedgerEra era)))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Exp.Certificate TxCert (ShelleyLedgerEra era)
c, Maybe (AnyWitness (ShelleyLedgerEra era))
_) -> Item (StrictSeq (TxCert (ShelleyLedgerEra era)))
TxCert (ShelleyLedgerEra era)
c) ([(Certificate (ShelleyLedgerEra era),
   Maybe (AnyWitness (ShelleyLedgerEra era)))]
 -> StrictSeq (TxCert (ShelleyLedgerEra era)))
-> [(Certificate (ShelleyLedgerEra era),
     Maybe (AnyWitness (ShelleyLedgerEra era)))]
-> StrictSeq (TxCert (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ OMap
  (Certificate (ShelleyLedgerEra era))
  (Maybe (AnyWitness (ShelleyLedgerEra era)))
-> [Item
      (OMap
         (Certificate (ShelleyLedgerEra era))
         (Maybe (AnyWitness (ShelleyLedgerEra era))))]
forall l. IsList l => l -> [Item l]
toList OMap
  (Certificate (ShelleyLedgerEra era))
  (Maybe (AnyWitness (ShelleyLedgerEra era)))
cs

convScriptData'
  :: ShelleyBasedEra era
  -> [(TxIn, Exp.AnyWitness (ShelleyLedgerEra era))]
  -> Exp.TxCertificates (ShelleyLedgerEra era)
  -> [(Witnessable ProposalItem (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))]
  -> [(Witnessable VoterItem (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))]
  -> [AnyWitness (ShelleyLedgerEra era)]
  -> Map L.DataHash (L.Data (ShelleyLedgerEra era))
  -> Maybe (L.TxDats (ShelleyLedgerEra era), L.Redeemers (ShelleyLedgerEra era))
convScriptData' :: forall era.
ShelleyBasedEra era
-> [(TxIn, AnyWitness (ShelleyLedgerEra era))]
-> TxCertificates (ShelleyLedgerEra era)
-> [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [(Witnessable 'VoterItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [AnyWitness (ShelleyLedgerEra era)]
-> Map DataHash (Data (ShelleyLedgerEra era))
-> Maybe
     (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
convScriptData' ShelleyBasedEra era
sbe [(TxIn, AnyWitness (ShelleyLedgerEra era))]
ins TxCertificates (ShelleyLedgerEra era)
txCertificates' [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
proposalWits [(Witnessable 'VoterItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
voteWits [AnyWitness (ShelleyLedgerEra era)]
allWitnesses Map DataHash (Data (ShelleyLedgerEra era))
extraDatums =
  CardanoEra era
-> Maybe
     (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
-> (AlonzoEraOnwards era
    -> Maybe
         (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era)))
-> Maybe
     (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
forall (eon :: * -> *) era a.
Eon eon =>
CardanoEra era -> a -> (eon era -> a) -> a
forEraInEon
    (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ShelleyBasedEra era
sbe)
    Maybe
  (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
forall a. Maybe a
Nothing
    ( \AlonzoEraOnwards era
w ->
        AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    Maybe
      (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era)))
-> Maybe
     (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
w ((AlonzoEraOnwardsConstraints era =>
  Maybe
    (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era)))
 -> Maybe
      (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era)))
-> (AlonzoEraOnwardsConstraints era =>
    Maybe
      (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era)))
-> Maybe
     (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ do
          let
            -- Four disjoint per-category redeemer maps merged into one.
            -- Ledger 'L.PlutusPurpose' tags (Spending/Certifying/Voting/Proposing)
            -- never collide across categories, so '<>' below cannot drop
            -- or overwrite an entry.
            --
            -- All four share the Witnessable-based indexing that
            -- 'Cardano.Api.Experimental.Tx.Internal.BodyContent.New.makeUnsignedTx'
            -- uses, via 'getAnyWitnessRedeemerPointerMap'.
            certRedeemers :: Redeemers (ShelleyLedgerEra era)
certRedeemers = [(Witnessable 'CertItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
-> Redeemers (ShelleyLedgerEra era)
forall era (witnessable :: WitnessableItem).
AlonzoEraScript era =>
[(Witnessable witnessable era, AnyWitness era)] -> Redeemers era
getAnyWitnessRedeemerPointerMap ([(Witnessable 'CertItem (ShelleyLedgerEra era),
   AnyWitness (ShelleyLedgerEra era))]
 -> Redeemers (ShelleyLedgerEra era))
-> [(Witnessable 'CertItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> Redeemers (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ TxCertificates (ShelleyLedgerEra era)
-> [(Witnessable 'CertItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
forall ledgerera.
(AlonzoEraScript ledgerera, EraTxCert ledgerera) =>
TxCertificates ledgerera
-> [(Witnessable 'CertItem ledgerera, AnyWitness ledgerera)]
witnessableCerts TxCertificates (ShelleyLedgerEra era)
txCertificates'
            inputRedeemers :: Redeemers (ShelleyLedgerEra era)
inputRedeemers = [(Witnessable 'TxInItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
-> Redeemers (ShelleyLedgerEra era)
forall era (witnessable :: WitnessableItem).
AlonzoEraScript era =>
[(Witnessable witnessable era, AnyWitness era)] -> Redeemers era
getAnyWitnessRedeemerPointerMap ([(Witnessable 'TxInItem (ShelleyLedgerEra era),
   AnyWitness (ShelleyLedgerEra era))]
 -> Redeemers (ShelleyLedgerEra era))
-> [(Witnessable 'TxInItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> Redeemers (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ [(TxIn, AnyWitness (ShelleyLedgerEra era))]
-> [(Witnessable 'TxInItem (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
forall ledgerera.
AlonzoEraScript ledgerera =>
[(TxIn, AnyWitness ledgerera)]
-> [(Witnessable 'TxInItem ledgerera, AnyWitness ledgerera)]
witnessableTxIns [(TxIn, AnyWitness (ShelleyLedgerEra era))]
ins
            proposalRedeemers :: Redeemers (ShelleyLedgerEra era)
proposalRedeemers = [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
-> Redeemers (ShelleyLedgerEra era)
forall era (witnessable :: WitnessableItem).
AlonzoEraScript era =>
[(Witnessable witnessable era, AnyWitness era)] -> Redeemers era
getAnyWitnessRedeemerPointerMap [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
proposalWits
            voteRedeemers :: Redeemers (ShelleyLedgerEra era)
voteRedeemers = [(Witnessable 'VoterItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
-> Redeemers (ShelleyLedgerEra era)
forall era (witnessable :: WitnessableItem).
AlonzoEraScript era =>
[(Witnessable witnessable era, AnyWitness era)] -> Redeemers era
getAnyWitnessRedeemerPointerMap [(Witnessable 'VoterItem (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
voteWits
            redeemers :: Redeemers (ShelleyLedgerEra era)
redeemers = Redeemers (ShelleyLedgerEra era)
certRedeemers Redeemers (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
forall a. Semigroup a => a -> a -> a
<> Redeemers (ShelleyLedgerEra era)
inputRedeemers Redeemers (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
forall a. Semigroup a => a -> a -> a
<> Redeemers (ShelleyLedgerEra era)
voteRedeemers Redeemers (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
forall a. Semigroup a => a -> a -> a
<> Redeemers (ShelleyLedgerEra era)
proposalRedeemers

            datums :: TxDats (ShelleyLedgerEra era)
datums = [TxDats (ShelleyLedgerEra era)] -> TxDats (ShelleyLedgerEra era)
forall a. Monoid a => [a] -> a
mconcat [AnyWitness (ShelleyLedgerEra era) -> TxDats (ShelleyLedgerEra era)
forall era. Era era => AnyWitness era -> TxDats era
getAnyWitnessScriptData AnyWitness (ShelleyLedgerEra era)
wit | AnyWitness (ShelleyLedgerEra era)
wit <- [AnyWitness (ShelleyLedgerEra era)]
allWitnesses]
            supplementalDatums :: TxDats (ShelleyLedgerEra era)
supplementalDatums = Map DataHash (Data (ShelleyLedgerEra era))
-> TxDats (ShelleyLedgerEra era)
forall era. Era era => Map DataHash (Data era) -> TxDats era
Alonzo.TxDats Map DataHash (Data (ShelleyLedgerEra era))
extraDatums
          (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
-> Maybe
     (TxDats (ShelleyLedgerEra era), Redeemers (ShelleyLedgerEra era))
forall a. a -> Maybe a
Just (TxDats (ShelleyLedgerEra era)
datums TxDats (ShelleyLedgerEra era)
-> TxDats (ShelleyLedgerEra era) -> TxDats (ShelleyLedgerEra era)
forall a. Semigroup a => a -> a -> a
<> TxDats (ShelleyLedgerEra era)
supplementalDatums, Redeemers (ShelleyLedgerEra era)
redeemers)
    )

-- | Copy of an experimental extractWitnessableTxIns not requiring 'IsEra era'
witnessableTxIns
  :: L.AlonzoEraScript ledgerera
  => [(TxIn, AnyWitness ledgerera)]
  -> [(Witnessable TxInItem ledgerera, AnyWitness ledgerera)]
witnessableTxIns :: forall ledgerera.
AlonzoEraScript ledgerera =>
[(TxIn, AnyWitness ledgerera)]
-> [(Witnessable 'TxInItem ledgerera, AnyWitness ledgerera)]
witnessableTxIns [(TxIn, AnyWitness ledgerera)]
txIns' = [(Witnessable 'TxInItem ledgerera, AnyWitness ledgerera)]
-> [(Witnessable 'TxInItem ledgerera, AnyWitness ledgerera)]
forall a. Eq a => [a] -> [a]
L.nub [(TxIn -> Witnessable 'TxInItem ledgerera
forall era.
AlonzoEraScript era =>
TxIn -> Witnessable 'TxInItem era
WitTxIn TxIn
txIn, AnyWitness ledgerera
wit) | (TxIn
txIn, AnyWitness ledgerera
wit) <- [(TxIn, AnyWitness ledgerera)]
txIns']

-- Every certificate, witnessed or not, wrapped as a 'Witnessable'.
--
-- Unwitnessed certs MUST be included, paired with
-- 'AnyKeyWitnessPlaceholder'. The ledger resolves 'Certifying' indices
-- against the full 'certsTxBodyL' sequence, not just the witnessed
-- subset, so dropping an unwitnessed cert here would shift every later
-- index.
--
-- Mirrors
-- 'Cardano.Api.Experimental.Tx.Internal.BodyContent.New.extractWitnessableCertificates'.
witnessableCerts
  :: L.AlonzoEraScript ledgerera
  => L.EraTxCert ledgerera
  => Exp.TxCertificates ledgerera
  -> [(Witnessable CertItem ledgerera, AnyWitness ledgerera)]
witnessableCerts :: forall ledgerera.
(AlonzoEraScript ledgerera, EraTxCert ledgerera) =>
TxCertificates ledgerera
-> [(Witnessable 'CertItem ledgerera, AnyWitness ledgerera)]
witnessableCerts (Exp.TxCertificates OMap (Certificate ledgerera) (Maybe (AnyWitness ledgerera))
certsWits) =
  [ (TxCert ledgerera -> Witnessable 'CertItem ledgerera
forall era.
(EraTxCert era, AlonzoEraScript era) =>
TxCert era -> Witnessable 'CertItem era
WitTxCert TxCert ledgerera
cert, AnyWitness ledgerera
-> Maybe (AnyWitness ledgerera) -> AnyWitness ledgerera
forall a. a -> Maybe a -> a
fromMaybe AnyWitness ledgerera
forall era. AnyWitness era
AnyKeyWitnessPlaceholder Maybe (AnyWitness ledgerera)
mWit)
  | (Exp.Certificate TxCert ledgerera
cert, Maybe (AnyWitness ledgerera)
mWit) <- OMap (Certificate ledgerera) (Maybe (AnyWitness ledgerera))
-> [Item
      (OMap (Certificate ledgerera) (Maybe (AnyWitness ledgerera)))]
forall l. IsList l => l -> [Item l]
toList OMap (Certificate ledgerera) (Maybe (AnyWitness ledgerera))
certsWits
  ]

createCommonTxBody
  :: ShelleyBasedEra era
  -> Set L.TxIn
  -- ^ The final set of ledger inputs, in ascending 'Ord' order. See
  -- 'ledgerTxIns' at the 'createCompatibleTx' call site.
  -> [Exp.TxOut (ShelleyLedgerEra era)]
  -> Lovelace
  -> L.TxBody L.TopTx (ShelleyLedgerEra era)
createCommonTxBody :: forall era.
ShelleyBasedEra era
-> Set TxIn
-> [TxOut (ShelleyLedgerEra era)]
-> Lovelace
-> TxBody TopTx (ShelleyLedgerEra era)
createCommonTxBody ShelleyBasedEra era
era Set TxIn
ledgerTxIns [TxOut (ShelleyLedgerEra era)]
outs Lovelace
txFee' =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    TxBody TopTx (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
era ((ShelleyBasedEraConstraints era =>
  TxBody TopTx (ShelleyLedgerEra era))
 -> TxBody TopTx (ShelleyLedgerEra era))
-> (ShelleyBasedEraConstraints era =>
    TxBody TopTx (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
    let txOuts' :: [TxOut (ShelleyLedgerEra era)]
txOuts' = (TxOut (ShelleyLedgerEra era) -> TxOut (ShelleyLedgerEra era))
-> [TxOut (ShelleyLedgerEra era)] -> [TxOut (ShelleyLedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Exp.TxOut TxOut (ShelleyLedgerEra era)
o) -> TxOut (ShelleyLedgerEra era)
o) [TxOut (ShelleyLedgerEra era)]
outs
     in TxBody TopTx (ShelleyLedgerEra era)
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel).
Typeable l =>
TxBody l (ShelleyLedgerEra era)
L.mkBasicTxBody
          TxBody TopTx (ShelleyLedgerEra era)
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx (ShelleyLedgerEra era)
-> Identity (TxBody TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel).
Lens' (TxBody l (ShelleyLedgerEra era)) (Set TxIn)
L.inputsTxBodyL
            ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx (ShelleyLedgerEra era)
 -> Identity (TxBody TopTx (ShelleyLedgerEra era)))
-> Set TxIn
-> TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
ledgerTxIns
          TxBody TopTx (ShelleyLedgerEra era)
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut (ShelleyLedgerEra era))
 -> Identity (StrictSeq (TxOut (ShelleyLedgerEra era))))
-> TxBody TopTx (ShelleyLedgerEra era)
-> Identity (TxBody TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens'
  (TxBody l (ShelleyLedgerEra era))
  (StrictSeq (TxOut (ShelleyLedgerEra era)))
L.outputsTxBodyL
            ((StrictSeq (TxOut (ShelleyLedgerEra era))
  -> Identity (StrictSeq (TxOut (ShelleyLedgerEra era))))
 -> TxBody TopTx (ShelleyLedgerEra era)
 -> Identity (TxBody TopTx (ShelleyLedgerEra era)))
-> StrictSeq (TxOut (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxOut (ShelleyLedgerEra era)]
-> StrictSeq (TxOut (ShelleyLedgerEra era))
forall a. [a] -> StrictSeq a
Seq.fromList [TxOut (ShelleyLedgerEra era)]
txOuts'
          TxBody TopTx (ShelleyLedgerEra era)
-> (TxBody TopTx (ShelleyLedgerEra era)
    -> TxBody TopTx (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (Lovelace -> Identity Lovelace)
-> TxBody TopTx (ShelleyLedgerEra era)
-> Identity (TxBody TopTx (ShelleyLedgerEra era))
forall era. EraTxBody era => Lens' (TxBody TopTx era) Lovelace
Lens' (TxBody TopTx (ShelleyLedgerEra era)) Lovelace
L.feeTxBodyL
            ((Lovelace -> Identity Lovelace)
 -> TxBody TopTx (ShelleyLedgerEra era)
 -> Identity (TxBody TopTx (ShelleyLedgerEra era)))
-> Lovelace
-> TxBody TopTx (ShelleyLedgerEra era)
-> TxBody TopTx (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Lovelace
txFee'

-- | Add provided witnesses to the transaction
addWitnesses
  :: forall era
   . [KeyWitness era]
  -> Tx era
  -> Tx era
  -- ^ a signed transaction
addWitnesses :: forall era. [KeyWitness era] -> Tx era -> Tx era
addWitnesses [KeyWitness era]
witnesses (ShelleyTx ShelleyBasedEra era
sbe Tx TopTx (ShelleyLedgerEra era)
tx) =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Tx era) -> Tx era
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Tx era) -> Tx era)
-> (ShelleyBasedEraConstraints era => Tx era) -> Tx era
forall a b. (a -> b) -> a -> b
$
    ShelleyBasedEra era -> Tx TopTx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx TopTx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra era
sbe Tx TopTx (ShelleyLedgerEra era)
forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx TopTx ledgerera
txCommon
 where
  txCommon
    :: forall ledgerera
     . ShelleyLedgerEra era ~ ledgerera
    => L.EraTx ledgerera
    => L.Tx L.TopTx ledgerera
  txCommon :: forall ledgerera.
(ShelleyLedgerEra era ~ ledgerera, EraTx ledgerera) =>
Tx TopTx ledgerera
txCommon =
    Tx TopTx ledgerera
Tx TopTx (ShelleyLedgerEra era)
tx
      Tx TopTx ledgerera
-> (Tx TopTx ledgerera -> Tx TopTx ledgerera) -> Tx TopTx ledgerera
forall a b. a -> (a -> b) -> b
& (TxWits ledgerera -> Identity (TxWits ledgerera))
-> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ledgerera) (TxWits ledgerera)
L.witsTxL
        ((TxWits ledgerera -> Identity (TxWits ledgerera))
 -> Tx TopTx ledgerera -> Identity (Tx TopTx ledgerera))
-> (TxWits ledgerera -> TxWits ledgerera)
-> Tx TopTx ledgerera
-> Tx TopTx ledgerera
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( ( (Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits ledgerera -> Identity (TxWits ledgerera)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey Witness))
Lens' (TxWits ledgerera) (Set (WitVKey Witness))
L.addrTxWitsL
                 ((Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
 -> TxWits ledgerera -> Identity (TxWits ledgerera))
-> (Set (WitVKey Witness) -> Set (WitVKey Witness))
-> TxWits ledgerera
-> TxWits ledgerera
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Set (WitVKey Witness)
-> Set (WitVKey Witness) -> Set (WitVKey Witness)
forall a. Semigroup a => a -> a -> a
<> [Item (Set (WitVKey Witness))] -> Set (WitVKey Witness)
forall l. IsList l => [Item l] -> l
fromList [Item (Set (WitVKey Witness))
WitVKey Witness
w | ShelleyKeyWitness ShelleyBasedEra era
_ WitVKey Witness
w <- [KeyWitness era]
witnesses])
             )
               (TxWits ledgerera -> TxWits ledgerera)
-> (TxWits ledgerera -> TxWits ledgerera)
-> TxWits ledgerera
-> TxWits ledgerera
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( (Set BootstrapWitness -> Identity (Set BootstrapWitness))
-> TxWits ledgerera -> Identity (TxWits ledgerera)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
Lens' (TxWits ledgerera) (Set BootstrapWitness)
L.bootAddrTxWitsL
                     ((Set BootstrapWitness -> Identity (Set BootstrapWitness))
 -> TxWits ledgerera -> Identity (TxWits ledgerera))
-> (Set BootstrapWitness -> Set BootstrapWitness)
-> TxWits ledgerera
-> TxWits ledgerera
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Set BootstrapWitness
-> Set BootstrapWitness -> Set BootstrapWitness
forall a. Semigroup a => a -> a -> a
<> [Item (Set BootstrapWitness)] -> Set BootstrapWitness
forall l. IsList l => [Item l] -> l
fromList [Item (Set BootstrapWitness)
BootstrapWitness
w | ShelleyBootstrapWitness ShelleyBasedEra era
_ BootstrapWitness
w <- [KeyWitness era]
witnesses])
                 )
           )