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

module Cardano.Ledger.Alonzo.Translation where

import Cardano.Binary
  ( DecoderError,
  )
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..), extendPPWithGenesis)
import Cardano.Ledger.Alonzo.PParams (PParams, PParamsUpdate, extendPP)
import Cardano.Ledger.Alonzo.Tx (IsValid (..), ValidatedTx (..))
import Cardano.Ledger.Alonzo.TxBody (TxOut (..))
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Era
  ( PreviousEra,
    TranslateEra (..),
    TranslationContext,
    translateEra',
  )
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Serialization (translateViaCBORAnn)
import Cardano.Ledger.Shelley.API
  ( EpochState (..),
    NewEpochState (..),
    ShelleyGenesis,
    StrictMaybe (..),
  )
import qualified Cardano.Ledger.Shelley.API as API
import qualified Cardano.Ledger.Shelley.PParams as Shelley
import qualified Cardano.Ledger.Shelley.Tx as LTX
import qualified Cardano.Ledger.Shelley.TxBody as Shelley

--------------------------------------------------------------------------------
-- Translation from Mary to Alonzo
--
-- The instances below are needed by the consensus layer. Do not remove any of
-- them without coordinating with consensus.
--
-- Please add auxiliary instances and other declarations at the bottom of this
-- module, not in the list below so that it remains clear which instances the
-- consensus layer needs.
--
-- WARNING: when a translation instance currently uses the default
-- 'TranslationError', i.e., 'Void', it means the consensus layer relies on it
-- being total. Do not change it!
--------------------------------------------------------------------------------

type instance PreviousEra (AlonzoEra c) = MaryEra c

type instance TranslationContext (AlonzoEra c) = AlonzoGenesis

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

instance Crypto c => TranslateEra (AlonzoEra c) ShelleyGenesis where
  translateEra :: TranslationContext (AlonzoEra c)
-> ShelleyGenesis (PreviousEra (AlonzoEra c))
-> Except
     (TranslationError (AlonzoEra c) ShelleyGenesis)
     (ShelleyGenesis (AlonzoEra c))
translateEra TranslationContext (AlonzoEra c)
ctxt ShelleyGenesis (PreviousEra (AlonzoEra c))
genesis =
    ShelleyGenesis (AlonzoEra c)
-> ExceptT Void Identity (ShelleyGenesis (AlonzoEra c))
forall (m :: * -> *) a. Monad m => a -> m a
return
      ShelleyGenesis :: forall era.
UTCTime
-> Word32
-> Network
-> PositiveUnitInterval
-> Word64
-> EpochSize
-> Word64
-> Word64
-> NominalDiffTime
-> Word64
-> Word64
-> PParams era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Map (Addr (Crypto era)) Coin
-> ShelleyGenesisStaking (Crypto era)
-> ShelleyGenesis era
API.ShelleyGenesis
        { sgSystemStart :: UTCTime
API.sgSystemStart = ShelleyGenesis (MaryEra c) -> UTCTime
forall era. ShelleyGenesis era -> UTCTime
API.sgSystemStart ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgNetworkMagic :: Word32
API.sgNetworkMagic = ShelleyGenesis (MaryEra c) -> Word32
forall era. ShelleyGenesis era -> Word32
API.sgNetworkMagic ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgNetworkId :: Network
API.sgNetworkId = ShelleyGenesis (MaryEra c) -> Network
forall era. ShelleyGenesis era -> Network
API.sgNetworkId ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgActiveSlotsCoeff :: PositiveUnitInterval
API.sgActiveSlotsCoeff = ShelleyGenesis (MaryEra c) -> PositiveUnitInterval
forall era. ShelleyGenesis era -> PositiveUnitInterval
API.sgActiveSlotsCoeff ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgSecurityParam :: Word64
API.sgSecurityParam = ShelleyGenesis (MaryEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
API.sgSecurityParam ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgEpochLength :: EpochSize
API.sgEpochLength = ShelleyGenesis (MaryEra c) -> EpochSize
forall era. ShelleyGenesis era -> EpochSize
API.sgEpochLength ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgSlotsPerKESPeriod :: Word64
API.sgSlotsPerKESPeriod = ShelleyGenesis (MaryEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
API.sgSlotsPerKESPeriod ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgMaxKESEvolutions :: Word64
API.sgMaxKESEvolutions = ShelleyGenesis (MaryEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
API.sgMaxKESEvolutions ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgSlotLength :: NominalDiffTime
API.sgSlotLength = ShelleyGenesis (MaryEra c) -> NominalDiffTime
forall era. ShelleyGenesis era -> NominalDiffTime
API.sgSlotLength ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgUpdateQuorum :: Word64
API.sgUpdateQuorum = ShelleyGenesis (MaryEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
API.sgUpdateQuorum ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgMaxLovelaceSupply :: Word64
API.sgMaxLovelaceSupply = ShelleyGenesis (MaryEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
API.sgMaxLovelaceSupply ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgProtocolParams :: PParams (AlonzoEra c)
API.sgProtocolParams = TranslationContext (AlonzoEra c)
-> PParams' Identity (PreviousEra (AlonzoEra c))
-> PParams (AlonzoEra c)
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (AlonzoEra c)
ctxt (ShelleyGenesis (MaryEra c) -> PParams (MaryEra c)
forall era. ShelleyGenesis era -> PParams era
API.sgProtocolParams ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis),
          sgGenDelegs :: Map
  (KeyHash 'Genesis (Crypto (AlonzoEra c)))
  (GenDelegPair (Crypto (AlonzoEra c)))
API.sgGenDelegs = ShelleyGenesis (MaryEra c)
-> Map
     (KeyHash 'Genesis (Crypto (MaryEra c)))
     (GenDelegPair (Crypto (MaryEra c)))
forall era.
ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
API.sgGenDelegs ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgInitialFunds :: Map (Addr (Crypto (AlonzoEra c))) Coin
API.sgInitialFunds = ShelleyGenesis (MaryEra c) -> Map (Addr (Crypto (MaryEra c))) Coin
forall era. ShelleyGenesis era -> Map (Addr (Crypto era)) Coin
API.sgInitialFunds ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis,
          sgStaking :: ShelleyGenesisStaking (Crypto (AlonzoEra c))
API.sgStaking = ShelleyGenesis (MaryEra c)
-> ShelleyGenesisStaking (Crypto (MaryEra c))
forall era.
ShelleyGenesis era -> ShelleyGenesisStaking (Crypto era)
API.sgStaking ShelleyGenesis (PreviousEra (AlonzoEra c))
ShelleyGenesis (MaryEra c)
genesis
        }

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

instance
  ( Crypto c,
    Core.Tx (AlonzoEra c) ~ ValidatedTx (AlonzoEra c)
  ) =>
  TranslateEra (AlonzoEra c) Tx
  where
  type TranslationError (AlonzoEra c) Tx = DecoderError
  translateEra :: TranslationContext (AlonzoEra c)
-> Tx (PreviousEra (AlonzoEra c))
-> Except (TranslationError (AlonzoEra c) Tx) (Tx (AlonzoEra c))
translateEra TranslationContext (AlonzoEra c)
_ctxt (Tx Tx (PreviousEra (AlonzoEra 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.
    TxBody (AlonzoEra c)
bdy <- Text
-> TxBody (ShelleyMAEra 'Mary c)
-> Except DecoderError (TxBody (AlonzoEra c))
forall a b.
(ToCBOR a, FromCBOR (Annotator b)) =>
Text -> a -> Except DecoderError b
translateViaCBORAnn Text
"txbody" (TxBody (ShelleyMAEra 'Mary c)
 -> Except DecoderError (TxBody (AlonzoEra c)))
-> TxBody (ShelleyMAEra 'Mary c)
-> Except DecoderError (TxBody (AlonzoEra c))
forall a b. (a -> b) -> a -> b
$ Tx (ShelleyMAEra 'Mary c)
-> (Era (ShelleyMAEra 'Mary c),
    ToCBOR (AuxiliaryData (ShelleyMAEra 'Mary c)),
    ToCBOR (TxBody (ShelleyMAEra 'Mary c)),
    ToCBOR (Witnesses (ShelleyMAEra 'Mary c))) =>
   TxBody (ShelleyMAEra 'Mary c)
forall era.
Tx era
-> (Era era, ToCBOR (AuxiliaryData era), ToCBOR (TxBody era),
    ToCBOR (Witnesses era)) =>
   TxBody era
LTX.body Tx (PreviousEra (AlonzoEra c))
Tx (ShelleyMAEra 'Mary c)
tx
    TxWitness (AlonzoEra c)
txwits <- Text
-> WitnessSet (ShelleyMAEra 'Mary c)
-> Except DecoderError (TxWitness (AlonzoEra c))
forall a b.
(ToCBOR a, FromCBOR (Annotator b)) =>
Text -> a -> Except DecoderError b
translateViaCBORAnn Text
"txwitness" (WitnessSet (ShelleyMAEra 'Mary c)
 -> Except DecoderError (TxWitness (AlonzoEra c)))
-> WitnessSet (ShelleyMAEra 'Mary c)
-> Except DecoderError (TxWitness (AlonzoEra c))
forall a b. (a -> b) -> a -> b
$ Tx (ShelleyMAEra 'Mary c)
-> (Era (ShelleyMAEra 'Mary c),
    ToCBOR (AuxiliaryData (ShelleyMAEra 'Mary c)),
    ToCBOR (TxBody (ShelleyMAEra 'Mary c)),
    ToCBOR (Witnesses (ShelleyMAEra 'Mary c))) =>
   Witnesses (ShelleyMAEra 'Mary c)
forall era.
Tx era
-> (Era era, ToCBOR (AuxiliaryData era), ToCBOR (TxBody era),
    ToCBOR (Witnesses era)) =>
   Witnesses era
LTX.wits Tx (PreviousEra (AlonzoEra c))
Tx (ShelleyMAEra 'Mary c)
tx
    -- transactions from Mary era always pass script ("phase 2") validation
    StrictMaybe (AuxiliaryData (AlonzoEra c))
aux <- case Tx (ShelleyMAEra 'Mary c)
-> (Era (ShelleyMAEra 'Mary c),
    ToCBOR (AuxiliaryData (ShelleyMAEra 'Mary c)),
    ToCBOR (TxBody (ShelleyMAEra 'Mary c)),
    ToCBOR (Witnesses (ShelleyMAEra 'Mary c))) =>
   StrictMaybe (AuxiliaryData (ShelleyMAEra 'Mary c))
forall era.
Tx era
-> (Era era, ToCBOR (AuxiliaryData era), ToCBOR (TxBody era),
    ToCBOR (Witnesses era)) =>
   StrictMaybe (AuxiliaryData era)
LTX.auxiliaryData Tx (PreviousEra (AlonzoEra c))
Tx (ShelleyMAEra 'Mary c)
tx of
      StrictMaybe (AuxiliaryData (ShelleyMAEra 'Mary c))
SNothing -> StrictMaybe (AuxiliaryData (AlonzoEra c))
-> ExceptT
     DecoderError Identity (StrictMaybe (AuxiliaryData (AlonzoEra c)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe (AuxiliaryData (AlonzoEra c))
forall a. StrictMaybe a
SNothing
      SJust AuxiliaryData (ShelleyMAEra 'Mary c)
axd -> AuxiliaryData (AlonzoEra c)
-> StrictMaybe (AuxiliaryData (AlonzoEra c))
forall a. a -> StrictMaybe a
SJust (AuxiliaryData (AlonzoEra c)
 -> StrictMaybe (AuxiliaryData (AlonzoEra c)))
-> ExceptT DecoderError Identity (AuxiliaryData (AlonzoEra c))
-> ExceptT
     DecoderError Identity (StrictMaybe (AuxiliaryData (AlonzoEra c)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AuxiliaryData (ShelleyMAEra 'Mary c)
-> ExceptT DecoderError Identity (AuxiliaryData (AlonzoEra c))
forall a b.
(ToCBOR a, FromCBOR (Annotator b)) =>
Text -> a -> Except DecoderError b
translateViaCBORAnn Text
"auxiliarydata" AuxiliaryData (ShelleyMAEra 'Mary c)
AuxiliaryData (ShelleyMAEra 'Mary c)
axd
    let validating :: IsValid
validating = Bool -> IsValid
IsValid Bool
True
    Tx (AlonzoEra c)
-> ExceptT DecoderError Identity (Tx (AlonzoEra c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx (AlonzoEra c)
 -> ExceptT DecoderError Identity (Tx (AlonzoEra c)))
-> Tx (AlonzoEra c)
-> ExceptT DecoderError Identity (Tx (AlonzoEra c))
forall a b. (a -> b) -> a -> b
$ Tx (AlonzoEra c) -> Tx (AlonzoEra c)
forall era. Tx era -> Tx era
Tx (Tx (AlonzoEra c) -> Tx (AlonzoEra c))
-> Tx (AlonzoEra c) -> Tx (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ TxBody (AlonzoEra c)
-> TxWitness (AlonzoEra c)
-> IsValid
-> StrictMaybe (AuxiliaryData (AlonzoEra c))
-> ValidatedTx (AlonzoEra c)
forall era.
TxBody era
-> TxWitness era
-> IsValid
-> StrictMaybe (AuxiliaryData era)
-> ValidatedTx era
ValidatedTx TxBody (AlonzoEra c)
TxBody (AlonzoEra c)
bdy TxWitness (AlonzoEra c)
txwits IsValid
validating StrictMaybe (AuxiliaryData (AlonzoEra c))
StrictMaybe (AuxiliaryData (AlonzoEra c))
aux

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

instance (Crypto c, Functor f) => TranslateEra (AlonzoEra c) (API.PParams' f)

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

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

instance Crypto c => TranslateEra (AlonzoEra c) API.UTxOState where
  translateEra :: TranslationContext (AlonzoEra c)
-> UTxOState (PreviousEra (AlonzoEra c))
-> Except
     (TranslationError (AlonzoEra c) UTxOState)
     (UTxOState (AlonzoEra c))
translateEra TranslationContext (AlonzoEra c)
ctxt UTxOState (PreviousEra (AlonzoEra c))
us =
    UTxOState (AlonzoEra c)
-> ExceptT Void Identity (UTxOState (AlonzoEra c))
forall (m :: * -> *) a. Monad m => a -> m a
return
      UTxOState :: forall era.
UTxO era
-> Coin
-> Coin
-> State (EraRule "PPUP" era)
-> IncrementalStake (Crypto era)
-> UTxOState era
API.UTxOState
        { _utxo :: UTxO (AlonzoEra c)
API._utxo = TranslationContext (AlonzoEra c)
-> UTxO (PreviousEra (AlonzoEra c)) -> UTxO (AlonzoEra c)
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (AlonzoEra c)
ctxt (UTxO (PreviousEra (AlonzoEra c)) -> UTxO (AlonzoEra c))
-> UTxO (PreviousEra (AlonzoEra c)) -> UTxO (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ UTxOState (MaryEra c) -> UTxO (MaryEra c)
forall era. UTxOState era -> UTxO era
API._utxo UTxOState (PreviousEra (AlonzoEra c))
UTxOState (MaryEra c)
us,
          _deposited :: Coin
API._deposited = UTxOState (MaryEra c) -> Coin
forall era. UTxOState era -> Coin
API._deposited UTxOState (PreviousEra (AlonzoEra c))
UTxOState (MaryEra c)
us,
          _fees :: Coin
API._fees = UTxOState (MaryEra c) -> Coin
forall era. UTxOState era -> Coin
API._fees UTxOState (PreviousEra (AlonzoEra c))
UTxOState (MaryEra c)
us,
          _ppups :: State (EraRule "PPUP" (AlonzoEra c))
API._ppups = TranslationContext (AlonzoEra c)
-> PPUPState (PreviousEra (AlonzoEra c)) -> PPUPState (AlonzoEra c)
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (AlonzoEra c)
ctxt (PPUPState (PreviousEra (AlonzoEra c)) -> PPUPState (AlonzoEra c))
-> PPUPState (PreviousEra (AlonzoEra c)) -> PPUPState (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ UTxOState (MaryEra c) -> State (EraRule "PPUP" (MaryEra c))
forall era. UTxOState era -> State (EraRule "PPUP" era)
API._ppups UTxOState (PreviousEra (AlonzoEra c))
UTxOState (MaryEra c)
us,
          _stakeDistro :: IncrementalStake (Crypto (AlonzoEra c))
API._stakeDistro = UTxOState (MaryEra c) -> IncrementalStake (Crypto (MaryEra c))
forall era. UTxOState era -> IncrementalStake (Crypto era)
API._stakeDistro UTxOState (PreviousEra (AlonzoEra c))
UTxOState (MaryEra c)
us
        }

instance Crypto c => TranslateEra (AlonzoEra c) API.UTxO where
  translateEra :: TranslationContext (AlonzoEra c)
-> UTxO (PreviousEra (AlonzoEra c))
-> Except
     (TranslationError (AlonzoEra c) UTxO) (UTxO (AlonzoEra c))
translateEra TranslationContext (AlonzoEra c)
_ctxt UTxO (PreviousEra (AlonzoEra c))
utxo =
    UTxO (AlonzoEra c) -> ExceptT Void Identity (UTxO (AlonzoEra c))
forall (m :: * -> *) a. Monad m => a -> m a
return (UTxO (AlonzoEra c) -> ExceptT Void Identity (UTxO (AlonzoEra c)))
-> UTxO (AlonzoEra c) -> ExceptT Void Identity (UTxO (AlonzoEra c))
forall a b. (a -> b) -> a -> b
$ Map (TxIn (Crypto (AlonzoEra c))) (TxOut (AlonzoEra c))
-> UTxO (AlonzoEra c)
forall era. Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
API.UTxO (Map (TxIn (Crypto (AlonzoEra c))) (TxOut (AlonzoEra c))
 -> UTxO (AlonzoEra c))
-> Map (TxIn (Crypto (AlonzoEra c))) (TxOut (AlonzoEra c))
-> UTxO (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ TxOut (ShelleyMAEra 'Mary c) -> TxOut (AlonzoEra c)
forall c. Crypto c => TxOut (MaryEra c) -> TxOut (AlonzoEra c)
translateTxOut (TxOut (ShelleyMAEra 'Mary c) -> TxOut (AlonzoEra c))
-> Map (TxIn c) (TxOut (ShelleyMAEra 'Mary c))
-> Map (TxIn c) (TxOut (AlonzoEra c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO (ShelleyMAEra 'Mary c)
-> Map
     (TxIn (Crypto (ShelleyMAEra 'Mary c)))
     (TxOut (ShelleyMAEra 'Mary c))
forall era. UTxO era -> Map (TxIn (Crypto era)) (TxOut era)
API.unUTxO UTxO (PreviousEra (AlonzoEra c))
UTxO (ShelleyMAEra 'Mary c)
utxo

instance Crypto c => TranslateEra (AlonzoEra c) API.PPUPState where
  translateEra :: TranslationContext (AlonzoEra c)
-> PPUPState (PreviousEra (AlonzoEra c))
-> Except
     (TranslationError (AlonzoEra c) PPUPState)
     (PPUPState (AlonzoEra c))
translateEra TranslationContext (AlonzoEra c)
ctxt PPUPState (PreviousEra (AlonzoEra c))
ps =
    PPUPState (AlonzoEra c)
-> ExceptT Void Identity (PPUPState (AlonzoEra c))
forall (m :: * -> *) a. Monad m => a -> m a
return
      PPUPState :: forall era.
ProposedPPUpdates era -> ProposedPPUpdates era -> PPUPState era
API.PPUPState
        { proposals :: ProposedPPUpdates (AlonzoEra c)
API.proposals = TranslationContext (AlonzoEra c)
-> ProposedPPUpdates (PreviousEra (AlonzoEra c))
-> ProposedPPUpdates (AlonzoEra c)
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (AlonzoEra c)
ctxt (ProposedPPUpdates (PreviousEra (AlonzoEra c))
 -> ProposedPPUpdates (AlonzoEra c))
-> ProposedPPUpdates (PreviousEra (AlonzoEra c))
-> ProposedPPUpdates (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ PPUPState (MaryEra c) -> ProposedPPUpdates (MaryEra c)
forall era. PPUPState era -> ProposedPPUpdates era
API.proposals PPUPState (PreviousEra (AlonzoEra c))
PPUPState (MaryEra c)
ps,
          futureProposals :: ProposedPPUpdates (AlonzoEra c)
API.futureProposals = TranslationContext (AlonzoEra c)
-> ProposedPPUpdates (PreviousEra (AlonzoEra c))
-> ProposedPPUpdates (AlonzoEra c)
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (AlonzoEra c)
ctxt (ProposedPPUpdates (PreviousEra (AlonzoEra c))
 -> ProposedPPUpdates (AlonzoEra c))
-> ProposedPPUpdates (PreviousEra (AlonzoEra c))
-> ProposedPPUpdates (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ PPUPState (MaryEra c) -> ProposedPPUpdates (MaryEra c)
forall era. PPUPState era -> ProposedPPUpdates era
API.futureProposals PPUPState (PreviousEra (AlonzoEra c))
PPUPState (MaryEra c)
ps
        }

instance Crypto c => TranslateEra (AlonzoEra c) API.ProposedPPUpdates where
  translateEra :: TranslationContext (AlonzoEra c)
-> ProposedPPUpdates (PreviousEra (AlonzoEra c))
-> Except
     (TranslationError (AlonzoEra c) ProposedPPUpdates)
     (ProposedPPUpdates (AlonzoEra c))
translateEra TranslationContext (AlonzoEra c)
_ctxt (API.ProposedPPUpdates Map
  (KeyHash 'Genesis (Crypto (PreviousEra (AlonzoEra c))))
  (PParamsDelta (PreviousEra (AlonzoEra c)))
ppup) =
    ProposedPPUpdates (AlonzoEra c)
-> ExceptT Void Identity (ProposedPPUpdates (AlonzoEra c))
forall (m :: * -> *) a. Monad m => a -> m a
return (ProposedPPUpdates (AlonzoEra c)
 -> ExceptT Void Identity (ProposedPPUpdates (AlonzoEra c)))
-> ProposedPPUpdates (AlonzoEra c)
-> ExceptT Void Identity (ProposedPPUpdates (AlonzoEra c))
forall a b. (a -> b) -> a -> b
$ Map
  (KeyHash 'Genesis (Crypto (AlonzoEra c)))
  (PParamsDelta (AlonzoEra c))
-> ProposedPPUpdates (AlonzoEra c)
forall era.
Map (KeyHash 'Genesis (Crypto era)) (PParamsDelta era)
-> ProposedPPUpdates era
API.ProposedPPUpdates (Map
   (KeyHash 'Genesis (Crypto (AlonzoEra c)))
   (PParamsDelta (AlonzoEra c))
 -> ProposedPPUpdates (AlonzoEra c))
-> Map
     (KeyHash 'Genesis (Crypto (AlonzoEra c)))
     (PParamsDelta (AlonzoEra c))
-> ProposedPPUpdates (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ (PParamsUpdate (MaryEra c) -> PParamsUpdate (AlonzoEra c))
-> Map (KeyHash 'Genesis c) (PParamsUpdate (MaryEra c))
-> Map (KeyHash 'Genesis c) (PParamsUpdate (AlonzoEra c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PParamsUpdate (MaryEra c) -> PParamsUpdate (AlonzoEra c)
forall c. PParamsUpdate (MaryEra c) -> PParamsUpdate (AlonzoEra c)
translatePParamsUpdate Map (KeyHash 'Genesis c) (PParamsUpdate (MaryEra c))
Map
  (KeyHash 'Genesis (Crypto (PreviousEra (AlonzoEra c))))
  (PParamsDelta (PreviousEra (AlonzoEra c)))
ppup

translateTxOut ::
  Crypto c =>
  Core.TxOut (MaryEra c) ->
  Core.TxOut (AlonzoEra c)
translateTxOut :: TxOut (MaryEra c) -> TxOut (AlonzoEra c)
translateTxOut (Shelley.TxOutCompact addr value) = CompactAddr (Crypto (AlonzoEra c))
-> CompactForm (Value (AlonzoEra c)) -> TxOut (AlonzoEra c)
forall era.
(Era era, Val (Value era), HasCallStack) =>
CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
TxOutCompact CompactAddr (Crypto (MaryEra c))
CompactAddr (Crypto (AlonzoEra c))
addr CompactForm (Value (MaryEra c))
CompactForm (Value (AlonzoEra c))
value

-- extendPP with type: extendPP :: Shelley.PParams' f era1 -> ... -> PParams' f era2
-- Is general enough to work for both
-- (PParams era)       = (PParams' Identity era)    and
-- (PParamsUpdate era) = (PParams' StrictMaybe era)

translatePParams ::
  AlonzoGenesis -> Shelley.PParams (MaryEra c) -> PParams (AlonzoEra c)
translatePParams :: AlonzoGenesis -> PParams (MaryEra c) -> PParams (AlonzoEra c)
translatePParams = (PParams (MaryEra c) -> AlonzoGenesis -> PParams (AlonzoEra c))
-> AlonzoGenesis -> PParams (MaryEra c) -> PParams (AlonzoEra c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip PParams (MaryEra c) -> AlonzoGenesis -> PParams (AlonzoEra c)
forall era1 era2.
PParams' Identity era1 -> AlonzoGenesis -> PParams' Identity era2
extendPPWithGenesis

translatePParamsUpdate ::
  Shelley.PParamsUpdate (MaryEra c) -> PParamsUpdate (AlonzoEra c)
translatePParamsUpdate :: PParamsUpdate (MaryEra c) -> PParamsUpdate (AlonzoEra c)
translatePParamsUpdate PParamsUpdate (MaryEra c)
pp =
  PParamsUpdate (MaryEra c)
-> HKD StrictMaybe Coin
-> HKD StrictMaybe CostModels
-> HKD StrictMaybe Prices
-> HKD StrictMaybe ExUnits
-> HKD StrictMaybe ExUnits
-> HKD StrictMaybe Natural
-> HKD StrictMaybe Natural
-> HKD StrictMaybe Natural
-> PParamsUpdate (AlonzoEra c)
forall (f :: * -> *) era1 era2.
PParams' f era1
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era2
extendPP PParamsUpdate (MaryEra c)
pp HKD StrictMaybe Coin
forall a. StrictMaybe a
SNothing HKD StrictMaybe CostModels
forall a. StrictMaybe a
SNothing HKD StrictMaybe Prices
forall a. StrictMaybe a
SNothing HKD StrictMaybe ExUnits
forall a. StrictMaybe a
SNothing HKD StrictMaybe ExUnits
forall a. StrictMaybe a
SNothing HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing