{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Babbage.Translation where

import Cardano.Ledger.Alonzo (AlonzoEra)
import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
import Cardano.Ledger.Babbage.Core hiding (Tx)
import Cardano.Ledger.Babbage.Era (BabbageEra)
import Cardano.Ledger.Babbage.PParams ()
import Cardano.Ledger.Babbage.Tx (AlonzoTx (..))
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Binary (DecoderError)
import Cardano.Ledger.CertState (CommitteeState (..))
import qualified Cardano.Ledger.Core as Core (Tx)
import Cardano.Ledger.Shelley.LedgerState (
  CertState (..),
  DState (..),
  EpochState (..),
  LedgerState (..),
  NewEpochState (..),
  PState (..),
  UTxOState (..),
  VState (..),
 )
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..))
import Cardano.Ledger.UTxO (UTxO (..))
import qualified Data.Map.Strict as Map
import Lens.Micro

--------------------------------------------------------------------------------
-- Translation from Alonzo to Babbage
--
-- The instances below are needed by the consensus layer. Do not remove any of
-- them without coordinating with consensus.
--
-- Please add auxiliary instances and other declarations at the bottom of this
-- module, not in the list below so that it remains clear which instances the
-- consensus layer needs.
--
-- WARNING: when a translation instance currently uses the default
-- 'TranslationError', i.e., 'Void', it means the consensus layer relies on it
-- being total. Do not change it!
--------------------------------------------------------------------------------

instance TranslateEra BabbageEra NewEpochState where
  translateEra :: TranslationContext BabbageEra
-> NewEpochState (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra NewEpochState)
     (NewEpochState BabbageEra)
translateEra TranslationContext BabbageEra
ctxt NewEpochState (PreviousEra BabbageEra)
nes =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      NewEpochState
        { nesEL :: EpochNo
nesEL = forall era. NewEpochState era -> EpochNo
nesEL NewEpochState (PreviousEra BabbageEra)
nes
        , nesBprev :: BlocksMade
nesBprev = forall era. NewEpochState era -> BlocksMade
nesBprev NewEpochState (PreviousEra BabbageEra)
nes
        , nesBcur :: BlocksMade
nesBcur = forall era. NewEpochState era -> BlocksMade
nesBcur NewEpochState (PreviousEra BabbageEra)
nes
        , nesEs :: EpochState BabbageEra
nesEs = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. NewEpochState era -> EpochState era
nesEs NewEpochState (PreviousEra BabbageEra)
nes
        , nesRu :: StrictMaybe PulsingRewUpdate
nesRu = forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesRu NewEpochState (PreviousEra BabbageEra)
nes
        , nesPd :: PoolDistr
nesPd = forall era. NewEpochState era -> PoolDistr
nesPd NewEpochState (PreviousEra BabbageEra)
nes
        , stashedAVVMAddresses :: StashedAVVMAddresses BabbageEra
stashedAVVMAddresses = ()
        }

newtype Tx era = Tx {forall era. Tx era -> Tx era
unTx :: Core.Tx era}

instance TranslateEra BabbageEra Tx where
  type TranslationError BabbageEra Tx = DecoderError
  translateEra :: TranslationContext BabbageEra
-> Tx (PreviousEra BabbageEra)
-> Except (TranslationError BabbageEra Tx) (Tx BabbageEra)
translateEra TranslationContext BabbageEra
_ctxt (Tx Tx (PreviousEra BabbageEra)
tx) = do
    -- Note that this does not preserve the hidden bytes field of the transaction.
    -- This is under the premise that this is irrelevant for TxInBlocks, which are
    -- not transmitted as contiguous chunks.
    BabbageTxBody BabbageEra
txBody <- forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)),
 DecCBOR (Annotator (to era))) =>
Text -> ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR Text
"TxBody" forall a b. (a -> b) -> a -> b
$ Tx (PreviousEra BabbageEra)
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL
    AlonzoTxWits BabbageEra
txWits <- forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)),
 DecCBOR (Annotator (to era))) =>
Text -> ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR Text
"TxWitness" forall a b. (a -> b) -> a -> b
$ Tx (PreviousEra BabbageEra)
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL
    StrictMaybe (AlonzoTxAuxData BabbageEra)
auxData <- case Tx (PreviousEra BabbageEra)
tx forall s a. s -> Getting a s a -> a
^. forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL of
      StrictMaybe (TxAuxData AlonzoEra)
SNothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. StrictMaybe a
SNothing
      SJust TxAuxData AlonzoEra
auxData -> forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)),
 DecCBOR (Annotator (to era))) =>
Text -> ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR Text
"AuxData" TxAuxData AlonzoEra
auxData
    let validating :: IsValid
validating = Tx (PreviousEra BabbageEra)
tx forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Alonzo.isValidTxL
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. Tx era -> Tx era
Tx forall a b. (a -> b) -> a -> b
$ forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx BabbageTxBody BabbageEra
txBody AlonzoTxWits BabbageEra
txWits IsValid
validating StrictMaybe (AlonzoTxAuxData BabbageEra)
auxData

--------------------------------------------------------------------------------
-- Auxiliary instances and functions
--------------------------------------------------------------------------------

instance TranslateEra BabbageEra PParams where
  translateEra :: TranslationContext BabbageEra
-> PParams (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra PParams) (PParams BabbageEra)
translateEra TranslationContext BabbageEra
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams Identity era
-> PParams (PreviousEra era) -> PParams era
upgradePParams ()

instance TranslateEra BabbageEra FuturePParams where
  translateEra :: TranslationContext BabbageEra
-> FuturePParams (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra FuturePParams)
     (FuturePParams BabbageEra)
translateEra TranslationContext BabbageEra
ctxt = \case
    FuturePParams (PreviousEra BabbageEra)
NoPParamsUpdate -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall era. FuturePParams era
NoPParamsUpdate
    DefinitePParamsUpdate PParams (PreviousEra BabbageEra)
pp -> forall era. PParams era -> FuturePParams era
DefinitePParamsUpdate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext BabbageEra
ctxt PParams (PreviousEra BabbageEra)
pp
    PotentialPParamsUpdate Maybe (PParams (PreviousEra BabbageEra))
mpp -> forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext BabbageEra
ctxt) Maybe (PParams (PreviousEra BabbageEra))
mpp

instance TranslateEra BabbageEra EpochState where
  translateEra :: TranslationContext BabbageEra
-> EpochState (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra EpochState) (EpochState BabbageEra)
translateEra TranslationContext BabbageEra
ctxt EpochState (PreviousEra BabbageEra)
es =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      EpochState
        { esAccountState :: AccountState
esAccountState = forall era. EpochState era -> AccountState
esAccountState EpochState (PreviousEra BabbageEra)
es
        , esSnapshots :: SnapShots
esSnapshots = forall era. EpochState era -> SnapShots
esSnapshots EpochState (PreviousEra BabbageEra)
es
        , esLState :: LedgerState BabbageEra
esLState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. EpochState era -> LedgerState era
esLState EpochState (PreviousEra BabbageEra)
es
        , esNonMyopic :: NonMyopic
esNonMyopic = forall era. EpochState era -> NonMyopic
esNonMyopic EpochState (PreviousEra BabbageEra)
es
        }

instance TranslateEra BabbageEra DState where
  translateEra :: TranslationContext BabbageEra
-> DState (PreviousEra BabbageEra)
-> Except (TranslationError BabbageEra DState) (DState BabbageEra)
translateEra TranslationContext BabbageEra
_ DState {Map FutureGenDeleg GenDelegPair
InstantaneousRewards
UMap
GenDelegs
dsUnified :: forall era. DState era -> UMap
dsFutureGenDelegs :: forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsGenDelegs :: forall era. DState era -> GenDelegs
dsIRewards :: forall era. DState era -> InstantaneousRewards
dsIRewards :: InstantaneousRewards
dsGenDelegs :: GenDelegs
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsUnified :: UMap
..} = forall (f :: * -> *) a. Applicative f => a -> f a
pure DState {Map FutureGenDeleg GenDelegPair
InstantaneousRewards
UMap
GenDelegs
dsUnified :: UMap
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsIRewards :: InstantaneousRewards
dsGenDelegs :: GenDelegs
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsUnified :: UMap
..}

instance TranslateEra BabbageEra CommitteeState where
  translateEra :: TranslationContext BabbageEra
-> CommitteeState (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra CommitteeState)
     (CommitteeState BabbageEra)
translateEra TranslationContext BabbageEra
_ CommitteeState {Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
..} = forall (f :: * -> *) a. Applicative f => a -> f a
pure CommitteeState {Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
..}

instance TranslateEra BabbageEra VState where
  translateEra :: TranslationContext BabbageEra
-> VState (PreviousEra BabbageEra)
-> Except (TranslationError BabbageEra VState) (VState BabbageEra)
translateEra TranslationContext BabbageEra
ctx VState {Map (Credential 'DRepRole) DRepState
CommitteeState (PreviousEra BabbageEra)
EpochNo
vsDReps :: forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsCommitteeState :: forall era. VState era -> CommitteeState era
vsNumDormantEpochs :: forall era. VState era -> EpochNo
vsNumDormantEpochs :: EpochNo
vsCommitteeState :: CommitteeState (PreviousEra BabbageEra)
vsDReps :: Map (Credential 'DRepRole) DRepState
..} = do
    CommitteeState BabbageEra
committeeState <- forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext BabbageEra
ctx CommitteeState (PreviousEra BabbageEra)
vsCommitteeState
    forall (f :: * -> *) a. Applicative f => a -> f a
pure VState {vsCommitteeState :: CommitteeState BabbageEra
vsCommitteeState = CommitteeState BabbageEra
committeeState, Map (Credential 'DRepRole) DRepState
EpochNo
vsDReps :: Map (Credential 'DRepRole) DRepState
vsNumDormantEpochs :: EpochNo
vsNumDormantEpochs :: EpochNo
vsDReps :: Map (Credential 'DRepRole) DRepState
..}

instance TranslateEra BabbageEra PState where
  translateEra :: TranslationContext BabbageEra
-> PState (PreviousEra BabbageEra)
-> Except (TranslationError BabbageEra PState) (PState BabbageEra)
translateEra TranslationContext BabbageEra
_ PState {Map (KeyHash 'StakePool) PoolParams
Map (KeyHash 'StakePool) Coin
Map (KeyHash 'StakePool) EpochNo
psStakePoolParams :: forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psRetiring :: forall era. PState era -> Map (KeyHash 'StakePool) EpochNo
psDeposits :: forall era. PState era -> Map (KeyHash 'StakePool) Coin
psDeposits :: Map (KeyHash 'StakePool) Coin
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
..} = forall (f :: * -> *) a. Applicative f => a -> f a
pure PState {Map (KeyHash 'StakePool) PoolParams
Map (KeyHash 'StakePool) Coin
Map (KeyHash 'StakePool) EpochNo
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psDeposits :: Map (KeyHash 'StakePool) Coin
psDeposits :: Map (KeyHash 'StakePool) Coin
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
..}

instance TranslateEra BabbageEra CertState where
  translateEra :: TranslationContext BabbageEra
-> CertState (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra CertState) (CertState BabbageEra)
translateEra TranslationContext BabbageEra
ctxt CertState (PreviousEra BabbageEra)
ls =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      CertState
        { certDState :: DState BabbageEra
certDState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> DState era
certDState CertState (PreviousEra BabbageEra)
ls
        , certPState :: PState BabbageEra
certPState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> PState era
certPState CertState (PreviousEra BabbageEra)
ls
        , certVState :: VState BabbageEra
certVState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> VState era
certVState CertState (PreviousEra BabbageEra)
ls
        }

instance TranslateEra BabbageEra LedgerState where
  translateEra :: TranslationContext BabbageEra
-> LedgerState (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra LedgerState) (LedgerState BabbageEra)
translateEra TranslationContext BabbageEra
ctxt LedgerState (PreviousEra BabbageEra)
ls =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      LedgerState
        { lsUTxOState :: UTxOState BabbageEra
lsUTxOState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState (PreviousEra BabbageEra)
ls
        , lsCertState :: CertState BabbageEra
lsCertState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. LedgerState era -> CertState era
lsCertState LedgerState (PreviousEra BabbageEra)
ls
        }

instance TranslateEra BabbageEra UTxOState where
  translateEra :: TranslationContext BabbageEra
-> UTxOState (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra UTxOState) (UTxOState BabbageEra)
translateEra TranslationContext BabbageEra
ctxt UTxOState (PreviousEra BabbageEra)
us =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      UTxOState
        { utxosUtxo :: UTxO BabbageEra
utxosUtxo = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. UTxOState era -> UTxO era
utxosUtxo UTxOState (PreviousEra BabbageEra)
us
        , utxosDeposited :: Coin
utxosDeposited = forall era. UTxOState era -> Coin
utxosDeposited UTxOState (PreviousEra BabbageEra)
us
        , utxosFees :: Coin
utxosFees = forall era. UTxOState era -> Coin
utxosFees UTxOState (PreviousEra BabbageEra)
us
        , utxosGovState :: GovState BabbageEra
utxosGovState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. UTxOState era -> GovState era
utxosGovState UTxOState (PreviousEra BabbageEra)
us
        , utxosStakeDistr :: IncrementalStake
utxosStakeDistr = forall era. UTxOState era -> IncrementalStake
utxosStakeDistr UTxOState (PreviousEra BabbageEra)
us
        , utxosDonation :: Coin
utxosDonation = forall era. UTxOState era -> Coin
utxosDonation UTxOState (PreviousEra BabbageEra)
us
        }

instance TranslateEra BabbageEra UTxO where
  translateEra :: TranslationContext BabbageEra
-> UTxO (PreviousEra BabbageEra)
-> Except (TranslationError BabbageEra UTxO) (UTxO BabbageEra)
translateEra TranslationContext BabbageEra
_ctxt UTxO (PreviousEra BabbageEra)
utxo =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. Map TxIn (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$ TxOut AlonzoEra -> TxOut BabbageEra
translateTxOut forall a b k. (a -> b) -> Map k a -> Map k b
`Map.map` forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO UTxO (PreviousEra BabbageEra)
utxo

instance TranslateEra BabbageEra ShelleyGovState where
  translateEra :: TranslationContext BabbageEra
-> ShelleyGovState (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra ShelleyGovState)
     (ShelleyGovState BabbageEra)
translateEra TranslationContext BabbageEra
ctxt ShelleyGovState (PreviousEra BabbageEra)
ps =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ShelleyGovState
        { sgsCurProposals :: ProposedPPUpdates BabbageEra
sgsCurProposals = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsCurProposals ShelleyGovState (PreviousEra BabbageEra)
ps
        , sgsFutureProposals :: ProposedPPUpdates BabbageEra
sgsFutureProposals = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsFutureProposals ShelleyGovState (PreviousEra BabbageEra)
ps
        , sgsCurPParams :: PParams BabbageEra
sgsCurPParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGovState era -> PParams era
sgsCurPParams ShelleyGovState (PreviousEra BabbageEra)
ps
        , sgsPrevPParams :: PParams BabbageEra
sgsPrevPParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGovState era -> PParams era
sgsPrevPParams ShelleyGovState (PreviousEra BabbageEra)
ps
        , sgsFuturePParams :: FuturePParams BabbageEra
sgsFuturePParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGovState era -> FuturePParams era
sgsFuturePParams ShelleyGovState (PreviousEra BabbageEra)
ps
        }

instance TranslateEra BabbageEra ProposedPPUpdates where
  translateEra :: TranslationContext BabbageEra
-> ProposedPPUpdates (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra ProposedPPUpdates)
     (ProposedPPUpdates BabbageEra)
translateEra TranslationContext BabbageEra
_ctxt (ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate (PreviousEra BabbageEra))
ppup) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams StrictMaybe era
-> PParamsUpdate (PreviousEra era) -> PParamsUpdate era
upgradePParamsUpdate ()) Map (KeyHash 'Genesis) (PParamsUpdate (PreviousEra BabbageEra))
ppup

translateTxOut ::
  TxOut AlonzoEra ->
  TxOut BabbageEra
translateTxOut :: TxOut AlonzoEra -> TxOut BabbageEra
translateTxOut = forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut
{-# DEPRECATED translateTxOut "Use `upgradeTxOut` instead" #-}