{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DisambiguateRecordFields   #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Shelley.Ledger.Ledger (
    ShelleyLedgerError (..)
  , ShelleyBasedEra
  , ShelleyTip (..)
  , shelleyTipToPoint
  , shelleyLedgerTipPoint
  , ShelleyTransition(..)
  , LedgerState (..)
  , Ticked(..)
    -- * Ledger config
  , ShelleyLedgerConfig (..)
  , shelleyLedgerGenesis
  , mkShelleyLedgerConfig
  , shelleyEraParams
  , shelleyEraParamsNeverHardForks
    -- * Auxiliary
  , getPParams
    -- * Serialisation
  , encodeShelleyAnnTip
  , decodeShelleyAnnTip
  , decodeShelleyLedgerState
  , encodeShelleyLedgerState
  , encodeShelleyHeaderState
  ) where

import           Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as CBOR
import           Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import           Codec.Serialise (decode, encode)
import           Control.Monad.Except
import           Data.Functor.Identity
import           Data.Word
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks (..))

import           Cardano.Binary (FromCBOR (..), ToCBOR (..), enforceSize)
import           Cardano.Slotting.EpochInfo

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime.WallClock.Types
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Forecast
import           Ouroboros.Consensus.HardFork.Abstract
import qualified Ouroboros.Consensus.HardFork.History as HardFork
import           Ouroboros.Consensus.HardFork.History.Util
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.CommonProtocolParams
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.Util ((...:), (..:))
import           Ouroboros.Consensus.Util.CBOR (decodeWithOrigin,
                     encodeWithOrigin)
import           Ouroboros.Consensus.Util.Versioned

import qualified Shelley.Spec.Ledger.API as SL
import qualified Shelley.Spec.Ledger.STS.Chain as SL (PredicateFailure)

import           Ouroboros.Consensus.Shelley.Eras (EraCrypto)
import           Ouroboros.Consensus.Shelley.Ledger.Block
import           Ouroboros.Consensus.Shelley.Ledger.Config
import           Ouroboros.Consensus.Shelley.Ledger.TPraos ()
import           Ouroboros.Consensus.Shelley.Protocol (MaxMajorProtVer (..),
                     Ticked (TickedPraosLedgerView))
import           Ouroboros.Consensus.Shelley.Protocol.Util (isNewEpoch)

{-------------------------------------------------------------------------------
  Ledger errors
-------------------------------------------------------------------------------}

newtype ShelleyLedgerError era = BBodyError (SL.BlockTransitionError era)
  deriving ((forall x.
 ShelleyLedgerError era -> Rep (ShelleyLedgerError era) x)
-> (forall x.
    Rep (ShelleyLedgerError era) x -> ShelleyLedgerError era)
-> Generic (ShelleyLedgerError era)
forall x. Rep (ShelleyLedgerError era) x -> ShelleyLedgerError era
forall x. ShelleyLedgerError era -> Rep (ShelleyLedgerError era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyLedgerError era) x -> ShelleyLedgerError era
forall era x.
ShelleyLedgerError era -> Rep (ShelleyLedgerError era) x
$cto :: forall era x.
Rep (ShelleyLedgerError era) x -> ShelleyLedgerError era
$cfrom :: forall era x.
ShelleyLedgerError era -> Rep (ShelleyLedgerError era) x
Generic)

deriving instance ShelleyBasedEra era => Eq   (ShelleyLedgerError era)
deriving instance ShelleyBasedEra era => Show (ShelleyLedgerError era)

instance ShelleyBasedEra era => NoThunks (ShelleyLedgerError era)

{-------------------------------------------------------------------------------
  Config
-------------------------------------------------------------------------------}

data ShelleyLedgerConfig era = ShelleyLedgerConfig {
      ShelleyLedgerConfig era -> CompactGenesis era
shelleyLedgerCompactGenesis :: !(CompactGenesis era)
      -- | Derived from 'shelleyLedgerGenesis' but we store a cached version
      -- because it used very often.
    , ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals        :: !SL.Globals
    }
  deriving ((forall x.
 ShelleyLedgerConfig era -> Rep (ShelleyLedgerConfig era) x)
-> (forall x.
    Rep (ShelleyLedgerConfig era) x -> ShelleyLedgerConfig era)
-> Generic (ShelleyLedgerConfig era)
forall x.
Rep (ShelleyLedgerConfig era) x -> ShelleyLedgerConfig era
forall x.
ShelleyLedgerConfig era -> Rep (ShelleyLedgerConfig era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyLedgerConfig era) x -> ShelleyLedgerConfig era
forall era x.
ShelleyLedgerConfig era -> Rep (ShelleyLedgerConfig era) x
$cto :: forall era x.
Rep (ShelleyLedgerConfig era) x -> ShelleyLedgerConfig era
$cfrom :: forall era x.
ShelleyLedgerConfig era -> Rep (ShelleyLedgerConfig era) x
Generic, Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
Proxy (ShelleyLedgerConfig era) -> String
(Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo))
-> (Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo))
-> (Proxy (ShelleyLedgerConfig era) -> String)
-> NoThunks (ShelleyLedgerConfig era)
forall era.
ShelleyBasedEra era =>
Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
forall era.
ShelleyBasedEra era =>
Proxy (ShelleyLedgerConfig era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ShelleyLedgerConfig era) -> String
$cshowTypeOf :: forall era.
ShelleyBasedEra era =>
Proxy (ShelleyLedgerConfig era) -> String
wNoThunks :: Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
ShelleyBasedEra era =>
Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
noThunks :: Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
ShelleyBasedEra era =>
Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
NoThunks)

shelleyLedgerGenesis :: ShelleyLedgerConfig era -> SL.ShelleyGenesis era
shelleyLedgerGenesis :: ShelleyLedgerConfig era -> ShelleyGenesis era
shelleyLedgerGenesis = CompactGenesis era -> ShelleyGenesis era
forall era. CompactGenesis era -> ShelleyGenesis era
getCompactGenesis (CompactGenesis era -> ShelleyGenesis era)
-> (ShelleyLedgerConfig era -> CompactGenesis era)
-> ShelleyLedgerConfig era
-> ShelleyGenesis era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerConfig era -> CompactGenesis era
forall era. ShelleyLedgerConfig era -> CompactGenesis era
shelleyLedgerCompactGenesis

shelleyEraParams ::
     HardFork.SafeBeforeEpoch
  -> SL.ShelleyGenesis era
  -> HardFork.EraParams
shelleyEraParams :: SafeBeforeEpoch -> ShelleyGenesis era -> EraParams
shelleyEraParams SafeBeforeEpoch
safeBeforeEpoch ShelleyGenesis era
genesis = EraParams :: EpochSize -> SlotLength -> SafeZone -> EraParams
HardFork.EraParams {
      eraEpochSize :: EpochSize
eraEpochSize  = ShelleyGenesis era -> EpochSize
forall era. ShelleyGenesis era -> EpochSize
SL.sgEpochLength ShelleyGenesis era
genesis
    , eraSlotLength :: SlotLength
eraSlotLength = NominalDiffTime -> SlotLength
mkSlotLength (NominalDiffTime -> SlotLength) -> NominalDiffTime -> SlotLength
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> NominalDiffTime
forall era. ShelleyGenesis era -> NominalDiffTime
SL.sgSlotLength ShelleyGenesis era
genesis
    , eraSafeZone :: SafeZone
eraSafeZone   = Word64 -> SafeBeforeEpoch -> SafeZone
HardFork.StandardSafeZone
                        Word64
stabilityWindow
                        SafeBeforeEpoch
safeBeforeEpoch
    }
  where
    stabilityWindow :: Word64
stabilityWindow =
        Word64 -> ActiveSlotCoeff -> Word64
SL.computeStabilityWindow
          (ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgSecurityParam ShelleyGenesis era
genesis)
          (ShelleyGenesis era -> ActiveSlotCoeff
forall era. ShelleyGenesis era -> ActiveSlotCoeff
SL.sgActiveSlotCoeff ShelleyGenesis era
genesis)

-- | Separate variant of 'shelleyEraParams' to be used for a Shelley-only chain.
shelleyEraParamsNeverHardForks :: SL.ShelleyGenesis era -> HardFork.EraParams
shelleyEraParamsNeverHardForks :: ShelleyGenesis era -> EraParams
shelleyEraParamsNeverHardForks ShelleyGenesis era
genesis = EraParams :: EpochSize -> SlotLength -> SafeZone -> EraParams
HardFork.EraParams {
      eraEpochSize :: EpochSize
eraEpochSize  = ShelleyGenesis era -> EpochSize
forall era. ShelleyGenesis era -> EpochSize
SL.sgEpochLength ShelleyGenesis era
genesis
    , eraSlotLength :: SlotLength
eraSlotLength = NominalDiffTime -> SlotLength
mkSlotLength (NominalDiffTime -> SlotLength) -> NominalDiffTime -> SlotLength
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> NominalDiffTime
forall era. ShelleyGenesis era -> NominalDiffTime
SL.sgSlotLength ShelleyGenesis era
genesis
    , eraSafeZone :: SafeZone
eraSafeZone   = SafeZone
HardFork.UnsafeIndefiniteSafeZone
    }

mkShelleyLedgerConfig
  :: SL.ShelleyGenesis era
  -> EpochInfo Identity
  -> MaxMajorProtVer
  -> ShelleyLedgerConfig era
mkShelleyLedgerConfig :: ShelleyGenesis era
-> EpochInfo Identity -> MaxMajorProtVer -> ShelleyLedgerConfig era
mkShelleyLedgerConfig ShelleyGenesis era
genesis EpochInfo Identity
epochInfo (MaxMajorProtVer Natural
maxMajorPV) =
    ShelleyLedgerConfig :: forall era.
CompactGenesis era -> Globals -> ShelleyLedgerConfig era
ShelleyLedgerConfig {
        shelleyLedgerCompactGenesis :: CompactGenesis era
shelleyLedgerCompactGenesis = ShelleyGenesis era -> CompactGenesis era
forall era. ShelleyGenesis era -> CompactGenesis era
compactGenesis ShelleyGenesis era
genesis
      , shelleyLedgerGlobals :: Globals
shelleyLedgerGlobals        = ShelleyGenesis era -> EpochInfo Identity -> Natural -> Globals
forall era.
ShelleyGenesis era -> EpochInfo Identity -> Natural -> Globals
SL.mkShelleyGlobals ShelleyGenesis era
genesis EpochInfo Identity
epochInfo Natural
maxMajorPV
      }

type instance LedgerCfg (LedgerState (ShelleyBlock era)) = ShelleyLedgerConfig era

{-------------------------------------------------------------------------------
  LedgerState
-------------------------------------------------------------------------------}

data ShelleyTip era = ShelleyTip {
      ShelleyTip era -> SlotNo
shelleyTipSlotNo  :: !SlotNo
    , ShelleyTip era -> BlockNo
shelleyTipBlockNo :: !BlockNo
    , ShelleyTip era -> HeaderHash (ShelleyBlock era)
shelleyTipHash    :: !(HeaderHash (ShelleyBlock era))
    }
  deriving (ShelleyTip era -> ShelleyTip era -> Bool
(ShelleyTip era -> ShelleyTip era -> Bool)
-> (ShelleyTip era -> ShelleyTip era -> Bool)
-> Eq (ShelleyTip era)
forall era. ShelleyTip era -> ShelleyTip era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyTip era -> ShelleyTip era -> Bool
$c/= :: forall era. ShelleyTip era -> ShelleyTip era -> Bool
== :: ShelleyTip era -> ShelleyTip era -> Bool
$c== :: forall era. ShelleyTip era -> ShelleyTip era -> Bool
Eq, Int -> ShelleyTip era -> ShowS
[ShelleyTip era] -> ShowS
ShelleyTip era -> String
(Int -> ShelleyTip era -> ShowS)
-> (ShelleyTip era -> String)
-> ([ShelleyTip era] -> ShowS)
-> Show (ShelleyTip era)
forall era. Int -> ShelleyTip era -> ShowS
forall era. [ShelleyTip era] -> ShowS
forall era. ShelleyTip era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyTip era] -> ShowS
$cshowList :: forall era. [ShelleyTip era] -> ShowS
show :: ShelleyTip era -> String
$cshow :: forall era. ShelleyTip era -> String
showsPrec :: Int -> ShelleyTip era -> ShowS
$cshowsPrec :: forall era. Int -> ShelleyTip era -> ShowS
Show, (forall x. ShelleyTip era -> Rep (ShelleyTip era) x)
-> (forall x. Rep (ShelleyTip era) x -> ShelleyTip era)
-> Generic (ShelleyTip era)
forall x. Rep (ShelleyTip era) x -> ShelleyTip era
forall x. ShelleyTip era -> Rep (ShelleyTip era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyTip era) x -> ShelleyTip era
forall era x. ShelleyTip era -> Rep (ShelleyTip era) x
$cto :: forall era x. Rep (ShelleyTip era) x -> ShelleyTip era
$cfrom :: forall era x. ShelleyTip era -> Rep (ShelleyTip era) x
Generic, Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
Proxy (ShelleyTip era) -> String
(Context -> ShelleyTip era -> IO (Maybe ThunkInfo))
-> (Context -> ShelleyTip era -> IO (Maybe ThunkInfo))
-> (Proxy (ShelleyTip era) -> String)
-> NoThunks (ShelleyTip era)
forall era. Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
forall era. Proxy (ShelleyTip era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ShelleyTip era) -> String
$cshowTypeOf :: forall era. Proxy (ShelleyTip era) -> String
wNoThunks :: Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
noThunks :: Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era. Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
NoThunks)

shelleyTipToPoint :: WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
shelleyTipToPoint :: WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
shelleyTipToPoint WithOrigin (ShelleyTip era)
Origin          = Point (ShelleyBlock era)
forall block. Point block
GenesisPoint
shelleyTipToPoint (NotOrigin ShelleyTip era
tip) = SlotNo -> HeaderHash (ShelleyBlock era) -> Point (ShelleyBlock era)
forall block. SlotNo -> HeaderHash block -> Point block
BlockPoint (ShelleyTip era -> SlotNo
forall era. ShelleyTip era -> SlotNo
shelleyTipSlotNo ShelleyTip era
tip)
                                               (ShelleyTip era -> HeaderHash (ShelleyBlock era)
forall era. ShelleyTip era -> HeaderHash (ShelleyBlock era)
shelleyTipHash   ShelleyTip era
tip)

data instance LedgerState (ShelleyBlock era) = ShelleyLedgerState {
      LedgerState (ShelleyBlock era) -> WithOrigin (ShelleyTip era)
shelleyLedgerTip        :: !(WithOrigin (ShelleyTip era))
    , LedgerState (ShelleyBlock era) -> NewEpochState era
shelleyLedgerState      :: !(SL.NewEpochState era)
    , LedgerState (ShelleyBlock era) -> ShelleyTransition
shelleyLedgerTransition :: !ShelleyTransition
    }
  deriving ((forall x.
 LedgerState (ShelleyBlock era)
 -> Rep (LedgerState (ShelleyBlock era)) x)
-> (forall x.
    Rep (LedgerState (ShelleyBlock era)) x
    -> LedgerState (ShelleyBlock era))
-> Generic (LedgerState (ShelleyBlock era))
forall x.
Rep (LedgerState (ShelleyBlock era)) x
-> LedgerState (ShelleyBlock era)
forall x.
LedgerState (ShelleyBlock era)
-> Rep (LedgerState (ShelleyBlock era)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (LedgerState (ShelleyBlock era)) x
-> LedgerState (ShelleyBlock era)
forall era x.
LedgerState (ShelleyBlock era)
-> Rep (LedgerState (ShelleyBlock era)) x
$cto :: forall era x.
Rep (LedgerState (ShelleyBlock era)) x
-> LedgerState (ShelleyBlock era)
$cfrom :: forall era x.
LedgerState (ShelleyBlock era)
-> Rep (LedgerState (ShelleyBlock era)) x
Generic, Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
Proxy (LedgerState (ShelleyBlock era)) -> String
(Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo))
-> (Context
    -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo))
-> (Proxy (LedgerState (ShelleyBlock era)) -> String)
-> NoThunks (LedgerState (ShelleyBlock era))
forall era.
Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
forall era. Proxy (LedgerState (ShelleyBlock era)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (LedgerState (ShelleyBlock era)) -> String
$cshowTypeOf :: forall era. Proxy (LedgerState (ShelleyBlock era)) -> String
wNoThunks :: Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
NoThunks)

deriving instance ShelleyBasedEra era => Show (LedgerState (ShelleyBlock era))
deriving instance ShelleyBasedEra era => Eq   (LedgerState (ShelleyBlock era))

-- | Information required to determine the hard fork point from Shelley to the
-- next ledger
newtype ShelleyTransition = ShelleyTransitionInfo {
      -- | The number of blocks in this epoch past the voting deadline
      --
      -- We record this to make sure that we can tell the HFC about hard forks
      -- if and only if we are certain:
      --
      -- 1. Blocks that came in within an epoch after the 4k/f voting deadline
      --    are not relevant (10k/f - 2 * 3k/f).
      -- 2. Since there are slots between blocks, we are probably only sure that
      --    there will be no more relevant block when we have seen the first
      --    block after the deadline.
      -- 3. If we count how many blocks we have seen post deadline, and we have
      --    reached k of them, we know that that last pre-deadline block won't
      --    be rolled back anymore.
      -- 4. At this point we can look at the ledger state and see which
      --    proposals we accepted in the voting period, if any, and notify the
      --    HFC is one of them indicates a transition.
      ShelleyTransition -> Word32
shelleyAfterVoting :: Word32
    }
  deriving stock   (ShelleyTransition -> ShelleyTransition -> Bool
(ShelleyTransition -> ShelleyTransition -> Bool)
-> (ShelleyTransition -> ShelleyTransition -> Bool)
-> Eq ShelleyTransition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyTransition -> ShelleyTransition -> Bool
$c/= :: ShelleyTransition -> ShelleyTransition -> Bool
== :: ShelleyTransition -> ShelleyTransition -> Bool
$c== :: ShelleyTransition -> ShelleyTransition -> Bool
Eq, Int -> ShelleyTransition -> ShowS
[ShelleyTransition] -> ShowS
ShelleyTransition -> String
(Int -> ShelleyTransition -> ShowS)
-> (ShelleyTransition -> String)
-> ([ShelleyTransition] -> ShowS)
-> Show ShelleyTransition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyTransition] -> ShowS
$cshowList :: [ShelleyTransition] -> ShowS
show :: ShelleyTransition -> String
$cshow :: ShelleyTransition -> String
showsPrec :: Int -> ShelleyTransition -> ShowS
$cshowsPrec :: Int -> ShelleyTransition -> ShowS
Show, (forall x. ShelleyTransition -> Rep ShelleyTransition x)
-> (forall x. Rep ShelleyTransition x -> ShelleyTransition)
-> Generic ShelleyTransition
forall x. Rep ShelleyTransition x -> ShelleyTransition
forall x. ShelleyTransition -> Rep ShelleyTransition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShelleyTransition x -> ShelleyTransition
$cfrom :: forall x. ShelleyTransition -> Rep ShelleyTransition x
Generic)
  deriving newtype (Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
Proxy ShelleyTransition -> String
(Context -> ShelleyTransition -> IO (Maybe ThunkInfo))
-> (Context -> ShelleyTransition -> IO (Maybe ThunkInfo))
-> (Proxy ShelleyTransition -> String)
-> NoThunks ShelleyTransition
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ShelleyTransition -> String
$cshowTypeOf :: Proxy ShelleyTransition -> String
wNoThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
noThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
NoThunks)

shelleyLedgerTipPoint :: LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era)
shelleyLedgerTipPoint :: LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era)
shelleyLedgerTipPoint = WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
forall era. WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
shelleyTipToPoint (WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era))
-> (LedgerState (ShelleyBlock era) -> WithOrigin (ShelleyTip era))
-> LedgerState (ShelleyBlock era)
-> Point (ShelleyBlock era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock era) -> WithOrigin (ShelleyTip era)
forall era.
LedgerState (ShelleyBlock era) -> WithOrigin (ShelleyTip era)
shelleyLedgerTip

instance ShelleyBasedEra era => UpdateLedger (ShelleyBlock era)

{-------------------------------------------------------------------------------
  GetTip
-------------------------------------------------------------------------------}

instance GetTip (LedgerState (ShelleyBlock era)) where
  getTip :: LedgerState (ShelleyBlock era)
-> Point (LedgerState (ShelleyBlock era))
getTip = Point (ShelleyBlock era) -> Point (LedgerState (ShelleyBlock era))
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (ShelleyBlock era)
 -> Point (LedgerState (ShelleyBlock era)))
-> (LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era))
-> LedgerState (ShelleyBlock era)
-> Point (LedgerState (ShelleyBlock era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era)
forall era.
LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era)
shelleyLedgerTipPoint

instance GetTip (Ticked (LedgerState (ShelleyBlock era))) where
  getTip :: Ticked (LedgerState (ShelleyBlock era))
-> Point (Ticked (LedgerState (ShelleyBlock era)))
getTip = Point (ShelleyBlock era)
-> Point (Ticked (LedgerState (ShelleyBlock era)))
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (ShelleyBlock era)
 -> Point (Ticked (LedgerState (ShelleyBlock era))))
-> (Ticked (LedgerState (ShelleyBlock era))
    -> Point (ShelleyBlock era))
-> Ticked (LedgerState (ShelleyBlock era))
-> Point (Ticked (LedgerState (ShelleyBlock era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (ShelleyBlock era)) -> Point (ShelleyBlock era)
forall era.
Ticked (LedgerState (ShelleyBlock era)) -> Point (ShelleyBlock era)
untickedShelleyLedgerTipPoint

{-------------------------------------------------------------------------------
  Ticking
-------------------------------------------------------------------------------}

-- | Ticking only affects the state itself
data instance Ticked (LedgerState (ShelleyBlock era)) = TickedShelleyLedgerState {
      Ticked (LedgerState (ShelleyBlock era))
-> WithOrigin (ShelleyTip era)
untickedShelleyLedgerTip      :: !(WithOrigin (ShelleyTip era))
      -- | We are counting blocks within an epoch, this means:
      --
      -- 1. We are only incrementing this when /applying/ a block, not when ticking.
      -- 2. However, we count within an epoch, which is slot-based. So the count
      --    must be reset when /ticking/, not when applying a block.
    , Ticked (LedgerState (ShelleyBlock era)) -> ShelleyTransition
tickedShelleyLedgerTransition :: !ShelleyTransition
    , Ticked (LedgerState (ShelleyBlock era)) -> NewEpochState era
tickedShelleyLedgerState      :: !(SL.NewEpochState era)
    }
  deriving ((forall x.
 Ticked (LedgerState (ShelleyBlock era))
 -> Rep (Ticked (LedgerState (ShelleyBlock era))) x)
-> (forall x.
    Rep (Ticked (LedgerState (ShelleyBlock era))) x
    -> Ticked (LedgerState (ShelleyBlock era)))
-> Generic (Ticked (LedgerState (ShelleyBlock era)))
forall x.
Rep (Ticked (LedgerState (ShelleyBlock era))) x
-> Ticked (LedgerState (ShelleyBlock era))
forall x.
Ticked (LedgerState (ShelleyBlock era))
-> Rep (Ticked (LedgerState (ShelleyBlock era))) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (Ticked (LedgerState (ShelleyBlock era))) x
-> Ticked (LedgerState (ShelleyBlock era))
forall era x.
Ticked (LedgerState (ShelleyBlock era))
-> Rep (Ticked (LedgerState (ShelleyBlock era))) x
$cto :: forall era x.
Rep (Ticked (LedgerState (ShelleyBlock era))) x
-> Ticked (LedgerState (ShelleyBlock era))
$cfrom :: forall era x.
Ticked (LedgerState (ShelleyBlock era))
-> Rep (Ticked (LedgerState (ShelleyBlock era))) x
Generic, Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
Proxy (Ticked (LedgerState (ShelleyBlock era))) -> String
(Context
 -> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo))
-> (Context
    -> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo))
-> (Proxy (Ticked (LedgerState (ShelleyBlock era))) -> String)
-> NoThunks (Ticked (LedgerState (ShelleyBlock era)))
forall era.
Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
forall era.
Proxy (Ticked (LedgerState (ShelleyBlock era))) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (Ticked (LedgerState (ShelleyBlock era))) -> String
$cshowTypeOf :: forall era.
Proxy (Ticked (LedgerState (ShelleyBlock era))) -> String
wNoThunks :: Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
NoThunks)

untickedShelleyLedgerTipPoint ::
     Ticked (LedgerState (ShelleyBlock era))
  -> Point (ShelleyBlock era)
untickedShelleyLedgerTipPoint :: Ticked (LedgerState (ShelleyBlock era)) -> Point (ShelleyBlock era)
untickedShelleyLedgerTipPoint = WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
forall era. WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
shelleyTipToPoint (WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era))
-> (Ticked (LedgerState (ShelleyBlock era))
    -> WithOrigin (ShelleyTip era))
-> Ticked (LedgerState (ShelleyBlock era))
-> Point (ShelleyBlock era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (ShelleyBlock era))
-> WithOrigin (ShelleyTip era)
forall era.
Ticked (LedgerState (ShelleyBlock era))
-> WithOrigin (ShelleyTip era)
untickedShelleyLedgerTip

instance ShelleyBasedEra era => IsLedger (LedgerState (ShelleyBlock era)) where
  type LedgerErr (LedgerState (ShelleyBlock era)) = ShelleyLedgerError era

  applyChainTick :: LedgerCfg (LedgerState (ShelleyBlock era))
-> SlotNo
-> LedgerState (ShelleyBlock era)
-> Ticked (LedgerState (ShelleyBlock era))
applyChainTick LedgerCfg (LedgerState (ShelleyBlock era))
cfg SlotNo
slotNo ShelleyLedgerState{
                                shelleyLedgerTip
                              , shelleyLedgerState
                              , shelleyLedgerTransition
                              } =
      TickedShelleyLedgerState :: forall era.
WithOrigin (ShelleyTip era)
-> ShelleyTransition
-> NewEpochState era
-> Ticked (LedgerState (ShelleyBlock era))
TickedShelleyLedgerState {
          untickedShelleyLedgerTip :: WithOrigin (ShelleyTip era)
untickedShelleyLedgerTip =
            WithOrigin (ShelleyTip era)
shelleyLedgerTip
        , tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition =
            -- The voting resets each epoch
            if EpochInfo Identity -> WithOrigin SlotNo -> SlotNo -> Bool
isNewEpoch EpochInfo Identity
ei (ShelleyTip era -> SlotNo
forall era. ShelleyTip era -> SlotNo
shelleyTipSlotNo (ShelleyTip era -> SlotNo)
-> WithOrigin (ShelleyTip era) -> WithOrigin SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithOrigin (ShelleyTip era)
shelleyLedgerTip) SlotNo
slotNo then
              ShelleyTransitionInfo :: Word32 -> ShelleyTransition
ShelleyTransitionInfo { shelleyAfterVoting :: Word32
shelleyAfterVoting = Word32
0 }
            else
              ShelleyTransition
shelleyLedgerTransition
        , tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState =
            Globals -> NewEpochState era -> SlotNo -> NewEpochState era
forall era.
ApplyBlock era =>
Globals -> NewEpochState era -> SlotNo -> NewEpochState era
SL.applyTick
              Globals
globals
              NewEpochState era
shelleyLedgerState
              SlotNo
slotNo
        }
    where
      globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerCfg (LedgerState (ShelleyBlock era))
ShelleyLedgerConfig era
cfg

      ei :: EpochInfo Identity
      ei :: EpochInfo Identity
ei = Globals -> EpochInfo Identity
SL.epochInfo Globals
globals

instance ShelleyBasedEra era
      => ApplyBlock (LedgerState (ShelleyBlock era)) (ShelleyBlock era) where
  -- Note: in the Shelley ledger, the @CHAIN@ rule is used to apply a whole
  -- block. In consensus, we split up the application of a block to the ledger
  -- into separate steps that are performed together by 'applyExtLedgerState':
  --
  -- + 'applyChainTick': executes the @TICK@ transition
  -- + 'validateHeader':
  --    - 'validateEnvelope': executes the @chainChecks@
  --    - 'updateChainDepState': executes the @PRTCL@ transition
  -- + 'applyLedgerBlock': executes the @BBODY@ transition
  --
  applyLedgerBlock :: LedgerCfg (LedgerState (ShelleyBlock era))
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> Except
     (LedgerErr (LedgerState (ShelleyBlock era)))
     (LedgerState (ShelleyBlock era))
applyLedgerBlock =
      (Globals
 -> NewEpochState era
 -> Block era
 -> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era))
-> LedgerCfg (LedgerState (ShelleyBlock era))
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> ExceptT
     (ShelleyLedgerError era) Identity (LedgerState (ShelleyBlock era))
forall era (m :: * -> *).
(ShelleyBasedEra era, Monad m) =>
(Globals
 -> NewEpochState era -> Block era -> m (NewEpochState era))
-> LedgerConfig (ShelleyBlock era)
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> m (LedgerState (ShelleyBlock era))
applyHelper ((Globals
  -> NewEpochState era
  -> Block era
  -> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era))
 -> LedgerCfg (LedgerState (ShelleyBlock era))
 -> ShelleyBlock era
 -> Ticked (LedgerState (ShelleyBlock era))
 -> ExceptT
      (ShelleyLedgerError era) Identity (LedgerState (ShelleyBlock era)))
-> (Globals
    -> NewEpochState era
    -> Block era
    -> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era))
-> LedgerCfg (LedgerState (ShelleyBlock era))
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> ExceptT
     (ShelleyLedgerError era) Identity (LedgerState (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$
        -- Apply the BBODY transition using the ticked state
        (BlockTransitionError era -> ShelleyLedgerError era)
-> Except (BlockTransitionError era) (NewEpochState era)
-> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept BlockTransitionError era -> ShelleyLedgerError era
forall era. BlockTransitionError era -> ShelleyLedgerError era
BBodyError (Except (BlockTransitionError era) (NewEpochState era)
 -> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era))
-> (Globals
    -> NewEpochState era
    -> Block era
    -> Except (BlockTransitionError era) (NewEpochState era))
-> Globals
-> NewEpochState era
-> Block era
-> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era)
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: Globals
-> NewEpochState era
-> Block era
-> Except (BlockTransitionError era) (NewEpochState era)
forall era (m :: * -> *).
(ApplyBlock era, MonadError (BlockTransitionError era) m) =>
Globals -> NewEpochState era -> Block era -> m (NewEpochState era)
SL.applyBlock

  reapplyLedgerBlock :: LedgerCfg (LedgerState (ShelleyBlock era))
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> LedgerState (ShelleyBlock era)
reapplyLedgerBlock = Identity (LedgerState (ShelleyBlock era))
-> LedgerState (ShelleyBlock era)
forall a. Identity a -> a
runIdentity (Identity (LedgerState (ShelleyBlock era))
 -> LedgerState (ShelleyBlock era))
-> ((Globals
     -> NewEpochState era -> Block era -> Identity (NewEpochState era))
    -> ShelleyLedgerConfig era
    -> ShelleyBlock era
    -> Ticked (LedgerState (ShelleyBlock era))
    -> Identity (LedgerState (ShelleyBlock era)))
-> (Globals
    -> NewEpochState era -> Block era -> Identity (NewEpochState era))
-> ShelleyLedgerConfig era
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> LedgerState (ShelleyBlock era)
forall y z x0 x1 x2 x3.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> y) -> x0 -> x1 -> x2 -> x3 -> z
...:
      (Globals
 -> NewEpochState era -> Block era -> Identity (NewEpochState era))
-> ShelleyLedgerConfig era
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> Identity (LedgerState (ShelleyBlock era))
forall era (m :: * -> *).
(ShelleyBasedEra era, Monad m) =>
(Globals
 -> NewEpochState era -> Block era -> m (NewEpochState era))
-> LedgerConfig (ShelleyBlock era)
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> m (LedgerState (ShelleyBlock era))
applyHelper ((Globals
  -> NewEpochState era -> Block era -> Identity (NewEpochState era))
 -> ShelleyLedgerConfig era
 -> ShelleyBlock era
 -> Ticked (LedgerState (ShelleyBlock era))
 -> LedgerState (ShelleyBlock era))
-> (Globals
    -> NewEpochState era -> Block era -> Identity (NewEpochState era))
-> ShelleyLedgerConfig era
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> LedgerState (ShelleyBlock era)
forall a b. (a -> b) -> a -> b
$
        -- Reapply the BBODY transition using the ticked state
        NewEpochState era -> Identity (NewEpochState era)
forall a. a -> Identity a
Identity (NewEpochState era -> Identity (NewEpochState era))
-> (Globals -> NewEpochState era -> Block era -> NewEpochState era)
-> Globals
-> NewEpochState era
-> Block era
-> Identity (NewEpochState era)
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: Globals -> NewEpochState era -> Block era -> NewEpochState era
forall era.
ApplyBlock era =>
Globals -> NewEpochState era -> Block era -> NewEpochState era
SL.reapplyBlock

applyHelper ::
     (ShelleyBasedEra era, Monad m)
  => (SL.Globals -> SL.NewEpochState era -> SL.Block era -> m (SL.NewEpochState era))
  -> LedgerConfig (ShelleyBlock era)
  -> ShelleyBlock era
  -> Ticked (LedgerState (ShelleyBlock era))
  -> m (LedgerState (ShelleyBlock era))
applyHelper :: (Globals
 -> NewEpochState era -> Block era -> m (NewEpochState era))
-> LedgerConfig (ShelleyBlock era)
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> m (LedgerState (ShelleyBlock era))
applyHelper Globals -> NewEpochState era -> Block era -> m (NewEpochState era)
f LedgerConfig (ShelleyBlock era)
cfg ShelleyBlock era
blk TickedShelleyLedgerState{
                          tickedShelleyLedgerTransition
                        , tickedShelleyLedgerState
                        } = do
    NewEpochState era
newNewEpochState <- Globals -> NewEpochState era -> Block era -> m (NewEpochState era)
f Globals
globals NewEpochState era
tickedShelleyLedgerState (ShelleyBlock era -> Block era
forall era. ShelleyBlock era -> Block era
shelleyBlockRaw ShelleyBlock era
blk)

    LedgerState (ShelleyBlock era)
-> m (LedgerState (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return ShelleyLedgerState :: forall era.
WithOrigin (ShelleyTip era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerState (ShelleyBlock era)
ShelleyLedgerState {
        shelleyLedgerTip :: WithOrigin (ShelleyTip era)
shelleyLedgerTip = ShelleyTip era -> WithOrigin (ShelleyTip era)
forall t. t -> WithOrigin t
NotOrigin ShelleyTip :: forall era.
SlotNo
-> BlockNo -> HeaderHash (ShelleyBlock era) -> ShelleyTip era
ShelleyTip {
            shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo = ShelleyBlock era -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo   ShelleyBlock era
blk
          , shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo  = ShelleyBlock era -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot ShelleyBlock era
blk
          , shelleyTipHash :: HeaderHash (ShelleyBlock era)
shelleyTipHash    = ShelleyBlock era -> HeaderHash (ShelleyBlock era)
forall b. HasHeader b => b -> HeaderHash b
blockHash ShelleyBlock era
blk
          }
      , shelleyLedgerState :: NewEpochState era
shelleyLedgerState =
          NewEpochState era
newNewEpochState
      , shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransitionInfo :: Word32 -> ShelleyTransition
ShelleyTransitionInfo {
            shelleyAfterVoting :: Word32
shelleyAfterVoting =
              -- We count the number of blocks that have been applied after the
              -- voting deadline has passed.
              (if ShelleyBlock era -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot ShelleyBlock era
blk SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
>= SlotNo
votingDeadline then Word32 -> Word32
forall a. Enum a => a -> a
succ else Word32 -> Word32
forall a. a -> a
id) (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$
                ShelleyTransition -> Word32
shelleyAfterVoting ShelleyTransition
tickedShelleyLedgerTransition
          }
      }
  where
    globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerConfig (ShelleyBlock era)
ShelleyLedgerConfig era
cfg
    swindow :: Word64
swindow = Globals -> Word64
SL.stabilityWindow Globals
globals

    ei :: EpochInfo Identity
    ei :: EpochInfo Identity
ei = Globals -> EpochInfo Identity
SL.epochInfo Globals
globals

    -- The start of the next epoch is within the safe zone, always.
    startOfNextEpoch :: SlotNo
    startOfNextEpoch :: SlotNo
startOfNextEpoch = Identity SlotNo -> SlotNo
forall a. Identity a -> a
runIdentity (Identity SlotNo -> SlotNo) -> Identity SlotNo -> SlotNo
forall a b. (a -> b) -> a -> b
$ do
        EpochNo
blockEpoch <- EpochInfo Identity -> SlotNo -> Identity EpochNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m EpochNo
epochInfoEpoch EpochInfo Identity
ei (ShelleyBlock era -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot ShelleyBlock era
blk)
        let nextEpoch :: EpochNo
nextEpoch = EpochNo -> EpochNo
forall a. Enum a => a -> a
succ EpochNo
blockEpoch
        EpochInfo Identity -> EpochNo -> Identity SlotNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m SlotNo
epochInfoFirst EpochInfo Identity
ei EpochNo
nextEpoch

    -- The block must come in strictly before the voting deadline
    -- See Fig 13, "Protocol Parameter Update Inference Rules", of the
    -- Shelley specification.
    votingDeadline :: SlotNo
    votingDeadline :: SlotNo
votingDeadline = Word64 -> SlotNo -> SlotNo
subSlots (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
swindow) SlotNo
startOfNextEpoch

instance ShelleyBasedEra era
      => LedgerSupportsProtocol (ShelleyBlock era) where
  protocolLedgerView :: LedgerConfig (ShelleyBlock era)
-> Ticked (LedgerState (ShelleyBlock era))
-> Ticked (LedgerView (BlockProtocol (ShelleyBlock era)))
protocolLedgerView LedgerConfig (ShelleyBlock era)
_cfg = LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era))
forall c. LedgerView c -> Ticked (LedgerView c)
TickedPraosLedgerView
                          (LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era)))
-> (Ticked (LedgerState (ShelleyBlock era))
    -> LedgerView (Crypto era))
-> Ticked (LedgerState (ShelleyBlock era))
-> Ticked (LedgerView (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> LedgerView (Crypto era)
forall era.
GetLedgerView era =>
NewEpochState era -> LedgerView (Crypto era)
SL.currentLedgerView
                          (NewEpochState era -> LedgerView (Crypto era))
-> (Ticked (LedgerState (ShelleyBlock era)) -> NewEpochState era)
-> Ticked (LedgerState (ShelleyBlock era))
-> LedgerView (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (ShelleyBlock era)) -> NewEpochState era
forall era.
Ticked (LedgerState (ShelleyBlock era)) -> NewEpochState era
tickedShelleyLedgerState

  ledgerViewForecastAt :: LedgerConfig (ShelleyBlock era)
-> LedgerState (ShelleyBlock era)
-> Forecast (LedgerView (BlockProtocol (ShelleyBlock era)))
ledgerViewForecastAt LedgerConfig (ShelleyBlock era)
cfg LedgerState (ShelleyBlock era)
ledgerState = WithOrigin SlotNo
-> (SlotNo
    -> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
-> Forecast (LedgerView (Crypto era))
forall a.
WithOrigin SlotNo
-> (SlotNo -> Except OutsideForecastRange (Ticked a)) -> Forecast a
Forecast WithOrigin SlotNo
at ((SlotNo
  -> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
 -> Forecast (LedgerView (Crypto era)))
-> (SlotNo
    -> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
-> Forecast (LedgerView (Crypto era))
forall a b. (a -> b) -> a -> b
$ \SlotNo
for -> if
      | SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
for WithOrigin SlotNo -> WithOrigin SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
== WithOrigin SlotNo
at ->
        Ticked (LedgerView (Crypto era))
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ticked (LedgerView (Crypto era))
 -> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
-> Ticked (LedgerView (Crypto era))
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall a b. (a -> b) -> a -> b
$ LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era))
forall c. LedgerView c -> Ticked (LedgerView c)
TickedPraosLedgerView (LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era)))
-> LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era))
forall a b. (a -> b) -> a -> b
$ NewEpochState era -> LedgerView (Crypto era)
forall era.
GetLedgerView era =>
NewEpochState era -> LedgerView (Crypto era)
SL.currentLedgerView NewEpochState era
shelleyLedgerState
      | SlotNo
for SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
maxFor ->
        Ticked (LedgerView (Crypto era))
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ticked (LedgerView (Crypto era))
 -> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
-> Ticked (LedgerView (Crypto era))
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall a b. (a -> b) -> a -> b
$ SlotNo -> Ticked (LedgerView (Crypto era))
futureLedgerView SlotNo
for
      | Bool
otherwise ->
        OutsideForecastRange
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (OutsideForecastRange
 -> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
-> OutsideForecastRange
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall a b. (a -> b) -> a -> b
$ OutsideForecastRange :: WithOrigin SlotNo -> SlotNo -> SlotNo -> OutsideForecastRange
OutsideForecastRange {
            outsideForecastAt :: WithOrigin SlotNo
outsideForecastAt     = WithOrigin SlotNo
at
          , outsideForecastMaxFor :: SlotNo
outsideForecastMaxFor = SlotNo
maxFor
          , outsideForecastFor :: SlotNo
outsideForecastFor    = SlotNo
for
          }
    where
      ShelleyLedgerState { shelleyLedgerState } = LedgerState (ShelleyBlock era)
ledgerState
      globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerConfig (ShelleyBlock era)
ShelleyLedgerConfig era
cfg
      swindow :: Word64
swindow = Globals -> Word64
SL.stabilityWindow Globals
globals
      at :: WithOrigin SlotNo
at      = LedgerState (ShelleyBlock era) -> WithOrigin SlotNo
forall blk.
UpdateLedger blk =>
LedgerState blk -> WithOrigin SlotNo
ledgerTipSlot LedgerState (ShelleyBlock era)
ledgerState

      -- | 'SL.futureLedgerView' imposes its own bounds. Those bounds could
      -- /exceed/ the 'maxFor' we have computed, but should never be /less/.
      futureLedgerView :: SlotNo -> Ticked (SL.LedgerView (EraCrypto era))
      futureLedgerView :: SlotNo -> Ticked (LedgerView (Crypto era))
futureLedgerView =
            (FutureLedgerViewError era -> Ticked (LedgerView (Crypto era)))
-> (LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era)))
-> Either (FutureLedgerViewError era) (LedgerView (Crypto era))
-> Ticked (LedgerView (Crypto era))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
              (\FutureLedgerViewError era
e -> String -> Ticked (LedgerView (Crypto era))
forall a. HasCallStack => String -> a
error (String
"futureLedgerView failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FutureLedgerViewError era -> String
forall a. Show a => a -> String
show FutureLedgerViewError era
e))
              LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era))
forall c. LedgerView c -> Ticked (LedgerView c)
TickedPraosLedgerView
          (Either (FutureLedgerViewError era) (LedgerView (Crypto era))
 -> Ticked (LedgerView (Crypto era)))
-> (SlotNo
    -> Either (FutureLedgerViewError era) (LedgerView (Crypto era)))
-> SlotNo
-> Ticked (LedgerView (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Globals
-> NewEpochState era
-> SlotNo
-> Either (FutureLedgerViewError era) (LedgerView (Crypto era))
forall era (m :: * -> *).
(GetLedgerView era, MonadError (FutureLedgerViewError era) m) =>
Globals
-> NewEpochState era -> SlotNo -> m (LedgerView (Crypto era))
SL.futureLedgerView Globals
globals NewEpochState era
shelleyLedgerState

      -- Exclusive upper bound
      maxFor :: SlotNo
      maxFor :: SlotNo
maxFor = Word64 -> SlotNo -> SlotNo
addSlots Word64
swindow (SlotNo -> SlotNo) -> SlotNo -> SlotNo
forall a b. (a -> b) -> a -> b
$ WithOrigin SlotNo -> SlotNo
forall t. (Bounded t, Enum t) => WithOrigin t -> t
succWithOrigin WithOrigin SlotNo
at

instance HasHardForkHistory (ShelleyBlock era) where
  type HardForkIndices (ShelleyBlock era) = '[ShelleyBlock era]
  hardForkSummary :: LedgerConfig (ShelleyBlock era)
-> LedgerState (ShelleyBlock era)
-> Summary (HardForkIndices (ShelleyBlock era))
hardForkSummary = (LedgerConfig (ShelleyBlock era) -> EraParams)
-> LedgerConfig (ShelleyBlock era)
-> LedgerState (ShelleyBlock era)
-> Summary '[ShelleyBlock era]
forall blk.
(LedgerConfig blk -> EraParams)
-> LedgerConfig blk -> LedgerState blk -> Summary '[blk]
neverForksHardForkSummary ((LedgerConfig (ShelleyBlock era) -> EraParams)
 -> LedgerConfig (ShelleyBlock era)
 -> LedgerState (ShelleyBlock era)
 -> Summary '[ShelleyBlock era])
-> (LedgerConfig (ShelleyBlock era) -> EraParams)
-> LedgerConfig (ShelleyBlock era)
-> LedgerState (ShelleyBlock era)
-> Summary '[ShelleyBlock era]
forall a b. (a -> b) -> a -> b
$
      ShelleyGenesis era -> EraParams
forall era. ShelleyGenesis era -> EraParams
shelleyEraParamsNeverHardForks (ShelleyGenesis era -> EraParams)
-> (ShelleyLedgerConfig era -> ShelleyGenesis era)
-> ShelleyLedgerConfig era
-> EraParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerConfig era -> ShelleyGenesis era
forall era. ShelleyLedgerConfig era -> ShelleyGenesis era
shelleyLedgerGenesis

instance ShelleyBasedEra era
      => CommonProtocolParams (ShelleyBlock era) where
  maxHeaderSize :: LedgerState (ShelleyBlock era) -> Word32
maxHeaderSize = Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32)
-> (LedgerState (ShelleyBlock era) -> Natural)
-> LedgerState (ShelleyBlock era)
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams' Identity era -> Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
SL._maxBHSize (PParams' Identity era -> Natural)
-> (LedgerState (ShelleyBlock era) -> PParams' Identity era)
-> LedgerState (ShelleyBlock era)
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> PParams' Identity era
forall era. NewEpochState era -> PParams era
getPParams (NewEpochState era -> PParams' Identity era)
-> (LedgerState (ShelleyBlock era) -> NewEpochState era)
-> LedgerState (ShelleyBlock era)
-> PParams' Identity era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock era) -> NewEpochState era
forall era. LedgerState (ShelleyBlock era) -> NewEpochState era
shelleyLedgerState
  maxTxSize :: LedgerState (ShelleyBlock era) -> Word32
maxTxSize     = Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32)
-> (LedgerState (ShelleyBlock era) -> Natural)
-> LedgerState (ShelleyBlock era)
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams' Identity era -> Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
SL._maxTxSize (PParams' Identity era -> Natural)
-> (LedgerState (ShelleyBlock era) -> PParams' Identity era)
-> LedgerState (ShelleyBlock era)
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> PParams' Identity era
forall era. NewEpochState era -> PParams era
getPParams (NewEpochState era -> PParams' Identity era)
-> (LedgerState (ShelleyBlock era) -> NewEpochState era)
-> LedgerState (ShelleyBlock era)
-> PParams' Identity era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock era) -> NewEpochState era
forall era. LedgerState (ShelleyBlock era) -> NewEpochState era
shelleyLedgerState

{-------------------------------------------------------------------------------
  ValidateEnvelope
-------------------------------------------------------------------------------}

instance ShelleyBasedEra era => BasicEnvelopeValidation (ShelleyBlock era) where
  -- defaults all OK

instance ShelleyBasedEra era => ValidateEnvelope (ShelleyBlock era) where
  type OtherHeaderEnvelopeError (ShelleyBlock era) =
    SL.PredicateFailure (SL.CHAIN era)

  additionalEnvelopeChecks :: TopLevelConfig (ShelleyBlock era)
-> Ticked (LedgerView (BlockProtocol (ShelleyBlock era)))
-> Header (ShelleyBlock era)
-> Except (OtherHeaderEnvelopeError (ShelleyBlock era)) ()
additionalEnvelopeChecks TopLevelConfig (ShelleyBlock era)
cfg (TickedPraosLedgerView ledgerView) Header (ShelleyBlock era)
hdr =
      Globals
-> ChainChecksData
-> BHeader (Crypto era)
-> ExceptT (ChainPredicateFailure era) Identity ()
forall era (m :: * -> *).
(Era era, MonadError (PredicateFailure (CHAIN era)) m) =>
Globals -> ChainChecksData -> BHeader (Crypto era) -> m ()
SL.chainChecks Globals
globals (LedgerView (Crypto era) -> ChainChecksData
forall crypto. LedgerView crypto -> ChainChecksData
SL.lvChainChecks LedgerView (Crypto era)
ledgerView) (Header (ShelleyBlock era) -> BHeader (Crypto era)
forall era. Header (ShelleyBlock era) -> BHeader (EraCrypto era)
shelleyHeaderRaw Header (ShelleyBlock era)
hdr)
    where
      globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals (TopLevelConfig (ShelleyBlock era)
-> LedgerConfig (ShelleyBlock era)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig (ShelleyBlock era)
cfg)

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

getPParams :: SL.NewEpochState era -> SL.PParams era
getPParams :: NewEpochState era -> PParams era
getPParams = EpochState era -> PParams era
forall era. EpochState era -> PParams era
SL.esPp (EpochState era -> PParams era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> PParams era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
SL.nesEs

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

-- | Current version
--
-- o 'serialisationFormatVersion0' used to include the 'LedgerViewHistory', but
--   since we had to break binary backwards compatibility of the 'TPraosState',
--   we dropped backwards compatibility with 'serialisationFormatVersion0' too.
-- o 'serialisationFormatVersion1' did not include a 'BlockNo' at the tip of
--   the ledger, which was introduced in version 2. Again, since we broke
--   compat anyway, we dropped support for version 1.
serialisationFormatVersion2 :: VersionNumber
serialisationFormatVersion2 :: VersionNumber
serialisationFormatVersion2 = VersionNumber
2

encodeShelleyAnnTip ::
     ShelleyBasedEra era
  => AnnTip (ShelleyBlock era) -> Encoding
encodeShelleyAnnTip :: AnnTip (ShelleyBlock era) -> Encoding
encodeShelleyAnnTip = (HeaderHash (ShelleyBlock era) -> Encoding)
-> AnnTip (ShelleyBlock era) -> Encoding
forall blk.
(TipInfo blk ~ HeaderHash blk) =>
(HeaderHash blk -> Encoding) -> AnnTip blk -> Encoding
defaultEncodeAnnTip HeaderHash (ShelleyBlock era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

decodeShelleyAnnTip ::
     ShelleyBasedEra era
  => Decoder s (AnnTip (ShelleyBlock era))
decodeShelleyAnnTip :: Decoder s (AnnTip (ShelleyBlock era))
decodeShelleyAnnTip = (forall s. Decoder s (HeaderHash (ShelleyBlock era)))
-> forall s. Decoder s (AnnTip (ShelleyBlock era))
forall blk.
(TipInfo blk ~ HeaderHash blk) =>
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (AnnTip blk)
defaultDecodeAnnTip forall s. Decoder s (HeaderHash (ShelleyBlock era))
forall a s. FromCBOR a => Decoder s a
fromCBOR

encodeShelleyHeaderState ::
     ShelleyBasedEra era
  => HeaderState (ShelleyBlock era)
  -> Encoding
encodeShelleyHeaderState :: HeaderState (ShelleyBlock era) -> Encoding
encodeShelleyHeaderState = (ChainDepState (BlockProtocol (ShelleyBlock era)) -> Encoding)
-> (AnnTip (ShelleyBlock era) -> Encoding)
-> HeaderState (ShelleyBlock era)
-> Encoding
forall blk.
(ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding) -> HeaderState blk -> Encoding
encodeHeaderState
    ChainDepState (BlockProtocol (ShelleyBlock era)) -> Encoding
forall a. Serialise a => a -> Encoding
encode
    AnnTip (ShelleyBlock era) -> Encoding
forall era.
ShelleyBasedEra era =>
AnnTip (ShelleyBlock era) -> Encoding
encodeShelleyAnnTip

encodeShelleyTip :: ShelleyBasedEra era => ShelleyTip era -> Encoding
encodeShelleyTip :: ShelleyTip era -> Encoding
encodeShelleyTip ShelleyTip {
                     SlotNo
shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo :: forall era. ShelleyTip era -> SlotNo
shelleyTipSlotNo
                   , BlockNo
shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo :: forall era. ShelleyTip era -> BlockNo
shelleyTipBlockNo
                   , HeaderHash (ShelleyBlock era)
shelleyTipHash :: HeaderHash (ShelleyBlock era)
shelleyTipHash :: forall era. ShelleyTip era -> HeaderHash (ShelleyBlock era)
shelleyTipHash
                   } = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
CBOR.encodeListLen Word
3
    , SlotNo -> Encoding
forall a. Serialise a => a -> Encoding
encode SlotNo
shelleyTipSlotNo
    , BlockNo -> Encoding
forall a. Serialise a => a -> Encoding
encode BlockNo
shelleyTipBlockNo
    , ShelleyHash (Crypto era) -> Encoding
forall a. Serialise a => a -> Encoding
encode HeaderHash (ShelleyBlock era)
ShelleyHash (Crypto era)
shelleyTipHash
    ]

decodeShelleyTip :: ShelleyBasedEra era => Decoder s (ShelleyTip era)
decodeShelleyTip :: Decoder s (ShelleyTip era)
decodeShelleyTip = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ShelleyTip" Int
3
    SlotNo
shelleyTipSlotNo  <- Decoder s SlotNo
forall a s. Serialise a => Decoder s a
decode
    BlockNo
shelleyTipBlockNo <- Decoder s BlockNo
forall a s. Serialise a => Decoder s a
decode
    ShelleyHash (Crypto era)
shelleyTipHash    <- Decoder s (ShelleyHash (Crypto era))
forall a s. Serialise a => Decoder s a
decode
    ShelleyTip era -> Decoder s (ShelleyTip era)
forall (m :: * -> *) a. Monad m => a -> m a
return ShelleyTip :: forall era.
SlotNo
-> BlockNo -> HeaderHash (ShelleyBlock era) -> ShelleyTip era
ShelleyTip {
        SlotNo
shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo
      , BlockNo
shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo
      , HeaderHash (ShelleyBlock era)
ShelleyHash (Crypto era)
shelleyTipHash :: ShelleyHash (Crypto era)
shelleyTipHash :: HeaderHash (ShelleyBlock era)
shelleyTipHash
      }

encodeShelleyTransition :: ShelleyTransition -> Encoding
encodeShelleyTransition :: ShelleyTransition -> Encoding
encodeShelleyTransition ShelleyTransitionInfo{Word32
shelleyAfterVoting :: Word32
shelleyAfterVoting :: ShelleyTransition -> Word32
shelleyAfterVoting} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word32 -> Encoding
CBOR.encodeWord32 Word32
shelleyAfterVoting
    ]

decodeShelleyTransition :: Decoder s ShelleyTransition
decodeShelleyTransition :: Decoder s ShelleyTransition
decodeShelleyTransition = do
    Word32
shelleyAfterVoting <- Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
    ShelleyTransition -> Decoder s ShelleyTransition
forall (m :: * -> *) a. Monad m => a -> m a
return ShelleyTransitionInfo :: Word32 -> ShelleyTransition
ShelleyTransitionInfo{Word32
shelleyAfterVoting :: Word32
shelleyAfterVoting :: Word32
shelleyAfterVoting}

encodeShelleyLedgerState ::
     ShelleyBasedEra era
  => LedgerState (ShelleyBlock era)
  -> Encoding
encodeShelleyLedgerState :: LedgerState (ShelleyBlock era) -> Encoding
encodeShelleyLedgerState
    ShelleyLedgerState { shelleyLedgerTip
                       , shelleyLedgerState
                       , shelleyLedgerTransition
                       } =
    VersionNumber -> Encoding -> Encoding
encodeVersion VersionNumber
serialisationFormatVersion2 (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
        Word -> Encoding
CBOR.encodeListLen Word
2
      , (ShelleyTip era -> Encoding)
-> WithOrigin (ShelleyTip era) -> Encoding
forall a. (a -> Encoding) -> WithOrigin a -> Encoding
encodeWithOrigin ShelleyTip era -> Encoding
forall era. ShelleyBasedEra era => ShelleyTip era -> Encoding
encodeShelleyTip WithOrigin (ShelleyTip era)
shelleyLedgerTip
      , NewEpochState era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NewEpochState era
shelleyLedgerState
      , ShelleyTransition -> Encoding
encodeShelleyTransition ShelleyTransition
shelleyLedgerTransition
      ]

decodeShelleyLedgerState ::
     forall era s. ShelleyBasedEra era
  => Decoder s (LedgerState (ShelleyBlock era))
decodeShelleyLedgerState :: Decoder s (LedgerState (ShelleyBlock era))
decodeShelleyLedgerState = [(VersionNumber, VersionDecoder (LedgerState (ShelleyBlock era)))]
-> forall s. Decoder s (LedgerState (ShelleyBlock era))
forall a.
[(VersionNumber, VersionDecoder a)] -> forall s. Decoder s a
decodeVersion [
      (VersionNumber
serialisationFormatVersion2, (forall s. Decoder s (LedgerState (ShelleyBlock era)))
-> VersionDecoder (LedgerState (ShelleyBlock era))
forall a. (forall s. Decoder s a) -> VersionDecoder a
Decode forall s. Decoder s (LedgerState (ShelleyBlock era))
decodeShelleyLedgerState2)
    ]
  where
    decodeShelleyLedgerState2 :: Decoder s' (LedgerState (ShelleyBlock era))
    decodeShelleyLedgerState2 :: Decoder s' (LedgerState (ShelleyBlock era))
decodeShelleyLedgerState2 = do
      Text -> Int -> Decoder s' ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"LedgerState ShelleyBlock" Int
2
      WithOrigin (ShelleyTip era)
shelleyLedgerTip        <- Decoder s' (ShelleyTip era)
-> Decoder s' (WithOrigin (ShelleyTip era))
forall s a. Decoder s a -> Decoder s (WithOrigin a)
decodeWithOrigin Decoder s' (ShelleyTip era)
forall era s. ShelleyBasedEra era => Decoder s (ShelleyTip era)
decodeShelleyTip
      NewEpochState era
shelleyLedgerState      <- Decoder s' (NewEpochState era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      ShelleyTransition
shelleyLedgerTransition <- Decoder s' ShelleyTransition
forall s. Decoder s ShelleyTransition
decodeShelleyTransition
      LedgerState (ShelleyBlock era)
-> Decoder s' (LedgerState (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return ShelleyLedgerState :: forall era.
WithOrigin (ShelleyTip era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerState (ShelleyBlock era)
ShelleyLedgerState {
          WithOrigin (ShelleyTip era)
shelleyLedgerTip :: WithOrigin (ShelleyTip era)
shelleyLedgerTip :: WithOrigin (ShelleyTip era)
shelleyLedgerTip
        , NewEpochState era
shelleyLedgerState :: NewEpochState era
shelleyLedgerState :: NewEpochState era
shelleyLedgerState
        , ShelleyTransition
shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition
        }