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

module Cardano.Ledger.Mary.Translation where

import Cardano.Binary
  ( DecoderError,
    decodeAnnotator,
    fromCBOR,
    serialize,
  )
import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Compactible (Compactible (..))
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Era hiding (Crypto)
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Mary.Value (Value (..))
import Cardano.Ledger.Shelley.API hiding (Metadata, TxBody)
import Cardano.Ledger.Shelley.Tx
  ( decodeWits,
  )
import Cardano.Ledger.ShelleyMA.AuxiliaryData
  ( AuxiliaryData (..),
    pattern AuxiliaryData,
  )
import qualified Cardano.Ledger.Val as Val
import Control.Monad.Except (throwError)
import Data.Coerce (coerce)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)

--------------------------------------------------------------------------------
-- Translation from Allegra to Mary
--
-- 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 (MaryEra c) = AllegraEra c

-- | Currently no context is needed to translate from Allegra to Mary.
--
-- Note: if context is needed, please coordinate with consensus, who will have
-- to provide the context in the right place.
type instance TranslationContext (MaryEra c) = ()

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

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

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

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

instance (Crypto c, Functor f) => TranslateEra (MaryEra c) (PParams' f)

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

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

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

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

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

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

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

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

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

instance Crypto c => TranslateEra (MaryEra c) AuxiliaryData where
  translateEra :: TranslationContext (MaryEra c)
-> AuxiliaryData (PreviousEra (MaryEra c))
-> Except
     (TranslationError (MaryEra c) AuxiliaryData)
     (AuxiliaryData (MaryEra c))
translateEra TranslationContext (MaryEra c)
_ (AuxiliaryData md as) =
    AuxiliaryData (MaryEra c)
-> ExceptT Void Identity (AuxiliaryData (MaryEra c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuxiliaryData (MaryEra c)
 -> ExceptT Void Identity (AuxiliaryData (MaryEra c)))
-> AuxiliaryData (MaryEra c)
-> ExceptT Void Identity (AuxiliaryData (MaryEra c))
forall a b. (a -> b) -> a -> b
$ Map Word64 Metadatum
-> StrictSeq (Script (MaryEra c)) -> AuxiliaryData (MaryEra c)
forall era.
(AnnotatedData (Script era), Ord (Script era)) =>
Map Word64 Metadatum -> StrictSeq (Script era) -> AuxiliaryData era
AuxiliaryData Map Word64 Metadatum
md StrictSeq (Script (MaryEra c))
StrictSeq (Script (AllegraEra c))
as

translateValue :: Crypto c => Coin -> Value c
translateValue :: Coin -> Value c
translateValue = Coin -> Value c
forall t. Val t => Coin -> t
Val.inject

translateCompactValue :: Crypto c => CompactForm Coin -> CompactForm (Value c)
translateCompactValue :: CompactForm Coin -> CompactForm (Value c)
translateCompactValue =
  CompactForm (Value c)
-> Maybe (CompactForm (Value c)) -> CompactForm (Value c)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> CompactForm (Value c)
forall a. HasCallStack => [Char] -> a
error [Char]
msg) (Maybe (CompactForm (Value c)) -> CompactForm (Value c))
-> (CompactForm Coin -> Maybe (CompactForm (Value c)))
-> CompactForm Coin
-> CompactForm (Value c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value c -> Maybe (CompactForm (Value c))
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact (Value c -> Maybe (CompactForm (Value c)))
-> (CompactForm Coin -> Value c)
-> CompactForm Coin
-> Maybe (CompactForm (Value c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Value c
forall c. Crypto c => Coin -> Value c
translateValue (Coin -> Value c)
-> (CompactForm Coin -> Coin) -> CompactForm Coin -> Value c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact
  where
    msg :: [Char]
msg = [Char]
"impossible error: compact coin is out of range"