{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Shelley.ShelleyHFC (
ProtocolShelley
, ShelleyBlockHFC
, ShelleyPartialLedgerConfig (..)
, crossEraForecastAcrossShelley
, forecastAcrossShelley
, translateChainDepStateAcrossShelley
) where
import qualified Cardano.Ledger.Api.Era as L
import qualified Cardano.Ledger.BaseTypes as SL (mkVersion)
import qualified Cardano.Ledger.Core as SL
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Protocol.TPraos.API as SL
import Cardano.Slotting.EpochInfo (hoistEpochInfo)
import Control.Monad (guard)
import Control.Monad.Except (runExcept, throwError, withExceptT)
import qualified Data.Map.Strict as Map
import Data.SOP.BasicFunctors
import Data.SOP.InPairs (RequiringBoth (..), ignoringBoth)
import qualified Data.Text as T (pack)
import Data.Void (Void)
import Data.Word
import GHC.Generics (Generic)
import Lens.Micro ((^.))
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.Forecast
import qualified Ouroboros.Consensus.Forecast as Forecast
import Ouroboros.Consensus.HardFork.Combinator hiding
(translateChainDepState)
import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
import Ouroboros.Consensus.HardFork.Combinator.State.Types
import Ouroboros.Consensus.HardFork.History (Bound (boundSlot))
import Ouroboros.Consensus.HardFork.Simple
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.SupportsMempool (TxLimits)
import Ouroboros.Consensus.Ledger.SupportsProtocol
(LedgerSupportsProtocol, ledgerViewForecastAt)
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Protocol.Praos
import Ouroboros.Consensus.Protocol.TPraos hiding (PraosCrypto)
import Ouroboros.Consensus.Shelley.Eras
import Ouroboros.Consensus.Shelley.Ledger
import Ouroboros.Consensus.Shelley.Ledger.Inspect as Shelley.Inspect
import Ouroboros.Consensus.Shelley.Node ()
import Ouroboros.Consensus.TypeFamilyWrappers
type ShelleyBlockHFC proto era = HardForkBlock '[ShelleyBlock proto era]
instance ( ShelleyCompatible proto era
, LedgerSupportsProtocol (ShelleyBlock proto era)
, TxLimits (ShelleyBlock proto era)
) => NoHardForks (ShelleyBlock proto era) where
getEraParams :: TopLevelConfig (ShelleyBlock proto era) -> EraParams
getEraParams =
ShelleyGenesis (EraCrypto era) -> EraParams
forall c. ShelleyGenesis c -> EraParams
shelleyEraParamsNeverHardForks
(ShelleyGenesis (EraCrypto era) -> EraParams)
-> (TopLevelConfig (ShelleyBlock proto era)
-> ShelleyGenesis (EraCrypto era))
-> TopLevelConfig (ShelleyBlock proto era)
-> EraParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerConfig era -> ShelleyGenesis (EraCrypto era)
forall era.
ShelleyLedgerConfig era -> ShelleyGenesis (EraCrypto era)
shelleyLedgerGenesis
(ShelleyLedgerConfig era -> ShelleyGenesis (EraCrypto era))
-> (TopLevelConfig (ShelleyBlock proto era)
-> ShelleyLedgerConfig era)
-> TopLevelConfig (ShelleyBlock proto era)
-> ShelleyGenesis (EraCrypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevelConfig (ShelleyBlock proto era)
-> LedgerConfig (ShelleyBlock proto era)
TopLevelConfig (ShelleyBlock proto era) -> ShelleyLedgerConfig era
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger
toPartialLedgerConfig :: forall (proxy :: * -> *).
proxy (ShelleyBlock proto era)
-> LedgerConfig (ShelleyBlock proto era)
-> PartialLedgerConfig (ShelleyBlock proto era)
toPartialLedgerConfig proxy (ShelleyBlock proto era)
_ LedgerConfig (ShelleyBlock proto era)
cfg = ShelleyPartialLedgerConfig {
shelleyLedgerConfig :: ShelleyLedgerConfig era
shelleyLedgerConfig = LedgerConfig (ShelleyBlock proto era)
ShelleyLedgerConfig era
cfg
, shelleyTriggerHardFork :: TriggerHardFork
shelleyTriggerHardFork = TriggerHardFork
TriggerHardForkNotDuringThisExecution
}
instance ( ShelleyCompatible proto era
, LedgerSupportsProtocol (ShelleyBlock proto era)
, TxLimits (ShelleyBlock proto era)
) => SupportedNetworkProtocolVersion (ShelleyBlockHFC proto era) where
supportedNodeToNodeVersions :: Proxy (ShelleyBlockHFC proto era)
-> Map
NodeToNodeVersion
(BlockNodeToNodeVersion (ShelleyBlockHFC proto era))
supportedNodeToNodeVersions Proxy (ShelleyBlockHFC proto era)
_ =
(BlockNodeToNodeVersion (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlockHFC proto era))
-> Map
NodeToNodeVersion (BlockNodeToNodeVersion (ShelleyBlock proto era))
-> Map
NodeToNodeVersion
(BlockNodeToNodeVersion (ShelleyBlockHFC proto era))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map BlockNodeToNodeVersion (ShelleyBlock proto era)
-> BlockNodeToNodeVersion (ShelleyBlockHFC proto era)
BlockNodeToNodeVersion (ShelleyBlock proto era)
-> HardForkNodeToNodeVersion '[ShelleyBlock proto era]
forall x (xs1 :: [*]).
BlockNodeToNodeVersion x -> HardForkNodeToNodeVersion (x : xs1)
HardForkNodeToNodeDisabled (Map
NodeToNodeVersion (BlockNodeToNodeVersion (ShelleyBlock proto era))
-> Map
NodeToNodeVersion
(BlockNodeToNodeVersion (ShelleyBlockHFC proto era)))
-> Map
NodeToNodeVersion (BlockNodeToNodeVersion (ShelleyBlock proto era))
-> Map
NodeToNodeVersion
(BlockNodeToNodeVersion (ShelleyBlockHFC proto era))
forall a b. (a -> b) -> a -> b
$
Proxy (ShelleyBlock proto era)
-> Map
NodeToNodeVersion (BlockNodeToNodeVersion (ShelleyBlock proto era))
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
supportedNodeToNodeVersions (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ShelleyBlock proto era))
supportedNodeToClientVersions :: Proxy (ShelleyBlockHFC proto era)
-> Map
NodeToClientVersion
(BlockNodeToClientVersion (ShelleyBlockHFC proto era))
supportedNodeToClientVersions Proxy (ShelleyBlockHFC proto era)
_ =
(BlockNodeToClientVersion (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlockHFC proto era))
-> Map
NodeToClientVersion
(BlockNodeToClientVersion (ShelleyBlock proto era))
-> Map
NodeToClientVersion
(BlockNodeToClientVersion (ShelleyBlockHFC proto era))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map BlockNodeToClientVersion (ShelleyBlock proto era)
-> BlockNodeToClientVersion (ShelleyBlockHFC proto era)
BlockNodeToClientVersion (ShelleyBlock proto era)
-> HardForkNodeToClientVersion '[ShelleyBlock proto era]
forall x (xs1 :: [*]).
BlockNodeToClientVersion x -> HardForkNodeToClientVersion (x : xs1)
HardForkNodeToClientDisabled (Map
NodeToClientVersion
(BlockNodeToClientVersion (ShelleyBlock proto era))
-> Map
NodeToClientVersion
(BlockNodeToClientVersion (ShelleyBlockHFC proto era)))
-> Map
NodeToClientVersion
(BlockNodeToClientVersion (ShelleyBlock proto era))
-> Map
NodeToClientVersion
(BlockNodeToClientVersion (ShelleyBlockHFC proto era))
forall a b. (a -> b) -> a -> b
$
Proxy (ShelleyBlock proto era)
-> Map
NodeToClientVersion
(BlockNodeToClientVersion (ShelleyBlock proto era))
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ShelleyBlock proto era))
latestReleasedNodeVersion :: Proxy (ShelleyBlockHFC proto era)
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersion = Proxy (ShelleyBlockHFC proto era)
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersionDefault
instance ( ShelleyCompatible proto era
, LedgerSupportsProtocol (ShelleyBlock proto era)
, TxLimits (ShelleyBlock proto era)
) => SerialiseHFC '[ShelleyBlock proto era]
instance ( ShelleyCompatible proto era
, LedgerSupportsProtocol (ShelleyBlock proto era)
, TxLimits (ShelleyBlock proto era)
) => SerialiseConstraintsHFC (ShelleyBlock proto era)
type ProtocolShelley = HardForkProtocol '[ ShelleyBlock (TPraos StandardCrypto) StandardShelley ]
shelleyTransition ::
forall era proto. ShelleyCompatible proto era
=> PartialLedgerConfig (ShelleyBlock proto era)
-> Word16
-> LedgerState (ShelleyBlock proto era)
-> Maybe EpochNo
shelleyTransition :: forall era proto.
ShelleyCompatible proto era =>
PartialLedgerConfig (ShelleyBlock proto era)
-> Word16 -> LedgerState (ShelleyBlock proto era) -> Maybe EpochNo
shelleyTransition ShelleyPartialLedgerConfig{TriggerHardFork
ShelleyLedgerConfig era
shelleyLedgerConfig :: forall era.
ShelleyPartialLedgerConfig era -> ShelleyLedgerConfig era
shelleyTriggerHardFork :: forall era. ShelleyPartialLedgerConfig era -> TriggerHardFork
shelleyLedgerConfig :: ShelleyLedgerConfig era
shelleyTriggerHardFork :: TriggerHardFork
..}
Word16
transitionMajorVersionRaw
LedgerState (ShelleyBlock proto era)
state =
ShelleyLedgerUpdate era -> Maybe EpochNo
isTransition
(ShelleyLedgerUpdate era -> Maybe EpochNo)
-> (LedgerState (ShelleyBlock proto era)
-> ShelleyLedgerUpdate era)
-> LedgerState (ShelleyBlock proto era)
-> Maybe EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) -> ShelleyLedgerUpdate era
forall era proto.
ShelleyBasedEra era =>
LedgerState (ShelleyBlock proto era) -> ShelleyLedgerUpdate era
Shelley.Inspect.pparamsUpdate
(LedgerState (ShelleyBlock proto era) -> Maybe EpochNo)
-> LedgerState (ShelleyBlock proto era) -> Maybe EpochNo
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era)
state
where
ShelleyTransitionInfo{Word32
shelleyAfterVoting :: Word32
shelleyAfterVoting :: ShelleyTransition -> Word32
..} = LedgerState (ShelleyBlock proto era) -> ShelleyTransition
forall proto era.
LedgerState (ShelleyBlock proto era) -> ShelleyTransition
shelleyLedgerTransition LedgerState (ShelleyBlock proto era)
state
genesis :: SL.ShelleyGenesis (EraCrypto era)
genesis :: ShelleyGenesis (EraCrypto era)
genesis = ShelleyLedgerConfig era -> ShelleyGenesis (EraCrypto era)
forall era.
ShelleyLedgerConfig era -> ShelleyGenesis (EraCrypto era)
shelleyLedgerGenesis ShelleyLedgerConfig era
shelleyLedgerConfig
k :: Word64
k :: Word64
k = ShelleyGenesis (ProtoCrypto proto) -> Word64
forall c. ShelleyGenesis c -> Word64
SL.sgSecurityParam ShelleyGenesis (EraCrypto era)
ShelleyGenesis (ProtoCrypto proto)
genesis
isTransition :: ShelleyLedgerUpdate era -> Maybe EpochNo
isTransition :: ShelleyLedgerUpdate era -> Maybe EpochNo
isTransition (ShelleyUpdatedPParams StrictMaybe (PParams era)
maybePParams EpochNo
newPParamsEpochNo) = do
SL.SJust PParams era
pp <- StrictMaybe (PParams era) -> Maybe (StrictMaybe (PParams era))
forall a. a -> Maybe a
Just StrictMaybe (PParams era)
maybePParams
let protVer :: ProtVer
protVer = PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
SL.ppProtocolVersionL
Version
transitionMajorVersion <- Word16 -> Maybe Version
forall i (m :: * -> *). (Integral i, MonadFail m) => i -> m Version
SL.mkVersion Word16
transitionMajorVersionRaw
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
SL.pvMajor ProtVer
protVer Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
transitionMajorVersion
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Word32
shelleyAfterVoting Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
k
EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return EpochNo
newPParamsEpochNo
instance ( ShelleyCompatible proto era
, LedgerSupportsProtocol (ShelleyBlock proto era)
, TxLimits (ShelleyBlock proto era)
) => SingleEraBlock (ShelleyBlock proto era) where
singleEraTransition :: PartialLedgerConfig (ShelleyBlock proto era)
-> EraParams
-> Bound
-> LedgerState (ShelleyBlock proto era)
-> Maybe EpochNo
singleEraTransition PartialLedgerConfig (ShelleyBlock proto era)
pcfg EraParams
_eraParams Bound
_eraStart LedgerState (ShelleyBlock proto era)
ledgerState =
case ShelleyPartialLedgerConfig era -> TriggerHardFork
forall era. ShelleyPartialLedgerConfig era -> TriggerHardFork
shelleyTriggerHardFork PartialLedgerConfig (ShelleyBlock proto era)
ShelleyPartialLedgerConfig era
pcfg of
TriggerHardFork
TriggerHardForkNotDuringThisExecution -> Maybe EpochNo
forall a. Maybe a
Nothing
TriggerHardForkAtEpoch EpochNo
epoch -> EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
epoch
TriggerHardForkAtVersion Word16
shelleyMajorVersion ->
PartialLedgerConfig (ShelleyBlock proto era)
-> Word16 -> LedgerState (ShelleyBlock proto era) -> Maybe EpochNo
forall era proto.
ShelleyCompatible proto era =>
PartialLedgerConfig (ShelleyBlock proto era)
-> Word16 -> LedgerState (ShelleyBlock proto era) -> Maybe EpochNo
shelleyTransition
PartialLedgerConfig (ShelleyBlock proto era)
pcfg
Word16
shelleyMajorVersion
LedgerState (ShelleyBlock proto era)
ledgerState
singleEraInfo :: forall (proxy :: * -> *).
proxy (ShelleyBlock proto era)
-> SingleEraInfo (ShelleyBlock proto era)
singleEraInfo proxy (ShelleyBlock proto era)
_ = SingleEraInfo {
singleEraName :: Text
singleEraName = String -> Text
T.pack (forall era. Era era => String
L.eraName @era)
}
instance PraosCrypto c => HasPartialConsensusConfig (Praos c) where
type PartialConsensusConfig (Praos c) = PraosParams
completeConsensusConfig :: forall (proxy :: * -> *).
proxy (Praos c)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (Praos c)
-> ConsensusConfig (Praos c)
completeConsensusConfig proxy (Praos c)
_ EpochInfo (Except PastHorizonException)
praosEpochInfo PartialConsensusConfig (Praos c)
praosParams = PraosConfig {EpochInfo (Except PastHorizonException)
PartialConsensusConfig (Praos c)
PraosParams
praosEpochInfo :: EpochInfo (Except PastHorizonException)
praosParams :: PartialConsensusConfig (Praos c)
praosParams :: PraosParams
praosEpochInfo :: EpochInfo (Except PastHorizonException)
..}
toPartialConsensusConfig :: forall (proxy :: * -> *).
proxy (Praos c)
-> ConsensusConfig (Praos c) -> PartialConsensusConfig (Praos c)
toPartialConsensusConfig proxy (Praos c)
_ = ConsensusConfig (Praos c) -> PartialConsensusConfig (Praos c)
ConsensusConfig (Praos c) -> PraosParams
forall c. ConsensusConfig (Praos c) -> PraosParams
praosParams
instance SL.PraosCrypto c => HasPartialConsensusConfig (TPraos c) where
type PartialConsensusConfig (TPraos c) = TPraosParams
completeConsensusConfig :: forall (proxy :: * -> *).
proxy (TPraos c)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (TPraos c)
-> ConsensusConfig (TPraos c)
completeConsensusConfig proxy (TPraos c)
_ EpochInfo (Except PastHorizonException)
tpraosEpochInfo PartialConsensusConfig (TPraos c)
tpraosParams = TPraosConfig {EpochInfo (Except PastHorizonException)
PartialConsensusConfig (TPraos c)
TPraosParams
tpraosEpochInfo :: EpochInfo (Except PastHorizonException)
tpraosParams :: PartialConsensusConfig (TPraos c)
tpraosParams :: TPraosParams
tpraosEpochInfo :: EpochInfo (Except PastHorizonException)
..}
toPartialConsensusConfig :: forall (proxy :: * -> *).
proxy (TPraos c)
-> ConsensusConfig (TPraos c) -> PartialConsensusConfig (TPraos c)
toPartialConsensusConfig proxy (TPraos c)
_ = ConsensusConfig (TPraos c) -> PartialConsensusConfig (TPraos c)
ConsensusConfig (TPraos c) -> TPraosParams
forall c. ConsensusConfig (TPraos c) -> TPraosParams
tpraosParams
data ShelleyPartialLedgerConfig era = ShelleyPartialLedgerConfig {
forall era.
ShelleyPartialLedgerConfig era -> ShelleyLedgerConfig era
shelleyLedgerConfig :: !(ShelleyLedgerConfig era)
, forall era. ShelleyPartialLedgerConfig era -> TriggerHardFork
shelleyTriggerHardFork :: !TriggerHardFork
}
deriving ((forall x.
ShelleyPartialLedgerConfig era
-> Rep (ShelleyPartialLedgerConfig era) x)
-> (forall x.
Rep (ShelleyPartialLedgerConfig era) x
-> ShelleyPartialLedgerConfig era)
-> Generic (ShelleyPartialLedgerConfig era)
forall x.
Rep (ShelleyPartialLedgerConfig era) x
-> ShelleyPartialLedgerConfig era
forall x.
ShelleyPartialLedgerConfig era
-> Rep (ShelleyPartialLedgerConfig era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyPartialLedgerConfig era) x
-> ShelleyPartialLedgerConfig era
forall era x.
ShelleyPartialLedgerConfig era
-> Rep (ShelleyPartialLedgerConfig era) x
$cfrom :: forall era x.
ShelleyPartialLedgerConfig era
-> Rep (ShelleyPartialLedgerConfig era) x
from :: forall x.
ShelleyPartialLedgerConfig era
-> Rep (ShelleyPartialLedgerConfig era) x
$cto :: forall era x.
Rep (ShelleyPartialLedgerConfig era) x
-> ShelleyPartialLedgerConfig era
to :: forall x.
Rep (ShelleyPartialLedgerConfig era) x
-> ShelleyPartialLedgerConfig era
Generic)
deriving instance (NoThunks (SL.TranslationContext era), SL.Era era) =>
NoThunks (ShelleyPartialLedgerConfig era)
instance ShelleyCompatible proto era => HasPartialLedgerConfig (ShelleyBlock proto era) where
type PartialLedgerConfig (ShelleyBlock proto era) = ShelleyPartialLedgerConfig era
completeLedgerConfig :: forall (proxy :: * -> *).
proxy (ShelleyBlock proto era)
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig (ShelleyBlock proto era)
-> LedgerConfig (ShelleyBlock proto era)
completeLedgerConfig proxy (ShelleyBlock proto era)
_ EpochInfo (Except PastHorizonException)
epochInfo (ShelleyPartialLedgerConfig ShelleyLedgerConfig era
cfg TriggerHardFork
_) =
ShelleyLedgerConfig era
cfg {
shelleyLedgerGlobals = (shelleyLedgerGlobals cfg) {
SL.epochInfo =
hoistEpochInfo
(runExcept . withExceptT (T.pack . show))
epochInfo
}
}
forecastAcrossShelley ::
forall protoFrom protoTo eraFrom eraTo.
( TranslateProto protoFrom protoTo
, LedgerSupportsProtocol (ShelleyBlock protoFrom eraFrom)
)
=> ShelleyLedgerConfig eraFrom
-> ShelleyLedgerConfig eraTo
-> Bound
-> SlotNo
-> LedgerState (ShelleyBlock protoFrom eraFrom)
-> Except OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo))
forecastAcrossShelley :: forall protoFrom protoTo eraFrom eraTo.
(TranslateProto protoFrom protoTo,
LedgerSupportsProtocol (ShelleyBlock protoFrom eraFrom)) =>
ShelleyLedgerConfig eraFrom
-> ShelleyLedgerConfig eraTo
-> Bound
-> SlotNo
-> LedgerState (ShelleyBlock protoFrom eraFrom)
-> Except
OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo))
forecastAcrossShelley ShelleyLedgerConfig eraFrom
cfgFrom ShelleyLedgerConfig eraTo
cfgTo Bound
transition SlotNo
forecastFor LedgerState (ShelleyBlock protoFrom eraFrom)
ledgerStateFrom
| SlotNo
forecastFor SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
maxFor
= WrapLedgerView (ShelleyBlock protoTo eraTo)
-> ExceptT
OutsideForecastRange
Identity
(WrapLedgerView (ShelleyBlock protoTo eraTo))
forall a. a -> ExceptT OutsideForecastRange Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapLedgerView (ShelleyBlock protoTo eraTo)
-> ExceptT
OutsideForecastRange
Identity
(WrapLedgerView (ShelleyBlock protoTo eraTo)))
-> WrapLedgerView (ShelleyBlock protoTo eraTo)
-> ExceptT
OutsideForecastRange
Identity
(WrapLedgerView (ShelleyBlock protoTo eraTo))
forall a b. (a -> b) -> a -> b
$ SlotNo -> WrapLedgerView (ShelleyBlock protoTo eraTo)
forall era. SlotNo -> WrapLedgerView (ShelleyBlock protoTo era)
futureLedgerView SlotNo
forecastFor
| Bool
otherwise
= OutsideForecastRange
-> ExceptT
OutsideForecastRange
Identity
(WrapLedgerView (ShelleyBlock protoTo eraTo))
forall a.
OutsideForecastRange -> ExceptT OutsideForecastRange Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (OutsideForecastRange
-> ExceptT
OutsideForecastRange
Identity
(WrapLedgerView (ShelleyBlock protoTo eraTo)))
-> OutsideForecastRange
-> ExceptT
OutsideForecastRange
Identity
(WrapLedgerView (ShelleyBlock protoTo eraTo))
forall a b. (a -> b) -> a -> b
$ OutsideForecastRange {
outsideForecastAt :: WithOrigin SlotNo
outsideForecastAt = LedgerState (ShelleyBlock protoFrom eraFrom) -> WithOrigin SlotNo
forall blk.
UpdateLedger blk =>
LedgerState blk -> WithOrigin SlotNo
ledgerTipSlot LedgerState (ShelleyBlock protoFrom eraFrom)
ledgerStateFrom
, outsideForecastMaxFor :: SlotNo
outsideForecastMaxFor = SlotNo
maxFor
, outsideForecastFor :: SlotNo
outsideForecastFor = SlotNo
forecastFor
}
where
futureLedgerView :: SlotNo -> WrapLedgerView (ShelleyBlock protoTo era)
futureLedgerView :: forall era. SlotNo -> WrapLedgerView (ShelleyBlock protoTo era)
futureLedgerView =
LedgerView protoTo -> WrapLedgerView (ShelleyBlock protoTo era)
LedgerView (BlockProtocol (ShelleyBlock protoTo era))
-> WrapLedgerView (ShelleyBlock protoTo era)
forall blk. LedgerView (BlockProtocol blk) -> WrapLedgerView blk
WrapLedgerView
(LedgerView protoTo -> WrapLedgerView (ShelleyBlock protoTo era))
-> (SlotNo -> LedgerView protoTo)
-> SlotNo
-> WrapLedgerView (ShelleyBlock protoTo era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OutsideForecastRange -> LedgerView protoTo)
-> (LedgerView protoFrom -> LedgerView protoTo)
-> Either OutsideForecastRange (LedgerView protoFrom)
-> LedgerView protoTo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\OutsideForecastRange
e -> String -> LedgerView protoTo
forall a. HasCallStack => String -> a
error (String
"futureLedgerView failed: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OutsideForecastRange -> String
forall a. Show a => a -> String
show OutsideForecastRange
e))
(Proxy (protoFrom, protoTo)
-> LedgerView protoFrom -> LedgerView protoTo
forall protoFrom protoTo.
TranslateProto protoFrom protoTo =>
Proxy (protoFrom, protoTo)
-> LedgerView protoFrom -> LedgerView protoTo
translateLedgerView (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(protoFrom, protoTo)))
(Either OutsideForecastRange (LedgerView protoFrom)
-> LedgerView protoTo)
-> (SlotNo -> Either OutsideForecastRange (LedgerView protoFrom))
-> SlotNo
-> LedgerView protoTo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except OutsideForecastRange (LedgerView protoFrom)
-> Either OutsideForecastRange (LedgerView protoFrom)
forall e a. Except e a -> Either e a
runExcept
(Except OutsideForecastRange (LedgerView protoFrom)
-> Either OutsideForecastRange (LedgerView protoFrom))
-> (SlotNo -> Except OutsideForecastRange (LedgerView protoFrom))
-> SlotNo
-> Either OutsideForecastRange (LedgerView protoFrom)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forecast (LedgerView protoFrom)
-> SlotNo -> Except OutsideForecastRange (LedgerView protoFrom)
forall a. Forecast a -> SlotNo -> Except OutsideForecastRange a
Forecast.forecastFor (LedgerConfig (ShelleyBlock protoFrom eraFrom)
-> LedgerState (ShelleyBlock protoFrom eraFrom)
-> Forecast
(LedgerView (BlockProtocol (ShelleyBlock protoFrom eraFrom)))
forall blk.
(LedgerSupportsProtocol blk, HasCallStack) =>
LedgerConfig blk
-> LedgerState blk -> Forecast (LedgerView (BlockProtocol blk))
ledgerViewForecastAt LedgerConfig (ShelleyBlock protoFrom eraFrom)
ShelleyLedgerConfig eraFrom
cfgFrom LedgerState (ShelleyBlock protoFrom eraFrom)
ledgerStateFrom)
maxFor :: SlotNo
maxFor :: SlotNo
maxFor = WithOrigin SlotNo -> SlotNo -> Word64 -> Word64 -> SlotNo
crossEraForecastBound
(LedgerState (ShelleyBlock protoFrom eraFrom) -> WithOrigin SlotNo
forall blk.
UpdateLedger blk =>
LedgerState blk -> WithOrigin SlotNo
ledgerTipSlot LedgerState (ShelleyBlock protoFrom eraFrom)
ledgerStateFrom)
(Bound -> SlotNo
boundSlot Bound
transition)
(Globals -> Word64
SL.stabilityWindow (ShelleyLedgerConfig eraFrom -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals ShelleyLedgerConfig eraFrom
cfgFrom))
(Globals -> Word64
SL.stabilityWindow (ShelleyLedgerConfig eraTo -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals ShelleyLedgerConfig eraTo
cfgTo))
translateChainDepStateAcrossShelley ::
forall eraFrom eraTo protoFrom protoTo.
( TranslateProto protoFrom protoTo
)
=> RequiringBoth
WrapConsensusConfig
(Translate WrapChainDepState)
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
translateChainDepStateAcrossShelley :: forall eraFrom eraTo protoFrom protoTo.
TranslateProto protoFrom protoTo =>
RequiringBoth
WrapConsensusConfig
(Translate WrapChainDepState)
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
translateChainDepStateAcrossShelley =
Translate
WrapChainDepState
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
-> RequiringBoth
WrapConsensusConfig
(Translate WrapChainDepState)
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
forall {k} (f :: k -> k -> *) (x :: k) (y :: k) (h :: k -> *).
f x y -> RequiringBoth h f x y
ignoringBoth (Translate
WrapChainDepState
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
-> RequiringBoth
WrapConsensusConfig
(Translate WrapChainDepState)
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo))
-> Translate
WrapChainDepState
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
-> RequiringBoth
WrapConsensusConfig
(Translate WrapChainDepState)
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
forall a b. (a -> b) -> a -> b
$
(EpochNo
-> WrapChainDepState (ShelleyBlock protoFrom eraFrom)
-> WrapChainDepState (ShelleyBlock protoTo eraTo))
-> Translate
WrapChainDepState
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
forall (f :: * -> *) x y.
(EpochNo -> f x -> f y) -> Translate f x y
Translate ((EpochNo
-> WrapChainDepState (ShelleyBlock protoFrom eraFrom)
-> WrapChainDepState (ShelleyBlock protoTo eraTo))
-> Translate
WrapChainDepState
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo))
-> (EpochNo
-> WrapChainDepState (ShelleyBlock protoFrom eraFrom)
-> WrapChainDepState (ShelleyBlock protoTo eraTo))
-> Translate
WrapChainDepState
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
forall a b. (a -> b) -> a -> b
$ \EpochNo
_epochNo (WrapChainDepState ChainDepState (BlockProtocol (ShelleyBlock protoFrom eraFrom))
chainDepState) ->
ChainDepState (BlockProtocol (ShelleyBlock protoTo eraTo))
-> WrapChainDepState (ShelleyBlock protoTo eraTo)
forall blk.
ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
WrapChainDepState (ChainDepState (BlockProtocol (ShelleyBlock protoTo eraTo))
-> WrapChainDepState (ShelleyBlock protoTo eraTo))
-> ChainDepState (BlockProtocol (ShelleyBlock protoTo eraTo))
-> WrapChainDepState (ShelleyBlock protoTo eraTo)
forall a b. (a -> b) -> a -> b
$ Proxy (protoFrom, protoTo)
-> ChainDepState protoFrom -> ChainDepState protoTo
forall protoFrom protoTo.
TranslateProto protoFrom protoTo =>
Proxy (protoFrom, protoTo)
-> ChainDepState protoFrom -> ChainDepState protoTo
translateChainDepState (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(protoFrom, protoTo)) ChainDepState protoFrom
ChainDepState (BlockProtocol (ShelleyBlock protoFrom eraFrom))
chainDepState
crossEraForecastAcrossShelley ::
forall eraFrom eraTo protoFrom protoTo.
( TranslateProto protoFrom protoTo
, LedgerSupportsProtocol (ShelleyBlock protoFrom eraFrom)
)
=> RequiringBoth
WrapLedgerConfig
(CrossEraForecaster LedgerState WrapLedgerView)
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
crossEraForecastAcrossShelley :: forall eraFrom eraTo protoFrom protoTo.
(TranslateProto protoFrom protoTo,
LedgerSupportsProtocol (ShelleyBlock protoFrom eraFrom)) =>
RequiringBoth
WrapLedgerConfig
(CrossEraForecaster LedgerState WrapLedgerView)
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
crossEraForecastAcrossShelley =
(WrapLedgerConfig (ShelleyBlock protoFrom eraFrom)
-> WrapLedgerConfig (ShelleyBlock protoTo eraTo)
-> CrossEraForecaster
LedgerState
WrapLedgerView
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo))
-> RequiringBoth
WrapLedgerConfig
(CrossEraForecaster LedgerState WrapLedgerView)
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
forall {k} (h :: k -> *) (f :: k -> k -> *) (x :: k) (y :: k).
(h x -> h y -> f x y) -> RequiringBoth h f x y
RequireBoth ((WrapLedgerConfig (ShelleyBlock protoFrom eraFrom)
-> WrapLedgerConfig (ShelleyBlock protoTo eraTo)
-> CrossEraForecaster
LedgerState
WrapLedgerView
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo))
-> RequiringBoth
WrapLedgerConfig
(CrossEraForecaster LedgerState WrapLedgerView)
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo))
-> (WrapLedgerConfig (ShelleyBlock protoFrom eraFrom)
-> WrapLedgerConfig (ShelleyBlock protoTo eraTo)
-> CrossEraForecaster
LedgerState
WrapLedgerView
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo))
-> RequiringBoth
WrapLedgerConfig
(CrossEraForecaster LedgerState WrapLedgerView)
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
forall a b. (a -> b) -> a -> b
$ \(WrapLedgerConfig LedgerConfig (ShelleyBlock protoFrom eraFrom)
cfgFrom)
(WrapLedgerConfig LedgerConfig (ShelleyBlock protoTo eraTo)
cfgTo) ->
(Bound
-> SlotNo
-> LedgerState (ShelleyBlock protoFrom eraFrom)
-> Except
OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo)))
-> CrossEraForecaster
LedgerState
WrapLedgerView
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
forall (state :: * -> *) (view :: * -> *) x y.
(Bound
-> SlotNo -> state x -> Except OutsideForecastRange (view y))
-> CrossEraForecaster state view x y
CrossEraForecaster ((Bound
-> SlotNo
-> LedgerState (ShelleyBlock protoFrom eraFrom)
-> Except
OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo)))
-> CrossEraForecaster
LedgerState
WrapLedgerView
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo))
-> (Bound
-> SlotNo
-> LedgerState (ShelleyBlock protoFrom eraFrom)
-> Except
OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo)))
-> CrossEraForecaster
LedgerState
WrapLedgerView
(ShelleyBlock protoFrom eraFrom)
(ShelleyBlock protoTo eraTo)
forall a b. (a -> b) -> a -> b
$ ShelleyLedgerConfig eraFrom
-> ShelleyLedgerConfig eraTo
-> Bound
-> SlotNo
-> LedgerState (ShelleyBlock protoFrom eraFrom)
-> Except
OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo))
forall protoFrom protoTo eraFrom eraTo.
(TranslateProto protoFrom protoTo,
LedgerSupportsProtocol (ShelleyBlock protoFrom eraFrom)) =>
ShelleyLedgerConfig eraFrom
-> ShelleyLedgerConfig eraTo
-> Bound
-> SlotNo
-> LedgerState (ShelleyBlock protoFrom eraFrom)
-> Except
OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo))
forecastAcrossShelley LedgerConfig (ShelleyBlock protoFrom eraFrom)
ShelleyLedgerConfig eraFrom
cfgFrom LedgerConfig (ShelleyBlock protoTo eraTo)
ShelleyLedgerConfig eraTo
cfgTo
instance ( ShelleyBasedEra era
, ShelleyBasedEra (SL.PreviousEra era)
, SL.Era (SL.PreviousEra era)
, EraCrypto (SL.PreviousEra era) ~ EraCrypto era
) => SL.TranslateEra era (ShelleyTip proto) where
translateEra :: TranslationContext era
-> ShelleyTip proto (PreviousEra era)
-> Except
(TranslationError era (ShelleyTip proto)) (ShelleyTip proto era)
translateEra TranslationContext era
_ (ShelleyTip SlotNo
sno BlockNo
bno (ShelleyHash Hash (ProtoCrypto proto) EraIndependentBlockHeader
hash)) =
ShelleyTip proto era
-> Except
(TranslationError era (ShelleyTip proto)) (ShelleyTip proto era)
forall a.
a -> ExceptT (TranslationError era (ShelleyTip proto)) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShelleyTip proto era
-> Except
(TranslationError era (ShelleyTip proto)) (ShelleyTip proto era))
-> ShelleyTip proto era
-> Except
(TranslationError era (ShelleyTip proto)) (ShelleyTip proto era)
forall a b. (a -> b) -> a -> b
$ SlotNo
-> BlockNo
-> HeaderHash (ShelleyBlock proto era)
-> ShelleyTip proto era
forall proto era.
SlotNo
-> BlockNo
-> HeaderHash (ShelleyBlock proto era)
-> ShelleyTip proto era
ShelleyTip SlotNo
sno BlockNo
bno (Hash (ProtoCrypto proto) EraIndependentBlockHeader
-> ShelleyHash (ProtoCrypto proto)
forall crypto.
Hash crypto EraIndependentBlockHeader -> ShelleyHash crypto
ShelleyHash Hash (ProtoCrypto proto) EraIndependentBlockHeader
hash)
instance ( ShelleyBasedEra era
, SL.TranslateEra era (ShelleyTip proto)
, SL.TranslateEra era SL.NewEpochState
, SL.TranslationError era SL.NewEpochState ~ Void
) => SL.TranslateEra era (LedgerState :.: ShelleyBlock proto) where
translateEra :: TranslationContext era
-> (:.:) LedgerState (ShelleyBlock proto) (PreviousEra era)
-> Except
(TranslationError era (LedgerState :.: ShelleyBlock proto))
((:.:) LedgerState (ShelleyBlock proto) era)
translateEra TranslationContext era
ctxt (Comp (ShelleyLedgerState WithOrigin (ShelleyTip proto (PreviousEra era))
tip NewEpochState (PreviousEra era)
state ShelleyTransition
_transition)) = do
WithOrigin (ShelleyTip proto era)
tip' <- (ShelleyTip proto (PreviousEra era)
-> ExceptT Void Identity (ShelleyTip proto era))
-> WithOrigin (ShelleyTip proto (PreviousEra era))
-> ExceptT Void Identity (WithOrigin (ShelleyTip proto era))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithOrigin a -> m (WithOrigin b)
mapM (TranslationContext era
-> ShelleyTip proto (PreviousEra era)
-> Except
(TranslationError era (ShelleyTip proto)) (ShelleyTip proto era)
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
SL.translateEra TranslationContext era
ctxt) WithOrigin (ShelleyTip proto (PreviousEra era))
tip
NewEpochState era
state' <- TranslationContext era
-> NewEpochState (PreviousEra era)
-> Except (TranslationError era NewEpochState) (NewEpochState era)
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
SL.translateEra TranslationContext era
ctxt NewEpochState (PreviousEra era)
state
(:.:) LedgerState (ShelleyBlock proto) era
-> ExceptT
Void Identity ((:.:) LedgerState (ShelleyBlock proto) era)
forall a. a -> ExceptT Void Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:.:) LedgerState (ShelleyBlock proto) era
-> ExceptT
Void Identity ((:.:) LedgerState (ShelleyBlock proto) era))
-> (:.:) LedgerState (ShelleyBlock proto) era
-> ExceptT
Void Identity ((:.:) LedgerState (ShelleyBlock proto) era)
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era)
-> (:.:) LedgerState (ShelleyBlock proto) era
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (LedgerState (ShelleyBlock proto era)
-> (:.:) LedgerState (ShelleyBlock proto) era)
-> LedgerState (ShelleyBlock proto era)
-> (:.:) LedgerState (ShelleyBlock proto) era
forall a b. (a -> b) -> a -> b
$ ShelleyLedgerState {
shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip = WithOrigin (ShelleyTip proto era)
tip'
, shelleyLedgerState :: NewEpochState era
shelleyLedgerState = NewEpochState era
state'
, shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = Word32 -> ShelleyTransition
ShelleyTransitionInfo Word32
0
}
instance ( ShelleyBasedEra era
, SL.TranslateEra era WrapTx
) => SL.TranslateEra era (GenTx :.: ShelleyBlock proto) where
type TranslationError era (GenTx :.: ShelleyBlock proto) = SL.TranslationError era WrapTx
translateEra :: TranslationContext era
-> (:.:) GenTx (ShelleyBlock proto) (PreviousEra era)
-> Except
(TranslationError era (GenTx :.: ShelleyBlock proto))
((:.:) GenTx (ShelleyBlock proto) era)
translateEra TranslationContext era
ctxt (Comp (ShelleyTx TxId (EraCrypto (PreviousEra era))
_txId Tx (PreviousEra era)
tx)) =
GenTx (ShelleyBlock proto era)
-> (:.:) GenTx (ShelleyBlock proto) era
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (GenTx (ShelleyBlock proto era)
-> (:.:) GenTx (ShelleyBlock proto) era)
-> (WrapTx era -> GenTx (ShelleyBlock proto era))
-> WrapTx era
-> (:.:) GenTx (ShelleyBlock proto) era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> GenTx (ShelleyBlock proto era)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx (Tx era -> GenTx (ShelleyBlock proto era))
-> (WrapTx era -> Tx era)
-> WrapTx era
-> GenTx (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. WrapTx era -> Tx era
unwrapTx @era
(WrapTx era -> (:.:) GenTx (ShelleyBlock proto) era)
-> ExceptT (TranslationError era WrapTx) Identity (WrapTx era)
-> ExceptT
(TranslationError era WrapTx)
Identity
((:.:) GenTx (ShelleyBlock proto) era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TranslationContext era
-> WrapTx (PreviousEra era)
-> ExceptT (TranslationError era WrapTx) Identity (WrapTx era)
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
SL.translateEra TranslationContext era
ctxt (forall era. Tx era -> WrapTx era
WrapTx @(SL.PreviousEra era) Tx (PreviousEra era)
tx)
instance ( ShelleyBasedEra era
, SL.TranslateEra era WrapTx
) => SL.TranslateEra era (WrapValidatedGenTx :.: ShelleyBlock proto) where
type TranslationError era (WrapValidatedGenTx :.: ShelleyBlock proto) = SL.TranslationError era WrapTx
translateEra :: TranslationContext era
-> (:.:) WrapValidatedGenTx (ShelleyBlock proto) (PreviousEra era)
-> Except
(TranslationError era (WrapValidatedGenTx :.: ShelleyBlock proto))
((:.:) WrapValidatedGenTx (ShelleyBlock proto) era)
translateEra TranslationContext era
ctxt (Comp (WrapValidatedGenTx (ShelleyValidatedTx TxId (EraCrypto (PreviousEra era))
_txId Validated (Tx (PreviousEra era))
vtx))) =
WrapValidatedGenTx (ShelleyBlock proto era)
-> (:.:) WrapValidatedGenTx (ShelleyBlock proto) era
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (WrapValidatedGenTx (ShelleyBlock proto era)
-> (:.:) WrapValidatedGenTx (ShelleyBlock proto) era)
-> (Validated (WrapTx era)
-> WrapValidatedGenTx (ShelleyBlock proto era))
-> Validated (WrapTx era)
-> (:.:) WrapValidatedGenTx (ShelleyBlock proto) era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx (ShelleyBlock proto era))
-> WrapValidatedGenTx (ShelleyBlock proto era)
forall blk. Validated (GenTx blk) -> WrapValidatedGenTx blk
WrapValidatedGenTx
(Validated (GenTx (ShelleyBlock proto era))
-> WrapValidatedGenTx (ShelleyBlock proto era))
-> (Validated (WrapTx era)
-> Validated (GenTx (ShelleyBlock proto era)))
-> Validated (WrapTx era)
-> WrapValidatedGenTx (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (Tx era) -> Validated (GenTx (ShelleyBlock proto era))
forall era proto.
ShelleyBasedEra era =>
Validated (Tx era) -> Validated (GenTx (ShelleyBlock proto era))
mkShelleyValidatedTx (Validated (Tx era) -> Validated (GenTx (ShelleyBlock proto era)))
-> (Validated (WrapTx era) -> Validated (Tx era))
-> Validated (WrapTx era)
-> Validated (GenTx (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (WrapTx era) -> Validated (Tx era)
forall a b. Coercible a b => Validated a -> Validated b
SL.coerceValidated
(Validated (WrapTx era)
-> (:.:) WrapValidatedGenTx (ShelleyBlock proto) era)
-> ExceptT
(TranslationError era WrapTx) Identity (Validated (WrapTx era))
-> ExceptT
(TranslationError era WrapTx)
Identity
((:.:) WrapValidatedGenTx (ShelleyBlock proto) era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> Validated (f (PreviousEra era))
-> Except (TranslationError era f) (Validated (f era))
SL.translateValidated @era @WrapTx TranslationContext era
ctxt (Validated (Tx (PreviousEra era))
-> Validated (WrapTx (PreviousEra era))
forall a b. Coercible a b => Validated a -> Validated b
SL.coerceValidated Validated (Tx (PreviousEra era))
vtx)