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

module Cardano.Ledger.Babbage.Translation where

import Cardano.Binary
  ( DecoderError,
  )
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis)
import qualified Cardano.Ledger.Alonzo.PParams as Alonzo
import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo (TxOut (..))
import Cardano.Ledger.Babbage (BabbageEra)
import Cardano.Ledger.Babbage.PParams (PParams' (..))
import Cardano.Ledger.Babbage.Tx (ValidatedTx (..))
import Cardano.Ledger.Babbage.TxBody (Datum (..), TxOut (..))
import Cardano.Ledger.Coin (Coin (..))
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Era
  ( PreviousEra,
    TranslateEra (..),
    TranslationContext,
    translateEra',
  )
import Cardano.Ledger.Serialization (translateViaCBORAnn)
import Cardano.Ledger.Shelley.API
  ( EpochState (..),
    NewEpochState (..),
    ShelleyGenesis,
    StrictMaybe (..),
  )
import qualified Cardano.Ledger.Shelley.API as API
import Cardano.Ledger.Shelley.PParams (HKDFunctor (..))
import Data.Proxy (Proxy (..))

--------------------------------------------------------------------------------
-- Translation from Alonzo to Babbage
--
-- 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 (BabbageEra c) = AlonzoEra c

type instance TranslationContext (BabbageEra c) = AlonzoGenesis

instance
  (Crypto c) =>
  TranslateEra (BabbageEra c) NewEpochState
  where
  translateEra :: TranslationContext (BabbageEra c)
-> NewEpochState (PreviousEra (BabbageEra c))
-> Except
     (TranslationError (BabbageEra c) NewEpochState)
     (NewEpochState (BabbageEra c))
translateEra TranslationContext (BabbageEra c)
ctxt NewEpochState (PreviousEra (BabbageEra c))
nes =
    NewEpochState (BabbageEra c)
-> ExceptT Void Identity (NewEpochState (BabbageEra c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewEpochState (BabbageEra c)
 -> ExceptT Void Identity (NewEpochState (BabbageEra c)))
-> NewEpochState (BabbageEra c)
-> ExceptT Void Identity (NewEpochState (BabbageEra 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 (AlonzoEra c) -> EpochNo
forall era. NewEpochState era -> EpochNo
nesEL NewEpochState (AlonzoEra c)
NewEpochState (PreviousEra (BabbageEra c))
nes,
          nesBprev :: BlocksMade (Crypto (BabbageEra c))
nesBprev = NewEpochState (AlonzoEra c) -> BlocksMade (Crypto (AlonzoEra c))
forall era. NewEpochState era -> BlocksMade (Crypto era)
nesBprev NewEpochState (AlonzoEra c)
NewEpochState (PreviousEra (BabbageEra c))
nes,
          nesBcur :: BlocksMade (Crypto (BabbageEra c))
nesBcur = NewEpochState (AlonzoEra c) -> BlocksMade (Crypto (AlonzoEra c))
forall era. NewEpochState era -> BlocksMade (Crypto era)
nesBcur NewEpochState (AlonzoEra c)
NewEpochState (PreviousEra (BabbageEra c))
nes,
          nesEs :: EpochState (BabbageEra c)
nesEs = TranslationContext (BabbageEra c)
-> EpochState (PreviousEra (BabbageEra c))
-> EpochState (BabbageEra c)
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (BabbageEra c)
ctxt (EpochState (PreviousEra (BabbageEra c))
 -> EpochState (BabbageEra c))
-> EpochState (PreviousEra (BabbageEra c))
-> EpochState (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ NewEpochState (AlonzoEra c) -> EpochState (AlonzoEra c)
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState (AlonzoEra c)
NewEpochState (PreviousEra (BabbageEra c))
nes,
          nesRu :: StrictMaybe (PulsingRewUpdate (Crypto (BabbageEra c)))
nesRu = NewEpochState (AlonzoEra c)
-> StrictMaybe (PulsingRewUpdate (Crypto (AlonzoEra c)))
forall era.
NewEpochState era -> StrictMaybe (PulsingRewUpdate (Crypto era))
nesRu NewEpochState (AlonzoEra c)
NewEpochState (PreviousEra (BabbageEra c))
nes,
          nesPd :: PoolDistr (Crypto (BabbageEra c))
nesPd = NewEpochState (AlonzoEra c) -> PoolDistr (Crypto (AlonzoEra c))
forall era. NewEpochState era -> PoolDistr (Crypto era)
nesPd NewEpochState (AlonzoEra c)
NewEpochState (PreviousEra (BabbageEra c))
nes,
          stashedAVVMAddresses :: StashedAVVMAddresses (BabbageEra c)
stashedAVVMAddresses = ()
        }

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

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

instance
  ( Crypto c,
    Core.Tx (BabbageEra c) ~ ValidatedTx (BabbageEra c)
  ) =>
  TranslateEra (BabbageEra c) Tx
  where
  type TranslationError (BabbageEra c) Tx = DecoderError
  translateEra :: TranslationContext (BabbageEra c)
-> Tx (PreviousEra (BabbageEra c))
-> Except (TranslationError (BabbageEra c) Tx) (Tx (BabbageEra c))
translateEra TranslationContext (BabbageEra c)
_ctxt (Tx Tx (PreviousEra (BabbageEra 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 (BabbageEra c)
bdy <- Text
-> TxBody (AlonzoEra c)
-> Except DecoderError (TxBody (BabbageEra c))
forall a b.
(ToCBOR a, FromCBOR (Annotator b)) =>
Text -> a -> Except DecoderError b
translateViaCBORAnn Text
"txbody" (TxBody (AlonzoEra c)
 -> Except DecoderError (TxBody (BabbageEra c)))
-> TxBody (AlonzoEra c)
-> Except DecoderError (TxBody (BabbageEra c))
forall a b. (a -> b) -> a -> b
$ ValidatedTx (AlonzoEra c) -> TxBody (AlonzoEra c)
forall era. ValidatedTx era -> TxBody era
Alonzo.body Tx (PreviousEra (BabbageEra c))
ValidatedTx (AlonzoEra c)
tx
    TxWitness (BabbageEra c)
txwits <- Text
-> TxWitness (AlonzoEra c)
-> Except DecoderError (TxWitness (BabbageEra c))
forall a b.
(ToCBOR a, FromCBOR (Annotator b)) =>
Text -> a -> Except DecoderError b
translateViaCBORAnn Text
"txwitness" (TxWitness (AlonzoEra c)
 -> Except DecoderError (TxWitness (BabbageEra c)))
-> TxWitness (AlonzoEra c)
-> Except DecoderError (TxWitness (BabbageEra c))
forall a b. (a -> b) -> a -> b
$ ValidatedTx (AlonzoEra c) -> TxWitness (AlonzoEra c)
forall era. ValidatedTx era -> TxWitness era
Alonzo.wits Tx (PreviousEra (BabbageEra c))
ValidatedTx (AlonzoEra c)
tx
    StrictMaybe (AuxiliaryData (BabbageEra c))
aux <- case ValidatedTx (AlonzoEra c)
-> StrictMaybe (AuxiliaryData (AlonzoEra c))
forall era. ValidatedTx era -> StrictMaybe (AuxiliaryData era)
Alonzo.auxiliaryData Tx (PreviousEra (BabbageEra c))
ValidatedTx (AlonzoEra c)
tx of
      StrictMaybe (AuxiliaryData (AlonzoEra c))
SNothing -> StrictMaybe (AuxiliaryData (BabbageEra c))
-> ExceptT
     DecoderError Identity (StrictMaybe (AuxiliaryData (BabbageEra c)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe (AuxiliaryData (BabbageEra c))
forall a. StrictMaybe a
SNothing
      SJust AuxiliaryData (AlonzoEra c)
axd -> AuxiliaryData (BabbageEra c)
-> StrictMaybe (AuxiliaryData (BabbageEra c))
forall a. a -> StrictMaybe a
SJust (AuxiliaryData (BabbageEra c)
 -> StrictMaybe (AuxiliaryData (BabbageEra c)))
-> ExceptT DecoderError Identity (AuxiliaryData (BabbageEra c))
-> ExceptT
     DecoderError Identity (StrictMaybe (AuxiliaryData (BabbageEra c)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AuxiliaryData (AlonzoEra c)
-> ExceptT DecoderError Identity (AuxiliaryData (BabbageEra c))
forall a b.
(ToCBOR a, FromCBOR (Annotator b)) =>
Text -> a -> Except DecoderError b
translateViaCBORAnn Text
"auxiliarydata" AuxiliaryData (AlonzoEra c)
AuxiliaryData (AlonzoEra c)
axd
    let validating :: IsValid
validating = ValidatedTx (AlonzoEra c) -> IsValid
forall era. ValidatedTx era -> IsValid
Alonzo.isValid Tx (PreviousEra (BabbageEra c))
ValidatedTx (AlonzoEra c)
tx
    Tx (BabbageEra c)
-> ExceptT DecoderError Identity (Tx (BabbageEra c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx (BabbageEra c)
 -> ExceptT DecoderError Identity (Tx (BabbageEra c)))
-> Tx (BabbageEra c)
-> ExceptT DecoderError Identity (Tx (BabbageEra c))
forall a b. (a -> b) -> a -> b
$ Tx (BabbageEra c) -> Tx (BabbageEra c)
forall era. Tx era -> Tx era
Tx (Tx (BabbageEra c) -> Tx (BabbageEra c))
-> Tx (BabbageEra c) -> Tx (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ TxBody (BabbageEra c)
-> TxWitness (BabbageEra c)
-> IsValid
-> StrictMaybe (AuxiliaryData (BabbageEra c))
-> ValidatedTx (BabbageEra c)
forall era.
TxBody era
-> TxWitness era
-> IsValid
-> StrictMaybe (AuxiliaryData era)
-> ValidatedTx era
ValidatedTx TxBody (BabbageEra c)
TxBody (BabbageEra c)
bdy TxWitness (BabbageEra c)
txwits IsValid
validating StrictMaybe (AuxiliaryData (BabbageEra c))
StrictMaybe (AuxiliaryData (BabbageEra c))
aux

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

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

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

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

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

instance Crypto c => TranslateEra (BabbageEra c) API.UTxO where
  translateEra :: TranslationContext (BabbageEra c)
-> UTxO (PreviousEra (BabbageEra c))
-> Except
     (TranslationError (BabbageEra c) UTxO) (UTxO (BabbageEra c))
translateEra TranslationContext (BabbageEra c)
_ctxt UTxO (PreviousEra (BabbageEra c))
utxo =
    UTxO (BabbageEra c) -> ExceptT Void Identity (UTxO (BabbageEra c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO (BabbageEra c)
 -> ExceptT Void Identity (UTxO (BabbageEra c)))
-> UTxO (BabbageEra c)
-> ExceptT Void Identity (UTxO (BabbageEra c))
forall a b. (a -> b) -> a -> b
$ Map (TxIn (Crypto (BabbageEra c))) (TxOut (BabbageEra c))
-> UTxO (BabbageEra c)
forall era. Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
API.UTxO (Map (TxIn (Crypto (BabbageEra c))) (TxOut (BabbageEra c))
 -> UTxO (BabbageEra c))
-> Map (TxIn (Crypto (BabbageEra c))) (TxOut (BabbageEra c))
-> UTxO (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ TxOut (AlonzoEra c) -> TxOut (BabbageEra c)
forall c. Crypto c => TxOut (AlonzoEra c) -> TxOut (BabbageEra c)
translateTxOut (TxOut (AlonzoEra c) -> TxOut (BabbageEra c))
-> Map (TxIn c) (TxOut (AlonzoEra c))
-> Map (TxIn c) (TxOut (BabbageEra c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO (AlonzoEra c)
-> Map (TxIn (Crypto (AlonzoEra c))) (TxOut (AlonzoEra c))
forall era. UTxO era -> Map (TxIn (Crypto era)) (TxOut era)
API.unUTxO UTxO (AlonzoEra c)
UTxO (PreviousEra (BabbageEra c))
utxo

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

instance Crypto c => TranslateEra (BabbageEra c) API.ProposedPPUpdates where
  translateEra :: TranslationContext (BabbageEra c)
-> ProposedPPUpdates (PreviousEra (BabbageEra c))
-> Except
     (TranslationError (BabbageEra c) ProposedPPUpdates)
     (ProposedPPUpdates (BabbageEra c))
translateEra TranslationContext (BabbageEra c)
_ctxt (API.ProposedPPUpdates Map
  (KeyHash 'Genesis (Crypto (PreviousEra (BabbageEra c))))
  (PParamsDelta (PreviousEra (BabbageEra c)))
ppup) =
    ProposedPPUpdates (BabbageEra c)
-> ExceptT Void Identity (ProposedPPUpdates (BabbageEra c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProposedPPUpdates (BabbageEra c)
 -> ExceptT Void Identity (ProposedPPUpdates (BabbageEra c)))
-> ProposedPPUpdates (BabbageEra c)
-> ExceptT Void Identity (ProposedPPUpdates (BabbageEra c))
forall a b. (a -> b) -> a -> b
$ Map
  (KeyHash 'Genesis (Crypto (BabbageEra c)))
  (PParamsDelta (BabbageEra c))
-> ProposedPPUpdates (BabbageEra c)
forall era.
Map (KeyHash 'Genesis (Crypto era)) (PParamsDelta era)
-> ProposedPPUpdates era
API.ProposedPPUpdates (Map
   (KeyHash 'Genesis (Crypto (BabbageEra c)))
   (PParamsDelta (BabbageEra c))
 -> ProposedPPUpdates (BabbageEra c))
-> Map
     (KeyHash 'Genesis (Crypto (BabbageEra c)))
     (PParamsDelta (BabbageEra c))
-> ProposedPPUpdates (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ (PParams' StrictMaybe (AlonzoEra c)
 -> PParams' StrictMaybe (BabbageEra c))
-> Map (KeyHash 'Genesis c) (PParams' StrictMaybe (AlonzoEra c))
-> Map (KeyHash 'Genesis c) (PParams' StrictMaybe (BabbageEra c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PParams' StrictMaybe (AlonzoEra c)
-> PParams' StrictMaybe (BabbageEra c)
forall (f :: * -> *) c.
HKDFunctor f =>
PParams' f (AlonzoEra c) -> PParams' f (BabbageEra c)
translatePParams Map (KeyHash 'Genesis c) (PParams' StrictMaybe (AlonzoEra c))
Map
  (KeyHash 'Genesis (Crypto (PreviousEra (BabbageEra c))))
  (PParamsDelta (PreviousEra (BabbageEra c)))
ppup

translateTxOut ::
  Crypto c =>
  Core.TxOut (AlonzoEra c) ->
  Core.TxOut (BabbageEra c)
translateTxOut :: TxOut (AlonzoEra c) -> TxOut (BabbageEra c)
translateTxOut (Alonzo.TxOut addr value dh) = Addr (Crypto (BabbageEra c))
-> Value (BabbageEra c)
-> Datum (BabbageEra c)
-> StrictMaybe (Script (BabbageEra c))
-> TxOut (BabbageEra c)
forall era.
(Era era, Compactible (Value era), Val (Value era),
 HasCallStack) =>
Addr (Crypto era)
-> Value era -> Datum era -> StrictMaybe (Script era) -> TxOut era
TxOut Addr (Crypto (AlonzoEra c))
Addr (Crypto (BabbageEra c))
addr Value (AlonzoEra c)
Value (BabbageEra c)
value Datum (BabbageEra c)
d StrictMaybe (Script (BabbageEra c))
forall a. StrictMaybe a
SNothing
  where
    d :: Datum (BabbageEra c)
d = case StrictMaybe (DataHash (Crypto (AlonzoEra c)))
dh of
      StrictMaybe (DataHash (Crypto (AlonzoEra c)))
SNothing -> Datum (BabbageEra c)
forall era. Datum era
NoDatum
      SJust DataHash (Crypto (AlonzoEra c))
d' -> DataHash (Crypto (BabbageEra c)) -> Datum (BabbageEra c)
forall era. DataHash (Crypto era) -> Datum era
DatumHash DataHash (Crypto (AlonzoEra c))
DataHash (Crypto (BabbageEra c))
d'

-- | A word is 8 bytes, so to convert from coinsPerUTxOWord to coinsPerUTxOByte, rounding down.
coinsPerUTxOWordToCoinsPerUTxOByte :: Coin -> Coin
coinsPerUTxOWordToCoinsPerUTxOByte :: Coin -> Coin
coinsPerUTxOWordToCoinsPerUTxOByte (Coin Integer
c) = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
c Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
8

translatePParams ::
  forall f c. HKDFunctor f => Alonzo.PParams' f (AlonzoEra c) -> PParams' f (BabbageEra c)
translatePParams :: PParams' f (AlonzoEra c) -> PParams' f (BabbageEra c)
translatePParams Alonzo.PParams {_coinsPerUTxOWord :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_coinsPerUTxOWord = HKD f Coin
cpuw, HKD f Natural
HKD f ExUnits
HKD f CostModels
HKD f Prices
HKD f ProtVer
HKD f NonNegativeInterval
HKD f UnitInterval
HKD f Nonce
HKD f Coin
HKD f EpochNo
_minfeeA :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBBSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxTxSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBHSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_keyDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_poolDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_eMax :: forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
_nOpt :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_a0 :: forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
_rho :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_tau :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_extraEntropy :: forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_protocolVersion :: forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_minPoolCost :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_costmdls :: forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
_prices :: forall (f :: * -> *) era. PParams' f era -> HKD f Prices
_maxTxExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxBlockExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxValSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_collateralPercentage :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxCollateralInputs :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxCollateralInputs :: HKD f Natural
_collateralPercentage :: HKD f Natural
_maxValSize :: HKD f Natural
_maxBlockExUnits :: HKD f ExUnits
_maxTxExUnits :: HKD f ExUnits
_prices :: HKD f Prices
_costmdls :: HKD f CostModels
_minPoolCost :: HKD f Coin
_protocolVersion :: HKD f ProtVer
_extraEntropy :: HKD f Nonce
_d :: HKD f UnitInterval
_tau :: HKD f UnitInterval
_rho :: HKD f UnitInterval
_a0 :: HKD f NonNegativeInterval
_nOpt :: HKD f Natural
_eMax :: HKD f EpochNo
_poolDeposit :: HKD f Coin
_keyDeposit :: HKD f Coin
_maxBHSize :: HKD f Natural
_maxTxSize :: HKD f Natural
_maxBBSize :: HKD f Natural
_minfeeB :: HKD f Natural
_minfeeA :: HKD f Natural
..} =
  PParams :: forall (f :: * -> *) era.
HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochNo
-> HKD f Natural
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f ProtVer
-> HKD f Coin
-> 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 era
PParams {_coinsPerUTxOByte :: HKD f Coin
_coinsPerUTxOByte = HKD f Coin
cpub, HKD f Natural
HKD f ExUnits
HKD f CostModels
HKD f Prices
HKD f ProtVer
HKD f NonNegativeInterval
HKD f UnitInterval
HKD f Coin
HKD f EpochNo
_maxCollateralInputs :: HKD f Natural
_collateralPercentage :: HKD f Natural
_maxValSize :: HKD f Natural
_maxBlockExUnits :: HKD f ExUnits
_maxTxExUnits :: HKD f ExUnits
_prices :: HKD f Prices
_costmdls :: HKD f CostModels
_minPoolCost :: HKD f Coin
_protocolVersion :: HKD f ProtVer
_tau :: HKD f UnitInterval
_rho :: HKD f UnitInterval
_a0 :: HKD f NonNegativeInterval
_nOpt :: HKD f Natural
_eMax :: HKD f EpochNo
_poolDeposit :: HKD f Coin
_keyDeposit :: HKD f Coin
_maxBHSize :: HKD f Natural
_maxTxSize :: HKD f Natural
_maxBBSize :: HKD f Natural
_minfeeB :: HKD f Natural
_minfeeA :: HKD f Natural
_maxCollateralInputs :: HKD f Natural
_collateralPercentage :: HKD f Natural
_maxValSize :: HKD f Natural
_maxBlockExUnits :: HKD f ExUnits
_maxTxExUnits :: HKD f ExUnits
_prices :: HKD f Prices
_costmdls :: HKD f CostModels
_minPoolCost :: HKD f Coin
_protocolVersion :: HKD f ProtVer
_tau :: HKD f UnitInterval
_rho :: HKD f UnitInterval
_a0 :: HKD f NonNegativeInterval
_nOpt :: HKD f Natural
_eMax :: HKD f EpochNo
_poolDeposit :: HKD f Coin
_keyDeposit :: HKD f Coin
_maxBHSize :: HKD f Natural
_maxTxSize :: HKD f Natural
_maxBBSize :: HKD f Natural
_minfeeB :: HKD f Natural
_minfeeA :: HKD f Natural
..}
  where
    cpub :: HKD f Coin
cpub = Proxy f -> (Coin -> Coin) -> HKD f Coin -> HKD f Coin
forall (f :: * -> *) a b.
HKDFunctor f =>
Proxy f -> (a -> b) -> HKD f a -> HKD f b
hkdMap (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f) Coin -> Coin
coinsPerUTxOWordToCoinsPerUTxOByte HKD f Coin
cpuw