{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- | This module is the Shelley Hard Fork Combinator
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, unNonZero)
import           Cardano.Ledger.Binary.Decoding (decShareCBOR, decodeMap,
                     decodeMemPack, internsFromMap)
import           Cardano.Ledger.Binary.Encoding (encodeMap, encodeMemPack,
                     toPlainEncoding)
import qualified Cardano.Ledger.Core as SL
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.LedgerState as SL
import qualified Cardano.Ledger.UMap as SL
import           Cardano.Protocol.Crypto (Crypto)
import qualified Cardano.Protocol.TPraos.API as SL
import           Codec.CBOR.Decoding
import           Codec.CBOR.Encoding
import           Control.Monad (guard)
import           Control.Monad.Except (runExcept, throwError)
import           Data.Coerce
import qualified Data.Map.Strict as Map
import           Data.MemPack
import           Data.SOP.BasicFunctors
import           Data.SOP.Functors (Flip (..))
import           Data.SOP.Index (Index (..))
import           Data.SOP.InPairs (RequiringBoth (..), ignoringBoth)
import           Data.SOP.Strict
import qualified Data.SOP.Tails as Tails
import qualified Data.SOP.Telescope as Telescope
import qualified Data.Text as T (pack)
import           Data.Typeable
import           Data.Void (Void)
import           Data.Word
import           Lens.Micro ((^.))
import           NoThunks.Class
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
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.Shelley.Protocol.Abstract (ProtoCrypto)
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util.IndexedMemPack

{-------------------------------------------------------------------------------
  Synonym for convenience
-------------------------------------------------------------------------------}

-- | Shelley as the single era in the hard fork combinator
type ShelleyBlockHFC proto era = HardForkBlock '[ShelleyBlock proto era]

{-------------------------------------------------------------------------------
  NoHardForks instance
-------------------------------------------------------------------------------}

instance ( ShelleyCompatible proto era
         , LedgerSupportsProtocol (ShelleyBlock proto era)
         ) => ImmutableEraParams (ShelleyBlock proto era) where
  immutableEraParams :: TopLevelConfig (ShelleyBlock proto era) -> EraParams
immutableEraParams =
        ShelleyGenesis -> EraParams
shelleyEraParamsNeverHardForks
      (ShelleyGenesis -> EraParams)
-> (TopLevelConfig (ShelleyBlock proto era) -> ShelleyGenesis)
-> TopLevelConfig (ShelleyBlock proto era)
-> EraParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerConfig era -> ShelleyGenesis
forall era. ShelleyLedgerConfig era -> ShelleyGenesis
shelleyLedgerGenesis
      (ShelleyLedgerConfig era -> ShelleyGenesis)
-> (TopLevelConfig (ShelleyBlock proto era)
    -> ShelleyLedgerConfig era)
-> TopLevelConfig (ShelleyBlock proto era)
-> ShelleyGenesis
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

instance ( ShelleyCompatible proto era
         , LedgerSupportsProtocol (ShelleyBlock proto era)
         , TxLimits (ShelleyBlock proto era)
         , Crypto (ProtoCrypto proto)
         ) => NoHardForks (ShelleyBlock proto era) where
  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
      }

{-------------------------------------------------------------------------------
  SupportedNetworkProtocolVersion instance
-------------------------------------------------------------------------------}

-- | Forward to the ShelleyBlock instance. Only supports
-- 'HardForkNodeToNodeDisabled', which is compatible with nodes running with
-- 'ShelleyBlock'.
instance ( ShelleyCompatible proto era
         , LedgerSupportsProtocol (ShelleyBlock proto era)
         , TxLimits               (ShelleyBlock proto era)
         , Crypto (ProtoCrypto proto)
         ) => 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

{-------------------------------------------------------------------------------
  SerialiseHFC instance
-------------------------------------------------------------------------------}

-- | Use the default implementations. This means the serialisation of blocks
-- includes an era wrapper. Each block should do this from the start to be
-- prepared for future hard forks without having to do any bit twiddling.
instance ( ShelleyCompatible proto era
         , LedgerSupportsProtocol (ShelleyBlock proto era)
         , TxLimits               (ShelleyBlock proto era)
         , Crypto (ProtoCrypto proto)
         ) => SerialiseHFC '[ShelleyBlock proto era]
instance ( ShelleyCompatible proto era
         , LedgerSupportsProtocol (ShelleyBlock proto era)
         , TxLimits               (ShelleyBlock proto era)
         , Crypto (ProtoCrypto proto)
         ) => SerialiseConstraintsHFC (ShelleyBlock proto era)

{-------------------------------------------------------------------------------
  Protocol type definition
-------------------------------------------------------------------------------}

type ProtocolShelley = HardForkProtocol '[ ShelleyBlock (TPraos StandardCrypto) ShelleyEra ]

{-------------------------------------------------------------------------------
  SingleEraBlock Shelley
-------------------------------------------------------------------------------}

shelleyTransition ::
     forall era proto mk. ShelleyCompatible proto era
  => PartialLedgerConfig (ShelleyBlock proto era)
  -> Word16   -- ^ Next era's initial major protocol version
  -> LedgerState (ShelleyBlock proto era) mk
  -> Maybe EpochNo
shelleyTransition :: forall era proto (mk :: MapKind).
ShelleyCompatible proto era =>
PartialLedgerConfig (ShelleyBlock proto era)
-> Word16
-> LedgerState (ShelleyBlock proto era) mk
-> 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) mk
state =
      ShelleyLedgerUpdate era -> Maybe EpochNo
isTransition
    (ShelleyLedgerUpdate era -> Maybe EpochNo)
-> (LedgerState (ShelleyBlock proto era) mk
    -> ShelleyLedgerUpdate era)
-> LedgerState (ShelleyBlock proto era) mk
-> Maybe EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) mk -> ShelleyLedgerUpdate era
forall era proto (mk :: MapKind).
ShelleyBasedEra era =>
LedgerState (ShelleyBlock proto era) mk -> ShelleyLedgerUpdate era
Shelley.Inspect.pparamsUpdate
    (LedgerState (ShelleyBlock proto era) mk -> Maybe EpochNo)
-> LedgerState (ShelleyBlock proto era) mk -> Maybe EpochNo
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era) mk
state
  where
    ShelleyTransitionInfo{Word32
shelleyAfterVoting :: Word32
shelleyAfterVoting :: ShelleyTransition -> Word32
..} = LedgerState (ShelleyBlock proto era) mk -> ShelleyTransition
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk -> ShelleyTransition
shelleyLedgerTransition LedgerState (ShelleyBlock proto era) mk
state

    -- 'shelleyLedgerConfig' contains a dummy 'EpochInfo' but this does not
    -- matter for extracting the genesis config
    genesis :: SL.ShelleyGenesis
    genesis :: ShelleyGenesis
genesis = ShelleyLedgerConfig era -> ShelleyGenesis
forall era. ShelleyLedgerConfig era -> ShelleyGenesis
shelleyLedgerGenesis ShelleyLedgerConfig era
shelleyLedgerConfig

    k :: Word64
    k :: Word64
k = NonZero Word64 -> Word64
forall a. NonZero a -> a
SL.unNonZero (NonZero Word64 -> Word64) -> NonZero Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis -> NonZero Word64
SL.sgSecurityParam ShelleyGenesis
genesis

    isTransition :: ShelleyLedgerUpdate era -> Maybe EpochNo
    isTransition :: ShelleyLedgerUpdate era -> Maybe EpochNo
isTransition (ShelleyUpdatedPParams StrictMaybe (PParams era)
maybePParams EpochNo
newPParamsEpochNo) = do
         SL.SJust pp <- StrictMaybe (PParams era) -> Maybe (StrictMaybe (PParams era))
forall a. a -> Maybe a
Just StrictMaybe (PParams era)
maybePParams
         let 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
         transitionMajorVersion <- SL.mkVersion transitionMajorVersionRaw
         guard $ SL.pvMajor protVer == transitionMajorVersion
         guard $ shelleyAfterVoting >= fromIntegral k
         return newPParamsEpochNo

instance ( ShelleyCompatible proto era
         , LedgerSupportsProtocol (ShelleyBlock proto era)
         , TxLimits               (ShelleyBlock proto era)
         , Crypto (ProtoCrypto proto)
         ) => SingleEraBlock (ShelleyBlock proto era) where
  singleEraTransition :: forall (mk :: MapKind).
PartialLedgerConfig (ShelleyBlock proto era)
-> EraParams
-> Bound
-> LedgerState (ShelleyBlock proto era) mk
-> Maybe EpochNo
singleEraTransition PartialLedgerConfig (ShelleyBlock proto era)
pcfg EraParams
_eraParams Bound
_eraStart LedgerState (ShelleyBlock proto era) mk
ledgerState =
      -- TODO: We might be evaluating 'singleEraTransition' more than once when
      -- replaying blocks. We should investigate if this is the case, and if so,
      -- whether this is the desired behaviour. If it is not, then we need to
      -- fix it.
      --
      -- For evidence of this behaviour, replace the cased-on expression by:
      -- > @traceShowId $ shelleyTriggerHardFork pcf@
      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) mk
-> Maybe EpochNo
forall era proto (mk :: MapKind).
ShelleyCompatible proto era =>
PartialLedgerConfig (ShelleyBlock proto era)
-> Word16
-> LedgerState (ShelleyBlock proto era) mk
-> Maybe EpochNo
shelleyTransition
              PartialLedgerConfig (ShelleyBlock proto era)
pcfg
              Word16
shelleyMajorVersion
              LedgerState (ShelleyBlock proto era) mk
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 Ouroboros.Consensus.Protocol.Praos.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)
praosEpochInfo :: EpochInfo (Except PastHorizonException)
praosParams :: PraosParams
..}

  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)
tpraosEpochInfo :: EpochInfo (Except PastHorizonException)
tpraosParams :: TPraosParams
..}

  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

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) ->
        -- Same protocol, same 'ChainDepState'. Note that we don't have to apply
        -- any changes related to an epoch transition, this is already done when
        -- ticking the state.
        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 = (ShelleyLedgerConfig eraFrom
 -> ShelleyLedgerConfig eraTo
 -> Bound
 -> SlotNo
 -> LedgerState (ShelleyBlock protoFrom eraFrom) EmptyMK
 -> Except
      OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo)))
-> RequiringBoth
     WrapLedgerConfig
     (CrossEraForecaster LedgerState WrapLedgerView)
     (ShelleyBlock protoFrom eraFrom)
     (ShelleyBlock protoTo eraTo)
forall a b. Coercible a b => a -> b
coerce ShelleyLedgerConfig eraFrom
-> ShelleyLedgerConfig eraTo
-> Bound
-> SlotNo
-> LedgerState (ShelleyBlock protoFrom eraFrom) EmptyMK
-> Except
     OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo))
forall protoFrom protoTo eraFrom eraTo (mk :: MapKind).
(TranslateProto protoFrom protoTo,
 LedgerSupportsProtocol (ShelleyBlock protoFrom eraFrom)) =>
ShelleyLedgerConfig eraFrom
-> ShelleyLedgerConfig eraTo
-> Bound
-> SlotNo
-> LedgerState (ShelleyBlock protoFrom eraFrom) mk
-> Except
     OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo))
forecastAcrossShelley

-- | Forecast from a Shelley-based era to the next Shelley-based era.
forecastAcrossShelley ::
     forall protoFrom protoTo eraFrom eraTo mk.
     ( TranslateProto protoFrom protoTo
     , LedgerSupportsProtocol (ShelleyBlock protoFrom eraFrom)
     )
  => ShelleyLedgerConfig eraFrom
  -> ShelleyLedgerConfig eraTo
  -> Bound  -- ^ Transition between the two eras
  -> SlotNo -- ^ Forecast for this slot
  -> LedgerState (ShelleyBlock protoFrom eraFrom) mk
  -> Except OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo))
forecastAcrossShelley :: forall protoFrom protoTo eraFrom eraTo (mk :: MapKind).
(TranslateProto protoFrom protoTo,
 LedgerSupportsProtocol (ShelleyBlock protoFrom eraFrom)) =>
ShelleyLedgerConfig eraFrom
-> ShelleyLedgerConfig eraTo
-> Bound
-> SlotNo
-> LedgerState (ShelleyBlock protoFrom eraFrom) mk
-> Except
     OutsideForecastRange (WrapLedgerView (ShelleyBlock protoTo eraTo))
forecastAcrossShelley ShelleyLedgerConfig eraFrom
cfgFrom ShelleyLedgerConfig eraTo
cfgTo Bound
transition SlotNo
forecastFor LedgerState (ShelleyBlock protoFrom eraFrom) mk
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) mk
-> WithOrigin SlotNo
forall blk (mk :: MapKind).
UpdateLedger blk =>
LedgerState blk mk -> WithOrigin SlotNo
ledgerTipSlot LedgerState (ShelleyBlock protoFrom eraFrom) mk
ledgerStateFrom
        , outsideForecastMaxFor :: SlotNo
outsideForecastMaxFor = SlotNo
maxFor
        , outsideForecastFor :: SlotNo
outsideForecastFor    = SlotNo
forecastFor
        }
  where
    -- | 'SL.futureLedgerView' imposes its own bounds. Those bounds could
    -- /exceed/ the 'maxFor' we have computed, but should never be /less/.
    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) mk
-> Forecast
     (LedgerView (BlockProtocol (ShelleyBlock protoFrom eraFrom)))
forall blk (mk :: MapKind).
(LedgerSupportsProtocol blk, HasCallStack) =>
LedgerConfig blk
-> LedgerState blk mk -> Forecast (LedgerView (BlockProtocol blk))
forall (mk :: MapKind).
HasCallStack =>
LedgerConfig (ShelleyBlock protoFrom eraFrom)
-> LedgerState (ShelleyBlock protoFrom eraFrom) mk
-> Forecast
     (LedgerView (BlockProtocol (ShelleyBlock protoFrom eraFrom)))
ledgerViewForecastAt LedgerConfig (ShelleyBlock protoFrom eraFrom)
ShelleyLedgerConfig eraFrom
cfgFrom LedgerState (ShelleyBlock protoFrom eraFrom) mk
ledgerStateFrom)

    -- Exclusive upper bound
    maxFor :: SlotNo
    maxFor :: SlotNo
maxFor = WithOrigin SlotNo -> SlotNo -> Word64 -> Word64 -> SlotNo
crossEraForecastBound
               (LedgerState (ShelleyBlock protoFrom eraFrom) mk
-> WithOrigin SlotNo
forall blk (mk :: MapKind).
UpdateLedger blk =>
LedgerState blk mk -> WithOrigin SlotNo
ledgerTipSlot LedgerState (ShelleyBlock protoFrom eraFrom) mk
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))

{-------------------------------------------------------------------------------
  Translation from one Shelley-based era to another Shelley-based era
-------------------------------------------------------------------------------}

instance ( ShelleyBasedEra era
         , ShelleyBasedEra (SL.PreviousEra era)
         , SL.Era (SL.PreviousEra 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 HASH 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 HASH EraIndependentBlockHeader -> ShelleyHash
ShelleyHash Hash HASH EraIndependentBlockHeader
hash)

instance ( ShelleyBasedEra era
         , ShelleyBasedEra (SL.PreviousEra era)
         , SL.TranslateEra era (ShelleyTip proto)
         , SL.TranslateEra era SL.NewEpochState
         , SL.TranslationError era SL.NewEpochState ~ Void
         , CanMapMK mk
         , CanMapKeysMK mk
         ) => SL.TranslateEra era (Flip LedgerState mk :.: ShelleyBlock proto) where
  translateEra :: TranslationContext era
-> (:.:)
     (Flip LedgerState mk) (ShelleyBlock proto) (PreviousEra era)
-> Except
     (TranslationError era (Flip LedgerState mk :.: ShelleyBlock proto))
     ((:.:) (Flip LedgerState mk) (ShelleyBlock proto) era)
translateEra TranslationContext era
ctxt (Comp (Flip (ShelleyLedgerState WithOrigin (ShelleyTip proto (PreviousEra era))
tip NewEpochState (PreviousEra era)
state ShelleyTransition
_transition LedgerTables
  (LedgerState (ShelleyBlock proto (PreviousEra era))) mk
tables))) = do
      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
      state' <- SL.translateEra ctxt state
      return $ Comp $ Flip $ ShelleyLedgerState {
          shelleyLedgerTip        = tip'
        , shelleyLedgerState      = state'
        , shelleyLedgerTransition = ShelleyTransitionInfo 0
        , shelleyLedgerTables     = translateShelleyTables tables
        }

translateShelleyTables ::
     ( CanMapMK mk
     , CanMapKeysMK mk
     , ShelleyBasedEra era
     , ShelleyBasedEra (SL.PreviousEra era)
     )
  => LedgerTables (LedgerState (ShelleyBlock proto (SL.PreviousEra era))) mk
  -> LedgerTables (LedgerState (ShelleyBlock proto                 era))  mk
translateShelleyTables :: forall (mk :: MapKind) era proto.
(CanMapMK mk, CanMapKeysMK mk, ShelleyBasedEra era,
 ShelleyBasedEra (PreviousEra era)) =>
LedgerTables
  (LedgerState (ShelleyBlock proto (PreviousEra era))) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
translateShelleyTables (LedgerTables mk
  (TxIn (LedgerState (ShelleyBlock proto (PreviousEra era))))
  (TxOut (LedgerState (ShelleyBlock proto (PreviousEra era))))
utxoTable) =
      mk
  (TxIn (LedgerState (ShelleyBlock proto era)))
  (TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
forall (l :: MapKind -> *) (mk :: MapKind).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (mk
   (TxIn (LedgerState (ShelleyBlock proto era)))
   (TxOut (LedgerState (ShelleyBlock proto era)))
 -> LedgerTables (LedgerState (ShelleyBlock proto era)) mk)
-> mk
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
forall a b. (a -> b) -> a -> b
$ (TxIn -> TxIn (LedgerState (ShelleyBlock proto era)))
-> mk TxIn (TxOut (LedgerState (ShelleyBlock proto era)))
-> mk
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
forall k' k v. Ord k' => (k -> k') -> mk k v -> mk k' v
forall (mk :: MapKind) k' k v.
(CanMapKeysMK mk, Ord k') =>
(k -> k') -> mk k v -> mk k' v
mapKeysMK TxIn -> TxIn
TxIn -> TxIn (LedgerState (ShelleyBlock proto era))
forall a b. Coercible a b => a -> b
coerce (mk TxIn (TxOut (LedgerState (ShelleyBlock proto era)))
 -> mk
      (TxIn (LedgerState (ShelleyBlock proto era)))
      (TxOut (LedgerState (ShelleyBlock proto era))))
-> mk TxIn (TxOut (LedgerState (ShelleyBlock proto era)))
-> mk
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ (TxOut (PreviousEra era) -> TxOut era)
-> mk TxIn (TxOut (PreviousEra era)) -> mk TxIn (TxOut era)
forall v v' k. (v -> v') -> mk k v -> mk k v'
forall (mk :: MapKind) v v' k.
CanMapMK mk =>
(v -> v') -> mk k v -> mk k v'
mapMK TxOut (PreviousEra era) -> TxOut era
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
SL.upgradeTxOut mk TxIn (TxOut (PreviousEra era))
mk
  (TxIn (LedgerState (ShelleyBlock proto (PreviousEra era))))
  (TxOut (LedgerState (ShelleyBlock proto (PreviousEra era))))
utxoTable

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
_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
_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)

{-------------------------------------------------------------------------------
  Canonical TxIn
-------------------------------------------------------------------------------}

instance (ShelleyCompatible proto era, ShelleyBasedEra era)
      => HasCanonicalTxIn '[ShelleyBlock proto era] where
  newtype instance CanonicalTxIn '[ShelleyBlock proto era] = ShelleyBlockHFCTxIn {
      forall proto era. CanonicalTxIn '[ShelleyBlock proto era] -> TxIn
getShelleyBlockHFCTxIn :: SL.TxIn
    }
    deriving stock (Int -> CanonicalTxIn '[ShelleyBlock proto era] -> String -> String
[CanonicalTxIn '[ShelleyBlock proto era]] -> String -> String
CanonicalTxIn '[ShelleyBlock proto era] -> String
(Int
 -> CanonicalTxIn '[ShelleyBlock proto era] -> String -> String)
-> (CanonicalTxIn '[ShelleyBlock proto era] -> String)
-> ([CanonicalTxIn '[ShelleyBlock proto era]] -> String -> String)
-> Show (CanonicalTxIn '[ShelleyBlock proto era])
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall proto era.
Int -> CanonicalTxIn '[ShelleyBlock proto era] -> String -> String
forall proto era.
[CanonicalTxIn '[ShelleyBlock proto era]] -> String -> String
forall proto era. CanonicalTxIn '[ShelleyBlock proto era] -> String
$cshowsPrec :: forall proto era.
Int -> CanonicalTxIn '[ShelleyBlock proto era] -> String -> String
showsPrec :: Int -> CanonicalTxIn '[ShelleyBlock proto era] -> String -> String
$cshow :: forall proto era. CanonicalTxIn '[ShelleyBlock proto era] -> String
show :: CanonicalTxIn '[ShelleyBlock proto era] -> String
$cshowList :: forall proto era.
[CanonicalTxIn '[ShelleyBlock proto era]] -> String -> String
showList :: [CanonicalTxIn '[ShelleyBlock proto era]] -> String -> String
Show, CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
(CanonicalTxIn '[ShelleyBlock proto era]
 -> CanonicalTxIn '[ShelleyBlock proto era] -> Bool)
-> (CanonicalTxIn '[ShelleyBlock proto era]
    -> CanonicalTxIn '[ShelleyBlock proto era] -> Bool)
-> Eq (CanonicalTxIn '[ShelleyBlock proto era])
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
$c== :: forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
== :: CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
$c/= :: forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
/= :: CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
Eq, Eq (CanonicalTxIn '[ShelleyBlock proto era])
Eq (CanonicalTxIn '[ShelleyBlock proto era]) =>
(CanonicalTxIn '[ShelleyBlock proto era]
 -> CanonicalTxIn '[ShelleyBlock proto era] -> Ordering)
-> (CanonicalTxIn '[ShelleyBlock proto era]
    -> CanonicalTxIn '[ShelleyBlock proto era] -> Bool)
-> (CanonicalTxIn '[ShelleyBlock proto era]
    -> CanonicalTxIn '[ShelleyBlock proto era] -> Bool)
-> (CanonicalTxIn '[ShelleyBlock proto era]
    -> CanonicalTxIn '[ShelleyBlock proto era] -> Bool)
-> (CanonicalTxIn '[ShelleyBlock proto era]
    -> CanonicalTxIn '[ShelleyBlock proto era] -> Bool)
-> (CanonicalTxIn '[ShelleyBlock proto era]
    -> CanonicalTxIn '[ShelleyBlock proto era]
    -> CanonicalTxIn '[ShelleyBlock proto era])
-> (CanonicalTxIn '[ShelleyBlock proto era]
    -> CanonicalTxIn '[ShelleyBlock proto era]
    -> CanonicalTxIn '[ShelleyBlock proto era])
-> Ord (CanonicalTxIn '[ShelleyBlock proto era])
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Ordering
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall proto era. Eq (CanonicalTxIn '[ShelleyBlock proto era])
forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Ordering
forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
$ccompare :: forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Ordering
compare :: CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Ordering
$c< :: forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
< :: CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
$c<= :: forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
<= :: CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
$c> :: forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
> :: CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
$c>= :: forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
>= :: CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era] -> Bool
$cmax :: forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
max :: CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
$cmin :: forall proto era.
CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
min :: CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
-> CanonicalTxIn '[ShelleyBlock proto era]
Ord)
    deriving newtype (Context
-> CanonicalTxIn '[ShelleyBlock proto era] -> IO (Maybe ThunkInfo)
Proxy (CanonicalTxIn '[ShelleyBlock proto era]) -> String
(Context
 -> CanonicalTxIn '[ShelleyBlock proto era] -> IO (Maybe ThunkInfo))
-> (Context
    -> CanonicalTxIn '[ShelleyBlock proto era] -> IO (Maybe ThunkInfo))
-> (Proxy (CanonicalTxIn '[ShelleyBlock proto era]) -> String)
-> NoThunks (CanonicalTxIn '[ShelleyBlock proto era])
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall proto era.
Context
-> CanonicalTxIn '[ShelleyBlock proto era] -> IO (Maybe ThunkInfo)
forall proto era.
Proxy (CanonicalTxIn '[ShelleyBlock proto era]) -> String
$cnoThunks :: forall proto era.
Context
-> CanonicalTxIn '[ShelleyBlock proto era] -> IO (Maybe ThunkInfo)
noThunks :: Context
-> CanonicalTxIn '[ShelleyBlock proto era] -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall proto era.
Context
-> CanonicalTxIn '[ShelleyBlock proto era] -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> CanonicalTxIn '[ShelleyBlock proto era] -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall proto era.
Proxy (CanonicalTxIn '[ShelleyBlock proto era]) -> String
showTypeOf :: Proxy (CanonicalTxIn '[ShelleyBlock proto era]) -> String
NoThunks)

  injectCanonicalTxIn :: forall x.
Index '[ShelleyBlock proto era] x
-> TxIn (LedgerState x) -> CanonicalTxIn '[ShelleyBlock proto era]
injectCanonicalTxIn Index '[ShelleyBlock proto era] x
IZ TxIn (LedgerState x)
txIn     = TxIn -> CanonicalTxIn '[ShelleyBlock proto era]
forall proto era. TxIn -> CanonicalTxIn '[ShelleyBlock proto era]
ShelleyBlockHFCTxIn TxIn
TxIn (LedgerState x)
txIn
  injectCanonicalTxIn (IS Index xs' x
idx') TxIn (LedgerState x)
_ = case Index xs' x
idx' of {}

  ejectCanonicalTxIn :: forall x.
Index '[ShelleyBlock proto era] x
-> CanonicalTxIn '[ShelleyBlock proto era] -> TxIn (LedgerState x)
ejectCanonicalTxIn Index '[ShelleyBlock proto era] x
IZ CanonicalTxIn '[ShelleyBlock proto era]
txIn     = CanonicalTxIn '[ShelleyBlock proto era] -> TxIn
forall proto era. CanonicalTxIn '[ShelleyBlock proto era] -> TxIn
getShelleyBlockHFCTxIn CanonicalTxIn '[ShelleyBlock proto era]
txIn
  ejectCanonicalTxIn (IS Index xs' x
idx') CanonicalTxIn '[ShelleyBlock proto era]
_ = case Index xs' x
idx' of {}

deriving newtype instance MemPack (CanonicalTxIn '[ShelleyBlock proto era])

{-------------------------------------------------------------------------------
  HardForkTxOut
-------------------------------------------------------------------------------}

instance ShelleyCompatible proto era => HasHardForkTxOut '[ShelleyBlock proto era] where
  type instance HardForkTxOut '[ShelleyBlock proto era] = SL.TxOut era
  injectHardForkTxOut :: forall x.
Index '[ShelleyBlock proto era] x
-> TxOut (LedgerState x) -> HardForkTxOut '[ShelleyBlock proto era]
injectHardForkTxOut Index '[ShelleyBlock proto era] x
IZ TxOut (LedgerState x)
txOut    = TxOut (LedgerState x)
HardForkTxOut '[ShelleyBlock proto era]
txOut
  injectHardForkTxOut (IS Index xs' x
idx') TxOut (LedgerState x)
_ = case Index xs' x
idx' of {}
  ejectHardForkTxOut :: forall x.
Index '[ShelleyBlock proto era] x
-> HardForkTxOut '[ShelleyBlock proto era] -> TxOut (LedgerState x)
ejectHardForkTxOut Index '[ShelleyBlock proto era] x
IZ HardForkTxOut '[ShelleyBlock proto era]
txOut    = TxOut (LedgerState x)
HardForkTxOut '[ShelleyBlock proto era]
txOut
  ejectHardForkTxOut (IS Index xs' x
idx') HardForkTxOut '[ShelleyBlock proto era]
_ = case Index xs' x
idx' of {}
  txOutEjections :: NP
  (K (NS WrapTxOut '[ShelleyBlock proto era]) -.-> WrapTxOut)
  '[ShelleyBlock proto era]
txOutEjections = (K (NS WrapTxOut '[ShelleyBlock proto era])
   (ShelleyBlock proto era)
 -> WrapTxOut (ShelleyBlock proto era))
-> (-.->)
     (K (NS WrapTxOut '[ShelleyBlock proto era]))
     WrapTxOut
     (ShelleyBlock proto era)
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn (NS WrapTxOut '[ShelleyBlock proto era]
-> WrapTxOut (ShelleyBlock proto era)
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ (NS WrapTxOut '[ShelleyBlock proto era]
 -> WrapTxOut (ShelleyBlock proto era))
-> (K (NS WrapTxOut '[ShelleyBlock proto era])
      (ShelleyBlock proto era)
    -> NS WrapTxOut '[ShelleyBlock proto era])
-> K (NS WrapTxOut '[ShelleyBlock proto era])
     (ShelleyBlock proto era)
-> WrapTxOut (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K (NS WrapTxOut '[ShelleyBlock proto era]) (ShelleyBlock proto era)
-> NS WrapTxOut '[ShelleyBlock proto era]
forall {k} a (b :: k). K a b -> a
unK) (-.->)
  (K (NS WrapTxOut '[ShelleyBlock proto era]))
  WrapTxOut
  (ShelleyBlock proto era)
-> NP
     (K (NS WrapTxOut '[ShelleyBlock proto era]) -.-> WrapTxOut) '[]
-> NP
     (K (NS WrapTxOut '[ShelleyBlock proto era]) -.-> WrapTxOut)
     '[ShelleyBlock proto era]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP (K (NS WrapTxOut '[ShelleyBlock proto era]) -.-> WrapTxOut) '[]
forall {k} (f :: k -> *). NP f '[]
Nil
  txOutTranslations :: Tails (Fn2 WrapTxOut) '[ShelleyBlock proto era]
txOutTranslations = Tails (Fn2 WrapTxOut) '[ShelleyBlock proto era]
forall {k} (f :: k -> k -> *) (x :: k). Tails f '[x]
Tails.mk1

{-------------------------------------------------------------------------------
  Queries
-------------------------------------------------------------------------------}

instance ( ShelleyCompatible proto era
         , ShelleyBasedEra era
         , TxOut (LedgerState (ShelleyBlock proto era)) ~ SL.TxOut era
         , HasHardForkTxOut '[ShelleyBlock proto era]
         ) => BlockSupportsHFLedgerQuery '[ShelleyBlock proto era] where

  answerBlockQueryHFLookup :: forall (m :: * -> *) x result.
(All SingleEraBlock '[ShelleyBlock proto era], Monad m) =>
Index '[ShelleyBlock proto era] x
-> ExtLedgerCfg x
-> BlockQuery x 'QFLookupTables result
-> ReadOnlyForker' m (HardForkBlock '[ShelleyBlock proto era])
-> m result
answerBlockQueryHFLookup = \case
    Index '[ShelleyBlock proto era] x
IZ -> (LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
 -> LedgerTables
      (LedgerState (HardForkBlock '[ShelleyBlock proto era])) KeysMK)
-> (TxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era]))
    -> TxOut era)
-> (TxIn (LedgerState (HardForkBlock '[ShelleyBlock proto era]))
    -> TxIn)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
-> ReadOnlyForker' m (HardForkBlock '[ShelleyBlock proto era])
-> m result
forall proto era (m :: * -> *) result blk.
(Monad m, ShelleyCompatible proto era) =>
(LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
 -> LedgerTables (LedgerState blk) KeysMK)
-> (TxOut (LedgerState blk) -> TxOut era)
-> (TxIn (LedgerState blk) -> TxIn)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
-> ReadOnlyForker' m blk
-> m result
answerShelleyLookupQueries (Index '[ShelleyBlock proto era] (ShelleyBlock proto era)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
-> LedgerTables
     (LedgerState (HardForkBlock '[ShelleyBlock proto era])) KeysMK
forall (xs :: [*]) x (mk :: MapKind).
(CanMapKeysMK mk, CanMapMK mk, HasCanonicalTxIn xs,
 HasHardForkTxOut xs) =>
Index xs x
-> LedgerTables (LedgerState x) mk
-> LedgerTables (LedgerState (HardForkBlock xs)) mk
injectLedgerTables Index '[ShelleyBlock proto era] (ShelleyBlock proto era)
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ) TxOut era -> TxOut era
TxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era]))
-> TxOut era
forall a. a -> a
id (Index '[ShelleyBlock proto era] (ShelleyBlock proto era)
-> CanonicalTxIn '[ShelleyBlock proto era]
-> TxIn (LedgerState (ShelleyBlock proto era))
forall (xs :: [*]) x.
HasCanonicalTxIn xs =>
Index xs x -> CanonicalTxIn xs -> TxIn (LedgerState x)
forall x.
Index '[ShelleyBlock proto era] x
-> CanonicalTxIn '[ShelleyBlock proto era] -> TxIn (LedgerState x)
ejectCanonicalTxIn Index '[ShelleyBlock proto era] (ShelleyBlock proto era)
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ)
    IS Index xs' x
idx -> case Index xs' x
idx of {}

  answerBlockQueryHFTraverse :: forall (m :: * -> *) x result.
(All SingleEraBlock '[ShelleyBlock proto era], Monad m) =>
Index '[ShelleyBlock proto era] x
-> ExtLedgerCfg x
-> BlockQuery x 'QFTraverseTables result
-> ReadOnlyForker' m (HardForkBlock '[ShelleyBlock proto era])
-> m result
answerBlockQueryHFTraverse = \case
    Index '[ShelleyBlock proto era] x
IZ -> (TxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era]))
 -> TxOut era)
-> (TxIn (LedgerState (HardForkBlock '[ShelleyBlock proto era]))
    -> TxIn)
-> (forall result'.
    BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
    -> TxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era]))
    -> Bool)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> ReadOnlyForker' m (HardForkBlock '[ShelleyBlock proto era])
-> m result
forall proto era (m :: * -> *) result blk.
(ShelleyCompatible proto era, Ord (TxIn (LedgerState blk)),
 Eq (TxOut (LedgerState blk)), MemPack (TxIn (LedgerState blk)),
 IndexedMemPack (LedgerState blk EmptyMK) (TxOut (LedgerState blk)),
 Monad m) =>
(TxOut (LedgerState blk) -> TxOut era)
-> (TxIn (LedgerState blk) -> TxIn)
-> (forall result'.
    BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
    -> TxOut (LedgerState blk) -> Bool)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> ReadOnlyForker' m blk
-> m result
answerShelleyTraversingQueries
      TxOut era -> TxOut era
TxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era]))
-> TxOut era
forall a. a -> a
id
      (Index '[ShelleyBlock proto era] (ShelleyBlock proto era)
-> CanonicalTxIn '[ShelleyBlock proto era]
-> TxIn (LedgerState (ShelleyBlock proto era))
forall (xs :: [*]) x.
HasCanonicalTxIn xs =>
Index xs x -> CanonicalTxIn xs -> TxIn (LedgerState x)
forall x.
Index '[ShelleyBlock proto era] x
-> CanonicalTxIn '[ShelleyBlock proto era] -> TxIn (LedgerState x)
ejectCanonicalTxIn Index '[ShelleyBlock proto era] (ShelleyBlock proto era)
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ)
      (forall (xs :: [*]) x result.
BlockSupportsHFLedgerQuery xs =>
Index xs x
-> BlockQuery x 'QFTraverseTables result
-> TxOut (LedgerState (HardForkBlock xs))
-> Bool
queryLedgerGetTraversingFilter @('[ShelleyBlock proto era]) Index '[ShelleyBlock proto era] (ShelleyBlock proto era)
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ)
    IS Index xs' x
idx -> case Index xs' x
idx of {}

  queryLedgerGetTraversingFilter :: forall x result.
Index '[ShelleyBlock proto era] x
-> BlockQuery x 'QFTraverseTables result
-> TxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era]))
-> Bool
queryLedgerGetTraversingFilter = \case
    Index '[ShelleyBlock proto era] x
IZ -> BlockQuery x 'QFTraverseTables result
-> TxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era]))
-> Bool
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> TxOut (LedgerState (ShelleyBlock Any era)) -> Bool
forall proto era proto' era' result.
(ShelleyBasedEra era, ShelleyBasedEra era') =>
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> TxOut (LedgerState (ShelleyBlock proto' era')) -> Bool
shelleyQFTraverseTablesPredicate
    IS Index xs' x
idx -> case Index xs' x
idx of {}

instance (txout ~ SL.TxOut era, MemPack txout)
      => IndexedMemPack (LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK) txout where
  indexedTypeName :: LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
-> String
indexedTypeName LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
_ = forall a. MemPack a => String
typeName @txout
  indexedPackedByteCount :: LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
-> txout -> Int
indexedPackedByteCount LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
_ = txout -> Int
forall a. MemPack a => a -> Int
packedByteCount
  indexedPackM :: forall s.
LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
-> txout -> Pack s ()
indexedPackM LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
_ = txout -> Pack s ()
forall s. txout -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM
  indexedUnpackM :: forall b.
Buffer b =>
LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
-> Unpack b txout
indexedUnpackM LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
_ = Unpack b txout
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b txout
unpackM

instance ShelleyCompatible proto era
         => SerializeTablesWithHint (LedgerState (HardForkBlock '[ShelleyBlock proto era])) where
  encodeTablesWithHint :: LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
                       -> LedgerTables (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK
                       -> Encoding
  encodeTablesWithHint :: LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
-> LedgerTables
     (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK
-> Encoding
encodeTablesWithHint (HardForkLedgerState (HardForkState Telescope
  (K Past)
  (Current (Flip LedgerState EmptyMK))
  '[ShelleyBlock proto era]
idx)) (LedgerTables (ValuesMK Map
  (TxIn (LedgerState (HardForkBlock '[ShelleyBlock proto era])))
  (TxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era])))
tbs)) =
    let
      np :: NP (f -.-> K Encoding) '[x]
np = ((f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> K Encoding x) -> (-.->) f (K Encoding) x)
-> (f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall a b. (a -> b) -> a -> b
$ K Encoding x -> f x -> K Encoding x
forall a b. a -> b -> a
const (K Encoding x -> f x -> K Encoding x)
-> K Encoding x -> f x -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Encoding -> K Encoding x
forall k a (b :: k). a -> K a b
K Encoding
encOne) (-.->) f (K Encoding) x
-> NP (f -.-> K Encoding) '[] -> NP (f -.-> K Encoding) '[x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP (f -.-> K Encoding) '[]
forall {k} (f :: k -> *). NP f '[]
Nil
    in NS (K Encoding) '[ShelleyBlock proto era] -> CollapseTo NS Encoding
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K Encoding) '[ShelleyBlock proto era]
 -> CollapseTo NS Encoding)
-> NS (K Encoding) '[ShelleyBlock proto era]
-> CollapseTo NS Encoding
forall a b. (a -> b) -> a -> b
$ Prod
  NS
  (Current (Flip LedgerState EmptyMK) -.-> K Encoding)
  '[ShelleyBlock proto era]
-> NS
     (Current (Flip LedgerState EmptyMK)) '[ShelleyBlock proto era]
-> NS (K Encoding) '[ShelleyBlock proto era]
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NS (f -.-> g) xs -> NS f xs -> NS g xs
hap Prod
  NS
  (Current (Flip LedgerState EmptyMK) -.-> K Encoding)
  '[ShelleyBlock proto era]
NP
  (Current (Flip LedgerState EmptyMK) -.-> K Encoding)
  '[ShelleyBlock proto era]
forall {f :: * -> *} {x}. NP (f -.-> K Encoding) '[x]
np (NS (Current (Flip LedgerState EmptyMK)) '[ShelleyBlock proto era]
 -> NS (K Encoding) '[ShelleyBlock proto era])
-> NS
     (Current (Flip LedgerState EmptyMK)) '[ShelleyBlock proto era]
-> NS (K Encoding) '[ShelleyBlock proto era]
forall a b. (a -> b) -> a -> b
$ Telescope
  (K Past)
  (Current (Flip LedgerState EmptyMK))
  '[ShelleyBlock proto era]
-> NS
     (Current (Flip LedgerState EmptyMK)) '[ShelleyBlock proto era]
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Telescope.tip Telescope
  (K Past)
  (Current (Flip LedgerState EmptyMK))
  '[ShelleyBlock proto era]
idx
   where
     encOne :: Encoding
     encOne :: Encoding
encOne = Version -> Encoding -> Encoding
toPlainEncoding (forall era. Era era => Version
SL.eraProtVerLow @era) (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ (CanonicalTxIn '[ShelleyBlock proto era] -> Encoding)
-> (TxOut era -> Encoding)
-> Map (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era)
-> Encoding
forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap CanonicalTxIn '[ShelleyBlock proto era] -> Encoding
forall a. MemPack a => a -> Encoding
encodeMemPack TxOut era -> Encoding
forall a. MemPack a => a -> Encoding
encodeMemPack Map
  (TxIn (LedgerState (HardForkBlock '[ShelleyBlock proto era])))
  (TxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era])))
Map (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era)
tbs

  decodeTablesWithHint :: forall s. LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
                    -> Decoder s (LedgerTables (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
  decodeTablesWithHint :: forall s.
LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
decodeTablesWithHint (HardForkLedgerState (HardForkState Telescope
  (K Past)
  (Current (Flip LedgerState EmptyMK))
  '[ShelleyBlock proto era]
idx)) =
    let
      np :: NP
  (Current (Flip LedgerState EmptyMK)
   -.-> (Decoder s
         :.: K (LedgerTables
                  (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)))
  '[ShelleyBlock proto era]
np = ((Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
      (ShelleyBlock proto era))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
     (ShelleyBlock proto era)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
  -> (:.:)
       (Decoder s)
       (K (LedgerTables
             (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
       (ShelleyBlock proto era))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (Decoder s
       :.: K (LedgerTables
                (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
      (ShelleyBlock proto era))
-> (Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
    -> (:.:)
         (Decoder s)
         (K (LedgerTables
               (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
         (ShelleyBlock proto era))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
     (ShelleyBlock proto era)
forall a b. (a -> b) -> a -> b
$ Decoder
  s
  (K (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
     (ShelleyBlock proto era))
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
     (ShelleyBlock proto era)
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder
   s
   (K (LedgerTables
         (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
      (ShelleyBlock proto era))
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
      (ShelleyBlock proto era))
-> (Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
    -> Decoder
         s
         (K (LedgerTables
               (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
            (ShelleyBlock proto era)))
-> Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
     (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerTables
   (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK
 -> K (LedgerTables
         (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
      (ShelleyBlock proto era))
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
        (ShelleyBlock proto era))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerTables
  (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK
-> K (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
     (ShelleyBlock proto era)
forall k a (b :: k). a -> K a b
K (Decoder
   s
   (LedgerTables
      (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
 -> Decoder
      s
      (K (LedgerTables
            (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
         (ShelleyBlock proto era)))
-> (Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
    -> Decoder
         s
         (LedgerTables
            (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
-> Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
        (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
getOne (LedgerState (ShelleyBlock proto era) EmptyMK
 -> Decoder
      s
      (LedgerTables
         (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
-> (Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
    -> LedgerState (ShelleyBlock proto era) EmptyMK)
-> Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState EmptyMK (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era) EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip (Flip LedgerState EmptyMK (ShelleyBlock proto era)
 -> LedgerState (ShelleyBlock proto era) EmptyMK)
-> (Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
    -> Flip LedgerState EmptyMK (ShelleyBlock proto era))
-> Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current (Flip LedgerState EmptyMK) (ShelleyBlock proto era)
-> Flip LedgerState EmptyMK (ShelleyBlock proto era)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState) (-.->)
  (Current (Flip LedgerState EmptyMK))
  (Decoder s
   :.: K (LedgerTables
            (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
  (ShelleyBlock proto era)
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)))
     '[]
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)))
     '[ShelleyBlock proto era]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP
  (Current (Flip LedgerState EmptyMK)
   -.-> (Decoder s
         :.: K (LedgerTables
                  (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)))
  '[]
forall {k} (f :: k -> *). NP f '[]
Nil
    in NS
  (K (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
  '[ShelleyBlock proto era]
-> LedgerTables
     (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK
NS
  (K (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
  '[ShelleyBlock proto era]
-> CollapseTo
     NS
     (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS
   (K (LedgerTables
         (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
   '[ShelleyBlock proto era]
 -> LedgerTables
      (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
-> Decoder
     s
     (NS
        (K (LedgerTables
              (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
        '[ShelleyBlock proto era])
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NS
  (Decoder s
   :.: K (LedgerTables
            (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
  '[ShelleyBlock proto era]
-> Decoder
     s
     (NS
        (K (LedgerTables
              (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
        '[ShelleyBlock proto era])
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
(SListIN NS xs, Applicative f) =>
NS (f :.: g) xs -> f (NS g xs)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
       (g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
hsequence' (NS
   (Decoder s
    :.: K (LedgerTables
             (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
   '[ShelleyBlock proto era]
 -> Decoder
      s
      (NS
         (K (LedgerTables
               (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
         '[ShelleyBlock proto era]))
-> NS
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
     '[ShelleyBlock proto era]
-> Decoder
     s
     (NS
        (K (LedgerTables
              (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
        '[ShelleyBlock proto era])
forall a b. (a -> b) -> a -> b
$ Prod
  NS
  (Current (Flip LedgerState EmptyMK)
   -.-> (Decoder s
         :.: K (LedgerTables
                  (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)))
  '[ShelleyBlock proto era]
-> NS
     (Current (Flip LedgerState EmptyMK)) '[ShelleyBlock proto era]
-> NS
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
     '[ShelleyBlock proto era]
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NS (f -.-> g) xs -> NS f xs -> NS g xs
hap Prod
  NS
  (Current (Flip LedgerState EmptyMK)
   -.-> (Decoder s
         :.: K (LedgerTables
                  (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)))
  '[ShelleyBlock proto era]
NP
  (Current (Flip LedgerState EmptyMK)
   -.-> (Decoder s
         :.: K (LedgerTables
                  (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)))
  '[ShelleyBlock proto era]
np (NS (Current (Flip LedgerState EmptyMK)) '[ShelleyBlock proto era]
 -> NS
      (Decoder s
       :.: K (LedgerTables
                (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
      '[ShelleyBlock proto era])
-> NS
     (Current (Flip LedgerState EmptyMK)) '[ShelleyBlock proto era]
-> NS
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK))
     '[ShelleyBlock proto era]
forall a b. (a -> b) -> a -> b
$ Telescope
  (K Past)
  (Current (Flip LedgerState EmptyMK))
  '[ShelleyBlock proto era]
-> NS
     (Current (Flip LedgerState EmptyMK)) '[ShelleyBlock proto era]
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Telescope.tip Telescope
  (K Past)
  (Current (Flip LedgerState EmptyMK))
  '[ShelleyBlock proto era]
idx)
   where
     getOne :: LedgerState (ShelleyBlock proto era) EmptyMK
            -> Decoder s (LedgerTables (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
     getOne :: LedgerState (ShelleyBlock proto era) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
getOne LedgerState (ShelleyBlock proto era) EmptyMK
st =
       let certInterns :: Interns (Credential 'Staking)
certInterns =
             Map (Credential 'Staking) UMElem -> Interns (Credential 'Staking)
forall k a. Ord k => Map k a -> Interns k
internsFromMap
             (Map (Credential 'Staking) UMElem -> Interns (Credential 'Staking))
-> Map (Credential 'Staking) UMElem
-> Interns (Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era) EmptyMK -> NewEpochState era
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState LedgerState (ShelleyBlock proto era) EmptyMK
st
               NewEpochState era
-> Getting
     (Map (Credential 'Staking) UMElem)
     (NewEpochState era)
     (Map (Credential 'Staking) UMElem)
-> Map (Credential 'Staking) UMElem
forall s a. s -> Getting a s a -> a
^. (EpochState era
 -> Const (Map (Credential 'Staking) UMElem) (EpochState era))
-> NewEpochState era
-> Const (Map (Credential 'Staking) UMElem) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
SL.nesEsL
                ((EpochState era
  -> Const (Map (Credential 'Staking) UMElem) (EpochState era))
 -> NewEpochState era
 -> Const (Map (Credential 'Staking) UMElem) (NewEpochState era))
-> ((Map (Credential 'Staking) UMElem
     -> Const
          (Map (Credential 'Staking) UMElem)
          (Map (Credential 'Staking) UMElem))
    -> EpochState era
    -> Const (Map (Credential 'Staking) UMElem) (EpochState era))
-> Getting
     (Map (Credential 'Staking) UMElem)
     (NewEpochState era)
     (Map (Credential 'Staking) UMElem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era
 -> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
-> EpochState era
-> Const (Map (Credential 'Staking) UMElem) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
SL.esLStateL
                ((LedgerState era
  -> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
 -> EpochState era
 -> Const (Map (Credential 'Staking) UMElem) (EpochState era))
-> ((Map (Credential 'Staking) UMElem
     -> Const
          (Map (Credential 'Staking) UMElem)
          (Map (Credential 'Staking) UMElem))
    -> LedgerState era
    -> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
-> (Map (Credential 'Staking) UMElem
    -> Const
         (Map (Credential 'Staking) UMElem)
         (Map (Credential 'Staking) UMElem))
-> EpochState era
-> Const (Map (Credential 'Staking) UMElem) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era
 -> Const (Map (Credential 'Staking) UMElem) (CertState era))
-> LedgerState era
-> Const (Map (Credential 'Staking) UMElem) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
SL.lsCertStateL
                ((CertState era
  -> Const (Map (Credential 'Staking) UMElem) (CertState era))
 -> LedgerState era
 -> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
-> ((Map (Credential 'Staking) UMElem
     -> Const
          (Map (Credential 'Staking) UMElem)
          (Map (Credential 'Staking) UMElem))
    -> CertState era
    -> Const (Map (Credential 'Staking) UMElem) (CertState era))
-> (Map (Credential 'Staking) UMElem
    -> Const
         (Map (Credential 'Staking) UMElem)
         (Map (Credential 'Staking) UMElem))
-> LedgerState era
-> Const (Map (Credential 'Staking) UMElem) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era
 -> Const (Map (Credential 'Staking) UMElem) (DState era))
-> CertState era
-> Const (Map (Credential 'Staking) UMElem) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
SL.certDStateL
                ((DState era
  -> Const (Map (Credential 'Staking) UMElem) (DState era))
 -> CertState era
 -> Const (Map (Credential 'Staking) UMElem) (CertState era))
-> ((Map (Credential 'Staking) UMElem
     -> Const
          (Map (Credential 'Staking) UMElem)
          (Map (Credential 'Staking) UMElem))
    -> DState era
    -> Const (Map (Credential 'Staking) UMElem) (DState era))
-> (Map (Credential 'Staking) UMElem
    -> Const
         (Map (Credential 'Staking) UMElem)
         (Map (Credential 'Staking) UMElem))
-> CertState era
-> Const (Map (Credential 'Staking) UMElem) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> Const (Map (Credential 'Staking) UMElem) UMap)
-> DState era
-> Const (Map (Credential 'Staking) UMElem) (DState era)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
SL.dsUnifiedL
                ((UMap -> Const (Map (Credential 'Staking) UMElem) UMap)
 -> DState era
 -> Const (Map (Credential 'Staking) UMElem) (DState era))
-> ((Map (Credential 'Staking) UMElem
     -> Const
          (Map (Credential 'Staking) UMElem)
          (Map (Credential 'Staking) UMElem))
    -> UMap -> Const (Map (Credential 'Staking) UMElem) UMap)
-> (Map (Credential 'Staking) UMElem
    -> Const
         (Map (Credential 'Staking) UMElem)
         (Map (Credential 'Staking) UMElem))
-> DState era
-> Const (Map (Credential 'Staking) UMElem) (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'Staking) UMElem
 -> Const
      (Map (Credential 'Staking) UMElem)
      (Map (Credential 'Staking) UMElem))
-> UMap -> Const (Map (Credential 'Staking) UMElem) UMap
Lens' UMap (Map (Credential 'Staking) UMElem)
SL.umElemsL
       in ValuesMK
  (TxIn (LedgerState (HardForkBlock '[ShelleyBlock proto era])))
  (TxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era])))
-> LedgerTables
     (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK
ValuesMK (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era)
-> LedgerTables
     (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK
forall (l :: MapKind -> *) (mk :: MapKind).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (ValuesMK (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era)
 -> LedgerTables
      (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
-> (Map (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era)
    -> ValuesMK (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era))
-> Map (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era)
-> LedgerTables
     (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era)
-> ValuesMK (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era)
forall k v. Map k v -> ValuesMK k v
ValuesMK (Map (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era)
 -> LedgerTables
      (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
-> Decoder
     s (Map (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era))
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock '[ShelleyBlock proto era])) ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. Era era => Decoder s t -> Decoder s t
SL.eraDecoder @era (Decoder s (CanonicalTxIn '[ShelleyBlock proto era])
-> Decoder s (TxOut era)
-> Decoder
     s (Map (CanonicalTxIn '[ShelleyBlock proto era]) (TxOut era))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s (CanonicalTxIn '[ShelleyBlock proto era])
forall a s. MemPack a => Decoder s a
decodeMemPack (Share (TxOut era) -> Decoder s (TxOut era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share (TxOut era) -> Decoder s (TxOut era)
decShareCBOR Share (TxOut era)
Interns (Credential 'Staking)
certInterns))