{-# 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 }