{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{- We disable warnings for name shadowing because of
https://gitlab.haskell.org/ghc/ghc/-/issues/14630, which means that we get
shadowing warnings for the named field puns when used with a pattern synonym.
-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# 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.ShelleyMA.Timelocks (translate)
import Control.Monad.Except (throwError)
import Data.Coerce (coerce)
import qualified Data.Map.Strict as Map
import Shelley.Spec.Ledger.API
import qualified Shelley.Spec.Ledger.LedgerState as LS
  ( returnRedeemAddrsToReserves,
  )
import Shelley.Spec.Ledger.Tx (WitnessSetHKD (..))

--------------------------------------------------------------------------------
-- 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!
--------------------------------------------------------------------------------

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 (RewardUpdate (Crypto era))
-> PoolDistr (Crypto era)
-> NewEpochState era
NewEpochState
        { nesEL :: EpochNo
nesEL = NewEpochState (ShelleyEra c) -> EpochNo
forall era. NewEpochState era -> EpochNo
nesEL NewEpochState (ShelleyEra c)
NewEpochState (PreviousEra (AllegraEra c))
nes,
          nesBprev :: BlocksMade (Crypto (AllegraEra c))
nesBprev = NewEpochState (ShelleyEra c) -> BlocksMade (Crypto (ShelleyEra c))
forall era. NewEpochState era -> BlocksMade (Crypto era)
nesBprev NewEpochState (ShelleyEra c)
NewEpochState (PreviousEra (AllegraEra c))
nes,
          nesBcur :: BlocksMade (Crypto (AllegraEra c))
nesBcur = NewEpochState (ShelleyEra c) -> BlocksMade (Crypto (ShelleyEra c))
forall era. NewEpochState era -> BlocksMade (Crypto era)
nesBcur NewEpochState (ShelleyEra c)
NewEpochState (PreviousEra (AllegraEra 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. ShelleyBased 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 (ShelleyEra c)
NewEpochState (PreviousEra (AllegraEra c))
nes,
          nesRu :: StrictMaybe (RewardUpdate (Crypto (AllegraEra c)))
nesRu = NewEpochState (ShelleyEra c)
-> StrictMaybe (RewardUpdate (Crypto (ShelleyEra c)))
forall era.
NewEpochState era -> StrictMaybe (RewardUpdate (Crypto era))
nesRu NewEpochState (ShelleyEra c)
NewEpochState (PreviousEra (AllegraEra c))
nes,
          nesPd :: PoolDistr (Crypto (AllegraEra c))
nesPd = NewEpochState (ShelleyEra c) -> PoolDistr (Crypto (ShelleyEra c))
forall era. NewEpochState era -> PoolDistr (Crypto era)
nesPd NewEpochState (ShelleyEra c)
NewEpochState (PreviousEra (AllegraEra c))
nes
        }

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 (ShelleyEra c)
Tx (PreviousEra (AllegraEra 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
-> Rational
-> 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 (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra c))
genesis,
          sgNetworkMagic :: Word32
sgNetworkMagic = ShelleyGenesis (ShelleyEra c) -> Word32
forall era. ShelleyGenesis era -> Word32
sgNetworkMagic ShelleyGenesis (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra c))
genesis,
          sgNetworkId :: Network
sgNetworkId = ShelleyGenesis (ShelleyEra c) -> Network
forall era. ShelleyGenesis era -> Network
sgNetworkId ShelleyGenesis (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra c))
genesis,
          sgActiveSlotsCoeff :: Rational
sgActiveSlotsCoeff = ShelleyGenesis (ShelleyEra c) -> Rational
forall era. ShelleyGenesis era -> Rational
sgActiveSlotsCoeff ShelleyGenesis (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra c))
genesis,
          sgSecurityParam :: Word64
sgSecurityParam = ShelleyGenesis (ShelleyEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
sgSecurityParam ShelleyGenesis (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra c))
genesis,
          sgEpochLength :: EpochSize
sgEpochLength = ShelleyGenesis (ShelleyEra c) -> EpochSize
forall era. ShelleyGenesis era -> EpochSize
sgEpochLength ShelleyGenesis (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra c))
genesis,
          sgSlotsPerKESPeriod :: Word64
sgSlotsPerKESPeriod = ShelleyGenesis (ShelleyEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
sgSlotsPerKESPeriod ShelleyGenesis (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra c))
genesis,
          sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions = ShelleyGenesis (ShelleyEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
sgMaxKESEvolutions ShelleyGenesis (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra c))
genesis,
          sgSlotLength :: NominalDiffTime
sgSlotLength = ShelleyGenesis (ShelleyEra c) -> NominalDiffTime
forall era. ShelleyGenesis era -> NominalDiffTime
sgSlotLength ShelleyGenesis (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra c))
genesis,
          sgUpdateQuorum :: Word64
sgUpdateQuorum = ShelleyGenesis (ShelleyEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
sgUpdateQuorum ShelleyGenesis (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra c))
genesis,
          sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply = ShelleyGenesis (ShelleyEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
sgMaxLovelaceSupply ShelleyGenesis (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra 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 (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra 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 (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra 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 (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra c))
genesis,
          sgStaking :: ShelleyGenesisStaking (Crypto (AllegraEra c))
sgStaking = ShelleyGenesis (ShelleyEra c)
-> ShelleyGenesisStaking (Crypto (ShelleyEra c))
forall era.
ShelleyGenesis era -> ShelleyGenesisStaking (Crypto era)
sgStaking ShelleyGenesis (ShelleyEra c)
ShelleyGenesis (PreviousEra (AllegraEra 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 Rational
-> 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra c))
pp,
          _a0 :: HKD f Rational
_a0 = PParams' f (ShelleyEra c) -> HKD f Rational
forall (f :: * -> *) era. PParams' f era -> HKD f Rational
_a0 PParams' f (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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 (ShelleyEra c)
PParams' f (PreviousEra (AllegraEra 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))))
  (PParamsUpdate (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)))
  (PParamsUpdate (AllegraEra c))
-> ProposedPPUpdates (AllegraEra c)
forall era.
Map (KeyHash 'Genesis (Crypto era)) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates (Map
   (KeyHash 'Genesis (Crypto (AllegraEra c)))
   (PParamsUpdate (AllegraEra c))
 -> ProposedPPUpdates (AllegraEra c))
-> Map
     (KeyHash 'Genesis (Crypto (AllegraEra c)))
     (PParamsUpdate (AllegraEra c))
-> ProposedPPUpdates (AllegraEra c)
forall a b. (a -> b) -> a -> b
$ (PParams' StrictMaybe (ShelleyEra c)
 -> PParamsUpdate (AllegraEra c))
-> Map (KeyHash 'Genesis c) (PParams' StrictMaybe (ShelleyEra c))
-> Map (KeyHash 'Genesis c) (PParamsUpdate (AllegraEra c))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (TranslationContext (AllegraEra c)
-> PParamsUpdate (PreviousEra (AllegraEra c))
-> PParamsUpdate (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))))
  (PParamsUpdate (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 (ShelleyEra c)
PPUPState (PreviousEra (AllegraEra 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 (ShelleyEra c)
PPUPState (PreviousEra (AllegraEra 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 (Map (TxIn (Crypto (AllegraEra c))) (TxOut (AllegraEra c))
 -> UTxO (AllegraEra c))
-> Map (TxIn (Crypto (AllegraEra c))) (TxOut (AllegraEra c))
-> UTxO (AllegraEra c)
forall a b. (a -> b) -> a -> b
$ (TxOut (ShelleyEra c) -> TxOut (AllegraEra c))
-> Map (TxIn c) (TxOut (ShelleyEra c))
-> Map (TxIn c) (TxOut (AllegraEra c))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (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) (Map (TxIn c) (TxOut (ShelleyEra c))
 -> Map (TxIn c) (TxOut (AllegraEra c)))
-> Map (TxIn c) (TxOut (ShelleyEra c))
-> Map (TxIn c) (TxOut (AllegraEra c))
forall a b. (a -> b) -> a -> b
$ UTxO (ShelleyEra c)
-> Map (TxIn (Crypto (ShelleyEra c))) (TxOut (ShelleyEra c))
forall era. UTxO era -> Map (TxIn (Crypto era)) (TxOut era)
unUTxO UTxO (ShelleyEra c)
UTxO (PreviousEra (AllegraEra 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 -> PPUPState 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 (ShelleyEra c)
UTxOState (PreviousEra (AllegraEra c))
us,
          _deposited :: Coin
_deposited = UTxOState (ShelleyEra c) -> Coin
forall era. UTxOState era -> Coin
_deposited UTxOState (ShelleyEra c)
UTxOState (PreviousEra (AllegraEra c))
us,
          _fees :: Coin
_fees = UTxOState (ShelleyEra c) -> Coin
forall era. UTxOState era -> Coin
_fees UTxOState (ShelleyEra c)
UTxOState (PreviousEra (AllegraEra c))
us,
          _ppups :: PPUPState (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) -> PPUPState (ShelleyEra c)
forall era. UTxOState era -> PPUPState era
_ppups UTxOState (ShelleyEra c)
UTxOState (PreviousEra (AllegraEra 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
        { _utxoState :: UTxOState (AllegraEra c)
_utxoState = 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
_utxoState LedgerState (ShelleyEra c)
LedgerState (PreviousEra (AllegraEra c))
ls,
          _delegationState :: DPState (Crypto (AllegraEra c))
_delegationState = LedgerState (ShelleyEra c) -> DPState (Crypto (ShelleyEra c))
forall era. LedgerState era -> DPState (Crypto era)
_delegationState LedgerState (ShelleyEra c)
LedgerState (PreviousEra (AllegraEra 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 (ShelleyEra c)
EpochState (PreviousEra (AllegraEra c))
es,
          esSnapshots :: SnapShots (Crypto (AllegraEra c))
esSnapshots = EpochState (ShelleyEra c) -> SnapShots (Crypto (ShelleyEra c))
forall era. EpochState era -> SnapShots (Crypto era)
esSnapshots EpochState (ShelleyEra c)
EpochState (PreviousEra (AllegraEra 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 (ShelleyEra c)
EpochState (PreviousEra (AllegraEra c))
es,
          esPrevPp :: PParams (AllegraEra c)
esPrevPp = 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 (PParams' Identity (PreviousEra (AllegraEra c))
 -> PParams (AllegraEra c))
-> PParams' Identity (PreviousEra (AllegraEra c))
-> PParams (AllegraEra c)
forall a b. (a -> b) -> a -> b
$ EpochState (ShelleyEra c) -> PParams (ShelleyEra c)
forall era. EpochState era -> PParams era
esPrevPp EpochState (ShelleyEra c)
EpochState (PreviousEra (AllegraEra c))
es,
          esPp :: PParams (AllegraEra c)
esPp = 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 (PParams' Identity (PreviousEra (AllegraEra c))
 -> PParams (AllegraEra c))
-> PParams' Identity (PreviousEra (AllegraEra c))
-> PParams (AllegraEra c)
forall a b. (a -> b) -> a -> b
$ EpochState (ShelleyEra c) -> PParams (ShelleyEra c)
forall era. EpochState era -> PParams era
esPp EpochState (ShelleyEra c)
EpochState (PreviousEra (AllegraEra c))
es,
          esNonMyopic :: NonMyopic (Crypto (AllegraEra c))
esNonMyopic = EpochState (ShelleyEra c) -> NonMyopic (Crypto (ShelleyEra c))
forall era. EpochState era -> NonMyopic (Crypto era)
esNonMyopic EpochState (ShelleyEra c)
EpochState (PreviousEra (AllegraEra c))
es
        }

instance Crypto c => TranslateEra (AllegraEra c) WitnessSet where
  translateEra :: TranslationContext (AllegraEra c)
-> WitnessSet (PreviousEra (AllegraEra c))
-> Except
     (TranslationError (AllegraEra c) WitnessSet)
     (WitnessSet (AllegraEra c))
translateEra TranslationContext (AllegraEra c)
_ctxt WitnessSet {addrWits, scriptWits, bootWits} =
    WitnessSet (AllegraEra c)
-> ExceptT Void Identity (WitnessSet (AllegraEra c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WitnessSet (AllegraEra c)
 -> ExceptT Void Identity (WitnessSet (AllegraEra c)))
-> WitnessSet (AllegraEra c)
-> ExceptT Void Identity (WitnessSet (AllegraEra c))
forall a b. (a -> b) -> a -> b
$
      WitnessSet :: forall era.
(Era era, AnnotatedData (Script era)) =>
Set (WitVKey 'Witness (Crypto era))
-> Map (ScriptHash (Crypto era)) (Script era)
-> Set (BootstrapWitness (Crypto era))
-> WitnessSet era
WitnessSet
        { addrWits :: Set (WitVKey 'Witness (Crypto (AllegraEra c)))
addrWits = Set (WitVKey 'Witness (Crypto (ShelleyEra c)))
Set (WitVKey 'Witness (Crypto (AllegraEra c)))
addrWits,
          scriptWits :: Map (ScriptHash (Crypto (AllegraEra c))) (Script (AllegraEra c))
scriptWits = (MultiSig c -> Timelock c)
-> Map (ScriptHash c) (MultiSig c)
-> Map (ScriptHash c) (Timelock c)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map MultiSig c -> Timelock c
forall crypto. Crypto crypto => MultiSig crypto -> Timelock crypto
translate Map (ScriptHash c) (MultiSig c)
Map (ScriptHash (Crypto (ShelleyEra c))) (Script (ShelleyEra c))
scriptWits,
          bootWits :: Set (BootstrapWitness (Crypto (AllegraEra c)))
bootWits = Set (BootstrapWitness (Crypto (ShelleyEra c)))
Set (BootstrapWitness (Crypto (AllegraEra c)))
bootWits
        }

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 (ShelleyEra c)
ProposedPPUpdates (PreviousEra (AllegraEra c))
pp) EpochNo
en