{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

module Ouroboros.Consensus.Ledger.Extended (
    -- * Extended ledger state
    ExtLedgerState(..)
  , ExtValidationError(..)
  , ExtLedgerCfg(..)
    -- * Serialisation
  , encodeExtLedgerState
  , decodeExtLedgerState
    -- * Casts
  , castExtLedgerState
    -- * Type family instances
  , Ticked(..)
  ) where

import           Codec.CBOR.Decoding (Decoder)
import           Codec.CBOR.Encoding (Encoding)
import           Control.Monad.Except
import           Data.Coerce
import           Data.Proxy
import           Data.Typeable
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks (..))

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.Protocol.Abstract

{-------------------------------------------------------------------------------
  Extended ledger state
-------------------------------------------------------------------------------}

-- | Extended ledger state
--
-- This is the combination of the header state and the ledger state proper.
data ExtLedgerState blk = ExtLedgerState {
      ExtLedgerState blk -> LedgerState blk
ledgerState :: !(LedgerState blk)
    , ExtLedgerState blk -> HeaderState blk
headerState :: !(HeaderState blk)
    }
  deriving ((forall x. ExtLedgerState blk -> Rep (ExtLedgerState blk) x)
-> (forall x. Rep (ExtLedgerState blk) x -> ExtLedgerState blk)
-> Generic (ExtLedgerState blk)
forall x. Rep (ExtLedgerState blk) x -> ExtLedgerState blk
forall x. ExtLedgerState blk -> Rep (ExtLedgerState blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (ExtLedgerState blk) x -> ExtLedgerState blk
forall blk x. ExtLedgerState blk -> Rep (ExtLedgerState blk) x
$cto :: forall blk x. Rep (ExtLedgerState blk) x -> ExtLedgerState blk
$cfrom :: forall blk x. ExtLedgerState blk -> Rep (ExtLedgerState blk) x
Generic)

data ExtValidationError blk =
    ExtValidationErrorLedger !(LedgerError blk)
  | ExtValidationErrorHeader !(HeaderError blk)
  deriving ((forall x.
 ExtValidationError blk -> Rep (ExtValidationError blk) x)
-> (forall x.
    Rep (ExtValidationError blk) x -> ExtValidationError blk)
-> Generic (ExtValidationError blk)
forall x. Rep (ExtValidationError blk) x -> ExtValidationError blk
forall x. ExtValidationError blk -> Rep (ExtValidationError blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (ExtValidationError blk) x -> ExtValidationError blk
forall blk x.
ExtValidationError blk -> Rep (ExtValidationError blk) x
$cto :: forall blk x.
Rep (ExtValidationError blk) x -> ExtValidationError blk
$cfrom :: forall blk x.
ExtValidationError blk -> Rep (ExtValidationError blk) x
Generic)

instance LedgerSupportsProtocol blk => NoThunks (ExtValidationError blk)

deriving instance LedgerSupportsProtocol blk => Show (ExtLedgerState     blk)
deriving instance LedgerSupportsProtocol blk => Show (ExtValidationError blk)
deriving instance LedgerSupportsProtocol blk => Eq   (ExtValidationError blk)

-- | We override 'showTypeOf' to show the type of the block
--
-- This makes debugging a bit easier, as the block gets used to resolve all
-- kinds of type families.
instance LedgerSupportsProtocol blk => NoThunks (ExtLedgerState blk) where
  showTypeOf :: Proxy (ExtLedgerState blk) -> String
showTypeOf Proxy (ExtLedgerState blk)
_ = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy (ExtLedgerState blk) -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy (ExtLedgerState blk)
forall k (t :: k). Proxy t
Proxy @(ExtLedgerState blk))

deriving instance ( LedgerSupportsProtocol blk
                  , Eq (ChainDepState (BlockProtocol blk))
                  ) => Eq (ExtLedgerState blk)

{-------------------------------------------------------------------------------
  The extended ledger can behave like a ledger
-------------------------------------------------------------------------------}

data instance Ticked (ExtLedgerState blk) = TickedExtLedgerState {
      Ticked (ExtLedgerState blk) -> Ticked (LedgerState blk)
tickedLedgerState :: Ticked (LedgerState blk)
    , Ticked (ExtLedgerState blk)
-> Ticked (LedgerView (BlockProtocol blk))
tickedLedgerView  :: Ticked (LedgerView (BlockProtocol blk))
    , Ticked (ExtLedgerState blk) -> Ticked (HeaderState blk)
tickedHeaderState :: Ticked (HeaderState blk)
    }

-- | " Ledger " configuration for the extended ledger
--
-- Since the extended ledger also does the consensus protocol validation, we
-- also need the consensus config.
newtype ExtLedgerCfg blk = ExtLedgerCfg {
      ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg :: TopLevelConfig blk
    }
  deriving ((forall x. ExtLedgerCfg blk -> Rep (ExtLedgerCfg blk) x)
-> (forall x. Rep (ExtLedgerCfg blk) x -> ExtLedgerCfg blk)
-> Generic (ExtLedgerCfg blk)
forall x. Rep (ExtLedgerCfg blk) x -> ExtLedgerCfg blk
forall x. ExtLedgerCfg blk -> Rep (ExtLedgerCfg blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (ExtLedgerCfg blk) x -> ExtLedgerCfg blk
forall blk x. ExtLedgerCfg blk -> Rep (ExtLedgerCfg blk) x
$cto :: forall blk x. Rep (ExtLedgerCfg blk) x -> ExtLedgerCfg blk
$cfrom :: forall blk x. ExtLedgerCfg blk -> Rep (ExtLedgerCfg blk) x
Generic)

instance ( ConsensusProtocol (BlockProtocol blk)
         , NoThunks (BlockConfig   blk)
         , NoThunks (CodecConfig   blk)
         , NoThunks (LedgerConfig  blk)
         , NoThunks (StorageConfig blk)
         ) => NoThunks (ExtLedgerCfg blk)

type instance LedgerCfg (ExtLedgerState blk) = ExtLedgerCfg blk

type instance HeaderHash (ExtLedgerState blk) = HeaderHash (LedgerState blk)

instance IsLedger (LedgerState blk) => GetTip (ExtLedgerState blk) where
  getTip :: ExtLedgerState blk -> Point (ExtLedgerState blk)
getTip = Point (LedgerState blk) -> Point (ExtLedgerState blk)
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (LedgerState blk) -> Point (ExtLedgerState blk))
-> (ExtLedgerState blk -> Point (LedgerState blk))
-> ExtLedgerState blk
-> Point (ExtLedgerState blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState blk -> Point (LedgerState blk)
forall l. GetTip l => l -> Point l
getTip (LedgerState blk -> Point (LedgerState blk))
-> (ExtLedgerState blk -> LedgerState blk)
-> ExtLedgerState blk
-> Point (LedgerState blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtLedgerState blk -> LedgerState blk
forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState

instance IsLedger (LedgerState blk) => GetTip (Ticked (ExtLedgerState blk)) where
  getTip :: Ticked (ExtLedgerState blk) -> Point (Ticked (ExtLedgerState blk))
getTip = Point (Ticked (LedgerState blk))
-> Point (Ticked (ExtLedgerState blk))
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (Ticked (LedgerState blk))
 -> Point (Ticked (ExtLedgerState blk)))
-> (Ticked (ExtLedgerState blk)
    -> Point (Ticked (LedgerState blk)))
-> Ticked (ExtLedgerState blk)
-> Point (Ticked (ExtLedgerState blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState blk) -> Point (Ticked (LedgerState blk))
forall l. GetTip l => l -> Point l
getTip (Ticked (LedgerState blk) -> Point (Ticked (LedgerState blk)))
-> (Ticked (ExtLedgerState blk) -> Ticked (LedgerState blk))
-> Ticked (ExtLedgerState blk)
-> Point (Ticked (LedgerState blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (ExtLedgerState blk) -> Ticked (LedgerState blk)
forall blk. Ticked (ExtLedgerState blk) -> Ticked (LedgerState blk)
tickedLedgerState

instance ( IsLedger (LedgerState  blk)
         , LedgerSupportsProtocol blk
         )
      => IsLedger (ExtLedgerState blk) where
  type LedgerErr (ExtLedgerState blk) = ExtValidationError blk

  applyChainTick :: LedgerCfg (ExtLedgerState blk)
-> SlotNo -> ExtLedgerState blk -> Ticked (ExtLedgerState blk)
applyChainTick LedgerCfg (ExtLedgerState blk)
cfg SlotNo
slot (ExtLedgerState LedgerState blk
ledger HeaderState blk
header) =
      TickedExtLedgerState :: forall blk.
Ticked (LedgerState blk)
-> Ticked (LedgerView (BlockProtocol blk))
-> Ticked (HeaderState blk)
-> Ticked (ExtLedgerState blk)
TickedExtLedgerState {Ticked (LedgerView (BlockProtocol blk))
Ticked (LedgerState blk)
Ticked (HeaderState blk)
tickedHeaderState :: Ticked (HeaderState blk)
tickedLedgerView :: Ticked (LedgerView (BlockProtocol blk))
tickedLedgerState :: Ticked (LedgerState blk)
tickedHeaderState :: Ticked (HeaderState blk)
tickedLedgerView :: Ticked (LedgerView (BlockProtocol blk))
tickedLedgerState :: Ticked (LedgerState blk)
..}
    where
      lcfg :: LedgerConfig blk
      lcfg :: LedgerConfig blk
lcfg = TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger (TopLevelConfig blk -> LedgerConfig blk)
-> TopLevelConfig blk -> LedgerConfig blk
forall a b. (a -> b) -> a -> b
$ ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
cfg

      tickedLedgerState :: Ticked (LedgerState blk)
      tickedLedgerState :: Ticked (LedgerState blk)
tickedLedgerState = LedgerConfig blk
-> SlotNo -> LedgerState blk -> Ticked (LedgerState blk)
forall l. IsLedger l => LedgerCfg l -> SlotNo -> l -> Ticked l
applyChainTick LedgerConfig blk
lcfg SlotNo
slot LedgerState blk
ledger

      tickedLedgerView :: Ticked (LedgerView (BlockProtocol blk))
      tickedLedgerView :: Ticked (LedgerView (BlockProtocol blk))
tickedLedgerView = LedgerConfig blk
-> Ticked (LedgerState blk)
-> Ticked (LedgerView (BlockProtocol blk))
forall blk.
LedgerSupportsProtocol blk =>
LedgerConfig blk
-> Ticked (LedgerState blk)
-> Ticked (LedgerView (BlockProtocol blk))
protocolLedgerView LedgerConfig blk
lcfg Ticked (LedgerState blk)
tickedLedgerState

      tickedHeaderState :: Ticked (HeaderState blk)
      tickedHeaderState :: Ticked (HeaderState blk)
tickedHeaderState =
          ConsensusConfig (BlockProtocol blk)
-> Ticked (LedgerView (BlockProtocol blk))
-> SlotNo
-> HeaderState blk
-> Ticked (HeaderState blk)
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
ConsensusConfig (BlockProtocol blk)
-> Ticked (LedgerView (BlockProtocol blk))
-> SlotNo
-> HeaderState blk
-> Ticked (HeaderState blk)
tickHeaderState
            (TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus (TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk))
-> TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
forall a b. (a -> b) -> a -> b
$ ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
cfg)
            Ticked (LedgerView (BlockProtocol blk))
tickedLedgerView
            SlotNo
slot
            HeaderState blk
header

instance LedgerSupportsProtocol blk => ApplyBlock (ExtLedgerState blk) blk where
  applyLedgerBlock :: LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk)
-> Except (LedgerErr (ExtLedgerState blk)) (ExtLedgerState blk)
applyLedgerBlock LedgerCfg (ExtLedgerState blk)
cfg blk
blk TickedExtLedgerState{..} = LedgerState blk -> HeaderState blk -> ExtLedgerState blk
forall blk.
LedgerState blk -> HeaderState blk -> ExtLedgerState blk
ExtLedgerState
      (LedgerState blk -> HeaderState blk -> ExtLedgerState blk)
-> ExceptT (ExtValidationError blk) Identity (LedgerState blk)
-> ExceptT
     (ExtValidationError blk)
     Identity
     (HeaderState blk -> ExtLedgerState blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((LedgerErr (LedgerState blk) -> ExtValidationError blk)
-> Except (LedgerErr (LedgerState blk)) (LedgerState blk)
-> ExceptT (ExtValidationError blk) Identity (LedgerState blk)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept LedgerErr (LedgerState blk) -> ExtValidationError blk
forall blk. LedgerError blk -> ExtValidationError blk
ExtValidationErrorLedger (Except (LedgerErr (LedgerState blk)) (LedgerState blk)
 -> ExceptT (ExtValidationError blk) Identity (LedgerState blk))
-> Except (LedgerErr (LedgerState blk)) (LedgerState blk)
-> ExceptT (ExtValidationError blk) Identity (LedgerState blk)
forall a b. (a -> b) -> a -> b
$
             LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk)
-> Except (LedgerErr (LedgerState blk)) (LedgerState blk)
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
LedgerCfg l -> blk -> Ticked l -> Except (LedgerErr l) l
applyLedgerBlock
               (TopLevelConfig blk -> LedgerCfg (LedgerState blk)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger (TopLevelConfig blk -> LedgerCfg (LedgerState blk))
-> TopLevelConfig blk -> LedgerCfg (LedgerState blk)
forall a b. (a -> b) -> a -> b
$ ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
cfg)
               blk
blk
               Ticked (LedgerState blk)
tickedLedgerState)
      ExceptT
  (ExtValidationError blk)
  Identity
  (HeaderState blk -> ExtLedgerState blk)
-> ExceptT (ExtValidationError blk) Identity (HeaderState blk)
-> ExceptT (ExtValidationError blk) Identity (ExtLedgerState blk)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((HeaderError blk -> ExtValidationError blk)
-> Except (HeaderError blk) (HeaderState blk)
-> ExceptT (ExtValidationError blk) Identity (HeaderState blk)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept HeaderError blk -> ExtValidationError blk
forall blk. HeaderError blk -> ExtValidationError blk
ExtValidationErrorHeader (Except (HeaderError blk) (HeaderState blk)
 -> ExceptT (ExtValidationError blk) Identity (HeaderState blk))
-> Except (HeaderError blk) (HeaderState blk)
-> ExceptT (ExtValidationError blk) Identity (HeaderState blk)
forall a b. (a -> b) -> a -> b
$
             TopLevelConfig blk
-> Ticked (LedgerView (BlockProtocol blk))
-> Header blk
-> Ticked (HeaderState blk)
-> Except (HeaderError blk) (HeaderState blk)
forall blk.
(BlockSupportsProtocol blk, ValidateEnvelope blk) =>
TopLevelConfig blk
-> Ticked (LedgerView (BlockProtocol blk))
-> Header blk
-> Ticked (HeaderState blk)
-> Except (HeaderError blk) (HeaderState blk)
validateHeader
               (ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
cfg)
               Ticked (LedgerView (BlockProtocol blk))
tickedLedgerView
               (blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader blk
blk)
               Ticked (HeaderState blk)
tickedHeaderState)

  reapplyLedgerBlock :: LedgerCfg (ExtLedgerState blk)
-> blk -> Ticked (ExtLedgerState blk) -> ExtLedgerState blk
reapplyLedgerBlock LedgerCfg (ExtLedgerState blk)
cfg blk
blk TickedExtLedgerState{..} = ExtLedgerState :: forall blk.
LedgerState blk -> HeaderState blk -> ExtLedgerState blk
ExtLedgerState {
        ledgerState :: LedgerState blk
ledgerState =
             LedgerCfg (LedgerState blk)
-> blk -> Ticked (LedgerState blk) -> LedgerState blk
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
LedgerCfg l -> blk -> Ticked l -> l
reapplyLedgerBlock
               (TopLevelConfig blk -> LedgerCfg (LedgerState blk)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger (TopLevelConfig blk -> LedgerCfg (LedgerState blk))
-> TopLevelConfig blk -> LedgerCfg (LedgerState blk)
forall a b. (a -> b) -> a -> b
$ ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
cfg)
               blk
blk
               Ticked (LedgerState blk)
tickedLedgerState
      , headerState :: HeaderState blk
headerState =
             TopLevelConfig blk
-> Ticked (LedgerView (BlockProtocol blk))
-> Header blk
-> Ticked (HeaderState blk)
-> HeaderState blk
forall blk.
(BlockSupportsProtocol blk, ValidateEnvelope blk, HasCallStack) =>
TopLevelConfig blk
-> Ticked (LedgerView (BlockProtocol blk))
-> Header blk
-> Ticked (HeaderState blk)
-> HeaderState blk
revalidateHeader
               (ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
cfg)
               Ticked (LedgerView (BlockProtocol blk))
tickedLedgerView
               (blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader blk
blk)
               Ticked (HeaderState blk)
tickedHeaderState
      }

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

encodeExtLedgerState :: (LedgerState   blk -> Encoding)
                     -> (ChainDepState (BlockProtocol blk) -> Encoding)
                     -> (AnnTip        blk -> Encoding)
                     -> ExtLedgerState blk -> Encoding
encodeExtLedgerState :: (LedgerState blk -> Encoding)
-> (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding)
-> ExtLedgerState blk
-> Encoding
encodeExtLedgerState LedgerState blk -> Encoding
encodeLedgerState
                     ChainDepState (BlockProtocol blk) -> Encoding
encodeChainDepState
                     AnnTip blk -> Encoding
encodeAnnTip
                     ExtLedgerState{LedgerState blk
HeaderState blk
headerState :: HeaderState blk
ledgerState :: LedgerState blk
headerState :: forall blk. ExtLedgerState blk -> HeaderState blk
ledgerState :: forall blk. ExtLedgerState blk -> LedgerState blk
..} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      LedgerState blk -> Encoding
encodeLedgerState  LedgerState blk
ledgerState
    , HeaderState blk -> Encoding
encodeHeaderState' HeaderState blk
headerState
    ]
  where
    encodeHeaderState' :: HeaderState blk -> Encoding
encodeHeaderState' = (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding) -> HeaderState blk -> Encoding
forall blk.
(ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding) -> HeaderState blk -> Encoding
encodeHeaderState
                           ChainDepState (BlockProtocol blk) -> Encoding
encodeChainDepState
                           AnnTip blk -> Encoding
encodeAnnTip

decodeExtLedgerState :: (forall s. Decoder s (LedgerState    blk))
                     -> (forall s. Decoder s (ChainDepState  (BlockProtocol blk)))
                     -> (forall s. Decoder s (AnnTip         blk))
                     -> (forall s. Decoder s (ExtLedgerState blk))
decodeExtLedgerState :: (forall s. Decoder s (LedgerState blk))
-> (forall s. Decoder s (ChainDepState (BlockProtocol blk)))
-> (forall s. Decoder s (AnnTip blk))
-> forall s. Decoder s (ExtLedgerState blk)
decodeExtLedgerState forall s. Decoder s (LedgerState blk)
decodeLedgerState
                     forall s. Decoder s (ChainDepState (BlockProtocol blk))
decodeChainDepState
                     forall s. Decoder s (AnnTip blk)
decodeAnnTip = do
    LedgerState blk
ledgerState <- Decoder s (LedgerState blk)
forall s. Decoder s (LedgerState blk)
decodeLedgerState
    HeaderState blk
headerState <- Decoder s (HeaderState blk)
decodeHeaderState'
    ExtLedgerState blk -> Decoder s (ExtLedgerState blk)
forall (m :: * -> *) a. Monad m => a -> m a
return ExtLedgerState :: forall blk.
LedgerState blk -> HeaderState blk -> ExtLedgerState blk
ExtLedgerState{LedgerState blk
HeaderState blk
headerState :: HeaderState blk
ledgerState :: LedgerState blk
headerState :: HeaderState blk
ledgerState :: LedgerState blk
..}
  where
    decodeHeaderState' :: Decoder s (HeaderState blk)
decodeHeaderState' = (forall s. Decoder s (ChainDepState (BlockProtocol blk)))
-> (forall s. Decoder s (AnnTip blk))
-> forall s. Decoder s (HeaderState blk)
forall blk.
(forall s. Decoder s (ChainDepState (BlockProtocol blk)))
-> (forall s. Decoder s (AnnTip blk))
-> forall s. Decoder s (HeaderState blk)
decodeHeaderState
                           forall s. Decoder s (ChainDepState (BlockProtocol blk))
decodeChainDepState
                           forall s. Decoder s (AnnTip blk)
decodeAnnTip

{-------------------------------------------------------------------------------
  Casts
-------------------------------------------------------------------------------}

castExtLedgerState
  :: ( Coercible (LedgerState blk)
                 (LedgerState blk')
     , Coercible (ChainDepState (BlockProtocol blk))
                 (ChainDepState (BlockProtocol blk'))
     , TipInfo blk ~ TipInfo blk'
     )
  => ExtLedgerState blk -> ExtLedgerState blk'
castExtLedgerState :: ExtLedgerState blk -> ExtLedgerState blk'
castExtLedgerState ExtLedgerState{LedgerState blk
HeaderState blk
headerState :: HeaderState blk
ledgerState :: LedgerState blk
headerState :: forall blk. ExtLedgerState blk -> HeaderState blk
ledgerState :: forall blk. ExtLedgerState blk -> LedgerState blk
..} = ExtLedgerState :: forall blk.
LedgerState blk -> HeaderState blk -> ExtLedgerState blk
ExtLedgerState {
      ledgerState :: LedgerState blk'
ledgerState = LedgerState blk -> LedgerState blk'
coerce LedgerState blk
ledgerState
    , headerState :: HeaderState blk'
headerState = HeaderState blk -> HeaderState blk'
forall blk blk'.
(Coercible
   (ChainDepState (BlockProtocol blk))
   (ChainDepState (BlockProtocol blk')),
 TipInfo blk ~ TipInfo blk') =>
HeaderState blk -> HeaderState blk'
castHeaderState HeaderState blk
headerState
    }