{-# 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.Crypto (Crypto)
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
  Crypto c =>
  TranslateEra (BabbageEra c) NewEpochState
  where
  translateEra :: TranslationContext (BabbageEra c)
-> NewEpochState (PreviousEra (BabbageEra c))
-> Except
     (TranslationError (BabbageEra c) NewEpochState)
     (NewEpochState (BabbageEra c))
translateEra TranslationContext (BabbageEra c)
ctxt NewEpochState (PreviousEra (BabbageEra c))
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 c))
nes
        , nesBprev :: BlocksMade (EraCrypto (BabbageEra c))
nesBprev = forall era. NewEpochState era -> BlocksMade (EraCrypto era)
nesBprev NewEpochState (PreviousEra (BabbageEra c))
nes
        , nesBcur :: BlocksMade (EraCrypto (BabbageEra c))
nesBcur = forall era. NewEpochState era -> BlocksMade (EraCrypto era)
nesBcur NewEpochState (PreviousEra (BabbageEra c))
nes
        , nesEs :: EpochState (BabbageEra c)
nesEs = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (BabbageEra c)
ctxt forall a b. (a -> b) -> a -> b
$ forall era. NewEpochState era -> EpochState era
nesEs NewEpochState (PreviousEra (BabbageEra c))
nes
        , nesRu :: StrictMaybe (PulsingRewUpdate (EraCrypto (BabbageEra c)))
nesRu = forall era.
NewEpochState era -> StrictMaybe (PulsingRewUpdate (EraCrypto era))
nesRu NewEpochState (PreviousEra (BabbageEra c))
nes
        , nesPd :: PoolDistr (EraCrypto (BabbageEra c))
nesPd = forall era. NewEpochState era -> PoolDistr (EraCrypto era)
nesPd NewEpochState (PreviousEra (BabbageEra c))
nes
        , stashedAVVMAddresses :: StashedAVVMAddresses (BabbageEra c)
stashedAVVMAddresses = ()
        }

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

instance Crypto c => TranslateEra (BabbageEra c) Tx where
  type TranslationError (BabbageEra c) Tx = DecoderError
  translateEra :: TranslationContext (BabbageEra c)
-> Tx (PreviousEra (BabbageEra c))
-> Except (TranslationError (BabbageEra c) Tx) (Tx (BabbageEra c))
translateEra TranslationContext (BabbageEra c)
_ctxt (Tx Tx (PreviousEra (BabbageEra c))
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 c)
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 c))
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL
    AlonzoTxWits (BabbageEra c)
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 c))
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL
    StrictMaybe (AlonzoTxAuxData (BabbageEra c))
auxData <- case Tx (PreviousEra (BabbageEra c))
tx forall s a. s -> Getting a s a -> a
^. forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (AuxiliaryData era))
auxDataTxL of
      StrictMaybe (TxAuxData (AlonzoEra c))
SNothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. StrictMaybe a
SNothing
      SJust TxAuxData (AlonzoEra c)
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 c)
auxData
    let validating :: IsValid
validating = Tx (PreviousEra (BabbageEra c))
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 c)
txBody AlonzoTxWits (BabbageEra c)
txWits IsValid
validating StrictMaybe (AlonzoTxAuxData (BabbageEra c))
auxData

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

instance Crypto c => TranslateEra (BabbageEra c) PParams where
  translateEra :: TranslationContext (BabbageEra c)
-> PParams (PreviousEra (BabbageEra c))
-> Except
     (TranslationError (BabbageEra c) PParams) (PParams (BabbageEra c))
translateEra TranslationContext (BabbageEra c)
_ = 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 Crypto c => TranslateEra (BabbageEra c) FuturePParams where
  translateEra :: TranslationContext (BabbageEra c)
-> FuturePParams (PreviousEra (BabbageEra c))
-> Except
     (TranslationError (BabbageEra c) FuturePParams)
     (FuturePParams (BabbageEra c))
translateEra TranslationContext (BabbageEra c)
ctxt = \case
    FuturePParams (PreviousEra (BabbageEra c))
NoPParamsUpdate -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall era. FuturePParams era
NoPParamsUpdate
    DefinitePParamsUpdate PParams (PreviousEra (BabbageEra c))
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 c)
ctxt PParams (PreviousEra (BabbageEra c))
pp
    PotentialPParamsUpdate Maybe (PParams (PreviousEra (BabbageEra c)))
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 c)
ctxt) Maybe (PParams (PreviousEra (BabbageEra c)))
mpp

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

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

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

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

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

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

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

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

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

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

instance Crypto c => TranslateEra (BabbageEra c) ProposedPPUpdates where
  translateEra :: TranslationContext (BabbageEra c)
-> ProposedPPUpdates (PreviousEra (BabbageEra c))
-> Except
     (TranslationError (BabbageEra c) ProposedPPUpdates)
     (ProposedPPUpdates (BabbageEra c))
translateEra TranslationContext (BabbageEra c)
_ctxt (ProposedPPUpdates Map
  (KeyHash 'Genesis (EraCrypto (PreviousEra (BabbageEra c))))
  (PParamsUpdate (PreviousEra (BabbageEra c)))
ppup) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
Map (KeyHash 'Genesis (EraCrypto era)) (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 (EraCrypto (PreviousEra (BabbageEra c))))
  (PParamsUpdate (PreviousEra (BabbageEra c)))
ppup

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