{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Translation (
  Tx (..),
  addrPtrNormalize,
  translateDatum,
) where

import Cardano.Ledger.Address (addrPtrNormalize)
import Cardano.Ledger.Babbage (BabbageEra)
import Cardano.Ledger.Binary (DecoderError)
import Cardano.Ledger.CertState (CommitteeState (..))
import Cardano.Ledger.Conway.Core hiding (Tx)
import Cardano.Ledger.Conway.Era (ConwayEra)
import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
import Cardano.Ledger.Conway.Governance (
  cgsCommitteeL,
  cgsConstitutionL,
  cgsCurPParamsL,
  cgsFuturePParamsL,
  cgsPrevPParamsL,
  mkEnactState,
  rsEnactStateL,
  setCompleteDRepPulsingState,
 )
import Cardano.Ledger.Conway.Scripts ()
import Cardano.Ledger.Conway.Tx ()
import qualified Cardano.Ledger.Core as Core (Tx)
import Cardano.Ledger.Plutus.Data (translateDatum)
import Cardano.Ledger.Shelley.API (
  CertState (..),
  DState (..),
  EpochState (..),
  NewEpochState (..),
  PState (..),
  StrictMaybe (..),
  UTxOState (..),
  VState (..),
 )
import qualified Cardano.Ledger.Shelley.API as API
import Cardano.Ledger.Shelley.LedgerState (
  epochStateGovStateL,
 )
import qualified Cardano.Ledger.UMap as UM
import Data.Default (Default (def))
import qualified Data.Map.Strict as Map
import Lens.Micro

--------------------------------------------------------------------------------
-- Translation from Babbage to Conway
--
-- 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 ConwayEra = ConwayGenesis

instance TranslateEra ConwayEra NewEpochState where
  translateEra :: TranslationContext ConwayEra
-> NewEpochState (PreviousEra ConwayEra)
-> Except
     (TranslationError ConwayEra NewEpochState)
     (NewEpochState ConwayEra)
translateEra TranslationContext ConwayEra
ctxt NewEpochState (PreviousEra ConwayEra)
nes = do
    let es :: EpochState ConwayEra
es = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext ConwayEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. NewEpochState era -> EpochState era
nesEs NewEpochState (PreviousEra ConwayEra)
nes
        -- We need to ensure that we have the same initial EnactState in the pulser as
        -- well as in the current EnactState, otherwise in the very first EPOCH rule call
        -- the pulser will reset it.
        ratifyState :: RatifyState ConwayEra
ratifyState =
          forall a. Default a => a
def
            forall a b. a -> (a -> b) -> b
& forall era. Lens' (RatifyState era) (EnactState era)
rsEnactStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era. ConwayEraGov era => GovState era -> EnactState era
mkEnactState (EpochState ConwayEra
es forall s a. s -> Getting a s a -> a
^. forall era. Lens' (EpochState era) (GovState era)
epochStateGovStateL)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      NewEpochState
        { nesEL :: EpochNo
nesEL = forall era. NewEpochState era -> EpochNo
nesEL NewEpochState (PreviousEra ConwayEra)
nes
        , nesBprev :: BlocksMade
nesBprev = forall era. NewEpochState era -> BlocksMade
nesBprev NewEpochState (PreviousEra ConwayEra)
nes
        , nesBcur :: BlocksMade
nesBcur = forall era. NewEpochState era -> BlocksMade
nesBcur NewEpochState (PreviousEra ConwayEra)
nes
        , nesEs :: EpochState ConwayEra
nesEs = forall era.
(GovState era ~ ConwayGovState era) =>
PulsingSnapshot era
-> RatifyState era -> EpochState era -> EpochState era
setCompleteDRepPulsingState forall a. Default a => a
def RatifyState ConwayEra
ratifyState EpochState ConwayEra
es
        , nesRu :: StrictMaybe PulsingRewUpdate
nesRu = forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesRu NewEpochState (PreviousEra ConwayEra)
nes
        , nesPd :: PoolDistr
nesPd = forall era. NewEpochState era -> PoolDistr
nesPd NewEpochState (PreviousEra ConwayEra)
nes
        , stashedAVVMAddresses :: StashedAVVMAddresses ConwayEra
stashedAVVMAddresses = ()
        }

newtype Tx era = Tx {forall era. Tx era -> Tx era
unTx :: Core.Tx era}

instance TranslateEra ConwayEra Tx where
  type TranslationError ConwayEra Tx = DecoderError
  translateEra :: TranslationContext ConwayEra
-> Tx (PreviousEra ConwayEra)
-> Except (TranslationError ConwayEra Tx) (Tx ConwayEra)
translateEra TranslationContext ConwayEra
_ctxt (Tx Tx (PreviousEra ConwayEra)
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.
    ConwayTxBody ConwayEra
txBody <- 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" forall a b. (a -> b) -> a -> b
$ Tx (PreviousEra ConwayEra)
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL
    AlonzoTxWits ConwayEra
txWits <- forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)),
 DecCBOR (Annotator (to era))) =>
Text -> ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR Text
"TxWitness" forall a b. (a -> b) -> a -> b
$ Tx (PreviousEra ConwayEra)
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL
    StrictMaybe (AlonzoTxAuxData ConwayEra)
auxData <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall era (ti :: * -> *) (to :: * -> *).
(Era era, ToCBOR (ti (PreviousEra era)),
 DecCBOR (Annotator (to era))) =>
Text -> ti (PreviousEra era) -> Except DecoderError (to era)
translateEraThroughCBOR Text
"AuxData") (Tx (PreviousEra ConwayEra)
tx forall s a. s -> Getting a s a -> a
^. forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL)
    let isValidTx :: IsValid
isValidTx = Tx (PreviousEra ConwayEra)
tx forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
isValidTxL
        newTx :: Tx ConwayEra
newTx =
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx ConwayTxBody ConwayEra
txBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ AlonzoTxWits ConwayEra
txWits
            forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
isValidTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ IsValid
isValidTx
            forall a b. a -> (a -> b) -> b
& forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (AlonzoTxAuxData ConwayEra)
auxData
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. Tx era -> Tx era
Tx Tx ConwayEra
newTx

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

instance TranslateEra ConwayEra PParams where
  translateEra :: TranslationContext ConwayEra
-> PParams (PreviousEra ConwayEra)
-> Except (TranslationError ConwayEra PParams) (PParams ConwayEra)
translateEra ConwayGenesis {UpgradeConwayPParams Identity
cgUpgradePParams :: ConwayGenesis -> UpgradeConwayPParams Identity
cgUpgradePParams :: UpgradeConwayPParams Identity
cgUpgradePParams} = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams Identity era
-> PParams (PreviousEra era) -> PParams era
upgradePParams UpgradeConwayPParams Identity
cgUpgradePParams

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

instance TranslateEra ConwayEra EpochState where
  translateEra :: TranslationContext ConwayEra
-> EpochState (PreviousEra ConwayEra)
-> Except
     (TranslationError ConwayEra EpochState) (EpochState ConwayEra)
translateEra TranslationContext ConwayEra
ctxt EpochState (PreviousEra ConwayEra)
es =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      EpochState
        { esAccountState :: AccountState
esAccountState = forall era. EpochState era -> AccountState
esAccountState EpochState (PreviousEra ConwayEra)
es
        , esSnapshots :: SnapShots
esSnapshots = forall era. EpochState era -> SnapShots
esSnapshots EpochState (PreviousEra ConwayEra)
es
        , esLState :: LedgerState ConwayEra
esLState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext ConwayEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. EpochState era -> LedgerState era
esLState EpochState (PreviousEra ConwayEra)
es
        , esNonMyopic :: NonMyopic
esNonMyopic = forall era. EpochState era -> NonMyopic
esNonMyopic EpochState (PreviousEra ConwayEra)
es
        }

instance TranslateEra ConwayEra DState where
  translateEra :: TranslationContext ConwayEra
-> DState (PreviousEra ConwayEra)
-> Except (TranslationError ConwayEra DState) (DState ConwayEra)
translateEra TranslationContext ConwayEra
_ DState {dsUnified :: forall era. DState era -> UMap
dsUnified = UMap
umap, Map FutureGenDeleg GenDelegPair
InstantaneousRewards
GenDelegs
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
..} = forall (f :: * -> *) a. Applicative f => a -> f a
pure DState {dsUnified :: UMap
dsUnified = UMap
umap', Map FutureGenDeleg GenDelegPair
InstantaneousRewards
GenDelegs
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsIRewards :: InstantaneousRewards
dsGenDelegs :: GenDelegs
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
..}
    where
      umap' :: UMap
umap' =
        UMap
umap
          { umElems :: Map (Credential 'Staking) UMElem
UM.umElems =
              forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(UM.UMElem StrictMaybe RDPair
rd Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
poolId StrictMaybe DRep
drep) -> StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UM.UMElem StrictMaybe RDPair
rd forall a. Monoid a => a
mempty StrictMaybe (KeyHash 'StakePool)
poolId StrictMaybe DRep
drep) (UMap -> Map (Credential 'Staking) UMElem
UM.umElems UMap
umap)
          , umPtrs :: Map Ptr (Credential 'Staking)
UM.umPtrs = forall a. Monoid a => a
mempty
          }

instance TranslateEra ConwayEra CommitteeState where
  translateEra :: TranslationContext ConwayEra
-> CommitteeState (PreviousEra ConwayEra)
-> Except
     (TranslationError ConwayEra CommitteeState)
     (CommitteeState ConwayEra)
translateEra TranslationContext ConwayEra
_ 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 ConwayEra VState where
  translateEra :: TranslationContext ConwayEra
-> VState (PreviousEra ConwayEra)
-> Except (TranslationError ConwayEra VState) (VState ConwayEra)
translateEra TranslationContext ConwayEra
ctx VState {Map (Credential 'DRepRole) DRepState
CommitteeState (PreviousEra ConwayEra)
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 ConwayEra)
vsDReps :: Map (Credential 'DRepRole) DRepState
..} = do
    CommitteeState ConwayEra
committeeState <- forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext ConwayEra
ctx CommitteeState (PreviousEra ConwayEra)
vsCommitteeState
    forall (f :: * -> *) a. Applicative f => a -> f a
pure VState {vsCommitteeState :: CommitteeState ConwayEra
vsCommitteeState = CommitteeState ConwayEra
committeeState, Map (Credential 'DRepRole) DRepState
EpochNo
vsDReps :: Map (Credential 'DRepRole) DRepState
vsNumDormantEpochs :: EpochNo
vsNumDormantEpochs :: EpochNo
vsDReps :: Map (Credential 'DRepRole) DRepState
..}

instance TranslateEra ConwayEra PState where
  translateEra :: TranslationContext ConwayEra
-> PState (PreviousEra ConwayEra)
-> Except (TranslationError ConwayEra PState) (PState ConwayEra)
translateEra TranslationContext ConwayEra
_ 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 ConwayEra CertState where
  translateEra :: TranslationContext ConwayEra
-> CertState (PreviousEra ConwayEra)
-> Except
     (TranslationError ConwayEra CertState) (CertState ConwayEra)
translateEra TranslationContext ConwayEra
ctxt CertState (PreviousEra ConwayEra)
ls =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      CertState
        { certDState :: DState ConwayEra
certDState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext ConwayEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> DState era
certDState CertState (PreviousEra ConwayEra)
ls
        , certPState :: PState ConwayEra
certPState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext ConwayEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> PState era
certPState CertState (PreviousEra ConwayEra)
ls
        , certVState :: VState ConwayEra
certVState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext ConwayEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> VState era
certVState CertState (PreviousEra ConwayEra)
ls
        }

instance TranslateEra ConwayEra API.LedgerState where
  translateEra :: TranslationContext ConwayEra
-> LedgerState (PreviousEra ConwayEra)
-> Except
     (TranslationError ConwayEra LedgerState) (LedgerState ConwayEra)
translateEra TranslationContext ConwayEra
conwayGenesis LedgerState (PreviousEra ConwayEra)
ls =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      API.LedgerState
        { lsUTxOState :: UTxOState ConwayEra
API.lsUTxOState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext ConwayEra
conwayGenesis forall a b. (a -> b) -> a -> b
$ forall era. LedgerState era -> UTxOState era
API.lsUTxOState LedgerState (PreviousEra ConwayEra)
ls
        , lsCertState :: CertState ConwayEra
API.lsCertState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext ConwayEra
conwayGenesis forall a b. (a -> b) -> a -> b
$ forall era. LedgerState era -> CertState era
API.lsCertState LedgerState (PreviousEra ConwayEra)
ls
        }

translateGovState ::
  TranslationContext ConwayEra ->
  GovState BabbageEra ->
  GovState ConwayEra
translateGovState :: TranslationContext ConwayEra
-> GovState BabbageEra -> GovState ConwayEra
translateGovState ctxt :: TranslationContext ConwayEra
ctxt@ConwayGenesis {ListMap (Credential 'Staking) Delegatee
ListMap (Credential 'DRepRole) DRepState
Constitution ConwayEra
Committee ConwayEra
UpgradeConwayPParams Identity
cgInitialDReps :: ConwayGenesis -> ListMap (Credential 'DRepRole) DRepState
cgDelegs :: ConwayGenesis -> ListMap (Credential 'Staking) Delegatee
cgCommittee :: ConwayGenesis -> Committee ConwayEra
cgConstitution :: ConwayGenesis -> Constitution ConwayEra
cgInitialDReps :: ListMap (Credential 'DRepRole) DRepState
cgDelegs :: ListMap (Credential 'Staking) Delegatee
cgCommittee :: Committee ConwayEra
cgConstitution :: Constitution ConwayEra
cgUpgradePParams :: UpgradeConwayPParams Identity
cgUpgradePParams :: ConwayGenesis -> UpgradeConwayPParams Identity
..} GovState BabbageEra
sgov =
  let curPParams :: PParams ConwayEra
curPParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext ConwayEra
ctxt (GovState BabbageEra
sgov forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (GovState era) (PParams era)
curPParamsGovStateL)
      prevPParams :: PParams ConwayEra
prevPParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext ConwayEra
ctxt (GovState BabbageEra
sgov forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (GovState era) (PParams era)
prevPParamsGovStateL)
      futurePParams :: FuturePParams ConwayEra
futurePParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext ConwayEra
ctxt (GovState BabbageEra
sgov forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (GovState era) (FuturePParams era)
futurePParamsGovStateL)
   in forall era. EraGov era => GovState era
emptyGovState
        forall a b. a -> (a -> b) -> b
& forall era. Lens' (ConwayGovState era) (PParams era)
cgsCurPParamsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams ConwayEra
curPParams
        forall a b. a -> (a -> b) -> b
& forall era. Lens' (ConwayGovState era) (PParams era)
cgsPrevPParamsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams ConwayEra
prevPParams
        forall a b. a -> (a -> b) -> b
& forall era. Lens' (ConwayGovState era) (FuturePParams era)
cgsFuturePParamsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ FuturePParams ConwayEra
futurePParams
        forall a b. a -> (a -> b) -> b
& forall era.
Lens' (ConwayGovState era) (StrictMaybe (Committee era))
cgsCommitteeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust Committee ConwayEra
cgCommittee
        forall a b. a -> (a -> b) -> b
& forall era. Lens' (ConwayGovState era) (Constitution era)
cgsConstitutionL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Constitution ConwayEra
cgConstitution

instance TranslateEra ConwayEra UTxOState where
  translateEra :: TranslationContext ConwayEra
-> UTxOState (PreviousEra ConwayEra)
-> Except
     (TranslationError ConwayEra UTxOState) (UTxOState ConwayEra)
translateEra TranslationContext ConwayEra
ctxt UTxOState (PreviousEra ConwayEra)
us =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      UTxOState
        { utxosUtxo :: UTxO ConwayEra
API.utxosUtxo = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext ConwayEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. UTxOState era -> UTxO era
API.utxosUtxo UTxOState (PreviousEra ConwayEra)
us
        , utxosDeposited :: Coin
API.utxosDeposited = forall era. UTxOState era -> Coin
API.utxosDeposited UTxOState (PreviousEra ConwayEra)
us
        , utxosFees :: Coin
API.utxosFees = forall era. UTxOState era -> Coin
API.utxosFees UTxOState (PreviousEra ConwayEra)
us
        , utxosGovState :: GovState ConwayEra
API.utxosGovState = TranslationContext ConwayEra
-> GovState BabbageEra -> GovState ConwayEra
translateGovState TranslationContext ConwayEra
ctxt forall a b. (a -> b) -> a -> b
$ forall era. UTxOState era -> GovState era
API.utxosGovState UTxOState (PreviousEra ConwayEra)
us
        , utxosStakeDistr :: IncrementalStake
API.utxosStakeDistr = (forall era. UTxOState era -> IncrementalStake
API.utxosStakeDistr UTxOState (PreviousEra ConwayEra)
us) {ptrMap :: Map Ptr (CompactForm Coin)
API.ptrMap = forall a. Monoid a => a
mempty}
        , utxosDonation :: Coin
API.utxosDonation = forall era. UTxOState era -> Coin
API.utxosDonation UTxOState (PreviousEra ConwayEra)
us
        }

instance TranslateEra ConwayEra API.UTxO where
  translateEra :: TranslationContext ConwayEra
-> UTxO (PreviousEra ConwayEra)
-> Except (TranslationError ConwayEra UTxO) (UTxO ConwayEra)
translateEra TranslationContext ConwayEra
_ctxt UTxO (PreviousEra ConwayEra)
utxo =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. Map TxIn (TxOut era) -> UTxO era
API.UTxO forall a b. (a -> b) -> a -> b
$ forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut forall a b k. (a -> b) -> Map k a -> Map k b
`Map.map` forall era. UTxO era -> Map TxIn (TxOut era)
API.unUTxO UTxO (PreviousEra ConwayEra)
utxo