{-# 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.Alonzo.Translation where

import Cardano.Ledger.Alonzo.Core hiding (Tx)
import Cardano.Ledger.Alonzo.Era (AlonzoEra)
import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
import Cardano.Ledger.Alonzo.PParams ()
import Cardano.Ledger.Alonzo.State
import Cardano.Ledger.Alonzo.Tx (IsValid (..), Tx (..))
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 Data.Default (def)
import qualified Data.Map.Strict as Map
import Lens.Micro ((&), (.~), (^.))

--------------------------------------------------------------------------------
-- Translation from Mary to Alonzo
--
-- 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!
--------------------------------------------------------------------------------

type instance TranslationContext AlonzoEra = AlonzoGenesis

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

instance TranslateEra AlonzoEra PParams where
  translateEra :: TranslationContext AlonzoEra
-> PParams (PreviousEra AlonzoEra)
-> Except (TranslationError AlonzoEra PParams) (PParams AlonzoEra)
translateEra (AlonzoGenesisWrapper UpgradeAlonzoPParams Identity
upgradeArgs) = PParams AlonzoEra -> ExceptT Void Identity (PParams AlonzoEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams AlonzoEra -> ExceptT Void Identity (PParams AlonzoEra))
-> (PParams MaryEra -> PParams AlonzoEra)
-> PParams MaryEra
-> ExceptT Void Identity (PParams AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpgradePParams Identity AlonzoEra
-> PParams (PreviousEra AlonzoEra) -> PParams AlonzoEra
forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams Identity era
-> PParams (PreviousEra era) -> PParams era
upgradePParams UpgradePParams Identity AlonzoEra
UpgradeAlonzoPParams Identity
upgradeArgs

instance TranslateEra AlonzoEra FuturePParams where
  translateEra :: TranslationContext AlonzoEra
-> FuturePParams (PreviousEra AlonzoEra)
-> Except
     (TranslationError AlonzoEra FuturePParams)
     (FuturePParams AlonzoEra)
translateEra TranslationContext AlonzoEra
ctxt = \case
    FuturePParams (PreviousEra AlonzoEra)
NoPParamsUpdate -> FuturePParams AlonzoEra
-> ExceptT Void Identity (FuturePParams AlonzoEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FuturePParams AlonzoEra
forall era. FuturePParams era
NoPParamsUpdate
    DefinitePParamsUpdate PParams (PreviousEra AlonzoEra)
pp -> PParams AlonzoEra -> FuturePParams AlonzoEra
forall era. PParams era -> FuturePParams era
DefinitePParamsUpdate (PParams AlonzoEra -> FuturePParams AlonzoEra)
-> ExceptT Void Identity (PParams AlonzoEra)
-> ExceptT Void Identity (FuturePParams AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TranslationContext AlonzoEra
-> PParams (PreviousEra AlonzoEra)
-> Except (TranslationError AlonzoEra PParams) (PParams AlonzoEra)
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext AlonzoEra
ctxt PParams (PreviousEra AlonzoEra)
pp
    PotentialPParamsUpdate Maybe (PParams (PreviousEra AlonzoEra))
mpp -> Maybe (PParams AlonzoEra) -> FuturePParams AlonzoEra
forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate (Maybe (PParams AlonzoEra) -> FuturePParams AlonzoEra)
-> ExceptT Void Identity (Maybe (PParams AlonzoEra))
-> ExceptT Void Identity (FuturePParams AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PParams MaryEra -> ExceptT Void Identity (PParams AlonzoEra))
-> Maybe (PParams MaryEra)
-> ExceptT Void Identity (Maybe (PParams AlonzoEra))
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 AlonzoEra
-> PParams (PreviousEra AlonzoEra)
-> Except (TranslationError AlonzoEra PParams) (PParams AlonzoEra)
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext AlonzoEra
ctxt) Maybe (PParams (PreviousEra AlonzoEra))
Maybe (PParams MaryEra)
mpp

instance TranslateEra AlonzoEra Tx where
  type TranslationError AlonzoEra Tx = DecoderError
  translateEra :: TranslationContext AlonzoEra
-> Tx (PreviousEra AlonzoEra)
-> Except (TranslationError AlonzoEra Tx) (Tx AlonzoEra)
translateEra TranslationContext AlonzoEra
_ctxt Tx (PreviousEra AlonzoEra)
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 AlonzoEra
txBody <- Text
-> TxBody (PreviousEra AlonzoEra)
-> Except DecoderError (TxBody AlonzoEra)
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 AlonzoEra)
 -> Except DecoderError (TxBody AlonzoEra))
-> TxBody (PreviousEra AlonzoEra)
-> Except DecoderError (TxBody AlonzoEra)
forall a b. (a -> b) -> a -> b
$ Tx (PreviousEra AlonzoEra)
Tx MaryEra
tx Tx MaryEra
-> Getting (TxBody MaryEra) (Tx MaryEra) (TxBody MaryEra)
-> TxBody MaryEra
forall s a. s -> Getting a s a -> a
^. Getting (TxBody MaryEra) (Tx MaryEra) (TxBody MaryEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx MaryEra) (TxBody MaryEra)
bodyTxL
    AlonzoTxWits AlonzoEra
txWits <- Text
-> ShelleyTxWits (PreviousEra AlonzoEra)
-> Except DecoderError (AlonzoTxWits AlonzoEra)
forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)),
 DecCBOR (Annotator (to era))) =>
Text -> ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR Text
"TxWits" (ShelleyTxWits (PreviousEra AlonzoEra)
 -> Except DecoderError (AlonzoTxWits AlonzoEra))
-> ShelleyTxWits (PreviousEra AlonzoEra)
-> Except DecoderError (AlonzoTxWits AlonzoEra)
forall a b. (a -> b) -> a -> b
$ Tx (PreviousEra AlonzoEra)
Tx MaryEra
tx Tx MaryEra
-> Getting
     (ShelleyTxWits (PreviousEra AlonzoEra))
     (Tx MaryEra)
     (ShelleyTxWits (PreviousEra AlonzoEra))
-> ShelleyTxWits (PreviousEra AlonzoEra)
forall s a. s -> Getting a s a -> a
^. (TxWits MaryEra
 -> Const (ShelleyTxWits (PreviousEra AlonzoEra)) (TxWits MaryEra))
-> Tx MaryEra
-> Const (ShelleyTxWits (PreviousEra AlonzoEra)) (Tx MaryEra)
Getting
  (ShelleyTxWits (PreviousEra AlonzoEra))
  (Tx MaryEra)
  (ShelleyTxWits (PreviousEra AlonzoEra))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx MaryEra) (TxWits MaryEra)
witsTxL
    StrictMaybe (AlonzoTxAuxData AlonzoEra)
txAuxData <- (AllegraTxAuxData (PreviousEra AlonzoEra)
 -> ExceptT DecoderError Identity (AlonzoTxAuxData AlonzoEra))
-> StrictMaybe (AllegraTxAuxData (PreviousEra AlonzoEra))
-> ExceptT
     DecoderError Identity (StrictMaybe (AlonzoTxAuxData AlonzoEra))
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) -> StrictMaybe a -> m (StrictMaybe b)
mapM (Text
-> AllegraTxAuxData (PreviousEra AlonzoEra)
-> ExceptT DecoderError Identity (AlonzoTxAuxData AlonzoEra)
forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)),
 DecCBOR (Annotator (to era))) =>
Text -> ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR Text
"TxAuxData") (Tx (PreviousEra AlonzoEra)
Tx MaryEra
tx Tx MaryEra
-> Getting
     (StrictMaybe (AllegraTxAuxData (PreviousEra AlonzoEra)))
     (Tx MaryEra)
     (StrictMaybe (AllegraTxAuxData (PreviousEra AlonzoEra)))
-> StrictMaybe (AllegraTxAuxData (PreviousEra AlonzoEra))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (AllegraTxAuxData (PreviousEra AlonzoEra)))
  (Tx MaryEra)
  (StrictMaybe (AllegraTxAuxData (PreviousEra AlonzoEra)))
(StrictMaybe (TxAuxData MaryEra)
 -> Const
      (StrictMaybe (AllegraTxAuxData (PreviousEra AlonzoEra)))
      (StrictMaybe (TxAuxData MaryEra)))
-> Tx MaryEra
-> Const
     (StrictMaybe (AllegraTxAuxData (PreviousEra AlonzoEra)))
     (Tx MaryEra)
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx MaryEra) (StrictMaybe (TxAuxData MaryEra))
auxDataTxL)
    -- transactions from Mary era always pass script ("phase 2") validation
    let validating :: IsValid
validating = Bool -> IsValid
IsValid Bool
True
    Tx AlonzoEra -> ExceptT DecoderError Identity (Tx AlonzoEra)
forall a. a -> ExceptT DecoderError Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx AlonzoEra -> ExceptT DecoderError Identity (Tx AlonzoEra))
-> Tx AlonzoEra -> ExceptT DecoderError Identity (Tx AlonzoEra)
forall a b. (a -> b) -> a -> b
$
      TxBody AlonzoEra -> Tx AlonzoEra
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody AlonzoEra
txBody
        Tx AlonzoEra -> (Tx AlonzoEra -> Tx AlonzoEra) -> Tx AlonzoEra
forall a b. a -> (a -> b) -> b
& (TxWits AlonzoEra -> Identity (TxWits AlonzoEra))
-> Tx AlonzoEra -> Identity (Tx AlonzoEra)
(AlonzoTxWits AlonzoEra -> Identity (AlonzoTxWits AlonzoEra))
-> Tx AlonzoEra -> Identity (Tx AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx AlonzoEra) (TxWits AlonzoEra)
witsTxL ((AlonzoTxWits AlonzoEra -> Identity (AlonzoTxWits AlonzoEra))
 -> Tx AlonzoEra -> Identity (Tx AlonzoEra))
-> AlonzoTxWits AlonzoEra -> Tx AlonzoEra -> Tx AlonzoEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AlonzoTxWits AlonzoEra
txWits
        Tx AlonzoEra -> (Tx AlonzoEra -> Tx AlonzoEra) -> Tx AlonzoEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData AlonzoEra)
 -> Identity (StrictMaybe (TxAuxData AlonzoEra)))
-> Tx AlonzoEra -> Identity (Tx AlonzoEra)
(StrictMaybe (AlonzoTxAuxData AlonzoEra)
 -> Identity (StrictMaybe (AlonzoTxAuxData AlonzoEra)))
-> Tx AlonzoEra -> Identity (Tx AlonzoEra)
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx AlonzoEra) (StrictMaybe (TxAuxData AlonzoEra))
auxDataTxL ((StrictMaybe (AlonzoTxAuxData AlonzoEra)
  -> Identity (StrictMaybe (AlonzoTxAuxData AlonzoEra)))
 -> Tx AlonzoEra -> Identity (Tx AlonzoEra))
-> StrictMaybe (AlonzoTxAuxData AlonzoEra)
-> Tx AlonzoEra
-> Tx AlonzoEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (AlonzoTxAuxData AlonzoEra)
txAuxData
        Tx AlonzoEra -> (Tx AlonzoEra -> Tx AlonzoEra) -> Tx AlonzoEra
forall a b. a -> (a -> b) -> b
& (IsValid -> Identity IsValid)
-> Tx AlonzoEra -> Identity (Tx AlonzoEra)
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx AlonzoEra) IsValid
isValidTxL ((IsValid -> Identity IsValid)
 -> Tx AlonzoEra -> Identity (Tx AlonzoEra))
-> IsValid -> Tx AlonzoEra -> Tx AlonzoEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ IsValid
validating

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

instance TranslateEra AlonzoEra EpochState where
  translateEra :: TranslationContext AlonzoEra
-> EpochState (PreviousEra AlonzoEra)
-> Except
     (TranslationError AlonzoEra EpochState) (EpochState AlonzoEra)
translateEra TranslationContext AlonzoEra
ctxt EpochState (PreviousEra AlonzoEra)
es =
    EpochState AlonzoEra
-> ExceptT Void Identity (EpochState AlonzoEra)
forall a. a -> ExceptT Void Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
      EpochState
        { esChainAccountState :: ChainAccountState
esChainAccountState = EpochState MaryEra -> ChainAccountState
forall era. EpochState era -> ChainAccountState
esChainAccountState EpochState (PreviousEra AlonzoEra)
EpochState MaryEra
es
        , esSnapshots :: SnapShots
esSnapshots = EpochState MaryEra -> SnapShots
forall era. EpochState era -> SnapShots
esSnapshots EpochState (PreviousEra AlonzoEra)
EpochState MaryEra
es
        , esLState :: LedgerState AlonzoEra
esLState = TranslationContext AlonzoEra
-> LedgerState (PreviousEra AlonzoEra) -> LedgerState AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (LedgerState (PreviousEra AlonzoEra) -> LedgerState AlonzoEra)
-> LedgerState (PreviousEra AlonzoEra) -> LedgerState AlonzoEra
forall a b. (a -> b) -> a -> b
$ EpochState MaryEra -> LedgerState MaryEra
forall era. EpochState era -> LedgerState era
esLState EpochState (PreviousEra AlonzoEra)
EpochState MaryEra
es
        , esNonMyopic :: NonMyopic
esNonMyopic = EpochState MaryEra -> NonMyopic
forall era. EpochState era -> NonMyopic
esNonMyopic EpochState (PreviousEra AlonzoEra)
EpochState MaryEra
es
        }

instance TranslateEra AlonzoEra DState where
  translateEra :: TranslationContext AlonzoEra
-> DState (PreviousEra AlonzoEra)
-> Except (TranslationError AlonzoEra DState) (DState AlonzoEra)
translateEra TranslationContext AlonzoEra
_ 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 AlonzoEra -> ExceptT Void Identity (DState AlonzoEra)
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 AlonzoEra CommitteeState where
  translateEra :: TranslationContext AlonzoEra
-> CommitteeState (PreviousEra AlonzoEra)
-> Except
     (TranslationError AlonzoEra CommitteeState)
     (CommitteeState AlonzoEra)
translateEra TranslationContext AlonzoEra
_ CommitteeState {Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
..} = CommitteeState AlonzoEra
-> ExceptT Void Identity (CommitteeState AlonzoEra)
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 AlonzoEra PState where
  translateEra :: TranslationContext AlonzoEra
-> PState (PreviousEra AlonzoEra)
-> Except (TranslationError AlonzoEra PState) (PState AlonzoEra)
translateEra TranslationContext AlonzoEra
_ 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 AlonzoEra -> ExceptT Void Identity (PState AlonzoEra)
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 AlonzoEra ShelleyCertState where
  translateEra :: TranslationContext AlonzoEra
-> ShelleyCertState (PreviousEra AlonzoEra)
-> Except
     (TranslationError AlonzoEra ShelleyCertState)
     (ShelleyCertState AlonzoEra)
translateEra TranslationContext AlonzoEra
ctxt ShelleyCertState (PreviousEra AlonzoEra)
ls =
    ShelleyCertState AlonzoEra
-> ExceptT Void Identity (ShelleyCertState AlonzoEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ShelleyCertState
        { shelleyCertDState :: DState AlonzoEra
shelleyCertDState = TranslationContext AlonzoEra
-> DState (PreviousEra AlonzoEra) -> DState AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (DState (PreviousEra AlonzoEra) -> DState AlonzoEra)
-> DState (PreviousEra AlonzoEra) -> DState AlonzoEra
forall a b. (a -> b) -> a -> b
$ ShelleyCertState MaryEra -> DState MaryEra
forall era. ShelleyCertState era -> DState era
shelleyCertDState ShelleyCertState (PreviousEra AlonzoEra)
ShelleyCertState MaryEra
ls
        , shelleyCertPState :: PState AlonzoEra
shelleyCertPState = TranslationContext AlonzoEra
-> PState (PreviousEra AlonzoEra) -> PState AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (PState (PreviousEra AlonzoEra) -> PState AlonzoEra)
-> PState (PreviousEra AlonzoEra) -> PState AlonzoEra
forall a b. (a -> b) -> a -> b
$ ShelleyCertState MaryEra -> PState MaryEra
forall era. ShelleyCertState era -> PState era
shelleyCertPState ShelleyCertState (PreviousEra AlonzoEra)
ShelleyCertState MaryEra
ls
        }

instance TranslateEra AlonzoEra LedgerState where
  translateEra :: TranslationContext AlonzoEra
-> LedgerState (PreviousEra AlonzoEra)
-> Except
     (TranslationError AlonzoEra LedgerState) (LedgerState AlonzoEra)
translateEra TranslationContext AlonzoEra
ctxt LedgerState (PreviousEra AlonzoEra)
ls =
    LedgerState AlonzoEra
-> ExceptT Void Identity (LedgerState AlonzoEra)
forall a. a -> ExceptT Void Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
      LedgerState
        { lsUTxOState :: UTxOState AlonzoEra
lsUTxOState = TranslationContext AlonzoEra
-> UTxOState (PreviousEra AlonzoEra) -> UTxOState AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (UTxOState (PreviousEra AlonzoEra) -> UTxOState AlonzoEra)
-> UTxOState (PreviousEra AlonzoEra) -> UTxOState AlonzoEra
forall a b. (a -> b) -> a -> b
$ LedgerState MaryEra -> UTxOState MaryEra
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState (PreviousEra AlonzoEra)
LedgerState MaryEra
ls
        , lsCertState :: CertState AlonzoEra
lsCertState = TranslationContext AlonzoEra
-> ShelleyCertState (PreviousEra AlonzoEra)
-> ShelleyCertState AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (ShelleyCertState (PreviousEra AlonzoEra)
 -> ShelleyCertState AlonzoEra)
-> ShelleyCertState (PreviousEra AlonzoEra)
-> ShelleyCertState AlonzoEra
forall a b. (a -> b) -> a -> b
$ LedgerState MaryEra -> CertState MaryEra
forall era. LedgerState era -> CertState era
lsCertState LedgerState (PreviousEra AlonzoEra)
LedgerState MaryEra
ls
        }

instance TranslateEra AlonzoEra UTxOState where
  translateEra :: TranslationContext AlonzoEra
-> UTxOState (PreviousEra AlonzoEra)
-> Except
     (TranslationError AlonzoEra UTxOState) (UTxOState AlonzoEra)
translateEra TranslationContext AlonzoEra
ctxt UTxOState (PreviousEra AlonzoEra)
us =
    UTxOState AlonzoEra -> ExceptT Void Identity (UTxOState AlonzoEra)
forall a. a -> ExceptT Void Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
      UTxOState
        { utxosUtxo :: UTxO AlonzoEra
utxosUtxo = TranslationContext AlonzoEra
-> UTxO (PreviousEra AlonzoEra) -> UTxO AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (UTxO (PreviousEra AlonzoEra) -> UTxO AlonzoEra)
-> UTxO (PreviousEra AlonzoEra) -> UTxO AlonzoEra
forall a b. (a -> b) -> a -> b
$ UTxOState MaryEra -> UTxO MaryEra
forall era. UTxOState era -> UTxO era
utxosUtxo UTxOState (PreviousEra AlonzoEra)
UTxOState MaryEra
us
        , utxosDeposited :: Coin
utxosDeposited = UTxOState MaryEra -> Coin
forall era. UTxOState era -> Coin
utxosDeposited UTxOState (PreviousEra AlonzoEra)
UTxOState MaryEra
us
        , utxosFees :: Coin
utxosFees = UTxOState MaryEra -> Coin
forall era. UTxOState era -> Coin
utxosFees UTxOState (PreviousEra AlonzoEra)
UTxOState MaryEra
us
        , utxosGovState :: GovState AlonzoEra
utxosGovState = TranslationContext AlonzoEra
-> ShelleyGovState (PreviousEra AlonzoEra)
-> ShelleyGovState AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (ShelleyGovState (PreviousEra AlonzoEra)
 -> ShelleyGovState AlonzoEra)
-> ShelleyGovState (PreviousEra AlonzoEra)
-> ShelleyGovState AlonzoEra
forall a b. (a -> b) -> a -> b
$ UTxOState MaryEra -> GovState MaryEra
forall era. UTxOState era -> GovState era
utxosGovState UTxOState (PreviousEra AlonzoEra)
UTxOState MaryEra
us
        , utxosInstantStake :: InstantStake AlonzoEra
utxosInstantStake = TranslationContext AlonzoEra
-> ShelleyInstantStake (PreviousEra AlonzoEra)
-> ShelleyInstantStake AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (ShelleyInstantStake (PreviousEra AlonzoEra)
 -> ShelleyInstantStake AlonzoEra)
-> ShelleyInstantStake (PreviousEra AlonzoEra)
-> ShelleyInstantStake AlonzoEra
forall a b. (a -> b) -> a -> b
$ UTxOState MaryEra -> InstantStake MaryEra
forall era. UTxOState era -> InstantStake era
utxosInstantStake UTxOState (PreviousEra AlonzoEra)
UTxOState MaryEra
us
        , utxosDonation :: Coin
utxosDonation = UTxOState MaryEra -> Coin
forall era. UTxOState era -> Coin
utxosDonation UTxOState (PreviousEra AlonzoEra)
UTxOState MaryEra
us
        }

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

instance TranslateEra AlonzoEra UTxO where
  translateEra :: TranslationContext AlonzoEra
-> UTxO (PreviousEra AlonzoEra)
-> Except (TranslationError AlonzoEra UTxO) (UTxO AlonzoEra)
translateEra TranslationContext AlonzoEra
_ctxt UTxO (PreviousEra AlonzoEra)
utxo =
    UTxO AlonzoEra
-> Except (TranslationError AlonzoEra UTxO) (UTxO AlonzoEra)
forall a. a -> ExceptT (TranslationError AlonzoEra UTxO) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTxO AlonzoEra
 -> Except (TranslationError AlonzoEra UTxO) (UTxO AlonzoEra))
-> UTxO AlonzoEra
-> Except (TranslationError AlonzoEra UTxO) (UTxO AlonzoEra)
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut AlonzoEra) -> UTxO AlonzoEra
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut AlonzoEra) -> UTxO AlonzoEra)
-> Map TxIn (TxOut AlonzoEra) -> UTxO AlonzoEra
forall a b. (a -> b) -> a -> b
$ TxOut (PreviousEra AlonzoEra) -> TxOut AlonzoEra
TxOut (PreviousEra AlonzoEra) -> AlonzoTxOut AlonzoEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut (TxOut (PreviousEra AlonzoEra) -> AlonzoTxOut AlonzoEra)
-> Map TxIn (TxOut (PreviousEra AlonzoEra))
-> Map TxIn (AlonzoTxOut AlonzoEra)
forall a b k. (a -> b) -> Map k a -> Map k b
`Map.map` UTxO MaryEra -> Map TxIn (TxOut MaryEra)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO UTxO (PreviousEra AlonzoEra)
UTxO MaryEra
utxo

instance TranslateEra AlonzoEra ShelleyGovState where
  translateEra :: TranslationContext AlonzoEra
-> ShelleyGovState (PreviousEra AlonzoEra)
-> Except
     (TranslationError AlonzoEra ShelleyGovState)
     (ShelleyGovState AlonzoEra)
translateEra TranslationContext AlonzoEra
ctxt ShelleyGovState (PreviousEra AlonzoEra)
ps =
    ShelleyGovState AlonzoEra
-> ExceptT Void Identity (ShelleyGovState AlonzoEra)
forall a. a -> ExceptT Void Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
      ShelleyGovState
        { sgsCurProposals :: ProposedPPUpdates AlonzoEra
sgsCurProposals = TranslationContext AlonzoEra
-> ProposedPPUpdates (PreviousEra AlonzoEra)
-> ProposedPPUpdates AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (ProposedPPUpdates (PreviousEra AlonzoEra)
 -> ProposedPPUpdates AlonzoEra)
-> ProposedPPUpdates (PreviousEra AlonzoEra)
-> ProposedPPUpdates AlonzoEra
forall a b. (a -> b) -> a -> b
$ ShelleyGovState MaryEra -> ProposedPPUpdates MaryEra
forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsCurProposals ShelleyGovState (PreviousEra AlonzoEra)
ShelleyGovState MaryEra
ps
        , sgsFutureProposals :: ProposedPPUpdates AlonzoEra
sgsFutureProposals = TranslationContext AlonzoEra
-> ProposedPPUpdates (PreviousEra AlonzoEra)
-> ProposedPPUpdates AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (ProposedPPUpdates (PreviousEra AlonzoEra)
 -> ProposedPPUpdates AlonzoEra)
-> ProposedPPUpdates (PreviousEra AlonzoEra)
-> ProposedPPUpdates AlonzoEra
forall a b. (a -> b) -> a -> b
$ ShelleyGovState MaryEra -> ProposedPPUpdates MaryEra
forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsFutureProposals ShelleyGovState (PreviousEra AlonzoEra)
ShelleyGovState MaryEra
ps
        , sgsCurPParams :: PParams AlonzoEra
sgsCurPParams = TranslationContext AlonzoEra
-> PParams (PreviousEra AlonzoEra) -> PParams AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (PParams (PreviousEra AlonzoEra) -> PParams AlonzoEra)
-> PParams (PreviousEra AlonzoEra) -> PParams AlonzoEra
forall a b. (a -> b) -> a -> b
$ ShelleyGovState MaryEra -> PParams MaryEra
forall era. ShelleyGovState era -> PParams era
sgsCurPParams ShelleyGovState (PreviousEra AlonzoEra)
ShelleyGovState MaryEra
ps
        , sgsPrevPParams :: PParams AlonzoEra
sgsPrevPParams = TranslationContext AlonzoEra
-> PParams (PreviousEra AlonzoEra) -> PParams AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (PParams (PreviousEra AlonzoEra) -> PParams AlonzoEra)
-> PParams (PreviousEra AlonzoEra) -> PParams AlonzoEra
forall a b. (a -> b) -> a -> b
$ ShelleyGovState MaryEra -> PParams MaryEra
forall era. ShelleyGovState era -> PParams era
sgsPrevPParams ShelleyGovState (PreviousEra AlonzoEra)
ShelleyGovState MaryEra
ps
        , sgsFuturePParams :: FuturePParams AlonzoEra
sgsFuturePParams = TranslationContext AlonzoEra
-> FuturePParams (PreviousEra AlonzoEra) -> FuturePParams AlonzoEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AlonzoEra
ctxt (FuturePParams (PreviousEra AlonzoEra) -> FuturePParams AlonzoEra)
-> FuturePParams (PreviousEra AlonzoEra) -> FuturePParams AlonzoEra
forall a b. (a -> b) -> a -> b
$ ShelleyGovState MaryEra -> FuturePParams MaryEra
forall era. ShelleyGovState era -> FuturePParams era
sgsFuturePParams ShelleyGovState (PreviousEra AlonzoEra)
ShelleyGovState MaryEra
ps
        }

instance TranslateEra AlonzoEra ProposedPPUpdates where
  translateEra :: TranslationContext AlonzoEra
-> ProposedPPUpdates (PreviousEra AlonzoEra)
-> Except
     (TranslationError AlonzoEra ProposedPPUpdates)
     (ProposedPPUpdates AlonzoEra)
translateEra TranslationContext AlonzoEra
_ctxt (ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate (PreviousEra AlonzoEra))
ppup) =
    ProposedPPUpdates AlonzoEra
-> Except
     (TranslationError AlonzoEra ProposedPPUpdates)
     (ProposedPPUpdates AlonzoEra)
forall a.
a
-> ExceptT
     (TranslationError AlonzoEra ProposedPPUpdates) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProposedPPUpdates AlonzoEra
 -> Except
      (TranslationError AlonzoEra ProposedPPUpdates)
      (ProposedPPUpdates AlonzoEra))
-> ProposedPPUpdates AlonzoEra
-> Except
     (TranslationError AlonzoEra ProposedPPUpdates)
     (ProposedPPUpdates AlonzoEra)
forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
-> ProposedPPUpdates AlonzoEra
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
 -> ProposedPPUpdates AlonzoEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
-> ProposedPPUpdates AlonzoEra
forall a b. (a -> b) -> a -> b
$ (PParamsUpdate MaryEra -> PParamsUpdate AlonzoEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
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 AlonzoEra
-> PParamsUpdate (PreviousEra AlonzoEra) -> PParamsUpdate AlonzoEra
forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams StrictMaybe era
-> PParamsUpdate (PreviousEra era) -> PParamsUpdate era
upgradePParamsUpdate UpgradePParams StrictMaybe AlonzoEra
UpgradeAlonzoPParams StrictMaybe
forall a. Default a => a
def) Map (KeyHash 'Genesis) (PParamsUpdate (PreviousEra AlonzoEra))
Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
ppup