module Hydra.Cardano.Api.Tx (
  -- * Extras
  module Hydra.Cardano.Api.Tx,

  -- * Re-export normal Tx (any era)
  Tx,
)
where

import Hydra.Cardano.Api.Prelude

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Allegra.Scripts (translateTimelock)
import Cardano.Ledger.Alonzo qualified as Ledger
import Cardano.Ledger.Alonzo.Scripts qualified as Ledger
import Cardano.Ledger.Alonzo.TxAuxData (translateAlonzoTxAuxData)
import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
import Cardano.Ledger.Api (
  AlonzoPlutusPurpose (..),
  AsIx (..),
  Babbage,
  Conway,
  ConwayPlutusPurpose (..),
  EraTx (mkBasicTx),
  addrTxOutL,
  addrTxWitsL,
  auxDataHashTxBodyL,
  auxDataTxL,
  bodyTxL,
  bootAddrTxWitsL,
  collateralInputsTxBodyL,
  collateralReturnTxBodyL,
  dataTxOutL,
  datsTxWitsL,
  feeTxBodyL,
  getLanguageView,
  inputsTxBodyL,
  isValidTxL,
  mintTxBodyL,
  mkBasicTxBody,
  mkBasicTxOut,
  mkBasicTxWits,
  networkIdTxBodyL,
  outputsTxBodyL,
  rdmrsTxWitsL,
  referenceInputsTxBodyL,
  referenceScriptTxOutL,
  reqSignerHashesTxBodyL,
  scriptIntegrityHashTxBodyL,
  scriptTxWitsL,
  totalCollateralTxBodyL,
  valueTxOutL,
  vldtTxBodyL,
  withdrawalsTxBodyL,
  witsTxL,
 )
import Cardano.Ledger.Api qualified as Ledger
import Cardano.Ledger.Babbage qualified as Ledger
import Cardano.Ledger.Babbage.Tx (hashScriptIntegrity)
import Cardano.Ledger.Babbage.TxWits (upgradeTxDats)
import Cardano.Ledger.BaseTypes (maybeToStrictMaybe)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Scripts (PlutusScript (..))
import Cardano.Ledger.Conway.Scripts qualified as Conway
import Cardano.Ledger.Conway.TxBody qualified as Ledger
import Cardano.Ledger.Plutus.Data (upgradeData)
import Cardano.Ledger.Plutus.Language qualified as Ledger
import Control.Lens ((&), (.~), (^.))
import Data.Bifunctor (bimap)
import Data.Functor ((<&>))
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Set qualified as Set
import Hydra.Cardano.Api.TxIn (mkTxIn, toLedgerTxIn)

-- * Extras

-- | Sign transaction using the provided secret key
-- It only works for tx not containing scripts.
-- You can't sign a script utxo with this.
signTx ::
  IsShelleyBasedEra era =>
  SigningKey PaymentKey ->
  Tx era ->
  Tx era
signTx :: forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
signingKey (Tx TxBody era
body [KeyWitness era]
wits) =
  [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction (KeyWitness era
witness KeyWitness era -> [KeyWitness era] -> [KeyWitness era]
forall a. a -> [a] -> [a]
: [KeyWitness era]
wits) TxBody era
body
 where
  witness :: KeyWitness era
witness = ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
forall era.
ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
makeShelleyKeyWitness ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra TxBody era
body (SigningKey PaymentKey -> ShelleyWitnessSigningKey
WitnessPaymentKey SigningKey PaymentKey
signingKey)

-- | Create a transaction spending all given `UTxO`.
txSpendingUTxO :: UTxO -> Tx Era
txSpendingUTxO :: UTxO -> Tx Era
txSpendingUTxO UTxO
utxo =
  Tx (ShelleyLedgerEra Era) -> Tx Era
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx (Tx (ShelleyLedgerEra Era) -> Tx Era)
-> Tx (ShelleyLedgerEra Era) -> Tx Era
forall a b. (a -> b) -> a -> b
$
    TxBody Conway -> Tx Conway
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx
      ( TxBody Conway
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          TxBody Conway
-> (TxBody Conway -> ConwayTxBody Conway) -> ConwayTxBody Conway
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto Conway))
 -> Identity (Set (TxIn (EraCrypto Conway))))
-> TxBody Conway -> Identity (TxBody Conway)
(Set (TxIn (EraCrypto Conway))
 -> Identity (Set (TxIn StandardCrypto)))
-> TxBody Conway -> Identity (ConwayTxBody Conway)
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody Conway) (Set (TxIn (EraCrypto Conway)))
inputsTxBodyL ((Set (TxIn (EraCrypto Conway))
  -> Identity (Set (TxIn StandardCrypto)))
 -> TxBody Conway -> Identity (ConwayTxBody Conway))
-> Set (TxIn StandardCrypto)
-> TxBody Conway
-> ConwayTxBody Conway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxIn -> TxIn StandardCrypto
toLedgerTxIn (TxIn -> TxIn StandardCrypto)
-> Set TxIn -> Set (TxIn StandardCrypto)
forall b a. Ord b => (a -> b) -> Set a -> Set b
`Set.map` Set TxIn
inputs)
      )
 where
  inputs :: Set TxIn
inputs = UTxO -> Set TxIn
forall out. UTxO' out -> Set TxIn
UTxO.inputSet UTxO
utxo

-- | Get the UTxO that are produced by some transaction.
-- XXX: Defined here to avoid cyclic module dependency
utxoProducedByTx :: Tx Era -> UTxO
utxoProducedByTx :: Tx Era -> UTxO
utxoProducedByTx Tx Era
tx =
  [(TxIn, TxOut CtxUTxO Era)] -> UTxO
forall out. [(TxIn, out)] -> UTxO' out
UTxO.fromPairs ([(TxIn, TxOut CtxUTxO Era)] -> UTxO)
-> [(TxIn, TxOut CtxUTxO Era)] -> UTxO
forall a b. (a -> b) -> a -> b
$
    [Word] -> [TxOut CtxTx Era] -> [(Word, TxOut CtxTx Era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0 ..] (TxBodyContent ViewTx Era -> [TxOut CtxTx Era]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts TxBodyContent ViewTx Era
body)
      [(Word, TxOut CtxTx Era)]
-> ((Word, TxOut CtxTx Era) -> (TxIn, TxOut CtxUTxO Era))
-> [(TxIn, TxOut CtxUTxO Era)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Word -> TxIn)
-> (TxOut CtxTx Era -> TxOut CtxUTxO Era)
-> (Word, TxOut CtxTx Era)
-> (TxIn, TxOut CtxUTxO Era)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Tx Era -> Word -> TxIn
forall era. Tx era -> Word -> TxIn
mkTxIn Tx Era
tx) TxOut CtxTx Era -> TxOut CtxUTxO Era
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
toCtxUTxOTxOut
 where
  TxBody TxBodyContent ViewTx Era
body = Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx Era
tx

-- | Get explicit fees allocated to a transaction.
txFee' :: Tx era -> Coin
txFee' :: forall era. Tx era -> Coin
txFee' (Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody -> TxBody TxBodyContent ViewTx era
body) =
  case TxBodyContent ViewTx era -> TxFee era
forall build era. TxBodyContent build era -> TxFee era
txFee TxBodyContent ViewTx era
body of
    TxFeeExplicit ShelleyBasedEra era
_ Coin
y -> Coin
y

-- * Type Conversions

-- | Convert a cardano-api 'Tx' into a matching cardano-ledger 'Tx'.
toLedgerTx ::
  Tx era ->
  Ledger.Tx (ShelleyLedgerEra era)
toLedgerTx :: forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx (ShelleyTx ShelleyBasedEra era
_era Tx (ShelleyLedgerEra era)
tx) = Tx (ShelleyLedgerEra era)
tx

-- | Convert a cardano-ledger's 'Tx' in the Babbage era into a cardano-api 'Tx'.
fromLedgerTx ::
  IsShelleyBasedEra era =>
  Ledger.Tx (ShelleyLedgerEra era) ->
  Tx era
fromLedgerTx :: forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx =
  ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra

-- | Compute the integrity hash of a transaction using a list of plutus languages.
recomputeIntegrityHash ::
  (Ledger.AlonzoEraPParams ppera, Ledger.AlonzoEraTxWits txera, Ledger.AlonzoEraTxBody txera, EraTx txera) =>
  Ledger.PParams ppera ->
  [Ledger.Language] ->
  Ledger.Tx txera ->
  Ledger.Tx txera
recomputeIntegrityHash :: forall ppera txera.
(AlonzoEraPParams ppera, AlonzoEraTxWits txera,
 AlonzoEraTxBody txera, EraTx txera) =>
PParams ppera -> [Language] -> Tx txera -> Tx txera
recomputeIntegrityHash PParams ppera
pp [Language]
languages Tx txera
tx = do
  Tx txera
tx Tx txera -> (Tx txera -> Tx txera) -> Tx txera
forall a b. a -> (a -> b) -> b
& (TxBody txera -> Identity (TxBody txera))
-> Tx txera -> Identity (Tx txera)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx txera) (TxBody txera)
bodyTxL ((TxBody txera -> Identity (TxBody txera))
 -> Tx txera -> Identity (Tx txera))
-> ((StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
     -> Identity (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))))
    -> TxBody txera -> Identity (TxBody txera))
-> (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
    -> Identity (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))))
-> Tx txera
-> Identity (Tx txera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
 -> Identity (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))))
-> TxBody txera -> Identity (TxBody txera)
forall era.
AlonzoEraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
Lens'
  (TxBody txera)
  (StrictMaybe (ScriptIntegrityHash (EraCrypto txera)))
scriptIntegrityHashTxBodyL ((StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
  -> Identity (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))))
 -> Tx txera -> Identity (Tx txera))
-> StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
-> Tx txera
-> Tx txera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
integrityHash
 where
  integrityHash :: StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
integrityHash =
    Set LangDepView
-> Redeemers txera
-> TxDats txera
-> StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
hashScriptIntegrity
      ([LangDepView] -> Set LangDepView
forall a. Ord a => [a] -> Set a
Set.fromList ([LangDepView] -> Set LangDepView)
-> [LangDepView] -> Set LangDepView
forall a b. (a -> b) -> a -> b
$ PParams ppera -> Language -> LangDepView
forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
getLanguageView PParams ppera
pp (Language -> LangDepView) -> [Language] -> [LangDepView]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Language]
languages)
      (Tx txera
tx Tx txera
-> Getting (Redeemers txera) (Tx txera) (Redeemers txera)
-> Redeemers txera
forall s a. s -> Getting a s a -> a
^. (TxWits txera -> Const (Redeemers txera) (TxWits txera))
-> Tx txera -> Const (Redeemers txera) (Tx txera)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx txera) (TxWits txera)
witsTxL ((TxWits txera -> Const (Redeemers txera) (TxWits txera))
 -> Tx txera -> Const (Redeemers txera) (Tx txera))
-> ((Redeemers txera -> Const (Redeemers txera) (Redeemers txera))
    -> TxWits txera -> Const (Redeemers txera) (TxWits txera))
-> Getting (Redeemers txera) (Tx txera) (Redeemers txera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers txera -> Const (Redeemers txera) (Redeemers txera))
-> TxWits txera -> Const (Redeemers txera) (TxWits txera)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits txera) (Redeemers txera)
rdmrsTxWitsL)
      (Tx txera
tx Tx txera
-> Getting (TxDats txera) (Tx txera) (TxDats txera) -> TxDats txera
forall s a. s -> Getting a s a -> a
^. (TxWits txera -> Const (TxDats txera) (TxWits txera))
-> Tx txera -> Const (TxDats txera) (Tx txera)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx txera) (TxWits txera)
witsTxL ((TxWits txera -> Const (TxDats txera) (TxWits txera))
 -> Tx txera -> Const (TxDats txera) (Tx txera))
-> ((TxDats txera -> Const (TxDats txera) (TxDats txera))
    -> TxWits txera -> Const (TxDats txera) (TxWits txera))
-> Getting (TxDats txera) (Tx txera) (TxDats txera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats txera -> Const (TxDats txera) (TxDats txera))
-> TxWits txera -> Const (TxDats txera) (TxWits txera)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits txera) (TxDats txera)
datsTxWitsL)

-- | Explicit downgrade from Conway to Babbage era.
--
-- XXX: This will invalidate the script integrity hash as datums and redeemers
-- are serialized differently.
--
-- XXX: This is not a complete mapping and does silently drop things like
-- protocol updates, certificates and voting procedures.
convertConwayTx :: Ledger.Tx Conway -> Ledger.Tx Babbage
convertConwayTx :: Tx Conway -> Tx Babbage
convertConwayTx Tx Conway
tx =
  TxBody Babbage -> Tx Babbage
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (ConwayTxBody Conway -> BabbageTxBody Babbage
translateBody (ConwayTxBody Conway -> BabbageTxBody Babbage)
-> ConwayTxBody Conway -> BabbageTxBody Babbage
forall a b. (a -> b) -> a -> b
$ AlonzoTx Conway
Tx Conway
tx AlonzoTx Conway
-> Getting
     (ConwayTxBody Conway) (AlonzoTx Conway) (ConwayTxBody Conway)
-> ConwayTxBody Conway
forall s a. s -> Getting a s a -> a
^. (TxBody Conway -> Const (ConwayTxBody Conway) (TxBody Conway))
-> Tx Conway -> Const (ConwayTxBody Conway) (Tx Conway)
Getting
  (ConwayTxBody Conway) (AlonzoTx Conway) (ConwayTxBody Conway)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx Conway) (TxBody Conway)
bodyTxL)
    Tx Babbage -> (Tx Babbage -> AlonzoTx Babbage) -> AlonzoTx Babbage
forall a b. a -> (a -> b) -> b
& (TxWits Babbage -> Identity (AlonzoTxWits Babbage))
-> Tx Babbage -> Identity (AlonzoTx Babbage)
(TxWits Babbage -> Identity (TxWits Babbage))
-> Tx Babbage -> Identity (Tx Babbage)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx Babbage) (TxWits Babbage)
witsTxL ((TxWits Babbage -> Identity (AlonzoTxWits Babbage))
 -> Tx Babbage -> Identity (AlonzoTx Babbage))
-> AlonzoTxWits Babbage -> Tx Babbage -> AlonzoTx Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AlonzoTxWits Conway -> AlonzoTxWits Babbage
translateWits (AlonzoTx Conway
Tx Conway
tx AlonzoTx Conway
-> Getting
     (AlonzoTxWits Conway) (AlonzoTx Conway) (AlonzoTxWits Conway)
-> AlonzoTxWits Conway
forall s a. s -> Getting a s a -> a
^. Getting
  (AlonzoTxWits Conway) (AlonzoTx Conway) (AlonzoTxWits Conway)
(TxWits Conway -> Const (AlonzoTxWits Conway) (TxWits Conway))
-> Tx Conway -> Const (AlonzoTxWits Conway) (Tx Conway)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx Conway) (TxWits Conway)
witsTxL)
    AlonzoTx Babbage
-> (AlonzoTx Babbage -> AlonzoTx Babbage) -> AlonzoTx Babbage
forall a b. a -> (a -> b) -> b
& (IsValid -> Identity IsValid)
-> AlonzoTx Babbage -> Identity (AlonzoTx Babbage)
(IsValid -> Identity IsValid)
-> Tx Babbage -> Identity (Tx Babbage)
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx Babbage) IsValid
isValidTxL ((IsValid -> Identity IsValid)
 -> AlonzoTx Babbage -> Identity (AlonzoTx Babbage))
-> IsValid -> AlonzoTx Babbage -> AlonzoTx Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AlonzoTx Conway
Tx Conway
tx AlonzoTx Conway
-> Getting IsValid (AlonzoTx Conway) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (AlonzoTx Conway) IsValid
(IsValid -> Const IsValid IsValid)
-> Tx Conway -> Const IsValid (Tx Conway)
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx Conway) IsValid
isValidTxL
    AlonzoTx Babbage
-> (AlonzoTx Babbage -> AlonzoTx Babbage) -> AlonzoTx Babbage
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData Babbage)
 -> Identity (StrictMaybe (AlonzoTxAuxData Babbage)))
-> AlonzoTx Babbage -> Identity (AlonzoTx Babbage)
(StrictMaybe (TxAuxData Babbage)
 -> Identity (StrictMaybe (TxAuxData Babbage)))
-> Tx Babbage -> Identity (Tx Babbage)
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (AuxiliaryData era))
Lens' (Tx Babbage) (StrictMaybe (TxAuxData Babbage))
auxDataTxL ((StrictMaybe (TxAuxData Babbage)
  -> Identity (StrictMaybe (AlonzoTxAuxData Babbage)))
 -> AlonzoTx Babbage -> Identity (AlonzoTx Babbage))
-> StrictMaybe (AlonzoTxAuxData Babbage)
-> AlonzoTx Babbage
-> AlonzoTx Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (AlonzoTxAuxData Conway -> AlonzoTxAuxData Babbage
forall era1 era2.
(AlonzoEraScript era1, AlonzoEraScript era2,
 EraCrypto era1 ~ EraCrypto era2) =>
AlonzoTxAuxData era1 -> AlonzoTxAuxData era2
translateAlonzoTxAuxData (AlonzoTxAuxData Conway -> AlonzoTxAuxData Babbage)
-> StrictMaybe (AlonzoTxAuxData Conway)
-> StrictMaybe (AlonzoTxAuxData Babbage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AlonzoTx Conway
Tx Conway
tx AlonzoTx Conway
-> Getting
     (StrictMaybe (AlonzoTxAuxData Conway))
     (AlonzoTx Conway)
     (StrictMaybe (AlonzoTxAuxData Conway))
-> StrictMaybe (AlonzoTxAuxData Conway)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (AlonzoTxAuxData Conway))
  (AlonzoTx Conway)
  (StrictMaybe (AlonzoTxAuxData Conway))
(StrictMaybe (AuxiliaryData Conway)
 -> Const
      (StrictMaybe (AlonzoTxAuxData Conway))
      (StrictMaybe (AuxiliaryData Conway)))
-> Tx Conway
-> Const (StrictMaybe (AlonzoTxAuxData Conway)) (Tx Conway)
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (AuxiliaryData era))
Lens' (Tx Conway) (StrictMaybe (AuxiliaryData Conway))
auxDataTxL)
 where
  translateBody ::
    Ledger.ConwayTxBody Ledger.Conway ->
    Ledger.BabbageTxBody Ledger.Babbage
  translateBody :: ConwayTxBody Conway -> BabbageTxBody Babbage
translateBody ConwayTxBody Conway
body =
    TxBody Babbage
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      TxBody Babbage
-> (TxBody Babbage -> TxBody Babbage) -> TxBody Babbage
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto Babbage))
 -> Identity (Set (TxIn (EraCrypto Babbage))))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody Babbage) (Set (TxIn (EraCrypto Babbage)))
inputsTxBodyL ((Set (TxIn (EraCrypto Babbage))
  -> Identity (Set (TxIn (EraCrypto Babbage))))
 -> TxBody Babbage -> Identity (TxBody Babbage))
-> Set (TxIn (EraCrypto Babbage))
-> TxBody Babbage
-> TxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (Set (TxIn (EraCrypto Babbage)))
     (ConwayTxBody Conway)
     (Set (TxIn (EraCrypto Babbage)))
-> Set (TxIn (EraCrypto Babbage))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (TxIn (EraCrypto Babbage)))
  (ConwayTxBody Conway)
  (Set (TxIn (EraCrypto Babbage)))
(Set (TxIn (EraCrypto Conway))
 -> Const
      (Set (TxIn (EraCrypto Babbage))) (Set (TxIn (EraCrypto Conway))))
-> TxBody Conway
-> Const (Set (TxIn (EraCrypto Babbage))) (TxBody Conway)
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody Conway) (Set (TxIn (EraCrypto Conway)))
inputsTxBodyL
      TxBody Babbage
-> (TxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut Babbage)
 -> Identity (StrictSeq (BabbageTxOut Babbage)))
-> TxBody Babbage -> Identity (BabbageTxBody Babbage)
(StrictSeq (TxOut Babbage) -> Identity (StrictSeq (TxOut Babbage)))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody Babbage) (StrictSeq (TxOut Babbage))
outputsTxBodyL ((StrictSeq (TxOut Babbage)
  -> Identity (StrictSeq (BabbageTxOut Babbage)))
 -> TxBody Babbage -> Identity (BabbageTxBody Babbage))
-> StrictSeq (BabbageTxOut Babbage)
-> TxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (BabbageTxOut Conway -> BabbageTxOut Babbage
translateTxOut (BabbageTxOut Conway -> BabbageTxOut Babbage)
-> StrictSeq (BabbageTxOut Conway)
-> StrictSeq (BabbageTxOut Babbage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (StrictSeq (BabbageTxOut Conway))
     (ConwayTxBody Conway)
     (StrictSeq (BabbageTxOut Conway))
-> StrictSeq (BabbageTxOut Conway)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (BabbageTxOut Conway))
  (ConwayTxBody Conway)
  (StrictSeq (BabbageTxOut Conway))
(StrictSeq (TxOut Conway)
 -> Const
      (StrictSeq (BabbageTxOut Conway)) (StrictSeq (TxOut Conway)))
-> TxBody Conway
-> Const (StrictSeq (BabbageTxOut Conway)) (TxBody Conway)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody Conway) (StrictSeq (TxOut Conway))
outputsTxBodyL)
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(Coin -> Identity Coin)
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody Babbage) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> Coin -> BabbageTxBody Babbage -> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting Coin (ConwayTxBody Conway) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Coin Coin)
-> TxBody Conway -> Const Coin (TxBody Conway)
Getting Coin (ConwayTxBody Conway) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody Conway) Coin
feeTxBodyL
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (Withdrawals (EraCrypto Babbage)
 -> Identity (Withdrawals (EraCrypto Babbage)))
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(Withdrawals (EraCrypto Babbage)
 -> Identity (Withdrawals (EraCrypto Babbage)))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
Lens' (TxBody Babbage) (Withdrawals (EraCrypto Babbage))
withdrawalsTxBodyL ((Withdrawals (EraCrypto Babbage)
  -> Identity (Withdrawals (EraCrypto Babbage)))
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> Withdrawals (EraCrypto Babbage)
-> BabbageTxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (Withdrawals (EraCrypto Babbage))
     (ConwayTxBody Conway)
     (Withdrawals (EraCrypto Babbage))
-> Withdrawals (EraCrypto Babbage)
forall s a. s -> Getting a s a -> a
^. Getting
  (Withdrawals (EraCrypto Babbage))
  (ConwayTxBody Conway)
  (Withdrawals (EraCrypto Babbage))
(Withdrawals (EraCrypto Conway)
 -> Const
      (Withdrawals (EraCrypto Babbage)) (Withdrawals (EraCrypto Conway)))
-> TxBody Conway
-> Const (Withdrawals (EraCrypto Babbage)) (TxBody Conway)
forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
Lens' (TxBody Conway) (Withdrawals (EraCrypto Conway))
withdrawalsTxBodyL
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage))
 -> Identity (StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage))))
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage))
 -> Identity (StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage))))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
Lens'
  (TxBody Babbage)
  (StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage)))
auxDataHashTxBodyL ((StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage))
  -> Identity (StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage))))
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage))
-> BabbageTxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage)))
     (ConwayTxBody Conway)
     (StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage)))
-> StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage)))
  (ConwayTxBody Conway)
  (StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage)))
(StrictMaybe (AuxiliaryDataHash (EraCrypto Conway))
 -> Const
      (StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage)))
      (StrictMaybe (AuxiliaryDataHash (EraCrypto Conway))))
-> TxBody Conway
-> Const
     (StrictMaybe (AuxiliaryDataHash (EraCrypto Babbage)))
     (TxBody Conway)
forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
Lens'
  (TxBody Conway)
  (StrictMaybe (AuxiliaryDataHash (EraCrypto Conway)))
auxDataHashTxBodyL
      -- NOTE: not considering 'updateTxBodyL' as upstream also does not upgrade it
      -- NOTE: not considering 'certsTxBodyL' as we are not interested in it
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(ValidityInterval -> Identity ValidityInterval)
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody Babbage) ValidityInterval
vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> ValidityInterval
-> BabbageTxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting ValidityInterval (ConwayTxBody Conway) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. (ValidityInterval -> Const ValidityInterval ValidityInterval)
-> TxBody Conway -> Const ValidityInterval (TxBody Conway)
Getting ValidityInterval (ConwayTxBody Conway) ValidityInterval
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody Conway) ValidityInterval
vldtTxBodyL
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (MultiAsset (EraCrypto Babbage)
 -> Identity (MultiAsset (EraCrypto Babbage)))
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(MultiAsset (EraCrypto Babbage)
 -> Identity (MultiAsset (EraCrypto Babbage)))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
Lens' (TxBody Babbage) (MultiAsset (EraCrypto Babbage))
mintTxBodyL ((MultiAsset (EraCrypto Babbage)
  -> Identity (MultiAsset (EraCrypto Babbage)))
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> MultiAsset (EraCrypto Babbage)
-> BabbageTxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (MultiAsset (EraCrypto Babbage))
     (ConwayTxBody Conway)
     (MultiAsset (EraCrypto Babbage))
-> MultiAsset (EraCrypto Babbage)
forall s a. s -> Getting a s a -> a
^. Getting
  (MultiAsset (EraCrypto Babbage))
  (ConwayTxBody Conway)
  (MultiAsset (EraCrypto Babbage))
(MultiAsset (EraCrypto Conway)
 -> Const
      (MultiAsset (EraCrypto Babbage)) (MultiAsset (EraCrypto Conway)))
-> TxBody Conway
-> Const (MultiAsset (EraCrypto Babbage)) (TxBody Conway)
forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
Lens' (TxBody Conway) (MultiAsset (EraCrypto Conway))
mintTxBodyL
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto Babbage))
 -> Identity (Set (TxIn (EraCrypto Babbage))))
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(Set (TxIn (EraCrypto Babbage))
 -> Identity (Set (TxIn (EraCrypto Babbage))))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody Babbage) (Set (TxIn (EraCrypto Babbage)))
collateralInputsTxBodyL ((Set (TxIn (EraCrypto Babbage))
  -> Identity (Set (TxIn (EraCrypto Babbage))))
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> Set (TxIn (EraCrypto Babbage))
-> BabbageTxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (Set (TxIn (EraCrypto Babbage)))
     (ConwayTxBody Conway)
     (Set (TxIn (EraCrypto Babbage)))
-> Set (TxIn (EraCrypto Babbage))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (TxIn (EraCrypto Babbage)))
  (ConwayTxBody Conway)
  (Set (TxIn (EraCrypto Babbage)))
(Set (TxIn (EraCrypto Conway))
 -> Const
      (Set (TxIn (EraCrypto Babbage))) (Set (TxIn (EraCrypto Conway))))
-> TxBody Conway
-> Const (Set (TxIn (EraCrypto Babbage))) (TxBody Conway)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody Conway) (Set (TxIn (EraCrypto Conway)))
collateralInputsTxBodyL
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (Set (KeyHash 'Witness (EraCrypto Babbage))
 -> Identity (Set (KeyHash 'Witness (EraCrypto Babbage))))
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(Set (KeyHash 'Witness (EraCrypto Babbage))
 -> Identity (Set (KeyHash 'Witness (EraCrypto Babbage))))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
Lens' (TxBody Babbage) (Set (KeyHash 'Witness (EraCrypto Babbage)))
reqSignerHashesTxBodyL ((Set (KeyHash 'Witness (EraCrypto Babbage))
  -> Identity (Set (KeyHash 'Witness (EraCrypto Babbage))))
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> Set (KeyHash 'Witness (EraCrypto Babbage))
-> BabbageTxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (Set (KeyHash 'Witness (EraCrypto Babbage)))
     (ConwayTxBody Conway)
     (Set (KeyHash 'Witness (EraCrypto Babbage)))
-> Set (KeyHash 'Witness (EraCrypto Babbage))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (KeyHash 'Witness (EraCrypto Babbage)))
  (ConwayTxBody Conway)
  (Set (KeyHash 'Witness (EraCrypto Babbage)))
(Set (KeyHash 'Witness (EraCrypto Conway))
 -> Const
      (Set (KeyHash 'Witness (EraCrypto Babbage)))
      (Set (KeyHash 'Witness (EraCrypto Conway))))
-> TxBody Conway
-> Const
     (Set (KeyHash 'Witness (EraCrypto Babbage))) (TxBody Conway)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
Lens' (TxBody Conway) (Set (KeyHash 'Witness (EraCrypto Conway)))
reqSignerHashesTxBodyL
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage))
 -> Identity
      (StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage))))
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage))
 -> Identity
      (StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage))))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
AlonzoEraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
Lens'
  (TxBody Babbage)
  (StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage)))
scriptIntegrityHashTxBodyL ((StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage))
  -> Identity
       (StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage))))
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage))
-> BabbageTxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage)))
     (ConwayTxBody Conway)
     (StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage)))
-> StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage)))
  (ConwayTxBody Conway)
  (StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage)))
(StrictMaybe (ScriptIntegrityHash (EraCrypto Conway))
 -> Const
      (StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage)))
      (StrictMaybe (ScriptIntegrityHash (EraCrypto Conway))))
-> TxBody Conway
-> Const
     (StrictMaybe (ScriptIntegrityHash (EraCrypto Babbage)))
     (TxBody Conway)
forall era.
AlonzoEraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
Lens'
  (TxBody Conway)
  (StrictMaybe (ScriptIntegrityHash (EraCrypto Conway)))
scriptIntegrityHashTxBodyL
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (StrictMaybe Network -> Identity (StrictMaybe Network))
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(StrictMaybe Network -> Identity (StrictMaybe Network))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Network)
Lens' (TxBody Babbage) (StrictMaybe Network)
networkIdTxBodyL ((StrictMaybe Network -> Identity (StrictMaybe Network))
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> StrictMaybe Network
-> BabbageTxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (StrictMaybe Network) (ConwayTxBody Conway) (StrictMaybe Network)
-> StrictMaybe Network
forall s a. s -> Getting a s a -> a
^. (StrictMaybe Network
 -> Const (StrictMaybe Network) (StrictMaybe Network))
-> TxBody Conway -> Const (StrictMaybe Network) (TxBody Conway)
Getting
  (StrictMaybe Network) (ConwayTxBody Conway) (StrictMaybe Network)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Network)
Lens' (TxBody Conway) (StrictMaybe Network)
networkIdTxBodyL
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto Babbage))
 -> Identity (Set (TxIn (EraCrypto Babbage))))
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(Set (TxIn (EraCrypto Babbage))
 -> Identity (Set (TxIn (EraCrypto Babbage))))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody Babbage) (Set (TxIn (EraCrypto Babbage)))
referenceInputsTxBodyL ((Set (TxIn (EraCrypto Babbage))
  -> Identity (Set (TxIn (EraCrypto Babbage))))
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> Set (TxIn (EraCrypto Babbage))
-> BabbageTxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (Set (TxIn (EraCrypto Babbage)))
     (ConwayTxBody Conway)
     (Set (TxIn (EraCrypto Babbage)))
-> Set (TxIn (EraCrypto Babbage))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (TxIn (EraCrypto Babbage)))
  (ConwayTxBody Conway)
  (Set (TxIn (EraCrypto Babbage)))
(Set (TxIn (EraCrypto Conway))
 -> Const
      (Set (TxIn (EraCrypto Babbage))) (Set (TxIn (EraCrypto Conway))))
-> TxBody Conway
-> Const (Set (TxIn (EraCrypto Babbage))) (TxBody Conway)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody Conway) (Set (TxIn (EraCrypto Conway)))
referenceInputsTxBodyL
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
Lens' (TxBody Babbage) (StrictMaybe Coin)
totalCollateralTxBodyL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> StrictMaybe Coin
-> BabbageTxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (StrictMaybe Coin) (ConwayTxBody Conway) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. (StrictMaybe Coin -> Const (StrictMaybe Coin) (StrictMaybe Coin))
-> TxBody Conway -> Const (StrictMaybe Coin) (TxBody Conway)
Getting (StrictMaybe Coin) (ConwayTxBody Conway) (StrictMaybe Coin)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
Lens' (TxBody Conway) (StrictMaybe Coin)
totalCollateralTxBodyL
      BabbageTxBody Babbage
-> (BabbageTxBody Babbage -> BabbageTxBody Babbage)
-> BabbageTxBody Babbage
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxOut Babbage)
 -> Identity (StrictMaybe (BabbageTxOut Babbage)))
-> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage)
(StrictMaybe (TxOut Babbage)
 -> Identity (StrictMaybe (TxOut Babbage)))
-> TxBody Babbage -> Identity (TxBody Babbage)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
Lens' (TxBody Babbage) (StrictMaybe (TxOut Babbage))
collateralReturnTxBodyL ((StrictMaybe (TxOut Babbage)
  -> Identity (StrictMaybe (BabbageTxOut Babbage)))
 -> BabbageTxBody Babbage -> Identity (BabbageTxBody Babbage))
-> StrictMaybe (BabbageTxOut Babbage)
-> BabbageTxBody Babbage
-> BabbageTxBody Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (BabbageTxOut Conway -> BabbageTxOut Babbage
translateTxOut (BabbageTxOut Conway -> BabbageTxOut Babbage)
-> StrictMaybe (BabbageTxOut Conway)
-> StrictMaybe (BabbageTxOut Babbage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConwayTxBody Conway
body ConwayTxBody Conway
-> Getting
     (StrictMaybe (BabbageTxOut Conway))
     (ConwayTxBody Conway)
     (StrictMaybe (BabbageTxOut Conway))
-> StrictMaybe (BabbageTxOut Conway)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (BabbageTxOut Conway))
  (ConwayTxBody Conway)
  (StrictMaybe (BabbageTxOut Conway))
(StrictMaybe (TxOut Conway)
 -> Const
      (StrictMaybe (BabbageTxOut Conway)) (StrictMaybe (TxOut Conway)))
-> TxBody Conway
-> Const (StrictMaybe (BabbageTxOut Conway)) (TxBody Conway)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
Lens' (TxBody Conway) (StrictMaybe (TxOut Conway))
collateralReturnTxBodyL)

  translateTxOut ::
    Ledger.BabbageTxOut Ledger.Conway ->
    Ledger.BabbageTxOut Ledger.Babbage
  translateTxOut :: BabbageTxOut Conway -> BabbageTxOut Babbage
translateTxOut BabbageTxOut Conway
out =
    Addr (EraCrypto Babbage) -> Value Babbage -> TxOut Babbage
forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (BabbageTxOut Conway
out BabbageTxOut Conway
-> Getting
     (Addr (EraCrypto Babbage))
     (BabbageTxOut Conway)
     (Addr (EraCrypto Babbage))
-> Addr (EraCrypto Babbage)
forall s a. s -> Getting a s a -> a
^. Getting
  (Addr (EraCrypto Babbage))
  (BabbageTxOut Conway)
  (Addr (EraCrypto Babbage))
(Addr (EraCrypto Conway)
 -> Const (Addr (EraCrypto Babbage)) (Addr (EraCrypto Conway)))
-> TxOut Conway -> Const (Addr (EraCrypto Babbage)) (TxOut Conway)
forall era.
EraTxOut era =>
Lens' (TxOut era) (Addr (EraCrypto era))
Lens' (TxOut Conway) (Addr (EraCrypto Conway))
addrTxOutL) (BabbageTxOut Conway
out BabbageTxOut Conway
-> Getting (Value Babbage) (BabbageTxOut Conway) (Value Babbage)
-> Value Babbage
forall s a. s -> Getting a s a -> a
^. Getting (Value Babbage) (BabbageTxOut Conway) (Value Babbage)
(Value Conway -> Const (Value Babbage) (Value Conway))
-> TxOut Conway -> Const (Value Babbage) (TxOut Conway)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut Conway) (Value Conway)
valueTxOutL)
      TxOut Babbage -> (TxOut Babbage -> TxOut Babbage) -> TxOut Babbage
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Data Babbage)
 -> Identity (StrictMaybe (Data Babbage)))
-> TxOut Babbage -> Identity (TxOut Babbage)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Data era))
Lens' (TxOut Babbage) (StrictMaybe (Data Babbage))
dataTxOutL ((StrictMaybe (Data Babbage)
  -> Identity (StrictMaybe (Data Babbage)))
 -> TxOut Babbage -> Identity (TxOut Babbage))
-> StrictMaybe (Data Babbage) -> TxOut Babbage -> TxOut Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Data Conway -> Data Babbage
forall era1 era2. (Era era1, Era era2) => Data era1 -> Data era2
upgradeData (Data Conway -> Data Babbage)
-> StrictMaybe (Data Conway) -> StrictMaybe (Data Babbage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BabbageTxOut Conway
out BabbageTxOut Conway
-> Getting
     (StrictMaybe (Data Conway))
     (BabbageTxOut Conway)
     (StrictMaybe (Data Conway))
-> StrictMaybe (Data Conway)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Data Conway))
  (BabbageTxOut Conway)
  (StrictMaybe (Data Conway))
(StrictMaybe (Data Conway)
 -> Const (StrictMaybe (Data Conway)) (StrictMaybe (Data Conway)))
-> TxOut Conway -> Const (StrictMaybe (Data Conway)) (TxOut Conway)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Data era))
Lens' (TxOut Conway) (StrictMaybe (Data Conway))
dataTxOutL)
      TxOut Babbage
-> (TxOut Babbage -> BabbageTxOut Babbage) -> BabbageTxOut Babbage
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script Babbage)
 -> Identity (StrictMaybe (AlonzoScript Babbage)))
-> TxOut Babbage -> Identity (BabbageTxOut Babbage)
(StrictMaybe (Script Babbage)
 -> Identity (StrictMaybe (Script Babbage)))
-> TxOut Babbage -> Identity (TxOut Babbage)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut Babbage) (StrictMaybe (Script Babbage))
referenceScriptTxOutL ((StrictMaybe (Script Babbage)
  -> Identity (StrictMaybe (AlonzoScript Babbage)))
 -> TxOut Babbage -> Identity (BabbageTxOut Babbage))
-> StrictMaybe (AlonzoScript Babbage)
-> TxOut Babbage
-> BabbageTxOut Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (BabbageTxOut Conway
out BabbageTxOut Conway
-> Getting
     (StrictMaybe (AlonzoScript Conway))
     (BabbageTxOut Conway)
     (StrictMaybe (AlonzoScript Conway))
-> StrictMaybe (AlonzoScript Conway)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (AlonzoScript Conway))
  (BabbageTxOut Conway)
  (StrictMaybe (AlonzoScript Conway))
(StrictMaybe (Script Conway)
 -> Const
      (StrictMaybe (AlonzoScript Conway)) (StrictMaybe (Script Conway)))
-> TxOut Conway
-> Const (StrictMaybe (AlonzoScript Conway)) (TxOut Conway)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut Conway) (StrictMaybe (Script Conway))
referenceScriptTxOutL StrictMaybe (AlonzoScript Conway)
-> (AlonzoScript Conway -> StrictMaybe (AlonzoScript Babbage))
-> StrictMaybe (AlonzoScript Babbage)
forall a b. StrictMaybe a -> (a -> StrictMaybe b) -> StrictMaybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (AlonzoScript Babbage) -> StrictMaybe (AlonzoScript Babbage)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe (AlonzoScript Babbage)
 -> StrictMaybe (AlonzoScript Babbage))
-> (AlonzoScript Conway -> Maybe (AlonzoScript Babbage))
-> AlonzoScript Conway
-> StrictMaybe (AlonzoScript Babbage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoScript Conway -> Maybe (AlonzoScript Babbage)
translateScript)

  translateWits ::
    Ledger.AlonzoTxWits Ledger.Conway ->
    Ledger.AlonzoTxWits Ledger.Babbage
  translateWits :: AlonzoTxWits Conway -> AlonzoTxWits Babbage
translateWits AlonzoTxWits Conway
wits =
    TxWits Babbage
forall era. EraTxWits era => TxWits era
mkBasicTxWits
      TxWits Babbage
-> (TxWits Babbage -> TxWits Babbage) -> TxWits Babbage
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness (EraCrypto Babbage))
 -> Identity (Set (WitVKey 'Witness (EraCrypto Babbage))))
-> TxWits Babbage -> Identity (TxWits Babbage)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness (EraCrypto era)))
Lens' (TxWits Babbage) (Set (WitVKey 'Witness (EraCrypto Babbage)))
addrTxWitsL ((Set (WitVKey 'Witness (EraCrypto Babbage))
  -> Identity (Set (WitVKey 'Witness (EraCrypto Babbage))))
 -> TxWits Babbage -> Identity (TxWits Babbage))
-> Set (WitVKey 'Witness (EraCrypto Babbage))
-> TxWits Babbage
-> TxWits Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AlonzoTxWits Conway
wits AlonzoTxWits Conway
-> Getting
     (Set (WitVKey 'Witness (EraCrypto Babbage)))
     (AlonzoTxWits Conway)
     (Set (WitVKey 'Witness (EraCrypto Babbage)))
-> Set (WitVKey 'Witness (EraCrypto Babbage))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (WitVKey 'Witness (EraCrypto Babbage)))
  (AlonzoTxWits Conway)
  (Set (WitVKey 'Witness (EraCrypto Babbage)))
(Set (WitVKey 'Witness (EraCrypto Conway))
 -> Const
      (Set (WitVKey 'Witness (EraCrypto Babbage)))
      (Set (WitVKey 'Witness (EraCrypto Conway))))
-> TxWits Conway
-> Const
     (Set (WitVKey 'Witness (EraCrypto Babbage))) (TxWits Conway)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness (EraCrypto era)))
Lens' (TxWits Conway) (Set (WitVKey 'Witness (EraCrypto Conway)))
addrTxWitsL
      TxWits Babbage
-> (TxWits Babbage -> TxWits Babbage) -> TxWits Babbage
forall a b. a -> (a -> b) -> b
& (Set (BootstrapWitness (EraCrypto Babbage))
 -> Identity (Set (BootstrapWitness (EraCrypto Babbage))))
-> TxWits Babbage -> Identity (TxWits Babbage)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (BootstrapWitness (EraCrypto era)))
Lens' (TxWits Babbage) (Set (BootstrapWitness (EraCrypto Babbage)))
bootAddrTxWitsL ((Set (BootstrapWitness (EraCrypto Babbage))
  -> Identity (Set (BootstrapWitness (EraCrypto Babbage))))
 -> TxWits Babbage -> Identity (TxWits Babbage))
-> Set (BootstrapWitness (EraCrypto Babbage))
-> TxWits Babbage
-> TxWits Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AlonzoTxWits Conway
wits AlonzoTxWits Conway
-> Getting
     (Set (BootstrapWitness (EraCrypto Babbage)))
     (AlonzoTxWits Conway)
     (Set (BootstrapWitness (EraCrypto Babbage)))
-> Set (BootstrapWitness (EraCrypto Babbage))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (BootstrapWitness (EraCrypto Babbage)))
  (AlonzoTxWits Conway)
  (Set (BootstrapWitness (EraCrypto Babbage)))
(Set (BootstrapWitness (EraCrypto Conway))
 -> Const
      (Set (BootstrapWitness (EraCrypto Babbage)))
      (Set (BootstrapWitness (EraCrypto Conway))))
-> TxWits Conway
-> Const
     (Set (BootstrapWitness (EraCrypto Babbage))) (TxWits Conway)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (BootstrapWitness (EraCrypto era)))
Lens' (TxWits Conway) (Set (BootstrapWitness (EraCrypto Conway)))
bootAddrTxWitsL
      TxWits Babbage
-> (TxWits Babbage -> AlonzoTxWits Babbage) -> AlonzoTxWits Babbage
forall a b. a -> (a -> b) -> b
& (Map (ScriptHash (EraCrypto Babbage)) (Script Babbage)
 -> Identity
      (Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Babbage)))
-> TxWits Babbage -> Identity (AlonzoTxWits Babbage)
(Map (ScriptHash (EraCrypto Babbage)) (Script Babbage)
 -> Identity
      (Map (ScriptHash (EraCrypto Babbage)) (Script Babbage)))
-> TxWits Babbage -> Identity (TxWits Babbage)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map (ScriptHash (EraCrypto era)) (Script era))
Lens'
  (TxWits Babbage)
  (Map (ScriptHash (EraCrypto Babbage)) (Script Babbage))
scriptTxWitsL ((Map (ScriptHash (EraCrypto Babbage)) (Script Babbage)
  -> Identity
       (Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Babbage)))
 -> TxWits Babbage -> Identity (AlonzoTxWits Babbage))
-> Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Babbage)
-> TxWits Babbage
-> AlonzoTxWits Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (AlonzoScript Conway -> Maybe (AlonzoScript Babbage))
-> Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Conway)
-> Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Babbage)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe AlonzoScript Conway -> Maybe (AlonzoScript Babbage)
translateScript (AlonzoTxWits Conway
wits AlonzoTxWits Conway
-> Getting
     (Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Conway))
     (AlonzoTxWits Conway)
     (Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Conway))
-> Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Conway)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Conway))
  (AlonzoTxWits Conway)
  (Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Conway))
(Map (ScriptHash (EraCrypto Conway)) (Script Conway)
 -> Const
      (Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Conway))
      (Map (ScriptHash (EraCrypto Conway)) (Script Conway)))
-> TxWits Conway
-> Const
     (Map (ScriptHash (EraCrypto Babbage)) (AlonzoScript Conway))
     (TxWits Conway)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map (ScriptHash (EraCrypto era)) (Script era))
Lens'
  (TxWits Conway)
  (Map (ScriptHash (EraCrypto Conway)) (Script Conway))
scriptTxWitsL)
      AlonzoTxWits Babbage
-> (AlonzoTxWits Babbage -> AlonzoTxWits Babbage)
-> AlonzoTxWits Babbage
forall a b. a -> (a -> b) -> b
& (TxDats Babbage -> Identity (TxDats Babbage))
-> AlonzoTxWits Babbage -> Identity (AlonzoTxWits Babbage)
(TxDats Babbage -> Identity (TxDats Babbage))
-> TxWits Babbage -> Identity (TxWits Babbage)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits Babbage) (TxDats Babbage)
datsTxWitsL ((TxDats Babbage -> Identity (TxDats Babbage))
 -> AlonzoTxWits Babbage -> Identity (AlonzoTxWits Babbage))
-> TxDats Babbage -> AlonzoTxWits Babbage -> AlonzoTxWits Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxDats Conway -> TxDats Babbage
forall era1 era2.
(Era era1, Era era2, EraCrypto era1 ~ EraCrypto era2) =>
TxDats era1 -> TxDats era2
upgradeTxDats (AlonzoTxWits Conway
wits AlonzoTxWits Conway
-> Getting (TxDats Conway) (AlonzoTxWits Conway) (TxDats Conway)
-> TxDats Conway
forall s a. s -> Getting a s a -> a
^. Getting (TxDats Conway) (AlonzoTxWits Conway) (TxDats Conway)
(TxDats Conway -> Const (TxDats Conway) (TxDats Conway))
-> TxWits Conway -> Const (TxDats Conway) (TxWits Conway)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits Conway) (TxDats Conway)
datsTxWitsL)
      AlonzoTxWits Babbage
-> (AlonzoTxWits Babbage -> AlonzoTxWits Babbage)
-> AlonzoTxWits Babbage
forall a b. a -> (a -> b) -> b
& (Redeemers Babbage -> Identity (Redeemers Babbage))
-> AlonzoTxWits Babbage -> Identity (AlonzoTxWits Babbage)
(Redeemers Babbage -> Identity (Redeemers Babbage))
-> TxWits Babbage -> Identity (TxWits Babbage)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits Babbage) (Redeemers Babbage)
rdmrsTxWitsL ((Redeemers Babbage -> Identity (Redeemers Babbage))
 -> AlonzoTxWits Babbage -> Identity (AlonzoTxWits Babbage))
-> Redeemers Babbage
-> AlonzoTxWits Babbage
-> AlonzoTxWits Babbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers Conway -> Redeemers Babbage
translateRdmrs (AlonzoTxWits Conway
wits AlonzoTxWits Conway
-> Getting
     (Redeemers Conway) (AlonzoTxWits Conway) (Redeemers Conway)
-> Redeemers Conway
forall s a. s -> Getting a s a -> a
^. Getting (Redeemers Conway) (AlonzoTxWits Conway) (Redeemers Conway)
(Redeemers Conway -> Const (Redeemers Conway) (Redeemers Conway))
-> TxWits Conway -> Const (Redeemers Conway) (TxWits Conway)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits Conway) (Redeemers Conway)
rdmrsTxWitsL)

  translateScript ::
    Ledger.AlonzoScript Ledger.Conway ->
    Maybe (Ledger.AlonzoScript Ledger.Babbage)
  translateScript :: AlonzoScript Conway -> Maybe (AlonzoScript Babbage)
translateScript = \case
    Ledger.TimelockScript Timelock Conway
ts -> AlonzoScript Babbage -> Maybe (AlonzoScript Babbage)
forall a. a -> Maybe a
Just (AlonzoScript Babbage -> Maybe (AlonzoScript Babbage))
-> (Timelock Babbage -> AlonzoScript Babbage)
-> Timelock Babbage
-> Maybe (AlonzoScript Babbage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timelock Babbage -> AlonzoScript Babbage
forall era. Timelock era -> AlonzoScript era
Ledger.TimelockScript (Timelock Babbage -> Maybe (AlonzoScript Babbage))
-> Timelock Babbage -> Maybe (AlonzoScript Babbage)
forall a b. (a -> b) -> a -> b
$ Timelock Conway -> Timelock Babbage
forall era1 era2.
(Era era1, Era era2, EraCrypto era1 ~ EraCrypto era2) =>
Timelock era1 -> Timelock era2
translateTimelock Timelock Conway
ts
    Ledger.PlutusScript PlutusScript Conway
ps -> case PlutusScript Conway
ps of
      ConwayPlutusV1 Plutus 'PlutusV1
p1 -> AlonzoScript Babbage -> Maybe (AlonzoScript Babbage)
forall a. a -> Maybe a
Just (AlonzoScript Babbage -> Maybe (AlonzoScript Babbage))
-> (PlutusScript Babbage -> AlonzoScript Babbage)
-> PlutusScript Babbage
-> Maybe (AlonzoScript Babbage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScript Babbage -> AlonzoScript Babbage
forall era. PlutusScript era -> AlonzoScript era
Ledger.PlutusScript (PlutusScript Babbage -> Maybe (AlonzoScript Babbage))
-> PlutusScript Babbage -> Maybe (AlonzoScript Babbage)
forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV1 -> PlutusScript Babbage
forall c. Plutus 'PlutusV1 -> PlutusScript (BabbageEra c)
BabbagePlutusV1 Plutus 'PlutusV1
p1
      ConwayPlutusV2 Plutus 'PlutusV2
p2 -> AlonzoScript Babbage -> Maybe (AlonzoScript Babbage)
forall a. a -> Maybe a
Just (AlonzoScript Babbage -> Maybe (AlonzoScript Babbage))
-> (PlutusScript Babbage -> AlonzoScript Babbage)
-> PlutusScript Babbage
-> Maybe (AlonzoScript Babbage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScript Babbage -> AlonzoScript Babbage
forall era. PlutusScript era -> AlonzoScript era
Ledger.PlutusScript (PlutusScript Babbage -> Maybe (AlonzoScript Babbage))
-> PlutusScript Babbage -> Maybe (AlonzoScript Babbage)
forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV2 -> PlutusScript Babbage
forall c. Plutus 'PlutusV2 -> PlutusScript (BabbageEra c)
BabbagePlutusV2 Plutus 'PlutusV2
p2
      ConwayPlutusV3{} -> Maybe (AlonzoScript Babbage)
forall a. Maybe a
Nothing

  translateRdmrs ::
    Ledger.Redeemers Ledger.Conway ->
    Ledger.Redeemers Ledger.Babbage
  translateRdmrs :: Redeemers Conway -> Redeemers Babbage
translateRdmrs (Ledger.Redeemers Map (PlutusPurpose AsIx Conway) (Data Conway, ExUnits)
redeemerMap) =
    Map (PlutusPurpose AsIx Babbage) (Data Babbage, ExUnits)
-> Redeemers Babbage
Map (AlonzoPlutusPurpose AsIx Babbage) (Data Babbage, ExUnits)
-> Redeemers Babbage
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Ledger.Redeemers
      (Map (AlonzoPlutusPurpose AsIx Babbage) (Data Babbage, ExUnits)
 -> Redeemers Babbage)
-> ([(AlonzoPlutusPurpose AsIx Babbage, (Data Babbage, ExUnits))]
    -> Map (AlonzoPlutusPurpose AsIx Babbage) (Data Babbage, ExUnits))
-> [(AlonzoPlutusPurpose AsIx Babbage, (Data Babbage, ExUnits))]
-> Redeemers Babbage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(AlonzoPlutusPurpose AsIx Babbage, (Data Babbage, ExUnits))]
-> Map (AlonzoPlutusPurpose AsIx Babbage) (Data Babbage, ExUnits)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      ([(AlonzoPlutusPurpose AsIx Babbage, (Data Babbage, ExUnits))]
 -> Redeemers Babbage)
-> [(AlonzoPlutusPurpose AsIx Babbage, (Data Babbage, ExUnits))]
-> Redeemers Babbage
forall a b. (a -> b) -> a -> b
$ ((ConwayPlutusPurpose AsIx Conway, (Data Conway, ExUnits))
 -> Maybe
      (AlonzoPlutusPurpose AsIx Babbage, (Data Babbage, ExUnits)))
-> [(ConwayPlutusPurpose AsIx Conway, (Data Conway, ExUnits))]
-> [(AlonzoPlutusPurpose AsIx Babbage, (Data Babbage, ExUnits))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        ( \(ConwayPlutusPurpose AsIx Conway
purpose, (Data Conway
dat, ExUnits
units)) -> do
            AlonzoPlutusPurpose AsIx Babbage
p' <- ConwayPlutusPurpose AsIx Conway
-> Maybe (AlonzoPlutusPurpose AsIx Babbage)
translatePlutusPurpose ConwayPlutusPurpose AsIx Conway
purpose
            (AlonzoPlutusPurpose AsIx Babbage, (Data Babbage, ExUnits))
-> Maybe
     (AlonzoPlutusPurpose AsIx Babbage, (Data Babbage, ExUnits))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlonzoPlutusPurpose AsIx Babbage
p', (Data Conway -> Data Babbage
forall era1 era2. (Era era1, Era era2) => Data era1 -> Data era2
upgradeData Data Conway
dat, ExUnits
units))
        )
      ([(ConwayPlutusPurpose AsIx Conway, (Data Conway, ExUnits))]
 -> [(AlonzoPlutusPurpose AsIx Babbage, (Data Babbage, ExUnits))])
-> [(ConwayPlutusPurpose AsIx Conway, (Data Conway, ExUnits))]
-> [(AlonzoPlutusPurpose AsIx Babbage, (Data Babbage, ExUnits))]
forall a b. (a -> b) -> a -> b
$ Map (ConwayPlutusPurpose AsIx Conway) (Data Conway, ExUnits)
-> [(ConwayPlutusPurpose AsIx Conway, (Data Conway, ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (PlutusPurpose AsIx Conway) (Data Conway, ExUnits)
Map (ConwayPlutusPurpose AsIx Conway) (Data Conway, ExUnits)
redeemerMap

  translatePlutusPurpose ::
    Conway.ConwayPlutusPurpose Ledger.AsIx Ledger.Conway ->
    Maybe (Ledger.AlonzoPlutusPurpose Ledger.AsIx Ledger.Babbage)
  translatePlutusPurpose :: ConwayPlutusPurpose AsIx Conway
-> Maybe (AlonzoPlutusPurpose AsIx Babbage)
translatePlutusPurpose = \case
    ConwaySpending (AsIx Word32
ix) -> AlonzoPlutusPurpose AsIx Babbage
-> Maybe (AlonzoPlutusPurpose AsIx Babbage)
forall a. a -> Maybe a
Just (AlonzoPlutusPurpose AsIx Babbage
 -> Maybe (AlonzoPlutusPurpose AsIx Babbage))
-> AlonzoPlutusPurpose AsIx Babbage
-> Maybe (AlonzoPlutusPurpose AsIx Babbage)
forall a b. (a -> b) -> a -> b
$ AsIx Word32 (TxIn (EraCrypto Babbage))
-> AlonzoPlutusPurpose AsIx Babbage
forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending (Word32 -> AsIx Word32 (TxIn StandardCrypto)
forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    ConwayMinting (AsIx Word32
ix) -> AlonzoPlutusPurpose AsIx Babbage
-> Maybe (AlonzoPlutusPurpose AsIx Babbage)
forall a. a -> Maybe a
Just (AlonzoPlutusPurpose AsIx Babbage
 -> Maybe (AlonzoPlutusPurpose AsIx Babbage))
-> AlonzoPlutusPurpose AsIx Babbage
-> Maybe (AlonzoPlutusPurpose AsIx Babbage)
forall a b. (a -> b) -> a -> b
$ AsIx Word32 (PolicyID (EraCrypto Babbage))
-> AlonzoPlutusPurpose AsIx Babbage
forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoMinting (Word32 -> AsIx Word32 (PolicyID StandardCrypto)
forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    ConwayCertifying (AsIx Word32
ix) -> AlonzoPlutusPurpose AsIx Babbage
-> Maybe (AlonzoPlutusPurpose AsIx Babbage)
forall a. a -> Maybe a
Just (AlonzoPlutusPurpose AsIx Babbage
 -> Maybe (AlonzoPlutusPurpose AsIx Babbage))
-> AlonzoPlutusPurpose AsIx Babbage
-> Maybe (AlonzoPlutusPurpose AsIx Babbage)
forall a b. (a -> b) -> a -> b
$ AsIx Word32 (TxCert Babbage) -> AlonzoPlutusPurpose AsIx Babbage
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying (Word32 -> AsIx Word32 (ShelleyTxCert Babbage)
forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    ConwayRewarding (AsIx Word32
ix) -> AlonzoPlutusPurpose AsIx Babbage
-> Maybe (AlonzoPlutusPurpose AsIx Babbage)
forall a. a -> Maybe a
Just (AlonzoPlutusPurpose AsIx Babbage
 -> Maybe (AlonzoPlutusPurpose AsIx Babbage))
-> AlonzoPlutusPurpose AsIx Babbage
-> Maybe (AlonzoPlutusPurpose AsIx Babbage)
forall a b. (a -> b) -> a -> b
$ AsIx Word32 (RewardAccount (EraCrypto Babbage))
-> AlonzoPlutusPurpose AsIx Babbage
forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> AlonzoPlutusPurpose f era
AlonzoRewarding (Word32 -> AsIx Word32 (RewardAccount StandardCrypto)
forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    ConwayVoting{} -> Maybe (AlonzoPlutusPurpose AsIx Babbage)
forall a. Maybe a
Nothing
    ConwayProposing{} -> Maybe (AlonzoPlutusPurpose AsIx Babbage)
forall a. Maybe a
Nothing