{-# 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
    ExtLedgerCfg (..)
  , ExtLedgerState (..)
  , ExtValidationError (..)
    -- * Serialisation
  , decodeExtLedgerState
  , encodeExtLedgerState
    -- * 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.Functor ((<&>))
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

  type AuxLedgerEvent (ExtLedgerState blk) = AuxLedgerEvent (LedgerState blk)

  applyChainTickLedgerResult :: LedgerCfg (ExtLedgerState blk)
-> SlotNo
-> ExtLedgerState blk
-> LedgerResult (ExtLedgerState blk) (Ticked (ExtLedgerState blk))
applyChainTickLedgerResult LedgerCfg (ExtLedgerState blk)
cfg SlotNo
slot (ExtLedgerState LedgerState blk
ledger HeaderState blk
header) =
      LedgerResult (LedgerState blk) (Ticked (LedgerState blk))
-> LedgerResult (ExtLedgerState blk) (Ticked (LedgerState blk))
forall l l' a.
(AuxLedgerEvent l ~ AuxLedgerEvent l') =>
LedgerResult l a -> LedgerResult l' a
castLedgerResult LedgerResult (LedgerState blk) (Ticked (LedgerState blk))
ledgerResult LedgerResult (ExtLedgerState blk) (Ticked (LedgerState blk))
-> (Ticked (LedgerState blk) -> Ticked (ExtLedgerState blk))
-> LedgerResult (ExtLedgerState blk) (Ticked (ExtLedgerState blk))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Ticked (LedgerState blk)
tickedLedgerState ->
      let 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
      in 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

      ledgerResult :: LedgerResult (LedgerState blk) (Ticked (LedgerState blk))
ledgerResult = LedgerConfig blk
-> SlotNo
-> LedgerState blk
-> LedgerResult (LedgerState blk) (Ticked (LedgerState blk))
forall l.
IsLedger l =>
LedgerCfg l -> SlotNo -> l -> LedgerResult l (Ticked l)
applyChainTickLedgerResult LedgerConfig blk
lcfg SlotNo
slot LedgerState blk
ledger

instance LedgerSupportsProtocol blk => ApplyBlock (ExtLedgerState blk) blk where
  applyBlockLedgerResult :: LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk)
-> Except
     (LedgerErr (ExtLedgerState blk))
     (LedgerResult (ExtLedgerState blk) (ExtLedgerState blk))
applyBlockLedgerResult LedgerCfg (ExtLedgerState blk)
cfg blk
blk TickedExtLedgerState{..} = do
    LedgerResult (LedgerState blk) (LedgerState blk)
ledgerResult <-
        (LedgerErr (LedgerState blk) -> ExtValidationError blk)
-> Except
     (LedgerErr (LedgerState blk))
     (LedgerResult (LedgerState blk) (LedgerState blk))
-> Except
     (ExtValidationError blk)
     (LedgerResult (LedgerState blk) (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))
   (LedgerResult (LedgerState blk) (LedgerState blk))
 -> Except
      (ExtValidationError blk)
      (LedgerResult (LedgerState blk) (LedgerState blk)))
-> Except
     (LedgerErr (LedgerState blk))
     (LedgerResult (LedgerState blk) (LedgerState blk))
-> Except
     (ExtValidationError blk)
     (LedgerResult (LedgerState blk) (LedgerState blk))
forall a b. (a -> b) -> a -> b
$ LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk)
-> Except
     (LedgerErr (LedgerState blk))
     (LedgerResult (LedgerState blk) (LedgerState blk))
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
LedgerCfg l
-> blk -> Ticked l -> Except (LedgerErr l) (LedgerResult l l)
applyBlockLedgerResult
          (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 blk
hdr <-
        (HeaderError blk -> ExtValidationError blk)
-> Except (HeaderError blk) (HeaderState blk)
-> Except (ExtValidationError blk) (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)
 -> Except (ExtValidationError blk) (HeaderState blk))
-> Except (HeaderError blk) (HeaderState blk)
-> Except (ExtValidationError blk) (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 @blk
          (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
    LedgerResult (ExtLedgerState blk) (ExtLedgerState blk)
-> ExceptT
     (ExtValidationError blk)
     Identity
     (LedgerResult (ExtLedgerState blk) (ExtLedgerState blk))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LedgerResult (ExtLedgerState blk) (ExtLedgerState blk)
 -> ExceptT
      (ExtValidationError blk)
      Identity
      (LedgerResult (ExtLedgerState blk) (ExtLedgerState blk)))
-> LedgerResult (ExtLedgerState blk) (ExtLedgerState blk)
-> ExceptT
     (ExtValidationError blk)
     Identity
     (LedgerResult (ExtLedgerState blk) (ExtLedgerState blk))
forall a b. (a -> b) -> a -> b
$ (\LedgerState blk
l -> LedgerState blk -> HeaderState blk -> ExtLedgerState blk
forall blk.
LedgerState blk -> HeaderState blk -> ExtLedgerState blk
ExtLedgerState LedgerState blk
l HeaderState blk
hdr) (LedgerState blk -> ExtLedgerState blk)
-> LedgerResult (ExtLedgerState blk) (LedgerState blk)
-> LedgerResult (ExtLedgerState blk) (ExtLedgerState blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LedgerResult (LedgerState blk) (LedgerState blk)
-> LedgerResult (ExtLedgerState blk) (LedgerState blk)
forall l l' a.
(AuxLedgerEvent l ~ AuxLedgerEvent l') =>
LedgerResult l a -> LedgerResult l' a
castLedgerResult LedgerResult (LedgerState blk) (LedgerState blk)
ledgerResult

  reapplyBlockLedgerResult :: LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk)
-> LedgerResult (ExtLedgerState blk) (ExtLedgerState blk)
reapplyBlockLedgerResult LedgerCfg (ExtLedgerState blk)
cfg blk
blk TickedExtLedgerState{..} =
      (\LedgerState blk
l -> LedgerState blk -> HeaderState blk -> ExtLedgerState blk
forall blk.
LedgerState blk -> HeaderState blk -> ExtLedgerState blk
ExtLedgerState LedgerState blk
l HeaderState blk
hdr) (LedgerState blk -> ExtLedgerState blk)
-> LedgerResult (ExtLedgerState blk) (LedgerState blk)
-> LedgerResult (ExtLedgerState blk) (ExtLedgerState blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LedgerResult (LedgerState blk) (LedgerState blk)
-> LedgerResult (ExtLedgerState blk) (LedgerState blk)
forall l l' a.
(AuxLedgerEvent l ~ AuxLedgerEvent l') =>
LedgerResult l a -> LedgerResult l' a
castLedgerResult LedgerResult (LedgerState blk) (LedgerState blk)
ledgerResult
    where
      ledgerResult :: LedgerResult (LedgerState blk) (LedgerState blk)
ledgerResult =
        LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk)
-> LedgerResult (LedgerState blk) (LedgerState blk)
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
LedgerCfg l -> blk -> Ticked l -> LedgerResult l l
reapplyBlockLedgerResult
          (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
      hdr :: HeaderState blk
hdr      =
        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
    }