{-# 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.CertState ()
import Cardano.Ledger.Allegra.Era (AllegraEra)
import Cardano.Ledger.Allegra.Tx ()
import Cardano.Ledger.Binary (DecoderError)
import Cardano.Ledger.CertState (CommitteeState (..))
import Cardano.Ledger.Genesis (NoGenesis (..))
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.CertState (ShelleyCertState)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
DState (..),
EpochState (..),
LedgerState (..),
NewEpochState (..),
PState (..),
UTxOState (..),
VState (..),
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 Cardano.Ledger.State (UTxO (..))
import Data.Coerce (coerce)
import qualified Data.Map.Strict as Map
shelleyToAllegraAVVMsToDelete :: NewEpochState ShelleyEra -> UTxO ShelleyEra
shelleyToAllegraAVVMsToDelete :: NewEpochState ShelleyEra -> UTxO ShelleyEra
shelleyToAllegraAVVMsToDelete = 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 =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
NewEpochState
{ nesEL :: EpochNo
nesEL = forall era. NewEpochState era -> EpochNo
nesEL NewEpochState (PreviousEra AllegraEra)
nes
, nesBprev :: BlocksMade
nesBprev = forall era. NewEpochState era -> BlocksMade
nesBprev NewEpochState (PreviousEra AllegraEra)
nes
, nesBcur :: BlocksMade
nesBcur = forall era. NewEpochState era -> BlocksMade
nesBcur NewEpochState (PreviousEra AllegraEra)
nes
, nesEs :: EpochState AllegraEra
nesEs = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. EraTxOut era => EpochState era -> EpochState era
returnRedeemAddrsToReserves forall a b. (a -> b) -> a -> b
$ forall era. NewEpochState era -> EpochState era
nesEs NewEpochState (PreviousEra AllegraEra)
nes
, nesRu :: StrictMaybe PulsingRewUpdate
nesRu = forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesRu NewEpochState (PreviousEra AllegraEra)
nes
, nesPd :: PoolDistr
nesPd = forall era. NewEpochState era -> PoolDistr
nesPd NewEpochState (PreviousEra AllegraEra)
nes
,
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 = forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)),
DecCBOR (Annotator (to era))) =>
Text -> ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR Text
"ShelleyTx"
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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall era. FuturePParams era
NoPParamsUpdate
DefinitePParamsUpdate PParams (PreviousEra AllegraEra)
pp -> forall era. PParams era -> FuturePParams era
DefinitePParamsUpdate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext AllegraEra
ctxt PParams (PreviousEra AllegraEra)
pp
PotentialPParamsUpdate Maybe (PParams (PreviousEra AllegraEra))
mpp -> forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext AllegraEra
ctxt) Maybe (PParams (PreviousEra AllegraEra))
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) =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (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))
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 =
forall (m :: * -> *) a. Monad m => a -> m a
return
ShelleyGovState
{ sgsCurProposals :: ProposedPPUpdates AllegraEra
sgsCurProposals = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsCurProposals ShelleyGovState (PreviousEra AllegraEra)
ps
, sgsFutureProposals :: ProposedPPUpdates AllegraEra
sgsFutureProposals = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsFutureProposals ShelleyGovState (PreviousEra AllegraEra)
ps
, sgsCurPParams :: PParams AllegraEra
sgsCurPParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGovState era -> PParams era
sgsCurPParams ShelleyGovState (PreviousEra AllegraEra)
ps
, sgsPrevPParams :: PParams AllegraEra
sgsPrevPParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGovState era -> PParams era
sgsPrevPParams ShelleyGovState (PreviousEra AllegraEra)
ps
, sgsFuturePParams :: FuturePParams AllegraEra
sgsFuturePParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGovState era -> FuturePParams era
sgsFuturePParams ShelleyGovState (PreviousEra AllegraEra)
ps
}
instance TranslateEra AllegraEra ShelleyTxOut where
translateEra :: TranslationContext AllegraEra
-> ShelleyTxOut (PreviousEra AllegraEra)
-> Except
(TranslationError AllegraEra ShelleyTxOut)
(ShelleyTxOut AllegraEra)
translateEra TranslationContext AllegraEra
NoGenesis AllegraEra
NoGenesis = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b k. (a -> b) -> Map k a -> Map k b
`Map.map` forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO UTxO (PreviousEra AllegraEra)
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 =
forall (m :: * -> *) a. Monad m => a -> m a
return
UTxOState
{ utxosUtxo :: UTxO AllegraEra
utxosUtxo = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. UTxOState era -> UTxO era
utxosUtxo UTxOState (PreviousEra AllegraEra)
us
, utxosDeposited :: Coin
utxosDeposited = forall era. UTxOState era -> Coin
utxosDeposited UTxOState (PreviousEra AllegraEra)
us
, utxosFees :: Coin
utxosFees = forall era. UTxOState era -> Coin
utxosFees UTxOState (PreviousEra AllegraEra)
us
, utxosGovState :: GovState AllegraEra
utxosGovState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. UTxOState era -> GovState era
utxosGovState UTxOState (PreviousEra AllegraEra)
us
, utxosStakeDistr :: IncrementalStake
utxosStakeDistr = forall era. UTxOState era -> IncrementalStake
utxosStakeDistr UTxOState (PreviousEra AllegraEra)
us
, utxosDonation :: Coin
utxosDonation = forall era. UTxOState era -> Coin
utxosDonation UTxOState (PreviousEra AllegraEra)
us
}
instance TranslateEra AllegraEra DState where
translateEra :: TranslationContext AllegraEra
-> DState (PreviousEra AllegraEra)
-> Except (TranslationError AllegraEra DState) (DState AllegraEra)
translateEra TranslationContext AllegraEra
_ DState {Map FutureGenDeleg GenDelegPair
InstantaneousRewards
UMap
GenDelegs
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
dsIRewards :: InstantaneousRewards
dsGenDelegs :: GenDelegs
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsUnified :: UMap
..} = forall (f :: * -> *) a. Applicative f => a -> f a
pure DState {Map FutureGenDeleg GenDelegPair
InstantaneousRewards
UMap
GenDelegs
dsUnified :: UMap
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsIRewards :: InstantaneousRewards
dsGenDelegs :: GenDelegs
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsUnified :: UMap
..}
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 :: forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
..} = 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 VState where
translateEra :: TranslationContext AllegraEra
-> VState (PreviousEra AllegraEra)
-> Except (TranslationError AllegraEra VState) (VState AllegraEra)
translateEra TranslationContext AllegraEra
ctx VState {Map (Credential 'DRepRole) DRepState
CommitteeState (PreviousEra AllegraEra)
EpochNo
vsDReps :: forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsCommitteeState :: forall era. VState era -> CommitteeState era
vsNumDormantEpochs :: forall era. VState era -> EpochNo
vsNumDormantEpochs :: EpochNo
vsCommitteeState :: CommitteeState (PreviousEra AllegraEra)
vsDReps :: Map (Credential 'DRepRole) DRepState
..} = do
CommitteeState AllegraEra
committeeState <- forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext AllegraEra
ctx CommitteeState (PreviousEra AllegraEra)
vsCommitteeState
forall (f :: * -> *) a. Applicative f => a -> f a
pure VState {vsCommitteeState :: CommitteeState AllegraEra
vsCommitteeState = CommitteeState AllegraEra
committeeState, Map (Credential 'DRepRole) DRepState
EpochNo
vsDReps :: Map (Credential 'DRepRole) DRepState
vsNumDormantEpochs :: EpochNo
vsNumDormantEpochs :: EpochNo
vsDReps :: Map (Credential 'DRepRole) DRepState
..}
instance TranslateEra AllegraEra PState where
translateEra :: TranslationContext AllegraEra
-> PState (PreviousEra AllegraEra)
-> Except (TranslationError AllegraEra PState) (PState AllegraEra)
translateEra TranslationContext AllegraEra
_ PState {Map (KeyHash 'StakePool) PoolParams
Map (KeyHash 'StakePool) Coin
Map (KeyHash 'StakePool) EpochNo
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
psDeposits :: Map (KeyHash 'StakePool) Coin
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
..} = forall (f :: * -> *) a. Applicative f => a -> f a
pure PState {Map (KeyHash 'StakePool) PoolParams
Map (KeyHash 'StakePool) Coin
Map (KeyHash 'StakePool) EpochNo
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psDeposits :: Map (KeyHash 'StakePool) Coin
psDeposits :: Map (KeyHash 'StakePool) Coin
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
..}
instance TranslateEra AllegraEra ShelleyCertState
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 =
forall (m :: * -> *) a. Monad m => a -> m a
return
LedgerState
{ lsUTxOState :: UTxOState AllegraEra
lsUTxOState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState (PreviousEra AllegraEra)
ls
, lsCertState :: CertState AllegraEra
lsCertState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. LedgerState era -> CertState era
lsCertState LedgerState (PreviousEra AllegraEra)
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 =
forall (m :: * -> *) a. Monad m => a -> m a
return
EpochState
{ esAccountState :: AccountState
esAccountState = forall era. EpochState era -> AccountState
esAccountState EpochState (PreviousEra AllegraEra)
es
, esSnapshots :: SnapShots
esSnapshots = forall era. EpochState era -> SnapShots
esSnapshots EpochState (PreviousEra AllegraEra)
es
, esLState :: LedgerState AllegraEra
esLState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext AllegraEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. EpochState era -> LedgerState era
esLState EpochState (PreviousEra AllegraEra)
es
, esNonMyopic :: NonMyopic
esNonMyopic = forall era. EpochState era -> NonMyopic
esNonMyopic EpochState (PreviousEra AllegraEra)
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 = forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)),
DecCBOR (Annotator (to era))) =>
Text -> ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR Text
"ShelleyTxWits"
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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update (coerce :: forall a b. Coercible a b => a -> b
coerce ProposedPPUpdates (PreviousEra AllegraEra)
pp) EpochNo
en