{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Allegra.Translation where

import Cardano.Binary
  ( DecoderError,
    decodeAnnotator,
    fromCBOR,
    serialize,
  )
import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Era hiding (Crypto)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.API
import qualified Cardano.Ledger.Shelley.LedgerState as LS
  ( returnRedeemAddrsToReserves,
  )
import Cardano.Ledger.Shelley.Tx (decodeWits)
import Control.Monad.Except (throwError)
import Data.Coerce (coerce)
import qualified Data.Map.Strict as Map

--------------------------------------------------------------------------------
-- Translation from Shelley to Allegra
--
-- 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!
--------------------------------------------------------------------------------

-- | Return the subset of UTxO corresponding to Byron-era AVVM addresses, which
-- are to be removed on the Shelley/Allegra boundary. This set will be passed
-- _back_ to the translation functions as the UTxO, allowing these addresses to
-- be removed. This is needed because we cannot do a full scan on the UTxO at
-- this point, since it has been persisted to disk.
shelleyToAllegraAVVMsToDelete :: NewEpochState (ShelleyEra c) -> UTxO (ShelleyEra c)
shelleyToAllegraAVVMsToDelete :: NewEpochState (ShelleyEra c) -> UTxO (ShelleyEra c)
shelleyToAllegraAVVMsToDelete = NewEpochState (ShelleyEra c) -> UTxO (ShelleyEra c)
forall era. NewEpochState era -> StashedAVVMAddresses era
stashedAVVMAddresses

type instance PreviousEra (AllegraEra c) = ShelleyEra c

-- | Currently no context is needed to translate from Shelley to Allegra.

-- Note: if context is needed, please coordinate with consensus, who will have
-- to provide the context in the right place.
type instance TranslationContext (AllegraEra c) = ()

instance Crypto c => TranslateEra (AllegraEra c) NewEpochState where
  translateEra :: TranslationContext (AllegraEra c)
-> NewEpochState (PreviousEra (AllegraEra c))
-> Except
     (TranslationError (AllegraEra c) NewEpochState)
     (NewEpochState (AllegraEra c))
translateEra TranslationContext (AllegraEra c)
ctxt NewEpochState (PreviousEra (AllegraEra c))
nes =
    NewEpochState (AllegraEra c)
-> ExceptT Void Identity (NewEpochState (AllegraEra c))
forall (m :: * -> *) a. Monad m => a -> m a
return (NewEpochState (AllegraEra c)
 -> ExceptT Void Identity (NewEpochState (AllegraEra c)))
-> NewEpochState (AllegraEra c)
-> ExceptT Void Identity (NewEpochState (AllegraEra 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 (ShelleyEra c) -> EpochNo
forall era. NewEpochState era -> EpochNo
nesEL NewEpochState (PreviousEra (AllegraEra c))
NewEpochState (ShelleyEra c)
nes,
          nesBprev :: BlocksMade (Crypto (AllegraEra c))
nesBprev = NewEpochState (ShelleyEra c) -> BlocksMade (Crypto (ShelleyEra c))
forall era. NewEpochState era -> BlocksMade (Crypto era)
nesBprev NewEpochState (PreviousEra (AllegraEra c))
NewEpochState (ShelleyEra c)
nes,
          nesBcur :: BlocksMade (Crypto (AllegraEra c))
nesBcur = NewEpochState (ShelleyEra c) -> BlocksMade (Crypto (ShelleyEra c))
forall era. NewEpochState era -> BlocksMade (Crypto era)
nesBcur NewEpochState (PreviousEra (AllegraEra c))
NewEpochState (ShelleyEra c)
nes,
          nesEs :: EpochState (AllegraEra c)
nesEs = TranslationContext (AllegraEra c)
-> EpochState (PreviousEra (AllegraEra c))
-> EpochState (AllegraEra c)
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (AllegraEra c)
ctxt (EpochState (PreviousEra (AllegraEra c))
 -> EpochState (AllegraEra c))
-> EpochState (PreviousEra (AllegraEra c))
-> EpochState (AllegraEra c)
forall a b. (a -> b) -> a -> b
$ EpochState (ShelleyEra c) -> EpochState (ShelleyEra c)
forall era. Era era => EpochState era -> EpochState era
LS.returnRedeemAddrsToReserves (EpochState (ShelleyEra c) -> EpochState (ShelleyEra c))
-> (NewEpochState (ShelleyEra c) -> EpochState (ShelleyEra c))
-> NewEpochState (ShelleyEra c)
-> EpochState (ShelleyEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState (ShelleyEra c) -> EpochState (ShelleyEra c)
forall era. NewEpochState era -> EpochState era
nesEs (NewEpochState (ShelleyEra c) -> EpochState (ShelleyEra c))
-> NewEpochState (ShelleyEra c) -> EpochState (ShelleyEra c)
forall a b. (a -> b) -> a -> b
$ NewEpochState (PreviousEra (AllegraEra c))
NewEpochState (ShelleyEra c)
nes,
          nesRu :: StrictMaybe (PulsingRewUpdate (Crypto (AllegraEra c)))
nesRu = NewEpochState (ShelleyEra c)
-> StrictMaybe (PulsingRewUpdate (Crypto (ShelleyEra c)))
forall era.
NewEpochState era -> StrictMaybe (PulsingRewUpdate (Crypto era))
nesRu NewEpochState (PreviousEra (AllegraEra c))
NewEpochState (ShelleyEra c)
nes,
          nesPd :: PoolDistr (Crypto (AllegraEra c))
nesPd = NewEpochState (ShelleyEra c) -> PoolDistr (Crypto (ShelleyEra c))
forall era. NewEpochState era -> PoolDistr (Crypto era)
nesPd NewEpochState (PreviousEra (AllegraEra c))
NewEpochState (ShelleyEra c)
nes,
          -- At this point, the consensus layer has passed in our stashed AVVM
          -- addresses as our UTxO, and we have deleted them above (with
          -- 'returnRedeemAddrsToReserves'), so we may safely discard this map.
          stashedAVVMAddresses :: StashedAVVMAddresses (AllegraEra c)
stashedAVVMAddresses = ()
        }

instance forall c. Crypto c => TranslateEra (AllegraEra c) Tx where
  type TranslationError (AllegraEra c) Tx = DecoderError
  translateEra :: TranslationContext (AllegraEra c)
-> Tx (PreviousEra (AllegraEra c))
-> Except (TranslationError (AllegraEra c) Tx) (Tx (AllegraEra c))
translateEra TranslationContext (AllegraEra c)
_ctx Tx (PreviousEra (AllegraEra c))
tx =
    case Text
-> (forall s. Decoder s (Annotator (Tx (AllegraEra c))))
-> LByteString
-> Either DecoderError (Tx (AllegraEra c))
forall a.
Text
-> (forall s. Decoder s (Annotator a))
-> LByteString
-> Either DecoderError a
decodeAnnotator Text
"tx" forall s. Decoder s (Annotator (Tx (AllegraEra c)))
forall a s. FromCBOR a => Decoder s a
fromCBOR (Tx (ShelleyEra c) -> LByteString
forall a. ToCBOR a => a -> LByteString
serialize Tx (PreviousEra (AllegraEra c))
Tx (ShelleyEra c)
tx) of
      Right Tx (AllegraEra c)
newTx -> Tx (AllegraEra c)
-> ExceptT DecoderError Identity (Tx (AllegraEra c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx (AllegraEra c)
newTx
      Left DecoderError
decoderError -> DecoderError -> ExceptT DecoderError Identity (Tx (AllegraEra c))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DecoderError
decoderError

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

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

instance Crypto c => TranslateEra (AllegraEra c) (PParams' f) where
  translateEra :: TranslationContext (AllegraEra c)
-> PParams' f (PreviousEra (AllegraEra c))
-> Except
     (TranslationError (AllegraEra c) (PParams' f))
     (PParams' f (AllegraEra c))
translateEra TranslationContext (AllegraEra c)
_ PParams' f (PreviousEra (AllegraEra c))
pp =
    PParams' f (AllegraEra c)
-> ExceptT Void Identity (PParams' f (AllegraEra c))
forall (m :: * -> *) a. Monad m => a -> m a
return (PParams' f (AllegraEra c)
 -> ExceptT Void Identity (PParams' f (AllegraEra c)))
-> PParams' f (AllegraEra c)
-> ExceptT Void Identity (PParams' f (AllegraEra c))
forall a b. (a -> b) -> a -> b
$
      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 UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> PParams' f era
PParams
        { _minfeeA :: HKD f Natural
_minfeeA = PParams' f (ShelleyEra c) -> HKD f Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeA PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _minfeeB :: HKD f Natural
_minfeeB = PParams' f (ShelleyEra c) -> HKD f Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _maxBBSize :: HKD f Natural
_maxBBSize = PParams' f (ShelleyEra c) -> HKD f Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBBSize PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _maxTxSize :: HKD f Natural
_maxTxSize = PParams' f (ShelleyEra c) -> HKD f Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxTxSize PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _maxBHSize :: HKD f Natural
_maxBHSize = PParams' f (ShelleyEra c) -> HKD f Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBHSize PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _keyDeposit :: HKD f Coin
_keyDeposit = PParams' f (ShelleyEra c) -> HKD f Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_keyDeposit PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _poolDeposit :: HKD f Coin
_poolDeposit = PParams' f (ShelleyEra c) -> HKD f Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_poolDeposit PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _eMax :: HKD f EpochNo
_eMax = PParams' f (ShelleyEra c) -> HKD f EpochNo
forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
_eMax PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _nOpt :: HKD f Natural
_nOpt = PParams' f (ShelleyEra c) -> HKD f Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_nOpt PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _a0 :: HKD f NonNegativeInterval
_a0 = PParams' f (ShelleyEra c) -> HKD f NonNegativeInterval
forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
_a0 PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _rho :: HKD f UnitInterval
_rho = PParams' f (ShelleyEra c) -> HKD f UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_rho PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _tau :: HKD f UnitInterval
_tau = PParams' f (ShelleyEra c) -> HKD f UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_tau PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _d :: HKD f UnitInterval
_d = PParams' f (ShelleyEra c) -> HKD f UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _extraEntropy :: HKD f Nonce
_extraEntropy = PParams' f (ShelleyEra c) -> HKD f Nonce
forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_extraEntropy PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _protocolVersion :: HKD f ProtVer
_protocolVersion = PParams' f (ShelleyEra c) -> HKD f ProtVer
forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_protocolVersion PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _minUTxOValue :: HKD f Coin
_minUTxOValue = PParams' f (ShelleyEra c) -> HKD f Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minUTxOValue PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp,
          _minPoolCost :: HKD f Coin
_minPoolCost = PParams' f (ShelleyEra c) -> HKD f Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minPoolCost PParams' f (PreviousEra (AllegraEra c))
PParams' f (ShelleyEra c)
pp
        }

instance Crypto c => TranslateEra (AllegraEra c) ProposedPPUpdates where
  translateEra :: TranslationContext (AllegraEra c)
-> ProposedPPUpdates (PreviousEra (AllegraEra c))
-> Except
     (TranslationError (AllegraEra c) ProposedPPUpdates)
     (ProposedPPUpdates (AllegraEra c))
translateEra TranslationContext (AllegraEra c)
ctxt (ProposedPPUpdates Map
  (KeyHash 'Genesis (Crypto (PreviousEra (AllegraEra c))))
  (PParamsDelta (PreviousEra (AllegraEra c)))
ppup) =
    ProposedPPUpdates (AllegraEra c)
-> ExceptT Void Identity (ProposedPPUpdates (AllegraEra c))
forall (m :: * -> *) a. Monad m => a -> m a
return (ProposedPPUpdates (AllegraEra c)
 -> ExceptT Void Identity (ProposedPPUpdates (AllegraEra c)))
-> ProposedPPUpdates (AllegraEra c)
-> ExceptT Void Identity (ProposedPPUpdates (AllegraEra c))
forall a b. (a -> b) -> a -> b
$ Map
  (KeyHash 'Genesis (Crypto (AllegraEra c)))
  (PParamsDelta (AllegraEra c))
-> ProposedPPUpdates (AllegraEra c)
forall era.
Map (KeyHash 'Genesis (Crypto era)) (PParamsDelta era)
-> ProposedPPUpdates era
ProposedPPUpdates (Map
   (KeyHash 'Genesis (Crypto (AllegraEra c)))
   (PParamsDelta (AllegraEra c))
 -> ProposedPPUpdates (AllegraEra c))
-> Map
     (KeyHash 'Genesis (Crypto (AllegraEra c)))
     (PParamsDelta (AllegraEra c))
-> ProposedPPUpdates (AllegraEra c)
forall a b. (a -> b) -> a -> b
$ (PParams' StrictMaybe (ShelleyEra c)
 -> PParams' StrictMaybe (AllegraEra c))
-> Map (KeyHash 'Genesis c) (PParams' StrictMaybe (ShelleyEra c))
-> Map (KeyHash 'Genesis c) (PParams' StrictMaybe (AllegraEra c))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (TranslationContext (AllegraEra c)
-> PParams' StrictMaybe (PreviousEra (AllegraEra c))
-> PParams' StrictMaybe (AllegraEra c)
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (AllegraEra c)
ctxt) Map (KeyHash 'Genesis c) (PParams' StrictMaybe (ShelleyEra c))
Map
  (KeyHash 'Genesis (Crypto (PreviousEra (AllegraEra c))))
  (PParamsDelta (PreviousEra (AllegraEra c)))
ppup

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

instance Crypto c => TranslateEra (AllegraEra c) TxOut where
  translateEra :: TranslationContext (AllegraEra c)
-> TxOut (PreviousEra (AllegraEra c))
-> Except
     (TranslationError (AllegraEra c) TxOut) (TxOut (AllegraEra c))
translateEra () (TxOutCompact CompactAddr (Crypto (PreviousEra (AllegraEra c)))
addr CompactForm (Value (PreviousEra (AllegraEra c)))
cfval) =
    TxOut (AllegraEra c)
-> ExceptT Void Identity (TxOut (AllegraEra c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut (AllegraEra c)
 -> ExceptT Void Identity (TxOut (AllegraEra c)))
-> TxOut (AllegraEra c)
-> ExceptT Void Identity (TxOut (AllegraEra c))
forall a b. (a -> b) -> a -> b
$ CompactAddr (Crypto (AllegraEra c))
-> CompactForm (Value (AllegraEra c)) -> TxOut (AllegraEra c)
forall era.
CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
TxOutCompact (CompactAddr c -> CompactAddr c
coerce CompactAddr c
CompactAddr (Crypto (PreviousEra (AllegraEra c)))
addr) CompactForm (Value (PreviousEra (AllegraEra c)))
CompactForm (Value (AllegraEra c))
cfval

instance Crypto c => TranslateEra (AllegraEra c) UTxO where
  translateEra :: TranslationContext (AllegraEra c)
-> UTxO (PreviousEra (AllegraEra c))
-> Except
     (TranslationError (AllegraEra c) UTxO) (UTxO (AllegraEra c))
translateEra TranslationContext (AllegraEra c)
ctxt UTxO (PreviousEra (AllegraEra c))
utxo =
    UTxO (AllegraEra c) -> ExceptT Void Identity (UTxO (AllegraEra c))
forall (m :: * -> *) a. Monad m => a -> m a
return (UTxO (AllegraEra c)
 -> ExceptT Void Identity (UTxO (AllegraEra c)))
-> UTxO (AllegraEra c)
-> ExceptT Void Identity (UTxO (AllegraEra c))
forall a b. (a -> b) -> a -> b
$ Map (TxIn (Crypto (AllegraEra c))) (TxOut (AllegraEra c))
-> UTxO (AllegraEra c)
forall era. Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
UTxO (TranslationContext (AllegraEra c)
-> TxOut (PreviousEra (AllegraEra c)) -> TxOut (AllegraEra c)
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (AllegraEra c)
ctxt (TxOut (ShelleyEra c) -> TxOut (AllegraEra c))
-> Map (TxIn c) (TxOut (ShelleyEra c))
-> Map (TxIn c) (TxOut (AllegraEra c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO (ShelleyEra c)
-> Map (TxIn (Crypto (ShelleyEra c))) (TxOut (ShelleyEra c))
forall era. UTxO era -> Map (TxIn (Crypto era)) (TxOut era)
unUTxO UTxO (PreviousEra (AllegraEra c))
UTxO (ShelleyEra c)
utxo)

instance Crypto c => TranslateEra (AllegraEra c) UTxOState where
  translateEra :: TranslationContext (AllegraEra c)
-> UTxOState (PreviousEra (AllegraEra c))
-> Except
     (TranslationError (AllegraEra c) UTxOState)
     (UTxOState (AllegraEra c))
translateEra TranslationContext (AllegraEra c)
ctxt UTxOState (PreviousEra (AllegraEra c))
us =
    UTxOState (AllegraEra c)
-> ExceptT Void Identity (UTxOState (AllegraEra 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
UTxOState
        { _utxo :: UTxO (AllegraEra c)
_utxo = TranslationContext (AllegraEra c)
-> UTxO (PreviousEra (AllegraEra c)) -> UTxO (AllegraEra c)
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (AllegraEra c)
ctxt (UTxO (PreviousEra (AllegraEra c)) -> UTxO (AllegraEra c))
-> UTxO (PreviousEra (AllegraEra c)) -> UTxO (AllegraEra c)
forall a b. (a -> b) -> a -> b
$ UTxOState (ShelleyEra c) -> UTxO (ShelleyEra c)
forall era. UTxOState era -> UTxO era
_utxo UTxOState (PreviousEra (AllegraEra c))
UTxOState (ShelleyEra c)
us,
          _deposited :: Coin
_deposited = UTxOState (ShelleyEra c) -> Coin
forall era. UTxOState era -> Coin
_deposited UTxOState (PreviousEra (AllegraEra c))
UTxOState (ShelleyEra c)
us,
          _fees :: Coin
_fees = UTxOState (ShelleyEra c) -> Coin
forall era. UTxOState era -> Coin
_fees UTxOState (PreviousEra (AllegraEra c))
UTxOState (ShelleyEra c)
us,
          _ppups :: State (EraRule "PPUP" (AllegraEra c))
_ppups = TranslationContext (AllegraEra c)
-> PPUPState (PreviousEra (AllegraEra c))
-> PPUPState (AllegraEra c)
forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext (AllegraEra c)
ctxt (PPUPState (PreviousEra (AllegraEra c))
 -> PPUPState (AllegraEra c))
-> PPUPState (PreviousEra (AllegraEra c))
-> PPUPState (AllegraEra c)
forall a b. (a -> b) -> a -> b
$ UTxOState (ShelleyEra c) -> State (EraRule "PPUP" (ShelleyEra c))
forall era. UTxOState era -> State (EraRule "PPUP" era)
_ppups UTxOState (PreviousEra (AllegraEra c))
UTxOState (ShelleyEra c)
us,
          _stakeDistro :: IncrementalStake (Crypto (AllegraEra c))
_stakeDistro = UTxOState (ShelleyEra c)
-> IncrementalStake (Crypto (ShelleyEra c))
forall era. UTxOState era -> IncrementalStake (Crypto era)
_stakeDistro UTxOState (PreviousEra (AllegraEra c))
UTxOState (ShelleyEra c)
us
        }

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

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

instance Crypto c => TranslateEra (AllegraEra c) WitnessSet where
  type TranslationError (AllegraEra c) WitnessSet = DecoderError
  translateEra :: TranslationContext (AllegraEra c)
-> WitnessSet (PreviousEra (AllegraEra c))
-> Except
     (TranslationError (AllegraEra c) WitnessSet)
     (WitnessSet (AllegraEra c))
translateEra TranslationContext (AllegraEra c)
_ctx WitnessSet (PreviousEra (AllegraEra c))
ws =
    case Text
-> (forall s. Decoder s (Annotator (WitnessSet (AllegraEra c))))
-> LByteString
-> Either DecoderError (WitnessSet (AllegraEra c))
forall a.
Text
-> (forall s. Decoder s (Annotator a))
-> LByteString
-> Either DecoderError a
decodeAnnotator Text
"witnessSet" forall s. Decoder s (Annotator (WitnessSet (AllegraEra c)))
forall era s.
(FromCBOR (Annotator (Script era)), ValidateScript era) =>
Decoder s (Annotator (WitnessSet era))
decodeWits (WitnessSet (ShelleyEra c) -> LByteString
forall a. ToCBOR a => a -> LByteString
serialize WitnessSet (PreviousEra (AllegraEra c))
WitnessSet (ShelleyEra c)
ws) of
      Right WitnessSet (AllegraEra c)
new -> WitnessSet (AllegraEra c)
-> ExceptT DecoderError Identity (WitnessSet (AllegraEra c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure WitnessSet (AllegraEra c)
new
      Left DecoderError
decoderError -> DecoderError
-> ExceptT DecoderError Identity (WitnessSet (AllegraEra c))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DecoderError
decoderError

instance Crypto c => TranslateEra (AllegraEra c) Update where
  translateEra :: TranslationContext (AllegraEra c)
-> Update (PreviousEra (AllegraEra c))
-> Except
     (TranslationError (AllegraEra c) Update) (Update (AllegraEra c))
translateEra TranslationContext (AllegraEra c)
_ (Update ProposedPPUpdates (PreviousEra (AllegraEra c))
pp EpochNo
en) = Update (AllegraEra c)
-> ExceptT Void Identity (Update (AllegraEra c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Update (AllegraEra c)
 -> ExceptT Void Identity (Update (AllegraEra c)))
-> Update (AllegraEra c)
-> ExceptT Void Identity (Update (AllegraEra c))
forall a b. (a -> b) -> a -> b
$ ProposedPPUpdates (AllegraEra c)
-> EpochNo -> Update (AllegraEra c)
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update (ProposedPPUpdates (ShelleyEra c)
-> ProposedPPUpdates (AllegraEra c)
coerce ProposedPPUpdates (PreviousEra (AllegraEra c))
ProposedPPUpdates (ShelleyEra c)
pp) EpochNo
en