{-# 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.State
import Cardano.Ledger.Babbage.Tx (AlonzoTx (..))
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Binary (DecoderError)
import qualified Cardano.Ledger.Core as Core (Tx)
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 = ()
        }

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.
    TxBody BabbageEra
txBody <- TxBody (PreviousEra BabbageEra)
-> Except DecoderError (TxBody BabbageEra)
forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)), DecCBOR (to era)) =>
ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR (TxBody (PreviousEra BabbageEra)
 -> Except DecoderError (TxBody BabbageEra))
-> TxBody (PreviousEra BabbageEra)
-> Except DecoderError (TxBody BabbageEra)
forall a b. (a -> b) -> a -> b
$ Tx (PreviousEra BabbageEra)
AlonzoTx AlonzoEra
tx AlonzoTx AlonzoEra
-> Getting
     (TxBody (PreviousEra BabbageEra))
     (AlonzoTx AlonzoEra)
     (TxBody (PreviousEra BabbageEra))
-> TxBody (PreviousEra BabbageEra)
forall s a. s -> Getting a s a -> a
^. (TxBody (PreviousEra BabbageEra)
 -> Const
      (TxBody (PreviousEra BabbageEra))
      (TxBody (PreviousEra BabbageEra)))
-> Tx (PreviousEra BabbageEra)
-> Const
     (TxBody (PreviousEra BabbageEra)) (Tx (PreviousEra BabbageEra))
Getting
  (TxBody (PreviousEra BabbageEra))
  (AlonzoTx AlonzoEra)
  (TxBody (PreviousEra BabbageEra))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (PreviousEra BabbageEra)) (TxBody (PreviousEra BabbageEra))
bodyTxL
    AlonzoTxWits BabbageEra
txWits <- AlonzoTxWits (PreviousEra BabbageEra)
-> Except DecoderError (AlonzoTxWits BabbageEra)
forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)), DecCBOR (to era)) =>
ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR (AlonzoTxWits (PreviousEra BabbageEra)
 -> Except DecoderError (AlonzoTxWits BabbageEra))
-> AlonzoTxWits (PreviousEra BabbageEra)
-> Except DecoderError (AlonzoTxWits BabbageEra)
forall a b. (a -> b) -> a -> b
$ Tx (PreviousEra BabbageEra)
AlonzoTx AlonzoEra
tx AlonzoTx AlonzoEra
-> Getting
     (AlonzoTxWits (PreviousEra BabbageEra))
     (AlonzoTx 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))
  (AlonzoTx 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)
AlonzoTx AlonzoEra
tx AlonzoTx AlonzoEra
-> Getting
     (StrictMaybe (TxAuxData AlonzoEra))
     (AlonzoTx AlonzoEra)
     (StrictMaybe (TxAuxData AlonzoEra))
-> StrictMaybe (TxAuxData AlonzoEra)
forall s a. s -> Getting a s a -> a
^. (StrictMaybe (TxAuxData AlonzoEra)
 -> Const
      (StrictMaybe (TxAuxData AlonzoEra))
      (StrictMaybe (TxAuxData AlonzoEra)))
-> Tx AlonzoEra
-> Const (StrictMaybe (TxAuxData AlonzoEra)) (Tx AlonzoEra)
Getting
  (StrictMaybe (TxAuxData AlonzoEra))
  (AlonzoTx AlonzoEra)
  (StrictMaybe (TxAuxData AlonzoEra))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx AlonzoEra) (StrictMaybe (TxAuxData AlonzoEra))
auxDataTxL of
      StrictMaybe (TxAuxData 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 TxAuxData 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
<$> AlonzoTxAuxData (PreviousEra BabbageEra)
-> ExceptT DecoderError Identity (AlonzoTxAuxData BabbageEra)
forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)), DecCBOR (to era)) =>
ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR TxAuxData AlonzoEra
AlonzoTxAuxData (PreviousEra BabbageEra)
auxData
    let validating :: IsValid
validating = Tx (PreviousEra BabbageEra)
AlonzoTx AlonzoEra
tx AlonzoTx AlonzoEra
-> Getting IsValid (AlonzoTx AlonzoEra) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. (IsValid -> Const IsValid IsValid)
-> Tx AlonzoEra -> Const IsValid (Tx AlonzoEra)
Getting IsValid (AlonzoTx AlonzoEra) IsValid
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx AlonzoEra) IsValid
Alonzo.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
$ Tx BabbageEra -> Tx BabbageEra
forall era. Tx era -> Tx era
Tx (Tx BabbageEra -> Tx BabbageEra) -> Tx BabbageEra -> Tx BabbageEra
forall a b. (a -> b) -> a -> b
$ TxBody BabbageEra
-> TxWits BabbageEra
-> IsValid
-> StrictMaybe (TxAuxData BabbageEra)
-> AlonzoTx BabbageEra
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody BabbageEra
txBody TxWits BabbageEra
AlonzoTxWits BabbageEra
txWits IsValid
validating StrictMaybe (TxAuxData BabbageEra)
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
_ = 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 DState where
  translateEra :: TranslationContext BabbageEra
-> DState (PreviousEra BabbageEra)
-> Except (TranslationError BabbageEra DState) (DState BabbageEra)
translateEra TranslationContext BabbageEra
_ DState {Map FutureGenDeleg GenDelegPair
InstantaneousRewards
GenDelegs
UMap
dsUnified :: UMap
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
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
..} = 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
InstantaneousRewards
GenDelegs
UMap
dsUnified :: UMap
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsUnified :: UMap
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
..}

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) Coin
Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psDeposits :: Map (KeyHash 'StakePool) 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) 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) Coin
Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psDeposits :: Map (KeyHash 'StakePool) Coin
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psDeposits :: Map (KeyHash 'StakePool) 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" #-}