{-# 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,
  translateTxOut,
) 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.Crypto (Crypto)
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.Class (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 c) = ConwayGenesis c

instance Crypto c => TranslateEra (ConwayEra c) NewEpochState where
  translateEra :: TranslationContext (ConwayEra c)
-> NewEpochState (PreviousEra (ConwayEra c))
-> Except
     (TranslationError (ConwayEra c) NewEpochState)
     (NewEpochState (ConwayEra c))
translateEra TranslationContext (ConwayEra c)
ctxt NewEpochState (PreviousEra (ConwayEra c))
nes = do
    let es :: EpochState (ConwayEra c)
es = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (ConwayEra c)
ctxt forall a b. (a -> b) -> a -> b
$ forall era. NewEpochState era -> EpochState era
nesEs NewEpochState (PreviousEra (ConwayEra c))
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 c)
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 c)
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 c))
nes
        , nesBprev :: BlocksMade (EraCrypto (ConwayEra c))
nesBprev = forall era. NewEpochState era -> BlocksMade (EraCrypto era)
nesBprev NewEpochState (PreviousEra (ConwayEra c))
nes
        , nesBcur :: BlocksMade (EraCrypto (ConwayEra c))
nesBcur = forall era. NewEpochState era -> BlocksMade (EraCrypto era)
nesBcur NewEpochState (PreviousEra (ConwayEra c))
nes
        , nesEs :: EpochState (ConwayEra c)
nesEs = forall era.
(GovState era ~ ConwayGovState era) =>
PulsingSnapshot era
-> RatifyState era -> EpochState era -> EpochState era
setCompleteDRepPulsingState forall a. Default a => a
def RatifyState (ConwayEra c)
ratifyState EpochState (ConwayEra c)
es
        , nesRu :: StrictMaybe (PulsingRewUpdate (EraCrypto (ConwayEra c)))
nesRu = forall era.
NewEpochState era -> StrictMaybe (PulsingRewUpdate (EraCrypto era))
nesRu NewEpochState (PreviousEra (ConwayEra c))
nes
        , nesPd :: PoolDistr (EraCrypto (ConwayEra c))
nesPd = forall era. NewEpochState era -> PoolDistr (EraCrypto era)
nesPd NewEpochState (PreviousEra (ConwayEra c))
nes
        , stashedAVVMAddresses :: StashedAVVMAddresses (ConwayEra c)
stashedAVVMAddresses = ()
        }

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

instance Crypto c => TranslateEra (ConwayEra c) Tx where
  type TranslationError (ConwayEra c) Tx = DecoderError
  translateEra :: TranslationContext (ConwayEra c)
-> Tx (PreviousEra (ConwayEra c))
-> Except (TranslationError (ConwayEra c) Tx) (Tx (ConwayEra c))
translateEra TranslationContext (ConwayEra c)
_ctxt (Tx Tx (PreviousEra (ConwayEra c))
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 c)
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 c))
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL
    AlonzoTxWits (ConwayEra c)
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 c))
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL
    StrictMaybe (AlonzoTxAuxData (ConwayEra c))
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 c))
tx forall s a. s -> Getting a s a -> a
^. forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (AuxiliaryData era))
auxDataTxL)
    let isValidTx :: IsValid
isValidTx = Tx (PreviousEra (ConwayEra c))
tx forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
isValidTxL
        newTx :: Tx (ConwayEra c)
newTx =
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx ConwayTxBody (ConwayEra c)
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 c)
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 (AuxiliaryData era))
auxDataTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (AlonzoTxAuxData (ConwayEra c))
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 c)
newTx

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

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

instance Crypto c => TranslateEra (ConwayEra c) EpochState where
  translateEra :: TranslationContext (ConwayEra c)
-> EpochState (PreviousEra (ConwayEra c))
-> Except
     (TranslationError (ConwayEra c) EpochState)
     (EpochState (ConwayEra c))
translateEra TranslationContext (ConwayEra c)
ctxt EpochState (PreviousEra (ConwayEra c))
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 c))
es
        , esSnapshots :: SnapShots (EraCrypto (ConwayEra c))
esSnapshots = forall era. EpochState era -> SnapShots (EraCrypto era)
esSnapshots EpochState (PreviousEra (ConwayEra c))
es
        , esLState :: LedgerState (ConwayEra c)
esLState = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (ConwayEra c)
ctxt forall a b. (a -> b) -> a -> b
$ forall era. EpochState era -> LedgerState era
esLState EpochState (PreviousEra (ConwayEra c))
es
        , esNonMyopic :: NonMyopic (EraCrypto (ConwayEra c))
esNonMyopic = forall era. EpochState era -> NonMyopic (EraCrypto era)
esNonMyopic EpochState (PreviousEra (ConwayEra c))
es
        }

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

instance Crypto c => TranslateEra (ConwayEra c) CommitteeState where
  translateEra :: TranslationContext (ConwayEra c)
-> CommitteeState (PreviousEra (ConwayEra c))
-> Except
     (TranslationError (ConwayEra c) CommitteeState)
     (CommitteeState (ConwayEra c))
translateEra TranslationContext (ConwayEra c)
_ CommitteeState {Map
  (Credential
     'ColdCommitteeRole (EraCrypto (PreviousEra (ConwayEra c))))
  (CommitteeAuthorization (EraCrypto (PreviousEra (ConwayEra c))))
csCommitteeCreds :: forall era.
CommitteeState era
-> Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era))
csCommitteeCreds :: Map
  (Credential
     'ColdCommitteeRole (EraCrypto (PreviousEra (ConwayEra c))))
  (CommitteeAuthorization (EraCrypto (PreviousEra (ConwayEra c))))
..} = forall (f :: * -> *) a. Applicative f => a -> f a
pure CommitteeState {Map
  (Credential
     'ColdCommitteeRole (EraCrypto (PreviousEra (ConwayEra c))))
  (CommitteeAuthorization (EraCrypto (PreviousEra (ConwayEra c))))
csCommitteeCreds :: Map
  (Credential 'ColdCommitteeRole (EraCrypto (ConwayEra c)))
  (CommitteeAuthorization (EraCrypto (ConwayEra c)))
csCommitteeCreds :: Map
  (Credential
     'ColdCommitteeRole (EraCrypto (PreviousEra (ConwayEra c))))
  (CommitteeAuthorization (EraCrypto (PreviousEra (ConwayEra c))))
..}

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

instance Crypto c => TranslateEra (ConwayEra c) PState where
  translateEra :: TranslationContext (ConwayEra c)
-> PState (PreviousEra (ConwayEra c))
-> Except
     (TranslationError (ConwayEra c) PState) (PState (ConwayEra c))
translateEra TranslationContext (ConwayEra c)
_ PState {Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c))))
  (PoolParams (EraCrypto (PreviousEra (ConwayEra c))))
Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c)))) Coin
Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c))))
  EpochNo
psStakePoolParams :: forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psFutureStakePoolParams :: forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psRetiring :: forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
psDeposits :: forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) Coin
psDeposits :: Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c)))) Coin
psRetiring :: Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c))))
  EpochNo
psFutureStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c))))
  (PoolParams (EraCrypto (PreviousEra (ConwayEra c))))
psStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c))))
  (PoolParams (EraCrypto (PreviousEra (ConwayEra c))))
..} = forall (f :: * -> *) a. Applicative f => a -> f a
pure PState {Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c))))
  (PoolParams (EraCrypto (PreviousEra (ConwayEra c))))
Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c)))) Coin
Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c))))
  EpochNo
psStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto (ConwayEra c)))
  (PoolParams (EraCrypto (ConwayEra c)))
psFutureStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto (ConwayEra c)))
  (PoolParams (EraCrypto (ConwayEra c)))
psRetiring :: Map (KeyHash 'StakePool (EraCrypto (ConwayEra c))) EpochNo
psDeposits :: Map (KeyHash 'StakePool (EraCrypto (ConwayEra c))) Coin
psDeposits :: Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c)))) Coin
psRetiring :: Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c))))
  EpochNo
psFutureStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c))))
  (PoolParams (EraCrypto (PreviousEra (ConwayEra c))))
psStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto (PreviousEra (ConwayEra c))))
  (PoolParams (EraCrypto (PreviousEra (ConwayEra c))))
..}

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

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

translateGovState ::
  Crypto c =>
  TranslationContext (ConwayEra c) ->
  GovState (BabbageEra c) ->
  GovState (ConwayEra c)
translateGovState :: forall c.
Crypto c =>
TranslationContext (ConwayEra c)
-> GovState (BabbageEra c) -> GovState (ConwayEra c)
translateGovState ctxt :: TranslationContext (ConwayEra c)
ctxt@ConwayGenesis {ListMap (Credential 'DRepRole c) (DRepState c)
ListMap (Credential 'Staking c) (Delegatee c)
Constitution (ConwayEra c)
Committee (ConwayEra c)
UpgradeConwayPParams Identity
cgInitialDReps :: forall c.
ConwayGenesis c -> ListMap (Credential 'DRepRole c) (DRepState c)
cgDelegs :: forall c.
ConwayGenesis c -> ListMap (Credential 'Staking c) (Delegatee c)
cgCommittee :: forall c. ConwayGenesis c -> Committee (ConwayEra c)
cgConstitution :: forall c. ConwayGenesis c -> Constitution (ConwayEra c)
cgInitialDReps :: ListMap (Credential 'DRepRole c) (DRepState c)
cgDelegs :: ListMap (Credential 'Staking c) (Delegatee c)
cgCommittee :: Committee (ConwayEra c)
cgConstitution :: Constitution (ConwayEra c)
cgUpgradePParams :: UpgradeConwayPParams Identity
cgUpgradePParams :: forall c. ConwayGenesis c -> UpgradeConwayPParams Identity
..} GovState (BabbageEra c)
sgov =
  let curPParams :: PParams (ConwayEra c)
curPParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (ConwayEra c)
ctxt (GovState (BabbageEra c)
sgov forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (GovState era) (PParams era)
curPParamsGovStateL)
      prevPParams :: PParams (ConwayEra c)
prevPParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (ConwayEra c)
ctxt (GovState (BabbageEra c)
sgov forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (GovState era) (PParams era)
prevPParamsGovStateL)
      futurePParams :: FuturePParams (ConwayEra c)
futurePParams = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (ConwayEra c)
ctxt (GovState (BabbageEra c)
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 c)
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 c)
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 c)
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 c)
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 c)
cgConstitution

instance Crypto c => TranslateEra (ConwayEra c) UTxOState where
  translateEra :: TranslationContext (ConwayEra c)
-> UTxOState (PreviousEra (ConwayEra c))
-> Except
     (TranslationError (ConwayEra c) UTxOState)
     (UTxOState (ConwayEra c))
translateEra TranslationContext (ConwayEra c)
ctxt UTxOState (PreviousEra (ConwayEra c))
us =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      UTxOState
        { utxosUtxo :: UTxO (ConwayEra c)
API.utxosUtxo = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (ConwayEra c)
ctxt forall a b. (a -> b) -> a -> b
$ forall era. UTxOState era -> UTxO era
API.utxosUtxo UTxOState (PreviousEra (ConwayEra c))
us
        , utxosDeposited :: Coin
API.utxosDeposited = forall era. UTxOState era -> Coin
API.utxosDeposited UTxOState (PreviousEra (ConwayEra c))
us
        , utxosFees :: Coin
API.utxosFees = forall era. UTxOState era -> Coin
API.utxosFees UTxOState (PreviousEra (ConwayEra c))
us
        , utxosGovState :: GovState (ConwayEra c)
API.utxosGovState = forall c.
Crypto c =>
TranslationContext (ConwayEra c)
-> GovState (BabbageEra c) -> GovState (ConwayEra c)
translateGovState TranslationContext (ConwayEra c)
ctxt forall a b. (a -> b) -> a -> b
$ forall era. UTxOState era -> GovState era
API.utxosGovState UTxOState (PreviousEra (ConwayEra c))
us
        , utxosStakeDistr :: IncrementalStake (EraCrypto (ConwayEra c))
API.utxosStakeDistr = (forall era. UTxOState era -> IncrementalStake (EraCrypto era)
API.utxosStakeDistr UTxOState (PreviousEra (ConwayEra c))
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 c))
us
        }

instance Crypto c => TranslateEra (ConwayEra c) API.UTxO where
  translateEra :: TranslationContext (ConwayEra c)
-> UTxO (PreviousEra (ConwayEra c))
-> Except
     (TranslationError (ConwayEra c) UTxO) (UTxO (ConwayEra c))
translateEra TranslationContext (ConwayEra c)
_ctxt UTxO (PreviousEra (ConwayEra c))
utxo =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. Map (TxIn (EraCrypto era)) (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 (EraCrypto era)) (TxOut era)
API.unUTxO UTxO (PreviousEra (ConwayEra c))
utxo

-- | Filter out `TxOut`s with zero Coins and normalize Pointers,
-- while converting `TxOut`s to Conway era.
translateTxOut ::
  Crypto c =>
  TxOut (BabbageEra c) ->
  TxOut (ConwayEra c)
translateTxOut :: forall c. Crypto c => TxOut (BabbageEra c) -> TxOut (ConwayEra c)
translateTxOut = forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut
{-# DEPRECATED translateTxOut "In favor of `upgradeTxOut`" #-}