{-# 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 Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.Era (BabbageEra)
import Cardano.Ledger.Babbage.PParams ()
import Cardano.Ledger.Babbage.State
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Binary (DecoderError)
import Cardano.Ledger.Shelley.LedgerState (
  EpochState (..),
  LedgerState (..),
  NewEpochState (..),
  UTxOState (..),
 )
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..))
import Data.Coerce (coerce)
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 =
    NewEpochState BabbageEra
-> Except
     (TranslationError BabbageEra NewEpochState)
     (NewEpochState BabbageEra)
forall a.
a -> ExceptT (TranslationError BabbageEra NewEpochState) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewEpochState BabbageEra
 -> Except
      (TranslationError BabbageEra NewEpochState)
      (NewEpochState BabbageEra))
-> NewEpochState BabbageEra
-> Except
     (TranslationError BabbageEra NewEpochState)
     (NewEpochState BabbageEra)
forall a b. (a -> b) -> a -> b
$
      NewEpochState
        { nesEL :: EpochNo
nesEL = NewEpochState AlonzoEra -> EpochNo
forall era. NewEpochState era -> EpochNo
nesEL NewEpochState (PreviousEra BabbageEra)
NewEpochState AlonzoEra
nes
        , nesBprev :: BlocksMade
nesBprev = NewEpochState AlonzoEra -> BlocksMade
forall era. NewEpochState era -> BlocksMade
nesBprev NewEpochState (PreviousEra BabbageEra)
NewEpochState AlonzoEra
nes
        , nesBcur :: BlocksMade
nesBcur = NewEpochState AlonzoEra -> BlocksMade
forall era. NewEpochState era -> BlocksMade
nesBcur NewEpochState (PreviousEra BabbageEra)
NewEpochState AlonzoEra
nes
        , nesEs :: EpochState BabbageEra
nesEs = TranslationContext BabbageEra
-> EpochState (PreviousEra BabbageEra) -> EpochState BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (EpochState (PreviousEra BabbageEra) -> EpochState BabbageEra)
-> EpochState (PreviousEra BabbageEra) -> EpochState BabbageEra
forall a b. (a -> b) -> a -> b
$ NewEpochState AlonzoEra -> EpochState AlonzoEra
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState (PreviousEra BabbageEra)
NewEpochState AlonzoEra
nes
        , nesRu :: StrictMaybe PulsingRewUpdate
nesRu = NewEpochState AlonzoEra -> StrictMaybe PulsingRewUpdate
forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesRu NewEpochState (PreviousEra BabbageEra)
NewEpochState AlonzoEra
nes
        , nesPd :: PoolDistr
nesPd = NewEpochState AlonzoEra -> PoolDistr
forall era. NewEpochState era -> PoolDistr
nesPd NewEpochState (PreviousEra BabbageEra)
NewEpochState AlonzoEra
nes
        , stashedAVVMAddresses :: StashedAVVMAddresses BabbageEra
stashedAVVMAddresses = ()
        }

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 (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.
    TxBody BabbageEra
txBody <- Text
-> TxBody (PreviousEra BabbageEra)
-> Except DecoderError (TxBody BabbageEra)
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" (TxBody (PreviousEra BabbageEra)
 -> Except DecoderError (TxBody BabbageEra))
-> TxBody (PreviousEra BabbageEra)
-> Except DecoderError (TxBody BabbageEra)
forall a b. (a -> b) -> a -> b
$ Tx (PreviousEra BabbageEra)
Tx AlonzoEra
tx Tx AlonzoEra
-> Getting (TxBody AlonzoEra) (Tx AlonzoEra) (TxBody AlonzoEra)
-> TxBody AlonzoEra
forall s a. s -> Getting a s a -> a
^. Getting (TxBody AlonzoEra) (Tx AlonzoEra) (TxBody AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx AlonzoEra) (TxBody AlonzoEra)
bodyTxL
    AlonzoTxWits BabbageEra
txWits <- Text
-> AlonzoTxWits (PreviousEra BabbageEra)
-> Except DecoderError (AlonzoTxWits BabbageEra)
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" (AlonzoTxWits (PreviousEra BabbageEra)
 -> Except DecoderError (AlonzoTxWits BabbageEra))
-> AlonzoTxWits (PreviousEra BabbageEra)
-> Except DecoderError (AlonzoTxWits BabbageEra)
forall a b. (a -> b) -> a -> b
$ Tx (PreviousEra BabbageEra)
Tx AlonzoEra
tx Tx AlonzoEra
-> Getting
     (AlonzoTxWits (PreviousEra BabbageEra))
     (Tx AlonzoEra)
     (AlonzoTxWits (PreviousEra BabbageEra))
-> AlonzoTxWits (PreviousEra BabbageEra)
forall s a. s -> Getting a s a -> a
^. (TxWits AlonzoEra
 -> Const
      (AlonzoTxWits (PreviousEra BabbageEra)) (TxWits AlonzoEra))
-> Tx AlonzoEra
-> Const (AlonzoTxWits (PreviousEra BabbageEra)) (Tx AlonzoEra)
Getting
  (AlonzoTxWits (PreviousEra BabbageEra))
  (Tx AlonzoEra)
  (AlonzoTxWits (PreviousEra BabbageEra))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx AlonzoEra) (TxWits AlonzoEra)
witsTxL
    StrictMaybe (AlonzoTxAuxData BabbageEra)
auxData <- case Tx (PreviousEra BabbageEra)
Tx AlonzoEra
tx Tx AlonzoEra
-> Getting
     (StrictMaybe (AlonzoTxAuxData AlonzoEra))
     (Tx AlonzoEra)
     (StrictMaybe (AlonzoTxAuxData AlonzoEra))
-> StrictMaybe (AlonzoTxAuxData AlonzoEra)
forall s a. s -> Getting a s a -> a
^. (StrictMaybe (TxAuxData AlonzoEra)
 -> Const
      (StrictMaybe (AlonzoTxAuxData AlonzoEra))
      (StrictMaybe (TxAuxData AlonzoEra)))
-> Tx AlonzoEra
-> Const (StrictMaybe (AlonzoTxAuxData AlonzoEra)) (Tx AlonzoEra)
Getting
  (StrictMaybe (AlonzoTxAuxData AlonzoEra))
  (Tx AlonzoEra)
  (StrictMaybe (AlonzoTxAuxData AlonzoEra))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx AlonzoEra) (StrictMaybe (TxAuxData AlonzoEra))
auxDataTxL of
      StrictMaybe (AlonzoTxAuxData AlonzoEra)
SNothing -> StrictMaybe (AlonzoTxAuxData BabbageEra)
-> ExceptT
     DecoderError Identity (StrictMaybe (AlonzoTxAuxData BabbageEra))
forall a. a -> ExceptT DecoderError Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe (AlonzoTxAuxData BabbageEra)
forall a. StrictMaybe a
SNothing
      SJust AlonzoTxAuxData AlonzoEra
auxData -> AlonzoTxAuxData BabbageEra
-> StrictMaybe (AlonzoTxAuxData BabbageEra)
forall a. a -> StrictMaybe a
SJust (AlonzoTxAuxData BabbageEra
 -> StrictMaybe (AlonzoTxAuxData BabbageEra))
-> ExceptT DecoderError Identity (AlonzoTxAuxData BabbageEra)
-> ExceptT
     DecoderError Identity (StrictMaybe (AlonzoTxAuxData BabbageEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AlonzoTxAuxData (PreviousEra BabbageEra)
-> ExceptT DecoderError Identity (AlonzoTxAuxData BabbageEra)
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" AlonzoTxAuxData (PreviousEra BabbageEra)
AlonzoTxAuxData AlonzoEra
auxData
    let validating :: IsValid
validating = Tx (PreviousEra BabbageEra)
Tx AlonzoEra
tx Tx AlonzoEra -> Getting IsValid (Tx AlonzoEra) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (Tx AlonzoEra) IsValid
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx AlonzoEra) IsValid
isValidTxL
    Tx BabbageEra -> ExceptT DecoderError Identity (Tx BabbageEra)
forall a. a -> ExceptT DecoderError Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx BabbageEra -> ExceptT DecoderError Identity (Tx BabbageEra))
-> Tx BabbageEra -> ExceptT DecoderError Identity (Tx BabbageEra)
forall a b. (a -> b) -> a -> b
$
      TxBody BabbageEra -> Tx BabbageEra
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody BabbageEra
txBody
        Tx BabbageEra -> (Tx BabbageEra -> Tx BabbageEra) -> Tx BabbageEra
forall a b. a -> (a -> b) -> b
& (TxWits BabbageEra -> Identity (TxWits BabbageEra))
-> Tx BabbageEra -> Identity (Tx BabbageEra)
(AlonzoTxWits BabbageEra -> Identity (AlonzoTxWits BabbageEra))
-> Tx BabbageEra -> Identity (Tx BabbageEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx BabbageEra) (TxWits BabbageEra)
witsTxL ((AlonzoTxWits BabbageEra -> Identity (AlonzoTxWits BabbageEra))
 -> Tx BabbageEra -> Identity (Tx BabbageEra))
-> AlonzoTxWits BabbageEra -> Tx BabbageEra -> Tx BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AlonzoTxWits BabbageEra
txWits
        Tx BabbageEra -> (Tx BabbageEra -> Tx BabbageEra) -> Tx BabbageEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData BabbageEra)
 -> Identity (StrictMaybe (TxAuxData BabbageEra)))
-> Tx BabbageEra -> Identity (Tx BabbageEra)
(StrictMaybe (AlonzoTxAuxData BabbageEra)
 -> Identity (StrictMaybe (AlonzoTxAuxData BabbageEra)))
-> Tx BabbageEra -> Identity (Tx BabbageEra)
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx BabbageEra) (StrictMaybe (TxAuxData BabbageEra))
auxDataTxL ((StrictMaybe (AlonzoTxAuxData BabbageEra)
  -> Identity (StrictMaybe (AlonzoTxAuxData BabbageEra)))
 -> Tx BabbageEra -> Identity (Tx BabbageEra))
-> StrictMaybe (AlonzoTxAuxData BabbageEra)
-> Tx BabbageEra
-> Tx BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (AlonzoTxAuxData BabbageEra)
auxData
        Tx BabbageEra -> (Tx BabbageEra -> Tx BabbageEra) -> Tx BabbageEra
forall a b. a -> (a -> b) -> b
& (IsValid -> Identity IsValid)
-> Tx BabbageEra -> Identity (Tx BabbageEra)
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx BabbageEra) IsValid
isValidTxL ((IsValid -> Identity IsValid)
 -> Tx BabbageEra -> Identity (Tx BabbageEra))
-> IsValid -> Tx BabbageEra -> Tx BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ IsValid
validating

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

instance TranslateEra BabbageEra PParams where
  translateEra :: TranslationContext BabbageEra
-> PParams (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra PParams) (PParams BabbageEra)
translateEra TranslationContext BabbageEra
_ = PParams BabbageEra -> ExceptT Void Identity (PParams BabbageEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams BabbageEra -> ExceptT Void Identity (PParams BabbageEra))
-> (PParams AlonzoEra -> PParams BabbageEra)
-> PParams AlonzoEra
-> ExceptT Void Identity (PParams BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpgradePParams Identity BabbageEra
-> PParams (PreviousEra BabbageEra) -> PParams BabbageEra
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 -> FuturePParams BabbageEra
-> ExceptT Void Identity (FuturePParams BabbageEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FuturePParams BabbageEra
forall era. FuturePParams era
NoPParamsUpdate
    DefinitePParamsUpdate PParams (PreviousEra BabbageEra)
pp -> PParams BabbageEra -> FuturePParams BabbageEra
forall era. PParams era -> FuturePParams era
DefinitePParamsUpdate (PParams BabbageEra -> FuturePParams BabbageEra)
-> ExceptT Void Identity (PParams BabbageEra)
-> ExceptT Void Identity (FuturePParams BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TranslationContext BabbageEra
-> PParams (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra PParams) (PParams BabbageEra)
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 -> Maybe (PParams BabbageEra) -> FuturePParams BabbageEra
forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate (Maybe (PParams BabbageEra) -> FuturePParams BabbageEra)
-> ExceptT Void Identity (Maybe (PParams BabbageEra))
-> ExceptT Void Identity (FuturePParams BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PParams AlonzoEra -> ExceptT Void Identity (PParams BabbageEra))
-> Maybe (PParams AlonzoEra)
-> ExceptT Void Identity (Maybe (PParams BabbageEra))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (TranslationContext BabbageEra
-> PParams (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra PParams) (PParams BabbageEra)
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))
Maybe (PParams AlonzoEra)
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 =
    EpochState BabbageEra
-> ExceptT Void Identity (EpochState BabbageEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      EpochState
        { esChainAccountState :: ChainAccountState
esChainAccountState = EpochState AlonzoEra -> ChainAccountState
forall era. EpochState era -> ChainAccountState
esChainAccountState EpochState (PreviousEra BabbageEra)
EpochState AlonzoEra
es
        , esSnapshots :: SnapShots
esSnapshots = EpochState AlonzoEra -> SnapShots
forall era. EpochState era -> SnapShots
esSnapshots EpochState (PreviousEra BabbageEra)
EpochState AlonzoEra
es
        , esLState :: LedgerState BabbageEra
esLState = TranslationContext BabbageEra
-> LedgerState (PreviousEra BabbageEra) -> LedgerState BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (LedgerState (PreviousEra BabbageEra) -> LedgerState BabbageEra)
-> LedgerState (PreviousEra BabbageEra) -> LedgerState BabbageEra
forall a b. (a -> b) -> a -> b
$ EpochState AlonzoEra -> LedgerState AlonzoEra
forall era. EpochState era -> LedgerState era
esLState EpochState (PreviousEra BabbageEra)
EpochState AlonzoEra
es
        , esNonMyopic :: NonMyopic
esNonMyopic = EpochState AlonzoEra -> NonMyopic
forall era. EpochState era -> NonMyopic
esNonMyopic EpochState (PreviousEra BabbageEra)
EpochState AlonzoEra
es
        }

instance TranslateEra BabbageEra ShelleyAccounts where
  translateEra :: TranslationContext BabbageEra
-> ShelleyAccounts (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra ShelleyAccounts)
     (ShelleyAccounts BabbageEra)
translateEra TranslationContext BabbageEra
_ = ShelleyAccounts BabbageEra
-> ExceptT Void Identity (ShelleyAccounts BabbageEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyAccounts BabbageEra
 -> ExceptT Void Identity (ShelleyAccounts BabbageEra))
-> (ShelleyAccounts AlonzoEra -> ShelleyAccounts BabbageEra)
-> ShelleyAccounts AlonzoEra
-> ExceptT Void Identity (ShelleyAccounts BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyAccounts AlonzoEra -> ShelleyAccounts BabbageEra
forall a b. Coercible a b => a -> b
coerce

instance TranslateEra BabbageEra DState where
  translateEra :: TranslationContext BabbageEra
-> DState (PreviousEra BabbageEra)
-> Except (TranslationError BabbageEra DState) (DState BabbageEra)
translateEra TranslationContext BabbageEra
ctx DState {dsAccounts :: forall era. DState era -> Accounts era
dsAccounts = Accounts (PreviousEra BabbageEra)
accountsShelley, Map FutureGenDeleg GenDelegPair
InstantaneousRewards
GenDelegs
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsFutureGenDelegs :: forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsGenDelegs :: forall era. DState era -> GenDelegs
dsIRewards :: forall era. DState era -> InstantaneousRewards
..} = do
    ShelleyAccounts BabbageEra
dsAccounts <- TranslationContext BabbageEra
-> ShelleyAccounts (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra ShelleyAccounts)
     (ShelleyAccounts BabbageEra)
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext BabbageEra
ctx Accounts (PreviousEra BabbageEra)
ShelleyAccounts (PreviousEra BabbageEra)
accountsShelley
    DState BabbageEra -> ExceptT Void Identity (DState BabbageEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DState {Map FutureGenDeleg GenDelegPair
Accounts BabbageEra
InstantaneousRewards
ShelleyAccounts BabbageEra
GenDelegs
dsAccounts :: Accounts BabbageEra
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsAccounts :: ShelleyAccounts BabbageEra
..}

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 :: Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
..} = CommitteeState BabbageEra
-> ExceptT Void Identity (CommitteeState BabbageEra)
forall a. a -> ExceptT Void Identity a
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 PState where
  translateEra :: TranslationContext BabbageEra
-> PState (PreviousEra BabbageEra)
-> Except (TranslationError BabbageEra PState) (PState BabbageEra)
translateEra TranslationContext BabbageEra
_ PState {Map (KeyHash 'StakePool) EpochNo
Map (KeyHash 'StakePool) (CompactForm Coin)
Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psDeposits :: Map (KeyHash 'StakePool) (CompactForm Coin)
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) (CompactForm Coin)
..} = PState BabbageEra -> ExceptT Void Identity (PState BabbageEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PState {Map (KeyHash 'StakePool) EpochNo
Map (KeyHash 'StakePool) (CompactForm Coin)
Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psDeposits :: Map (KeyHash 'StakePool) (CompactForm Coin)
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psDeposits :: Map (KeyHash 'StakePool) (CompactForm Coin)
..}

instance TranslateEra BabbageEra ShelleyCertState where
  translateEra :: TranslationContext BabbageEra
-> ShelleyCertState (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra ShelleyCertState)
     (ShelleyCertState BabbageEra)
translateEra TranslationContext BabbageEra
ctxt ShelleyCertState (PreviousEra BabbageEra)
ls =
    ShelleyCertState BabbageEra
-> ExceptT Void Identity (ShelleyCertState BabbageEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ShelleyCertState
        { shelleyCertDState :: DState BabbageEra
shelleyCertDState = TranslationContext BabbageEra
-> DState (PreviousEra BabbageEra) -> DState BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (DState (PreviousEra BabbageEra) -> DState BabbageEra)
-> DState (PreviousEra BabbageEra) -> DState BabbageEra
forall a b. (a -> b) -> a -> b
$ ShelleyCertState AlonzoEra -> DState AlonzoEra
forall era. ShelleyCertState era -> DState era
shelleyCertDState ShelleyCertState (PreviousEra BabbageEra)
ShelleyCertState AlonzoEra
ls
        , shelleyCertPState :: PState BabbageEra
shelleyCertPState = TranslationContext BabbageEra
-> PState (PreviousEra BabbageEra) -> PState BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (PState (PreviousEra BabbageEra) -> PState BabbageEra)
-> PState (PreviousEra BabbageEra) -> PState BabbageEra
forall a b. (a -> b) -> a -> b
$ ShelleyCertState AlonzoEra -> PState AlonzoEra
forall era. ShelleyCertState era -> PState era
shelleyCertPState ShelleyCertState (PreviousEra BabbageEra)
ShelleyCertState AlonzoEra
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 =
    LedgerState BabbageEra
-> ExceptT Void Identity (LedgerState BabbageEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      LedgerState
        { lsUTxOState :: UTxOState BabbageEra
lsUTxOState = TranslationContext BabbageEra
-> UTxOState (PreviousEra BabbageEra) -> UTxOState BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (UTxOState (PreviousEra BabbageEra) -> UTxOState BabbageEra)
-> UTxOState (PreviousEra BabbageEra) -> UTxOState BabbageEra
forall a b. (a -> b) -> a -> b
$ LedgerState AlonzoEra -> UTxOState AlonzoEra
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState (PreviousEra BabbageEra)
LedgerState AlonzoEra
ls
        , lsCertState :: CertState BabbageEra
lsCertState = TranslationContext BabbageEra
-> ShelleyCertState (PreviousEra BabbageEra)
-> ShelleyCertState BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (ShelleyCertState (PreviousEra BabbageEra)
 -> ShelleyCertState BabbageEra)
-> ShelleyCertState (PreviousEra BabbageEra)
-> ShelleyCertState BabbageEra
forall a b. (a -> b) -> a -> b
$ LedgerState AlonzoEra -> CertState AlonzoEra
forall era. LedgerState era -> CertState era
lsCertState LedgerState (PreviousEra BabbageEra)
LedgerState AlonzoEra
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 =
    UTxOState BabbageEra
-> ExceptT Void Identity (UTxOState BabbageEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      UTxOState
        { utxosUtxo :: UTxO BabbageEra
utxosUtxo = TranslationContext BabbageEra
-> UTxO (PreviousEra BabbageEra) -> UTxO BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (UTxO (PreviousEra BabbageEra) -> UTxO BabbageEra)
-> UTxO (PreviousEra BabbageEra) -> UTxO BabbageEra
forall a b. (a -> b) -> a -> b
$ UTxOState AlonzoEra -> UTxO AlonzoEra
forall era. UTxOState era -> UTxO era
utxosUtxo UTxOState (PreviousEra BabbageEra)
UTxOState AlonzoEra
us
        , utxosDeposited :: Coin
utxosDeposited = UTxOState AlonzoEra -> Coin
forall era. UTxOState era -> Coin
utxosDeposited UTxOState (PreviousEra BabbageEra)
UTxOState AlonzoEra
us
        , utxosFees :: Coin
utxosFees = UTxOState AlonzoEra -> Coin
forall era. UTxOState era -> Coin
utxosFees UTxOState (PreviousEra BabbageEra)
UTxOState AlonzoEra
us
        , utxosGovState :: GovState BabbageEra
utxosGovState = TranslationContext BabbageEra
-> ShelleyGovState (PreviousEra BabbageEra)
-> ShelleyGovState BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (ShelleyGovState (PreviousEra BabbageEra)
 -> ShelleyGovState BabbageEra)
-> ShelleyGovState (PreviousEra BabbageEra)
-> ShelleyGovState BabbageEra
forall a b. (a -> b) -> a -> b
$ UTxOState AlonzoEra -> GovState AlonzoEra
forall era. UTxOState era -> GovState era
utxosGovState UTxOState (PreviousEra BabbageEra)
UTxOState AlonzoEra
us
        , utxosInstantStake :: InstantStake BabbageEra
utxosInstantStake = TranslationContext BabbageEra
-> ShelleyInstantStake (PreviousEra BabbageEra)
-> ShelleyInstantStake BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (ShelleyInstantStake (PreviousEra BabbageEra)
 -> ShelleyInstantStake BabbageEra)
-> ShelleyInstantStake (PreviousEra BabbageEra)
-> ShelleyInstantStake BabbageEra
forall a b. (a -> b) -> a -> b
$ UTxOState AlonzoEra -> InstantStake AlonzoEra
forall era. UTxOState era -> InstantStake era
utxosInstantStake UTxOState (PreviousEra BabbageEra)
UTxOState AlonzoEra
us
        , utxosDonation :: Coin
utxosDonation = UTxOState AlonzoEra -> Coin
forall era. UTxOState era -> Coin
utxosDonation UTxOState (PreviousEra BabbageEra)
UTxOState AlonzoEra
us
        }

instance TranslateEra BabbageEra ShelleyInstantStake where
  translateEra :: TranslationContext BabbageEra
-> ShelleyInstantStake (PreviousEra BabbageEra)
-> Except
     (TranslationError BabbageEra ShelleyInstantStake)
     (ShelleyInstantStake BabbageEra)
translateEra TranslationContext BabbageEra
_ = ShelleyInstantStake BabbageEra
-> ExceptT Void Identity (ShelleyInstantStake BabbageEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyInstantStake BabbageEra
 -> ExceptT Void Identity (ShelleyInstantStake BabbageEra))
-> (ShelleyInstantStake AlonzoEra
    -> ShelleyInstantStake BabbageEra)
-> ShelleyInstantStake AlonzoEra
-> ExceptT Void Identity (ShelleyInstantStake BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyInstantStake AlonzoEra -> ShelleyInstantStake BabbageEra
forall a b. Coercible a b => a -> b
coerce

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 =
    UTxO BabbageEra
-> Except (TranslationError BabbageEra UTxO) (UTxO BabbageEra)
forall a.
a -> ExceptT (TranslationError BabbageEra UTxO) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO BabbageEra
 -> Except (TranslationError BabbageEra UTxO) (UTxO BabbageEra))
-> UTxO BabbageEra
-> Except (TranslationError BabbageEra UTxO) (UTxO BabbageEra)
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut BabbageEra) -> UTxO BabbageEra
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut BabbageEra) -> UTxO BabbageEra)
-> Map TxIn (TxOut BabbageEra) -> UTxO BabbageEra
forall a b. (a -> b) -> a -> b
$ TxOut AlonzoEra -> TxOut BabbageEra
AlonzoTxOut AlonzoEra -> BabbageTxOut BabbageEra
translateTxOut (AlonzoTxOut AlonzoEra -> BabbageTxOut BabbageEra)
-> Map TxIn (AlonzoTxOut AlonzoEra)
-> Map TxIn (BabbageTxOut BabbageEra)
forall a b k. (a -> b) -> Map k a -> Map k b
`Map.map` UTxO AlonzoEra -> Map TxIn (TxOut AlonzoEra)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO UTxO (PreviousEra BabbageEra)
UTxO AlonzoEra
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 =
    ShelleyGovState BabbageEra
-> ExceptT Void Identity (ShelleyGovState BabbageEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ShelleyGovState
        { sgsCurProposals :: ProposedPPUpdates BabbageEra
sgsCurProposals = TranslationContext BabbageEra
-> ProposedPPUpdates (PreviousEra BabbageEra)
-> ProposedPPUpdates BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (ProposedPPUpdates (PreviousEra BabbageEra)
 -> ProposedPPUpdates BabbageEra)
-> ProposedPPUpdates (PreviousEra BabbageEra)
-> ProposedPPUpdates BabbageEra
forall a b. (a -> b) -> a -> b
$ ShelleyGovState AlonzoEra -> ProposedPPUpdates AlonzoEra
forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsCurProposals ShelleyGovState (PreviousEra BabbageEra)
ShelleyGovState AlonzoEra
ps
        , sgsFutureProposals :: ProposedPPUpdates BabbageEra
sgsFutureProposals = TranslationContext BabbageEra
-> ProposedPPUpdates (PreviousEra BabbageEra)
-> ProposedPPUpdates BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (ProposedPPUpdates (PreviousEra BabbageEra)
 -> ProposedPPUpdates BabbageEra)
-> ProposedPPUpdates (PreviousEra BabbageEra)
-> ProposedPPUpdates BabbageEra
forall a b. (a -> b) -> a -> b
$ ShelleyGovState AlonzoEra -> ProposedPPUpdates AlonzoEra
forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsFutureProposals ShelleyGovState (PreviousEra BabbageEra)
ShelleyGovState AlonzoEra
ps
        , sgsCurPParams :: PParams BabbageEra
sgsCurPParams = TranslationContext BabbageEra
-> PParams (PreviousEra BabbageEra) -> PParams BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (PParams (PreviousEra BabbageEra) -> PParams BabbageEra)
-> PParams (PreviousEra BabbageEra) -> PParams BabbageEra
forall a b. (a -> b) -> a -> b
$ ShelleyGovState AlonzoEra -> PParams AlonzoEra
forall era. ShelleyGovState era -> PParams era
sgsCurPParams ShelleyGovState (PreviousEra BabbageEra)
ShelleyGovState AlonzoEra
ps
        , sgsPrevPParams :: PParams BabbageEra
sgsPrevPParams = TranslationContext BabbageEra
-> PParams (PreviousEra BabbageEra) -> PParams BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (PParams (PreviousEra BabbageEra) -> PParams BabbageEra)
-> PParams (PreviousEra BabbageEra) -> PParams BabbageEra
forall a b. (a -> b) -> a -> b
$ ShelleyGovState AlonzoEra -> PParams AlonzoEra
forall era. ShelleyGovState era -> PParams era
sgsPrevPParams ShelleyGovState (PreviousEra BabbageEra)
ShelleyGovState AlonzoEra
ps
        , sgsFuturePParams :: FuturePParams BabbageEra
sgsFuturePParams = TranslationContext BabbageEra
-> FuturePParams (PreviousEra BabbageEra)
-> FuturePParams BabbageEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext BabbageEra
ctxt (FuturePParams (PreviousEra BabbageEra)
 -> FuturePParams BabbageEra)
-> FuturePParams (PreviousEra BabbageEra)
-> FuturePParams BabbageEra
forall a b. (a -> b) -> a -> b
$ ShelleyGovState AlonzoEra -> FuturePParams AlonzoEra
forall era. ShelleyGovState era -> FuturePParams era
sgsFuturePParams ShelleyGovState (PreviousEra BabbageEra)
ShelleyGovState AlonzoEra
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) =
    ProposedPPUpdates BabbageEra
-> Except
     (TranslationError BabbageEra ProposedPPUpdates)
     (ProposedPPUpdates BabbageEra)
forall a.
a
-> ExceptT
     (TranslationError BabbageEra ProposedPPUpdates) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProposedPPUpdates BabbageEra
 -> Except
      (TranslationError BabbageEra ProposedPPUpdates)
      (ProposedPPUpdates BabbageEra))
-> ProposedPPUpdates BabbageEra
-> Except
     (TranslationError BabbageEra ProposedPPUpdates)
     (ProposedPPUpdates BabbageEra)
forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
-> ProposedPPUpdates BabbageEra
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
 -> ProposedPPUpdates BabbageEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
-> ProposedPPUpdates BabbageEra
forall a b. (a -> b) -> a -> b
$ (PParamsUpdate AlonzoEra -> PParamsUpdate BabbageEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
forall a b.
(a -> b) -> Map (KeyHash 'Genesis) a -> Map (KeyHash 'Genesis) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UpgradePParams StrictMaybe BabbageEra
-> PParamsUpdate (PreviousEra BabbageEra)
-> PParamsUpdate BabbageEra
forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams StrictMaybe era
-> PParamsUpdate (PreviousEra era) -> PParamsUpdate era
upgradePParamsUpdate ()) Map (KeyHash 'Genesis) (PParamsUpdate (PreviousEra BabbageEra))
Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
ppup

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