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

module Cardano.Ledger.Allegra.Translation (shelleyToAllegraAVVMsToDelete) where

import Cardano.Ledger.Allegra.Era (AllegraEra)
import Cardano.Ledger.Allegra.State
import Cardano.Ledger.Allegra.Tx ()
import Cardano.Ledger.Binary (DecoderError)
import Cardano.Ledger.Genesis (NoGenesis (..))
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  EpochState (..),
  LedgerState (..),
  NewEpochState (..),
  UTxOState (..),
  returnRedeemAddrsToReserves,
 )
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..), Update (..))
import Cardano.Ledger.Shelley.Tx (ShelleyTx)
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut)
import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits)
import Data.Coerce (coerce)
import qualified Data.Map.Strict as Map

--------------------------------------------------------------------------------
-- Translation from Shelley to Allegra
--
-- 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!
--------------------------------------------------------------------------------

-- | Return the subset of UTxO corresponding to Byron-era AVVM addresses, which
-- are to be removed on the Shelley/Allegra boundary. This set will be passed
-- _back_ to the translation functions as the UTxO, allowing these addresses to
-- be removed. This is needed because we cannot do a full scan on the UTxO at
-- this point, since it has been persisted to disk.
shelleyToAllegraAVVMsToDelete :: NewEpochState ShelleyEra -> UTxO ShelleyEra
shelleyToAllegraAVVMsToDelete :: NewEpochState ShelleyEra -> UTxO ShelleyEra
shelleyToAllegraAVVMsToDelete = NewEpochState ShelleyEra -> UTxO ShelleyEra
NewEpochState ShelleyEra -> StashedAVVMAddresses ShelleyEra
forall era. NewEpochState era -> StashedAVVMAddresses era
stashedAVVMAddresses

instance TranslateEra AllegraEra NewEpochState where
  translateEra :: TranslationContext AllegraEra
-> NewEpochState (PreviousEra AllegraEra)
-> Except
     (TranslationError AllegraEra NewEpochState)
     (NewEpochState AllegraEra)
translateEra TranslationContext AllegraEra
ctxt NewEpochState (PreviousEra AllegraEra)
nes =
    NewEpochState AllegraEra
-> Except
     (TranslationError AllegraEra NewEpochState)
     (NewEpochState AllegraEra)
forall a.
a -> ExceptT (TranslationError AllegraEra NewEpochState) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (NewEpochState AllegraEra
 -> Except
      (TranslationError AllegraEra NewEpochState)
      (NewEpochState AllegraEra))
-> NewEpochState AllegraEra
-> Except
     (TranslationError AllegraEra NewEpochState)
     (NewEpochState AllegraEra)
forall a b. (a -> b) -> a -> b
$
      NewEpochState
        { nesEL :: EpochNo
nesEL = NewEpochState ShelleyEra -> EpochNo
forall era. NewEpochState era -> EpochNo
nesEL NewEpochState (PreviousEra AllegraEra)
NewEpochState ShelleyEra
nes
        , nesBprev :: BlocksMade
nesBprev = NewEpochState ShelleyEra -> BlocksMade
forall era. NewEpochState era -> BlocksMade
nesBprev NewEpochState (PreviousEra AllegraEra)
NewEpochState ShelleyEra
nes
        , nesBcur :: BlocksMade
nesBcur = NewEpochState ShelleyEra -> BlocksMade
forall era. NewEpochState era -> BlocksMade
nesBcur NewEpochState (PreviousEra AllegraEra)
NewEpochState ShelleyEra
nes
        , nesEs :: EpochState AllegraEra
nesEs = TranslationContext AllegraEra
-> EpochState (PreviousEra AllegraEra) -> EpochState AllegraEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt (EpochState (PreviousEra AllegraEra) -> EpochState AllegraEra)
-> EpochState (PreviousEra AllegraEra) -> EpochState AllegraEra
forall a b. (a -> b) -> a -> b
$ EpochState (PreviousEra AllegraEra)
-> EpochState (PreviousEra AllegraEra)
forall era. EraTxOut era => EpochState era -> EpochState era
returnRedeemAddrsToReserves (EpochState (PreviousEra AllegraEra)
 -> EpochState (PreviousEra AllegraEra))
-> EpochState (PreviousEra AllegraEra)
-> EpochState (PreviousEra AllegraEra)
forall a b. (a -> b) -> a -> b
$ NewEpochState ShelleyEra -> EpochState ShelleyEra
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState (PreviousEra AllegraEra)
NewEpochState ShelleyEra
nes
        , nesRu :: StrictMaybe PulsingRewUpdate
nesRu = NewEpochState ShelleyEra -> StrictMaybe PulsingRewUpdate
forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesRu NewEpochState (PreviousEra AllegraEra)
NewEpochState ShelleyEra
nes
        , nesPd :: PoolDistr
nesPd = NewEpochState ShelleyEra -> PoolDistr
forall era. NewEpochState era -> PoolDistr
nesPd NewEpochState (PreviousEra AllegraEra)
NewEpochState ShelleyEra
nes
        , -- At this point, the consensus layer has passed in our stashed AVVM
          -- addresses as our UTxO, and we have deleted them above (with
          -- 'returnRedeemAddrsToReserves'), so we may safely discard this map.
          stashedAVVMAddresses :: StashedAVVMAddresses AllegraEra
stashedAVVMAddresses = ()
        }

instance TranslateEra AllegraEra ShelleyTx where
  type TranslationError AllegraEra ShelleyTx = DecoderError
  translateEra :: TranslationContext AllegraEra
-> ShelleyTx (PreviousEra AllegraEra)
-> Except
     (TranslationError AllegraEra ShelleyTx) (ShelleyTx AllegraEra)
translateEra TranslationContext AllegraEra
_ctx = ShelleyTx (PreviousEra AllegraEra)
-> Except DecoderError (ShelleyTx AllegraEra)
ShelleyTx (PreviousEra AllegraEra)
-> Except
     (TranslationError AllegraEra ShelleyTx) (ShelleyTx AllegraEra)
forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)), DecCBOR (to era)) =>
ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR

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

instance TranslateEra AllegraEra PParams

instance TranslateEra AllegraEra PParamsUpdate

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

instance TranslateEra AllegraEra ProposedPPUpdates where
  translateEra :: TranslationContext AllegraEra
-> ProposedPPUpdates (PreviousEra AllegraEra)
-> Except
     (TranslationError AllegraEra ProposedPPUpdates)
     (ProposedPPUpdates AllegraEra)
translateEra TranslationContext AllegraEra
ctxt (ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate (PreviousEra AllegraEra))
ppup) =
    ProposedPPUpdates AllegraEra
-> Except
     (TranslationError AllegraEra ProposedPPUpdates)
     (ProposedPPUpdates AllegraEra)
forall a.
a
-> ExceptT
     (TranslationError AllegraEra ProposedPPUpdates) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProposedPPUpdates AllegraEra
 -> Except
      (TranslationError AllegraEra ProposedPPUpdates)
      (ProposedPPUpdates AllegraEra))
-> ProposedPPUpdates AllegraEra
-> Except
     (TranslationError AllegraEra ProposedPPUpdates)
     (ProposedPPUpdates AllegraEra)
forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'Genesis) (PParamsUpdate AllegraEra)
-> ProposedPPUpdates AllegraEra
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate AllegraEra)
 -> ProposedPPUpdates AllegraEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate AllegraEra)
-> ProposedPPUpdates AllegraEra
forall a b. (a -> b) -> a -> b
$ (PParamsUpdate ShelleyEra -> PParamsUpdate AllegraEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate AllegraEra)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (TranslationContext AllegraEra
-> PParamsUpdate (PreviousEra AllegraEra)
-> PParamsUpdate AllegraEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt) Map (KeyHash 'Genesis) (PParamsUpdate (PreviousEra AllegraEra))
Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
ppup

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

instance TranslateEra AllegraEra ShelleyTxOut where
  translateEra :: TranslationContext AllegraEra
-> ShelleyTxOut (PreviousEra AllegraEra)
-> Except
     (TranslationError AllegraEra ShelleyTxOut)
     (ShelleyTxOut AllegraEra)
translateEra NoGenesis AllegraEra
TranslationContext AllegraEra
NoGenesis = ShelleyTxOut AllegraEra
-> ExceptT Void Identity (ShelleyTxOut AllegraEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyTxOut AllegraEra
 -> ExceptT Void Identity (ShelleyTxOut AllegraEra))
-> (ShelleyTxOut ShelleyEra -> ShelleyTxOut AllegraEra)
-> ShelleyTxOut ShelleyEra
-> ExceptT Void Identity (ShelleyTxOut AllegraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut (PreviousEra AllegraEra) -> TxOut AllegraEra
ShelleyTxOut ShelleyEra -> ShelleyTxOut AllegraEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut

instance TranslateEra AllegraEra UTxO where
  translateEra :: TranslationContext AllegraEra
-> UTxO (PreviousEra AllegraEra)
-> Except (TranslationError AllegraEra UTxO) (UTxO AllegraEra)
translateEra TranslationContext AllegraEra
ctxt UTxO (PreviousEra AllegraEra)
utxo =
    UTxO AllegraEra
-> Except (TranslationError AllegraEra UTxO) (UTxO AllegraEra)
forall a.
a -> ExceptT (TranslationError AllegraEra UTxO) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTxO AllegraEra
 -> Except (TranslationError AllegraEra UTxO) (UTxO AllegraEra))
-> UTxO AllegraEra
-> Except (TranslationError AllegraEra UTxO) (UTxO AllegraEra)
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut AllegraEra) -> UTxO AllegraEra
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (TranslationContext AllegraEra
-> ShelleyTxOut (PreviousEra AllegraEra) -> ShelleyTxOut AllegraEra
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt (ShelleyTxOut ShelleyEra -> ShelleyTxOut AllegraEra)
-> Map TxIn (ShelleyTxOut ShelleyEra)
-> Map TxIn (ShelleyTxOut AllegraEra)
forall a b k. (a -> b) -> Map k a -> Map k b
`Map.map` UTxO ShelleyEra -> Map TxIn (TxOut ShelleyEra)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO UTxO (PreviousEra AllegraEra)
UTxO ShelleyEra
utxo)

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

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

instance TranslateEra AllegraEra DState where
  translateEra :: TranslationContext AllegraEra
-> DState (PreviousEra AllegraEra)
-> Except (TranslationError AllegraEra DState) (DState AllegraEra)
translateEra TranslationContext AllegraEra
_ DState {Map FutureGenDeleg GenDelegPair
GenDelegs
UMap
InstantaneousRewards
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 AllegraEra -> ExceptT Void Identity (DState AllegraEra)
forall a. a -> ExceptT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DState {Map FutureGenDeleg GenDelegPair
GenDelegs
UMap
InstantaneousRewards
dsUnified :: UMap
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsUnified :: UMap
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
..}

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

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

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

instance TranslateEra AllegraEra ShelleyTxWits where
  type TranslationError AllegraEra ShelleyTxWits = DecoderError
  translateEra :: TranslationContext AllegraEra
-> ShelleyTxWits (PreviousEra AllegraEra)
-> Except
     (TranslationError AllegraEra ShelleyTxWits)
     (ShelleyTxWits AllegraEra)
translateEra TranslationContext AllegraEra
_ctx = ShelleyTxWits (PreviousEra AllegraEra)
-> Except DecoderError (ShelleyTxWits AllegraEra)
ShelleyTxWits (PreviousEra AllegraEra)
-> Except
     (TranslationError AllegraEra ShelleyTxWits)
     (ShelleyTxWits AllegraEra)
forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)), DecCBOR (to era)) =>
ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR

instance TranslateEra AllegraEra Update where
  translateEra :: TranslationContext AllegraEra
-> Update (PreviousEra AllegraEra)
-> Except (TranslationError AllegraEra Update) (Update AllegraEra)
translateEra TranslationContext AllegraEra
_ (Update ProposedPPUpdates (PreviousEra AllegraEra)
pp EpochNo
en) = Update AllegraEra
-> Except (TranslationError AllegraEra Update) (Update AllegraEra)
forall a.
a -> ExceptT (TranslationError AllegraEra Update) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Update AllegraEra
 -> Except (TranslationError AllegraEra Update) (Update AllegraEra))
-> Update AllegraEra
-> Except (TranslationError AllegraEra Update) (Update AllegraEra)
forall a b. (a -> b) -> a -> b
$ ProposedPPUpdates AllegraEra -> EpochNo -> Update AllegraEra
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update (ProposedPPUpdates ShelleyEra -> ProposedPPUpdates AllegraEra
forall a b. Coercible a b => a -> b
coerce ProposedPPUpdates (PreviousEra AllegraEra)
ProposedPPUpdates ShelleyEra
pp) EpochNo
en