{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Consensus.HardFork.Combinator.B (
    BlockB (..)
  , ProtocolB
  , blockForgingB
  , safeZoneB
    -- * Type family instances
  , BlockConfig (..)
  , CodecConfig (..)
  , ConsensusConfig (..)
  , GenTx (..)
  , Header (..)
  , LedgerState (..)
  , NestedCtxt_ (..)
  , StorageConfig (..)
  , TxId (..)
  ) where

import           Codec.Serialise
import qualified Data.Binary as B
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Void
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (..))
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Config.SupportsNode
import           Ouroboros.Consensus.Forecast
import           Ouroboros.Consensus.HardFork.Combinator
import           Ouroboros.Consensus.HardFork.Combinator.Condense
import           Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
import qualified Ouroboros.Consensus.HardFork.History as History
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.CommonProtocolParams
import           Ouroboros.Consensus.Ledger.Inspect
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Ledger.SupportsPeerSelection
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.Node.InitStorage
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Node.Serialisation
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.Storage.ImmutableDB (simpleChunkInfo)
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.Util.Condense
import           Ouroboros.Consensus.Util.Orphans ()
import           Ouroboros.Network.Block (Serialised, unwrapCBORinCBOR,
                     wrapCBORinCBOR)
import           Ouroboros.Network.Magic
import           Test.Cardano.Slotting.Numeric ()
import           Test.Util.Time (dawnOfTime)

{-------------------------------------------------------------------------------
  BlockB
-------------------------------------------------------------------------------}

data ProtocolB

data instance ConsensusConfig ProtocolB = CfgB {
      ConsensusConfig ProtocolB -> SecurityParam
cfgB_k           :: SecurityParam
    , ConsensusConfig ProtocolB -> Set SlotNo
cfgB_leadInSlots :: Set SlotNo
    }
  deriving Context -> ConsensusConfig ProtocolB -> IO (Maybe ThunkInfo)
Proxy (ConsensusConfig ProtocolB) -> String
(Context -> ConsensusConfig ProtocolB -> IO (Maybe ThunkInfo))
-> (Context -> ConsensusConfig ProtocolB -> IO (Maybe ThunkInfo))
-> (Proxy (ConsensusConfig ProtocolB) -> String)
-> NoThunks (ConsensusConfig ProtocolB)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ConsensusConfig ProtocolB -> IO (Maybe ThunkInfo)
noThunks :: Context -> ConsensusConfig ProtocolB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ConsensusConfig ProtocolB -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ConsensusConfig ProtocolB -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (ConsensusConfig ProtocolB) -> String
showTypeOf :: Proxy (ConsensusConfig ProtocolB) -> String
NoThunks via OnlyCheckWhnfNamed "CfgB" (ConsensusConfig ProtocolB)

instance ConsensusProtocol ProtocolB where
  type ChainDepState ProtocolB = ()
  type LedgerView    ProtocolB = ()
  type IsLeader      ProtocolB = ()
  type CanBeLeader   ProtocolB = ()
  type ValidateView  ProtocolB = ()
  type ValidationErr ProtocolB = Void

  checkIsLeader :: HasCallStack =>
ConsensusConfig ProtocolB
-> CanBeLeader ProtocolB
-> SlotNo
-> Ticked (ChainDepState ProtocolB)
-> Maybe (IsLeader ProtocolB)
checkIsLeader CfgB{Set SlotNo
SecurityParam
cfgB_k :: ConsensusConfig ProtocolB -> SecurityParam
cfgB_leadInSlots :: ConsensusConfig ProtocolB -> Set SlotNo
cfgB_k :: SecurityParam
cfgB_leadInSlots :: Set SlotNo
..} () SlotNo
slot Ticked (ChainDepState ProtocolB)
_ =
      if SlotNo
slot SlotNo -> Set SlotNo -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set SlotNo
cfgB_leadInSlots
      then () -> Maybe ()
forall a. a -> Maybe a
Just ()
      else Maybe ()
Maybe (IsLeader ProtocolB)
forall a. Maybe a
Nothing

  protocolSecurityParam :: ConsensusConfig ProtocolB -> SecurityParam
protocolSecurityParam = ConsensusConfig ProtocolB -> SecurityParam
cfgB_k

  tickChainDepState :: ConsensusConfig ProtocolB
-> LedgerView ProtocolB
-> SlotNo
-> ChainDepState ProtocolB
-> Ticked (ChainDepState ProtocolB)
tickChainDepState     ConsensusConfig ProtocolB
_ LedgerView ProtocolB
_ SlotNo
_ ChainDepState ProtocolB
_ = Ticked ()
Ticked (ChainDepState ProtocolB)
TickedTrivial
  updateChainDepState :: HasCallStack =>
ConsensusConfig ProtocolB
-> ValidateView ProtocolB
-> SlotNo
-> Ticked (ChainDepState ProtocolB)
-> Except (ValidationErr ProtocolB) (ChainDepState ProtocolB)
updateChainDepState   ConsensusConfig ProtocolB
_ ValidateView ProtocolB
_ SlotNo
_ Ticked (ChainDepState ProtocolB)
_ = () -> ExceptT Void Identity ()
forall a. a -> ExceptT Void Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  reupdateChainDepState :: HasCallStack =>
ConsensusConfig ProtocolB
-> ValidateView ProtocolB
-> SlotNo
-> Ticked (ChainDepState ProtocolB)
-> ChainDepState ProtocolB
reupdateChainDepState ConsensusConfig ProtocolB
_ ValidateView ProtocolB
_ SlotNo
_ Ticked (ChainDepState ProtocolB)
_ = ()

data BlockB = BlkB {
      BlockB -> Header BlockB
blkB_header :: Header BlockB
    }
  deriving stock    (Int -> BlockB -> ShowS
[BlockB] -> ShowS
BlockB -> String
(Int -> BlockB -> ShowS)
-> (BlockB -> String) -> ([BlockB] -> ShowS) -> Show BlockB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockB -> ShowS
showsPrec :: Int -> BlockB -> ShowS
$cshow :: BlockB -> String
show :: BlockB -> String
$cshowList :: [BlockB] -> ShowS
showList :: [BlockB] -> ShowS
Show, BlockB -> BlockB -> Bool
(BlockB -> BlockB -> Bool)
-> (BlockB -> BlockB -> Bool) -> Eq BlockB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockB -> BlockB -> Bool
== :: BlockB -> BlockB -> Bool
$c/= :: BlockB -> BlockB -> Bool
/= :: BlockB -> BlockB -> Bool
Eq, (forall x. BlockB -> Rep BlockB x)
-> (forall x. Rep BlockB x -> BlockB) -> Generic BlockB
forall x. Rep BlockB x -> BlockB
forall x. BlockB -> Rep BlockB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockB -> Rep BlockB x
from :: forall x. BlockB -> Rep BlockB x
$cto :: forall x. Rep BlockB x -> BlockB
to :: forall x. Rep BlockB x -> BlockB
Generic)
  deriving anyclass ([BlockB] -> Encoding
BlockB -> Encoding
(BlockB -> Encoding)
-> (forall s. Decoder s BlockB)
-> ([BlockB] -> Encoding)
-> (forall s. Decoder s [BlockB])
-> Serialise BlockB
forall s. Decoder s [BlockB]
forall s. Decoder s BlockB
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: BlockB -> Encoding
encode :: BlockB -> Encoding
$cdecode :: forall s. Decoder s BlockB
decode :: forall s. Decoder s BlockB
$cencodeList :: [BlockB] -> Encoding
encodeList :: [BlockB] -> Encoding
$cdecodeList :: forall s. Decoder s [BlockB]
decodeList :: forall s. Decoder s [BlockB]
Serialise)
  deriving Context -> BlockB -> IO (Maybe ThunkInfo)
Proxy BlockB -> String
(Context -> BlockB -> IO (Maybe ThunkInfo))
-> (Context -> BlockB -> IO (Maybe ThunkInfo))
-> (Proxy BlockB -> String)
-> NoThunks BlockB
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> BlockB -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BlockB -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockB -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy BlockB -> String
showTypeOf :: Proxy BlockB -> String
NoThunks via OnlyCheckWhnfNamed "BlkB" BlockB

data instance Header BlockB = HdrB {
      Header BlockB -> HeaderFields BlockB
hdrB_fields :: HeaderFields BlockB
    , Header BlockB -> ChainHash BlockB
hdrB_prev   :: ChainHash BlockB
    }
  deriving stock    (Int -> Header BlockB -> ShowS
[Header BlockB] -> ShowS
Header BlockB -> String
(Int -> Header BlockB -> ShowS)
-> (Header BlockB -> String)
-> ([Header BlockB] -> ShowS)
-> Show (Header BlockB)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header BlockB -> ShowS
showsPrec :: Int -> Header BlockB -> ShowS
$cshow :: Header BlockB -> String
show :: Header BlockB -> String
$cshowList :: [Header BlockB] -> ShowS
showList :: [Header BlockB] -> ShowS
Show, Header BlockB -> Header BlockB -> Bool
(Header BlockB -> Header BlockB -> Bool)
-> (Header BlockB -> Header BlockB -> Bool) -> Eq (Header BlockB)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Header BlockB -> Header BlockB -> Bool
== :: Header BlockB -> Header BlockB -> Bool
$c/= :: Header BlockB -> Header BlockB -> Bool
/= :: Header BlockB -> Header BlockB -> Bool
Eq, (forall x. Header BlockB -> Rep (Header BlockB) x)
-> (forall x. Rep (Header BlockB) x -> Header BlockB)
-> Generic (Header BlockB)
forall x. Rep (Header BlockB) x -> Header BlockB
forall x. Header BlockB -> Rep (Header BlockB) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Header BlockB -> Rep (Header BlockB) x
from :: forall x. Header BlockB -> Rep (Header BlockB) x
$cto :: forall x. Rep (Header BlockB) x -> Header BlockB
to :: forall x. Rep (Header BlockB) x -> Header BlockB
Generic)
  deriving anyclass ([Header BlockB] -> Encoding
Header BlockB -> Encoding
(Header BlockB -> Encoding)
-> (forall s. Decoder s (Header BlockB))
-> ([Header BlockB] -> Encoding)
-> (forall s. Decoder s [Header BlockB])
-> Serialise (Header BlockB)
forall s. Decoder s [Header BlockB]
forall s. Decoder s (Header BlockB)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: Header BlockB -> Encoding
encode :: Header BlockB -> Encoding
$cdecode :: forall s. Decoder s (Header BlockB)
decode :: forall s. Decoder s (Header BlockB)
$cencodeList :: [Header BlockB] -> Encoding
encodeList :: [Header BlockB] -> Encoding
$cdecodeList :: forall s. Decoder s [Header BlockB]
decodeList :: forall s. Decoder s [Header BlockB]
Serialise)
  deriving Context -> Header BlockB -> IO (Maybe ThunkInfo)
Proxy (Header BlockB) -> String
(Context -> Header BlockB -> IO (Maybe ThunkInfo))
-> (Context -> Header BlockB -> IO (Maybe ThunkInfo))
-> (Proxy (Header BlockB) -> String)
-> NoThunks (Header BlockB)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Header BlockB -> IO (Maybe ThunkInfo)
noThunks :: Context -> Header BlockB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Header BlockB -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Header BlockB -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (Header BlockB) -> String
showTypeOf :: Proxy (Header BlockB) -> String
NoThunks via OnlyCheckWhnfNamed "HdrB" (Header BlockB)

instance GetHeader BlockB where
  getHeader :: BlockB -> Header BlockB
getHeader          = BlockB -> Header BlockB
blkB_header
  blockMatchesHeader :: Header BlockB -> BlockB -> Bool
blockMatchesHeader = \Header BlockB
_ BlockB
_ -> Bool
True -- We are not interested in integrity here
  headerIsEBB :: Header BlockB -> Maybe EpochNo
headerIsEBB        = Maybe EpochNo -> Header BlockB -> Maybe EpochNo
forall a b. a -> b -> a
const Maybe EpochNo
forall a. Maybe a
Nothing

data instance BlockConfig BlockB = BCfgB
  deriving ((forall x. BlockConfig BlockB -> Rep (BlockConfig BlockB) x)
-> (forall x. Rep (BlockConfig BlockB) x -> BlockConfig BlockB)
-> Generic (BlockConfig BlockB)
forall x. Rep (BlockConfig BlockB) x -> BlockConfig BlockB
forall x. BlockConfig BlockB -> Rep (BlockConfig BlockB) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockConfig BlockB -> Rep (BlockConfig BlockB) x
from :: forall x. BlockConfig BlockB -> Rep (BlockConfig BlockB) x
$cto :: forall x. Rep (BlockConfig BlockB) x -> BlockConfig BlockB
to :: forall x. Rep (BlockConfig BlockB) x -> BlockConfig BlockB
Generic, Context -> BlockConfig BlockB -> IO (Maybe ThunkInfo)
Proxy (BlockConfig BlockB) -> String
(Context -> BlockConfig BlockB -> IO (Maybe ThunkInfo))
-> (Context -> BlockConfig BlockB -> IO (Maybe ThunkInfo))
-> (Proxy (BlockConfig BlockB) -> String)
-> NoThunks (BlockConfig BlockB)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> BlockConfig BlockB -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockConfig BlockB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BlockConfig BlockB -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockConfig BlockB -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (BlockConfig BlockB) -> String
showTypeOf :: Proxy (BlockConfig BlockB) -> String
NoThunks)

type instance BlockProtocol BlockB = ProtocolB
type instance HeaderHash    BlockB = Strict.ByteString

data instance CodecConfig BlockB = CCfgB
  deriving ((forall x. CodecConfig BlockB -> Rep (CodecConfig BlockB) x)
-> (forall x. Rep (CodecConfig BlockB) x -> CodecConfig BlockB)
-> Generic (CodecConfig BlockB)
forall x. Rep (CodecConfig BlockB) x -> CodecConfig BlockB
forall x. CodecConfig BlockB -> Rep (CodecConfig BlockB) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CodecConfig BlockB -> Rep (CodecConfig BlockB) x
from :: forall x. CodecConfig BlockB -> Rep (CodecConfig BlockB) x
$cto :: forall x. Rep (CodecConfig BlockB) x -> CodecConfig BlockB
to :: forall x. Rep (CodecConfig BlockB) x -> CodecConfig BlockB
Generic, Context -> CodecConfig BlockB -> IO (Maybe ThunkInfo)
Proxy (CodecConfig BlockB) -> String
(Context -> CodecConfig BlockB -> IO (Maybe ThunkInfo))
-> (Context -> CodecConfig BlockB -> IO (Maybe ThunkInfo))
-> (Proxy (CodecConfig BlockB) -> String)
-> NoThunks (CodecConfig BlockB)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CodecConfig BlockB -> IO (Maybe ThunkInfo)
noThunks :: Context -> CodecConfig BlockB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CodecConfig BlockB -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CodecConfig BlockB -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (CodecConfig BlockB) -> String
showTypeOf :: Proxy (CodecConfig BlockB) -> String
NoThunks)

data instance StorageConfig BlockB = SCfgB
  deriving ((forall x. StorageConfig BlockB -> Rep (StorageConfig BlockB) x)
-> (forall x. Rep (StorageConfig BlockB) x -> StorageConfig BlockB)
-> Generic (StorageConfig BlockB)
forall x. Rep (StorageConfig BlockB) x -> StorageConfig BlockB
forall x. StorageConfig BlockB -> Rep (StorageConfig BlockB) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StorageConfig BlockB -> Rep (StorageConfig BlockB) x
from :: forall x. StorageConfig BlockB -> Rep (StorageConfig BlockB) x
$cto :: forall x. Rep (StorageConfig BlockB) x -> StorageConfig BlockB
to :: forall x. Rep (StorageConfig BlockB) x -> StorageConfig BlockB
Generic, Context -> StorageConfig BlockB -> IO (Maybe ThunkInfo)
Proxy (StorageConfig BlockB) -> String
(Context -> StorageConfig BlockB -> IO (Maybe ThunkInfo))
-> (Context -> StorageConfig BlockB -> IO (Maybe ThunkInfo))
-> (Proxy (StorageConfig BlockB) -> String)
-> NoThunks (StorageConfig BlockB)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> StorageConfig BlockB -> IO (Maybe ThunkInfo)
noThunks :: Context -> StorageConfig BlockB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> StorageConfig BlockB -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> StorageConfig BlockB -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (StorageConfig BlockB) -> String
showTypeOf :: Proxy (StorageConfig BlockB) -> String
NoThunks)

instance ConfigSupportsNode BlockB where
  getSystemStart :: BlockConfig BlockB -> SystemStart
getSystemStart  BlockConfig BlockB
_ = UTCTime -> SystemStart
SystemStart UTCTime
dawnOfTime
  getNetworkMagic :: BlockConfig BlockB -> NetworkMagic
getNetworkMagic BlockConfig BlockB
_ = Word32 -> NetworkMagic
NetworkMagic Word32
0

instance StandardHash BlockB

instance HasHeader BlockB where
  getHeaderFields :: BlockB -> HeaderFields BlockB
getHeaderFields = BlockB -> HeaderFields BlockB
forall blk. GetHeader blk => blk -> HeaderFields blk
getBlockHeaderFields

instance HasHeader (Header BlockB) where
  getHeaderFields :: Header BlockB -> HeaderFields (Header BlockB)
getHeaderFields = HeaderFields BlockB -> HeaderFields (Header BlockB)
forall {k1} {k2} (b :: k1) (b' :: k2).
(HeaderHash b ~ HeaderHash b') =>
HeaderFields b -> HeaderFields b'
castHeaderFields (HeaderFields BlockB -> HeaderFields (Header BlockB))
-> (Header BlockB -> HeaderFields BlockB)
-> Header BlockB
-> HeaderFields (Header BlockB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header BlockB -> HeaderFields BlockB
hdrB_fields

instance GetPrevHash BlockB where
  headerPrevHash :: Header BlockB -> ChainHash BlockB
headerPrevHash = Header BlockB -> ChainHash BlockB
hdrB_prev

instance HasAnnTip BlockB where

instance BasicEnvelopeValidation BlockB where
  -- Use defaults

instance ValidateEnvelope BlockB where

data instance LedgerState BlockB = LgrB {
      LedgerState BlockB -> Point BlockB
lgrB_tip :: Point BlockB
    }
  deriving (Int -> LedgerState BlockB -> ShowS
[LedgerState BlockB] -> ShowS
LedgerState BlockB -> String
(Int -> LedgerState BlockB -> ShowS)
-> (LedgerState BlockB -> String)
-> ([LedgerState BlockB] -> ShowS)
-> Show (LedgerState BlockB)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerState BlockB -> ShowS
showsPrec :: Int -> LedgerState BlockB -> ShowS
$cshow :: LedgerState BlockB -> String
show :: LedgerState BlockB -> String
$cshowList :: [LedgerState BlockB] -> ShowS
showList :: [LedgerState BlockB] -> ShowS
Show, LedgerState BlockB -> LedgerState BlockB -> Bool
(LedgerState BlockB -> LedgerState BlockB -> Bool)
-> (LedgerState BlockB -> LedgerState BlockB -> Bool)
-> Eq (LedgerState BlockB)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LedgerState BlockB -> LedgerState BlockB -> Bool
== :: LedgerState BlockB -> LedgerState BlockB -> Bool
$c/= :: LedgerState BlockB -> LedgerState BlockB -> Bool
/= :: LedgerState BlockB -> LedgerState BlockB -> Bool
Eq, (forall x. LedgerState BlockB -> Rep (LedgerState BlockB) x)
-> (forall x. Rep (LedgerState BlockB) x -> LedgerState BlockB)
-> Generic (LedgerState BlockB)
forall x. Rep (LedgerState BlockB) x -> LedgerState BlockB
forall x. LedgerState BlockB -> Rep (LedgerState BlockB) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LedgerState BlockB -> Rep (LedgerState BlockB) x
from :: forall x. LedgerState BlockB -> Rep (LedgerState BlockB) x
$cto :: forall x. Rep (LedgerState BlockB) x -> LedgerState BlockB
to :: forall x. Rep (LedgerState BlockB) x -> LedgerState BlockB
Generic, [LedgerState BlockB] -> Encoding
LedgerState BlockB -> Encoding
(LedgerState BlockB -> Encoding)
-> (forall s. Decoder s (LedgerState BlockB))
-> ([LedgerState BlockB] -> Encoding)
-> (forall s. Decoder s [LedgerState BlockB])
-> Serialise (LedgerState BlockB)
forall s. Decoder s [LedgerState BlockB]
forall s. Decoder s (LedgerState BlockB)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: LedgerState BlockB -> Encoding
encode :: LedgerState BlockB -> Encoding
$cdecode :: forall s. Decoder s (LedgerState BlockB)
decode :: forall s. Decoder s (LedgerState BlockB)
$cencodeList :: [LedgerState BlockB] -> Encoding
encodeList :: [LedgerState BlockB] -> Encoding
$cdecodeList :: forall s. Decoder s [LedgerState BlockB]
decodeList :: forall s. Decoder s [LedgerState BlockB]
Serialise)
  deriving Context -> LedgerState BlockB -> IO (Maybe ThunkInfo)
Proxy (LedgerState BlockB) -> String
(Context -> LedgerState BlockB -> IO (Maybe ThunkInfo))
-> (Context -> LedgerState BlockB -> IO (Maybe ThunkInfo))
-> (Proxy (LedgerState BlockB) -> String)
-> NoThunks (LedgerState BlockB)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LedgerState BlockB -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerState BlockB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LedgerState BlockB -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LedgerState BlockB -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (LedgerState BlockB) -> String
showTypeOf :: Proxy (LedgerState BlockB) -> String
NoThunks via OnlyCheckWhnfNamed "LgrB" (LedgerState BlockB)

type instance LedgerCfg (LedgerState BlockB) = ()

-- | Ticking has no state on the B ledger state
newtype instance Ticked (LedgerState BlockB) = TickedLedgerStateB {
      Ticked (LedgerState BlockB) -> LedgerState BlockB
getTickedLedgerStateB :: LedgerState BlockB
    }
  deriving Context -> Ticked (LedgerState BlockB) -> IO (Maybe ThunkInfo)
Proxy (Ticked (LedgerState BlockB)) -> String
(Context -> Ticked (LedgerState BlockB) -> IO (Maybe ThunkInfo))
-> (Context -> Ticked (LedgerState BlockB) -> IO (Maybe ThunkInfo))
-> (Proxy (Ticked (LedgerState BlockB)) -> String)
-> NoThunks (Ticked (LedgerState BlockB))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Ticked (LedgerState BlockB) -> IO (Maybe ThunkInfo)
noThunks :: Context -> Ticked (LedgerState BlockB) -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Ticked (LedgerState BlockB) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Ticked (LedgerState BlockB) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (Ticked (LedgerState BlockB)) -> String
showTypeOf :: Proxy (Ticked (LedgerState BlockB)) -> String
NoThunks via OnlyCheckWhnfNamed "TickedLgrB" (Ticked (LedgerState BlockB))

instance GetTip (LedgerState BlockB) where
  getTip :: LedgerState BlockB -> Point (LedgerState BlockB)
getTip = Point BlockB -> Point (LedgerState BlockB)
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point BlockB -> Point (LedgerState BlockB))
-> (LedgerState BlockB -> Point BlockB)
-> LedgerState BlockB
-> Point (LedgerState BlockB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState BlockB -> Point BlockB
lgrB_tip

instance GetTip (Ticked (LedgerState BlockB)) where
  getTip :: Ticked (LedgerState BlockB) -> Point (Ticked (LedgerState BlockB))
getTip = Point (LedgerState BlockB) -> Point (Ticked (LedgerState BlockB))
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (LedgerState BlockB) -> Point (Ticked (LedgerState BlockB)))
-> (Ticked (LedgerState BlockB) -> Point (LedgerState BlockB))
-> Ticked (LedgerState BlockB)
-> Point (Ticked (LedgerState BlockB))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState BlockB -> Point (LedgerState BlockB)
forall l. GetTip l => l -> Point l
getTip (LedgerState BlockB -> Point (LedgerState BlockB))
-> (Ticked (LedgerState BlockB) -> LedgerState BlockB)
-> Ticked (LedgerState BlockB)
-> Point (LedgerState BlockB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState BlockB) -> LedgerState BlockB
getTickedLedgerStateB

instance IsLedger (LedgerState BlockB) where
  type LedgerErr (LedgerState BlockB) = Void

  type AuxLedgerEvent (LedgerState BlockB) =
    VoidLedgerEvent (LedgerState BlockB)

  applyChainTickLedgerResult :: LedgerCfg (LedgerState BlockB)
-> SlotNo
-> LedgerState BlockB
-> LedgerResult (LedgerState BlockB) (Ticked (LedgerState BlockB))
applyChainTickLedgerResult LedgerCfg (LedgerState BlockB)
_ SlotNo
_ = Ticked (LedgerState BlockB)
-> LedgerResult (LedgerState BlockB) (Ticked (LedgerState BlockB))
forall a l. a -> LedgerResult l a
pureLedgerResult (Ticked (LedgerState BlockB)
 -> LedgerResult (LedgerState BlockB) (Ticked (LedgerState BlockB)))
-> (LedgerState BlockB -> Ticked (LedgerState BlockB))
-> LedgerState BlockB
-> LedgerResult (LedgerState BlockB) (Ticked (LedgerState BlockB))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState BlockB -> Ticked (LedgerState BlockB)
TickedLedgerStateB

instance ApplyBlock (LedgerState BlockB) BlockB where
  applyBlockLedgerResult :: HasCallStack =>
LedgerCfg (LedgerState BlockB)
-> BlockB
-> Ticked (LedgerState BlockB)
-> Except
     (LedgerErr (LedgerState BlockB))
     (LedgerResult (LedgerState BlockB) (LedgerState BlockB))
applyBlockLedgerResult   = \LedgerCfg (LedgerState BlockB)
_ BlockB
b Ticked (LedgerState BlockB)
_ -> LedgerResult (LedgerState BlockB) (LedgerState BlockB)
-> Except
     (LedgerErr (LedgerState BlockB))
     (LedgerResult (LedgerState BlockB) (LedgerState BlockB))
forall a. a -> ExceptT (LedgerErr (LedgerState BlockB)) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerResult (LedgerState BlockB) (LedgerState BlockB)
 -> Except
      (LedgerErr (LedgerState BlockB))
      (LedgerResult (LedgerState BlockB) (LedgerState BlockB)))
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB)
-> Except
     (LedgerErr (LedgerState BlockB))
     (LedgerResult (LedgerState BlockB) (LedgerState BlockB))
forall a b. (a -> b) -> a -> b
$ LedgerState BlockB
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB)
forall a l. a -> LedgerResult l a
pureLedgerResult (LedgerState BlockB
 -> LedgerResult (LedgerState BlockB) (LedgerState BlockB))
-> LedgerState BlockB
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB)
forall a b. (a -> b) -> a -> b
$ Point BlockB -> LedgerState BlockB
LgrB (BlockB -> Point BlockB
forall block. HasHeader block => block -> Point block
blockPoint BlockB
b)
  reapplyBlockLedgerResult :: HasCallStack =>
LedgerCfg (LedgerState BlockB)
-> BlockB
-> Ticked (LedgerState BlockB)
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB)
reapplyBlockLedgerResult = \LedgerCfg (LedgerState BlockB)
_ BlockB
b Ticked (LedgerState BlockB)
_ ->          LedgerState BlockB
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB)
forall a l. a -> LedgerResult l a
pureLedgerResult (LedgerState BlockB
 -> LedgerResult (LedgerState BlockB) (LedgerState BlockB))
-> LedgerState BlockB
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB)
forall a b. (a -> b) -> a -> b
$ Point BlockB -> LedgerState BlockB
LgrB (BlockB -> Point BlockB
forall block. HasHeader block => block -> Point block
blockPoint BlockB
b)

instance UpdateLedger BlockB

instance CommonProtocolParams BlockB where
  maxHeaderSize :: LedgerState BlockB -> Word32
maxHeaderSize LedgerState BlockB
_ = Word32
forall a. Bounded a => a
maxBound
  maxTxSize :: LedgerState BlockB -> Word32
maxTxSize     LedgerState BlockB
_ = Word32
forall a. Bounded a => a
maxBound

instance BlockSupportsProtocol BlockB where
  validateView :: BlockConfig BlockB
-> Header BlockB -> ValidateView (BlockProtocol BlockB)
validateView BlockConfig BlockB
_ Header BlockB
_ = ()

instance LedgerSupportsProtocol BlockB where
  protocolLedgerView :: LedgerCfg (LedgerState BlockB)
-> Ticked (LedgerState BlockB) -> LedgerView (BlockProtocol BlockB)
protocolLedgerView   LedgerCfg (LedgerState BlockB)
_ Ticked (LedgerState BlockB)
_ = ()
  ledgerViewForecastAt :: HasCallStack =>
LedgerCfg (LedgerState BlockB)
-> LedgerState BlockB
-> Forecast (LedgerView (BlockProtocol BlockB))
ledgerViewForecastAt LedgerCfg (LedgerState BlockB)
_   = LedgerState BlockB -> Forecast ()
LedgerState BlockB -> Forecast (LedgerView (BlockProtocol BlockB))
forall b. GetTip b => b -> Forecast ()
trivialForecast

instance HasPartialConsensusConfig ProtocolB

instance HasPartialLedgerConfig BlockB

type instance CannotForge           BlockB = Void
type instance ForgeStateInfo        BlockB = ()
type instance ForgeStateUpdateError BlockB = Void

forgeBlockB ::
     TopLevelConfig BlockB
  -> BlockNo
  -> SlotNo
  -> TickedLedgerState BlockB
  -> [GenTx BlockB]
  -> IsLeader (BlockProtocol BlockB)
  -> BlockB
forgeBlockB :: TopLevelConfig BlockB
-> BlockNo
-> SlotNo
-> Ticked (LedgerState BlockB)
-> [GenTx BlockB]
-> IsLeader (BlockProtocol BlockB)
-> BlockB
forgeBlockB TopLevelConfig BlockB
_ BlockNo
bno SlotNo
sno (TickedLedgerStateB LedgerState BlockB
st) [GenTx BlockB]
_txs IsLeader (BlockProtocol BlockB)
_ = BlkB {
      blkB_header :: Header BlockB
blkB_header = HdrB {
          hdrB_fields :: HeaderFields BlockB
hdrB_fields = HeaderFields {
              headerFieldHash :: HeaderHash BlockB
headerFieldHash    = ByteString -> ByteString
ByteString -> HeaderHash BlockB
Lazy.toStrict (ByteString -> HeaderHash BlockB)
-> (Word64 -> ByteString) -> Word64 -> HeaderHash BlockB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Word64 -> HeaderHash BlockB) -> Word64 -> HeaderHash BlockB
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
sno
            , headerFieldSlot :: SlotNo
headerFieldSlot    = SlotNo
sno
            , headerFieldBlockNo :: BlockNo
headerFieldBlockNo = BlockNo
bno
            }
        , hdrB_prev :: ChainHash BlockB
hdrB_prev = LedgerState BlockB -> ChainHash BlockB
forall blk. UpdateLedger blk => LedgerState blk -> ChainHash blk
ledgerTipHash LedgerState BlockB
st
        }
    }

blockForgingB :: Monad m => BlockForging m BlockB
blockForgingB :: forall (m :: * -> *). Monad m => BlockForging m BlockB
blockForgingB = BlockForging {
     forgeLabel :: Text
forgeLabel       = Text
"BlockB"
   , canBeLeader :: CanBeLeader (BlockProtocol BlockB)
canBeLeader      = ()
   , updateForgeState :: TopLevelConfig BlockB
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol BlockB))
-> m (ForgeStateUpdateInfo BlockB)
updateForgeState = \TopLevelConfig BlockB
_ SlotNo
_ Ticked (ChainDepState (BlockProtocol BlockB))
_ -> ForgeStateUpdateInfo BlockB -> m (ForgeStateUpdateInfo BlockB)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForgeStateUpdateInfo BlockB -> m (ForgeStateUpdateInfo BlockB))
-> ForgeStateUpdateInfo BlockB -> m (ForgeStateUpdateInfo BlockB)
forall a b. (a -> b) -> a -> b
$ ForgeStateInfo BlockB -> ForgeStateUpdateInfo BlockB
forall blk. ForgeStateInfo blk -> ForgeStateUpdateInfo blk
ForgeStateUpdated ()
   , checkCanForge :: TopLevelConfig BlockB
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol BlockB))
-> IsLeader (BlockProtocol BlockB)
-> ForgeStateInfo BlockB
-> Either (CannotForge BlockB) ()
checkCanForge    = \TopLevelConfig BlockB
_ SlotNo
_ Ticked (ChainDepState (BlockProtocol BlockB))
_ IsLeader (BlockProtocol BlockB)
_ ForgeStateInfo BlockB
_ -> () -> Either Void ()
forall a. a -> Either Void a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   , forgeBlock :: TopLevelConfig BlockB
-> BlockNo
-> SlotNo
-> Ticked (LedgerState BlockB)
-> [Validated (GenTx BlockB)]
-> IsLeader (BlockProtocol BlockB)
-> m BlockB
forgeBlock       = \TopLevelConfig BlockB
cfg BlockNo
bno SlotNo
slot Ticked (LedgerState BlockB)
st [Validated (GenTx BlockB)]
txs IsLeader (BlockProtocol BlockB)
proof -> BlockB -> m BlockB
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockB -> m BlockB) -> BlockB -> m BlockB
forall a b. (a -> b) -> a -> b
$
       TopLevelConfig BlockB
-> BlockNo
-> SlotNo
-> Ticked (LedgerState BlockB)
-> [GenTx BlockB]
-> IsLeader (BlockProtocol BlockB)
-> BlockB
forgeBlockB TopLevelConfig BlockB
cfg BlockNo
bno SlotNo
slot Ticked (LedgerState BlockB)
st ((Validated (GenTx BlockB) -> GenTx BlockB)
-> [Validated (GenTx BlockB)] -> [GenTx BlockB]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Validated (GenTx BlockB) -> GenTx BlockB
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated [Validated (GenTx BlockB)]
txs) IsLeader (BlockProtocol BlockB)
proof
   }

-- | A basic 'History.SafeZone'
--
-- The mock B ledger has no transactions and so can't end and so needs no
-- safezone. However, we give it a default one anyway, since that makes the
-- test more realistic.
safeZoneB :: SecurityParam -> History.SafeZone
safeZoneB :: SecurityParam -> SafeZone
safeZoneB (SecurityParam Word64
k) = Word64 -> SafeZone
History.StandardSafeZone Word64
k

data instance GenTx BlockB
  deriving (Int -> GenTx BlockB -> ShowS
[GenTx BlockB] -> ShowS
GenTx BlockB -> String
(Int -> GenTx BlockB -> ShowS)
-> (GenTx BlockB -> String)
-> ([GenTx BlockB] -> ShowS)
-> Show (GenTx BlockB)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenTx BlockB -> ShowS
showsPrec :: Int -> GenTx BlockB -> ShowS
$cshow :: GenTx BlockB -> String
show :: GenTx BlockB -> String
$cshowList :: [GenTx BlockB] -> ShowS
showList :: [GenTx BlockB] -> ShowS
Show, GenTx BlockB -> GenTx BlockB -> Bool
(GenTx BlockB -> GenTx BlockB -> Bool)
-> (GenTx BlockB -> GenTx BlockB -> Bool) -> Eq (GenTx BlockB)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenTx BlockB -> GenTx BlockB -> Bool
== :: GenTx BlockB -> GenTx BlockB -> Bool
$c/= :: GenTx BlockB -> GenTx BlockB -> Bool
/= :: GenTx BlockB -> GenTx BlockB -> Bool
Eq, (forall x. GenTx BlockB -> Rep (GenTx BlockB) x)
-> (forall x. Rep (GenTx BlockB) x -> GenTx BlockB)
-> Generic (GenTx BlockB)
forall x. Rep (GenTx BlockB) x -> GenTx BlockB
forall x. GenTx BlockB -> Rep (GenTx BlockB) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenTx BlockB -> Rep (GenTx BlockB) x
from :: forall x. GenTx BlockB -> Rep (GenTx BlockB) x
$cto :: forall x. Rep (GenTx BlockB) x -> GenTx BlockB
to :: forall x. Rep (GenTx BlockB) x -> GenTx BlockB
Generic, Context -> GenTx BlockB -> IO (Maybe ThunkInfo)
Proxy (GenTx BlockB) -> String
(Context -> GenTx BlockB -> IO (Maybe ThunkInfo))
-> (Context -> GenTx BlockB -> IO (Maybe ThunkInfo))
-> (Proxy (GenTx BlockB) -> String)
-> NoThunks (GenTx BlockB)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> GenTx BlockB -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenTx BlockB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenTx BlockB -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> GenTx BlockB -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (GenTx BlockB) -> String
showTypeOf :: Proxy (GenTx BlockB) -> String
NoThunks, [GenTx BlockB] -> Encoding
GenTx BlockB -> Encoding
(GenTx BlockB -> Encoding)
-> (forall s. Decoder s (GenTx BlockB))
-> ([GenTx BlockB] -> Encoding)
-> (forall s. Decoder s [GenTx BlockB])
-> Serialise (GenTx BlockB)
forall s. Decoder s [GenTx BlockB]
forall s. Decoder s (GenTx BlockB)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: GenTx BlockB -> Encoding
encode :: GenTx BlockB -> Encoding
$cdecode :: forall s. Decoder s (GenTx BlockB)
decode :: forall s. Decoder s (GenTx BlockB)
$cencodeList :: [GenTx BlockB] -> Encoding
encodeList :: [GenTx BlockB] -> Encoding
$cdecodeList :: forall s. Decoder s [GenTx BlockB]
decodeList :: forall s. Decoder s [GenTx BlockB]
Serialise)

data instance Validated (GenTx BlockB)
  deriving (Int -> Validated (GenTx BlockB) -> ShowS
[Validated (GenTx BlockB)] -> ShowS
Validated (GenTx BlockB) -> String
(Int -> Validated (GenTx BlockB) -> ShowS)
-> (Validated (GenTx BlockB) -> String)
-> ([Validated (GenTx BlockB)] -> ShowS)
-> Show (Validated (GenTx BlockB))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Validated (GenTx BlockB) -> ShowS
showsPrec :: Int -> Validated (GenTx BlockB) -> ShowS
$cshow :: Validated (GenTx BlockB) -> String
show :: Validated (GenTx BlockB) -> String
$cshowList :: [Validated (GenTx BlockB)] -> ShowS
showList :: [Validated (GenTx BlockB)] -> ShowS
Show, Validated (GenTx BlockB) -> Validated (GenTx BlockB) -> Bool
(Validated (GenTx BlockB) -> Validated (GenTx BlockB) -> Bool)
-> (Validated (GenTx BlockB) -> Validated (GenTx BlockB) -> Bool)
-> Eq (Validated (GenTx BlockB))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Validated (GenTx BlockB) -> Validated (GenTx BlockB) -> Bool
== :: Validated (GenTx BlockB) -> Validated (GenTx BlockB) -> Bool
$c/= :: Validated (GenTx BlockB) -> Validated (GenTx BlockB) -> Bool
/= :: Validated (GenTx BlockB) -> Validated (GenTx BlockB) -> Bool
Eq, (forall x.
 Validated (GenTx BlockB) -> Rep (Validated (GenTx BlockB)) x)
-> (forall x.
    Rep (Validated (GenTx BlockB)) x -> Validated (GenTx BlockB))
-> Generic (Validated (GenTx BlockB))
forall x.
Rep (Validated (GenTx BlockB)) x -> Validated (GenTx BlockB)
forall x.
Validated (GenTx BlockB) -> Rep (Validated (GenTx BlockB)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
Validated (GenTx BlockB) -> Rep (Validated (GenTx BlockB)) x
from :: forall x.
Validated (GenTx BlockB) -> Rep (Validated (GenTx BlockB)) x
$cto :: forall x.
Rep (Validated (GenTx BlockB)) x -> Validated (GenTx BlockB)
to :: forall x.
Rep (Validated (GenTx BlockB)) x -> Validated (GenTx BlockB)
Generic, Context -> Validated (GenTx BlockB) -> IO (Maybe ThunkInfo)
Proxy (Validated (GenTx BlockB)) -> String
(Context -> Validated (GenTx BlockB) -> IO (Maybe ThunkInfo))
-> (Context -> Validated (GenTx BlockB) -> IO (Maybe ThunkInfo))
-> (Proxy (Validated (GenTx BlockB)) -> String)
-> NoThunks (Validated (GenTx BlockB))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Validated (GenTx BlockB) -> IO (Maybe ThunkInfo)
noThunks :: Context -> Validated (GenTx BlockB) -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Validated (GenTx BlockB) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Validated (GenTx BlockB) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (Validated (GenTx BlockB)) -> String
showTypeOf :: Proxy (Validated (GenTx BlockB)) -> String
NoThunks)

type instance ApplyTxErr BlockB = Void

instance LedgerSupportsMempool BlockB where
  applyTx :: LedgerCfg (LedgerState BlockB)
-> WhetherToIntervene
-> SlotNo
-> GenTx BlockB
-> Ticked (LedgerState BlockB)
-> Except
     (ApplyTxErr BlockB)
     (Ticked (LedgerState BlockB), Validated (GenTx BlockB))
applyTx   = \LedgerCfg (LedgerState BlockB)
_ WhetherToIntervene
_ SlotNo
_wti GenTx BlockB
tx -> case GenTx BlockB
tx of {}
  reapplyTx :: HasCallStack =>
LedgerCfg (LedgerState BlockB)
-> SlotNo
-> Validated (GenTx BlockB)
-> Ticked (LedgerState BlockB)
-> Except (ApplyTxErr BlockB) (Ticked (LedgerState BlockB))
reapplyTx = \LedgerCfg (LedgerState BlockB)
_ SlotNo
_ Validated (GenTx BlockB)
vtx -> case Validated (GenTx BlockB)
vtx of {}

  txForgetValidated :: Validated (GenTx BlockB) -> GenTx BlockB
txForgetValidated = \case {}

instance TxLimits BlockB where
  type TxMeasure BlockB = IgnoringOverflow ByteSize32
  blockCapacityTxMeasure :: LedgerCfg (LedgerState BlockB)
-> Ticked (LedgerState BlockB) -> TxMeasure BlockB
blockCapacityTxMeasure LedgerCfg (LedgerState BlockB)
_cfg Ticked (LedgerState BlockB)
_st     = ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteSize32
ByteSize32 (Word32 -> ByteSize32) -> Word32 -> ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32
100 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1024   -- arbitrary
  txMeasure :: LedgerCfg (LedgerState BlockB)
-> Ticked (LedgerState BlockB)
-> GenTx BlockB
-> Except (ApplyTxErr BlockB) (TxMeasure BlockB)
txMeasure              LedgerCfg (LedgerState BlockB)
_cfg Ticked (LedgerState BlockB)
_st GenTx BlockB
_tx = TxMeasure BlockB -> Except (ApplyTxErr BlockB) (TxMeasure BlockB)
forall a. a -> ExceptT (ApplyTxErr BlockB) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxMeasure BlockB -> Except (ApplyTxErr BlockB) (TxMeasure BlockB))
-> TxMeasure BlockB
-> Except (ApplyTxErr BlockB) (TxMeasure BlockB)
forall a b. (a -> b) -> a -> b
$ ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteSize32
ByteSize32 Word32
0

data instance TxId (GenTx BlockB)
  deriving stock    (Int -> TxId (GenTx BlockB) -> ShowS
[TxId (GenTx BlockB)] -> ShowS
TxId (GenTx BlockB) -> String
(Int -> TxId (GenTx BlockB) -> ShowS)
-> (TxId (GenTx BlockB) -> String)
-> ([TxId (GenTx BlockB)] -> ShowS)
-> Show (TxId (GenTx BlockB))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxId (GenTx BlockB) -> ShowS
showsPrec :: Int -> TxId (GenTx BlockB) -> ShowS
$cshow :: TxId (GenTx BlockB) -> String
show :: TxId (GenTx BlockB) -> String
$cshowList :: [TxId (GenTx BlockB)] -> ShowS
showList :: [TxId (GenTx BlockB)] -> ShowS
Show, TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
(TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool)
-> (TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool)
-> Eq (TxId (GenTx BlockB))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
== :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
$c/= :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
/= :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
Eq, Eq (TxId (GenTx BlockB))
Eq (TxId (GenTx BlockB)) =>
(TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Ordering)
-> (TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool)
-> (TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool)
-> (TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool)
-> (TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool)
-> (TxId (GenTx BlockB)
    -> TxId (GenTx BlockB) -> TxId (GenTx BlockB))
-> (TxId (GenTx BlockB)
    -> TxId (GenTx BlockB) -> TxId (GenTx BlockB))
-> Ord (TxId (GenTx BlockB))
TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Ordering
TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> TxId (GenTx BlockB)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Ordering
compare :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Ordering
$c< :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
< :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
$c<= :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
<= :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
$c> :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
> :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
$c>= :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
>= :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> Bool
$cmax :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> TxId (GenTx BlockB)
max :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> TxId (GenTx BlockB)
$cmin :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> TxId (GenTx BlockB)
min :: TxId (GenTx BlockB) -> TxId (GenTx BlockB) -> TxId (GenTx BlockB)
Ord, (forall x. TxId (GenTx BlockB) -> Rep (TxId (GenTx BlockB)) x)
-> (forall x. Rep (TxId (GenTx BlockB)) x -> TxId (GenTx BlockB))
-> Generic (TxId (GenTx BlockB))
forall x. Rep (TxId (GenTx BlockB)) x -> TxId (GenTx BlockB)
forall x. TxId (GenTx BlockB) -> Rep (TxId (GenTx BlockB)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxId (GenTx BlockB) -> Rep (TxId (GenTx BlockB)) x
from :: forall x. TxId (GenTx BlockB) -> Rep (TxId (GenTx BlockB)) x
$cto :: forall x. Rep (TxId (GenTx BlockB)) x -> TxId (GenTx BlockB)
to :: forall x. Rep (TxId (GenTx BlockB)) x -> TxId (GenTx BlockB)
Generic)
  deriving anyclass (Context -> TxId (GenTx BlockB) -> IO (Maybe ThunkInfo)
Proxy (TxId (GenTx BlockB)) -> String
(Context -> TxId (GenTx BlockB) -> IO (Maybe ThunkInfo))
-> (Context -> TxId (GenTx BlockB) -> IO (Maybe ThunkInfo))
-> (Proxy (TxId (GenTx BlockB)) -> String)
-> NoThunks (TxId (GenTx BlockB))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> TxId (GenTx BlockB) -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId (GenTx BlockB) -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TxId (GenTx BlockB) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxId (GenTx BlockB) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (TxId (GenTx BlockB)) -> String
showTypeOf :: Proxy (TxId (GenTx BlockB)) -> String
NoThunks, [TxId (GenTx BlockB)] -> Encoding
TxId (GenTx BlockB) -> Encoding
(TxId (GenTx BlockB) -> Encoding)
-> (forall s. Decoder s (TxId (GenTx BlockB)))
-> ([TxId (GenTx BlockB)] -> Encoding)
-> (forall s. Decoder s [TxId (GenTx BlockB)])
-> Serialise (TxId (GenTx BlockB))
forall s. Decoder s [TxId (GenTx BlockB)]
forall s. Decoder s (TxId (GenTx BlockB))
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: TxId (GenTx BlockB) -> Encoding
encode :: TxId (GenTx BlockB) -> Encoding
$cdecode :: forall s. Decoder s (TxId (GenTx BlockB))
decode :: forall s. Decoder s (TxId (GenTx BlockB))
$cencodeList :: [TxId (GenTx BlockB)] -> Encoding
encodeList :: [TxId (GenTx BlockB)] -> Encoding
$cdecodeList :: forall s. Decoder s [TxId (GenTx BlockB)]
decodeList :: forall s. Decoder s [TxId (GenTx BlockB)]
Serialise)

instance HasTxId (GenTx BlockB) where
  txId :: GenTx BlockB -> TxId (GenTx BlockB)
txId GenTx BlockB
tx = case GenTx BlockB
tx of {}

instance ConvertRawTxId (GenTx BlockB) where
  toRawTxIdHash :: TxId (GenTx BlockB) -> ShortByteString
toRawTxIdHash = \case {}

instance ShowQuery (BlockQuery BlockB) where
  showResult :: forall result. BlockQuery BlockB result -> result -> String
showResult BlockQuery BlockB result
qry = case BlockQuery BlockB result
qry of {}

data instance BlockQuery BlockB result
  deriving (Int -> BlockQuery BlockB result -> ShowS
[BlockQuery BlockB result] -> ShowS
BlockQuery BlockB result -> String
(Int -> BlockQuery BlockB result -> ShowS)
-> (BlockQuery BlockB result -> String)
-> ([BlockQuery BlockB result] -> ShowS)
-> Show (BlockQuery BlockB result)
forall result. Int -> BlockQuery BlockB result -> ShowS
forall result. [BlockQuery BlockB result] -> ShowS
forall result. BlockQuery BlockB result -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall result. Int -> BlockQuery BlockB result -> ShowS
showsPrec :: Int -> BlockQuery BlockB result -> ShowS
$cshow :: forall result. BlockQuery BlockB result -> String
show :: BlockQuery BlockB result -> String
$cshowList :: forall result. [BlockQuery BlockB result] -> ShowS
showList :: [BlockQuery BlockB result] -> ShowS
Show)

instance BlockSupportsLedgerQuery BlockB where
  answerBlockQuery :: forall result.
ExtLedgerCfg BlockB
-> BlockQuery BlockB result -> ExtLedgerState BlockB -> result
answerBlockQuery ExtLedgerCfg BlockB
_ BlockQuery BlockB result
qry = case BlockQuery BlockB result
qry of {}

instance SameDepIndex (BlockQuery BlockB) where
  sameDepIndex :: forall a b.
BlockQuery BlockB a -> BlockQuery BlockB b -> Maybe (a :~: b)
sameDepIndex BlockQuery BlockB a
qry BlockQuery BlockB b
_qry' = case BlockQuery BlockB a
qry of {}

instance ConvertRawHash BlockB where
  toRawHash :: forall (proxy :: * -> *).
proxy BlockB -> HeaderHash BlockB -> ByteString
toRawHash   proxy BlockB
_ = ByteString -> ByteString
HeaderHash BlockB -> ByteString
forall a. a -> a
id
  fromRawHash :: forall (proxy :: * -> *).
proxy BlockB -> ByteString -> HeaderHash BlockB
fromRawHash proxy BlockB
_ = ByteString -> ByteString
ByteString -> HeaderHash BlockB
forall a. a -> a
id
  hashSize :: forall (proxy :: * -> *). proxy BlockB -> Word32
hashSize    proxy BlockB
_ = Word32
8 -- We use the SlotNo as the hash, which is Word64

data instance NestedCtxt_ BlockB f a where
  CtxtB :: NestedCtxt_ BlockB f (f BlockB)

deriving instance Show (NestedCtxt_ BlockB f a)
instance SameDepIndex (NestedCtxt_ BlockB f)

instance TrivialDependency (NestedCtxt_ BlockB f) where
  type TrivialIndex (NestedCtxt_ BlockB f) = f BlockB
  hasSingleIndex :: forall a b.
NestedCtxt_ BlockB f a -> NestedCtxt_ BlockB f b -> a :~: b
hasSingleIndex NestedCtxt_ BlockB f a
R:NestedCtxt_BlockBfa f a
CtxtB NestedCtxt_ BlockB f b
R:NestedCtxt_BlockBfa f b
CtxtB = a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  indexIsTrivial :: NestedCtxt_ BlockB f (TrivialIndex (NestedCtxt_ BlockB f))
indexIsTrivial = NestedCtxt_ BlockB f (f BlockB)
NestedCtxt_ BlockB f (TrivialIndex (NestedCtxt_ BlockB f))
forall (f :: * -> *). NestedCtxt_ BlockB f (f BlockB)
CtxtB

instance EncodeDisk BlockB (Header BlockB)
instance DecodeDisk BlockB (Lazy.ByteString -> Header BlockB) where
  decodeDisk :: CodecConfig BlockB
-> forall s. Decoder s (ByteString -> Header BlockB)
decodeDisk CodecConfig BlockB
_ = Header BlockB -> ByteString -> Header BlockB
forall a b. a -> b -> a
const (Header BlockB -> ByteString -> Header BlockB)
-> Decoder s (Header BlockB)
-> Decoder s (ByteString -> Header BlockB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Header BlockB)
forall s. Decoder s (Header BlockB)
forall a s. Serialise a => Decoder s a
decode

instance EncodeDiskDepIx (NestedCtxt Header) BlockB
instance EncodeDiskDep   (NestedCtxt Header) BlockB

instance DecodeDiskDepIx (NestedCtxt Header) BlockB
instance DecodeDiskDep   (NestedCtxt Header) BlockB

instance HasNestedContent Header BlockB where
  -- Use defaults

instance ReconstructNestedCtxt Header BlockB
  -- Use defaults

instance InspectLedger BlockB where
  -- Use defaults

instance LedgerSupportsPeerSelection BlockB where
  getPeers :: LedgerState BlockB -> [(PoolStake, NonEmpty StakePoolRelay)]
getPeers = [(PoolStake, NonEmpty StakePoolRelay)]
-> LedgerState BlockB -> [(PoolStake, NonEmpty StakePoolRelay)]
forall a b. a -> b -> a
const []

instance NodeInitStorage BlockB where
  nodeCheckIntegrity :: StorageConfig BlockB -> BlockB -> Bool
nodeCheckIntegrity  StorageConfig BlockB
_ BlockB
_ = Bool
True

  -- Pick some chunk size
  nodeImmutableDbChunkInfo :: StorageConfig BlockB -> ChunkInfo
nodeImmutableDbChunkInfo StorageConfig BlockB
_ = EpochSize -> ChunkInfo
simpleChunkInfo EpochSize
10

instance BlockSupportsMetrics BlockB where
  isSelfIssued :: BlockConfig BlockB -> Header BlockB -> WhetherSelfIssued
isSelfIssued = BlockConfig BlockB -> Header BlockB -> WhetherSelfIssued
forall blk. BlockConfig blk -> Header blk -> WhetherSelfIssued
isSelfIssuedConstUnknown

deriving via SelectViewDiffusionPipelining BlockB
  instance BlockSupportsDiffusionPipelining BlockB

instance SingleEraBlock BlockB where
  singleEraInfo :: forall (proxy :: * -> *). proxy BlockB -> SingleEraInfo BlockB
singleEraInfo proxy BlockB
_     = Text -> SingleEraInfo BlockB
forall blk. Text -> SingleEraInfo blk
SingleEraInfo Text
"B"
  singleEraTransition :: PartialLedgerConfig BlockB
-> EraParams -> Bound -> LedgerState BlockB -> Maybe EpochNo
singleEraTransition = \PartialLedgerConfig BlockB
_ EraParams
_ Bound
_ LedgerState BlockB
_ -> Maybe EpochNo
forall a. Maybe a
Nothing

instance HasTxs BlockB where
  extractTxs :: BlockB -> [GenTx BlockB]
extractTxs = [GenTx BlockB] -> BlockB -> [GenTx BlockB]
forall a b. a -> b -> a
const []

{-------------------------------------------------------------------------------
  Condense
-------------------------------------------------------------------------------}

instance CondenseConstraints BlockB

instance Condense BlockB                where condense :: BlockB -> String
condense = BlockB -> String
forall a. Show a => a -> String
show
instance Condense (Header BlockB)       where condense :: Header BlockB -> String
condense = Header BlockB -> String
forall a. Show a => a -> String
show
instance Condense (GenTx BlockB)        where condense :: GenTx BlockB -> String
condense = GenTx BlockB -> String
forall a. Show a => a -> String
show
instance Condense (TxId (GenTx BlockB)) where condense :: TxId (GenTx BlockB) -> String
condense = TxId (GenTx BlockB) -> String
forall a. Show a => a -> String
show

{-------------------------------------------------------------------------------
  Top-level serialisation constraints
-------------------------------------------------------------------------------}

instance HasBinaryBlockInfo BlockB where
  -- Standard cborg generic serialisation is:
  --
  -- > [number of fields in the product]
  -- >   [tag of the constructor]
  -- >   field1
  -- >   ..
  -- >   fieldN
  getBinaryBlockInfo :: BlockB -> BinaryBlockInfo
getBinaryBlockInfo BlkB{Header BlockB
blkB_header :: BlockB -> Header BlockB
blkB_header :: Header BlockB
..} = BinaryBlockInfo {
        headerOffset :: Word16
headerOffset = Word16
2
      , headerSize :: Word16
headerSize   = Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
Lazy.length (Header BlockB -> ByteString
forall a. Serialise a => a -> ByteString
serialise Header BlockB
blkB_header)
      }

instance SerialiseConstraintsHFC          BlockB
instance SerialiseDiskConstraints         BlockB
instance SerialiseNodeToClientConstraints BlockB
instance SerialiseNodeToNodeConstraints   BlockB where
    estimateBlockSize :: Header BlockB -> SizeInBytes
estimateBlockSize = SizeInBytes -> Header BlockB -> SizeInBytes
forall a b. a -> b -> a
const SizeInBytes
0

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

deriving instance Serialise (AnnTip BlockB)

instance EncodeDisk BlockB (LedgerState BlockB)
instance DecodeDisk BlockB (LedgerState BlockB)

instance EncodeDisk BlockB BlockB
instance DecodeDisk BlockB (Lazy.ByteString -> BlockB) where
  decodeDisk :: CodecConfig BlockB -> forall s. Decoder s (ByteString -> BlockB)
decodeDisk CodecConfig BlockB
_ = BlockB -> ByteString -> BlockB
forall a b. a -> b -> a
const (BlockB -> ByteString -> BlockB)
-> Decoder s BlockB -> Decoder s (ByteString -> BlockB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s BlockB
forall s. Decoder s BlockB
forall a s. Serialise a => Decoder s a
decode

instance EncodeDisk BlockB (AnnTip BlockB)
instance DecodeDisk BlockB (AnnTip BlockB)

instance EncodeDisk BlockB ()
instance DecodeDisk BlockB ()

instance HasNetworkProtocolVersion BlockB

{-------------------------------------------------------------------------------
  SerialiseNodeToNode
-------------------------------------------------------------------------------}

instance SerialiseNodeToNode BlockB BlockB
instance SerialiseNodeToNode BlockB Strict.ByteString
instance SerialiseNodeToNode BlockB (Serialised BlockB)
instance SerialiseNodeToNode BlockB (SerialisedHeader BlockB)
instance SerialiseNodeToNode BlockB (GenTx BlockB)
instance SerialiseNodeToNode BlockB (GenTxId BlockB)

-- Must be compatible with @(SerialisedHeader BlockB)@, which uses
-- the @Serialise (SerialisedHeader BlockB)@ instance below
instance SerialiseNodeToNode BlockB (Header BlockB) where
  encodeNodeToNode :: CodecConfig BlockB
-> BlockNodeToNodeVersion BlockB -> Header BlockB -> Encoding
encodeNodeToNode CodecConfig BlockB
_ BlockNodeToNodeVersion BlockB
_ = (Header BlockB -> Encoding) -> Header BlockB -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR   Header BlockB -> Encoding
forall a. Serialise a => a -> Encoding
encode
  decodeNodeToNode :: CodecConfig BlockB
-> BlockNodeToNodeVersion BlockB
-> forall s. Decoder s (Header BlockB)
decodeNodeToNode CodecConfig BlockB
_ BlockNodeToNodeVersion BlockB
_ = (forall s. Decoder s (ByteString -> Header BlockB))
-> forall s. Decoder s (Header BlockB)
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR (Header BlockB -> ByteString -> Header BlockB
forall a b. a -> b -> a
const (Header BlockB -> ByteString -> Header BlockB)
-> Decoder s (Header BlockB)
-> Decoder s (ByteString -> Header BlockB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Header BlockB)
forall s. Decoder s (Header BlockB)
forall a s. Serialise a => Decoder s a
decode)

instance Serialise (SerialisedHeader BlockB) where
  encode :: SerialisedHeader BlockB -> Encoding
encode = SerialisedHeader BlockB -> Encoding
forall blk.
TrivialDependency (NestedCtxt_ blk Header) =>
SerialisedHeader blk -> Encoding
encodeTrivialSerialisedHeader
  decode :: forall s. Decoder s (SerialisedHeader BlockB)
decode = Decoder s (SerialisedHeader BlockB)
forall s. Decoder s (SerialisedHeader BlockB)
forall blk s.
TrivialDependency (NestedCtxt_ blk Header) =>
Decoder s (SerialisedHeader blk)
decodeTrivialSerialisedHeader

{-------------------------------------------------------------------------------
  SerialiseNodeToClient
-------------------------------------------------------------------------------}

instance SerialiseNodeToClient BlockB BlockB
instance SerialiseNodeToClient BlockB (Serialised BlockB)
instance SerialiseNodeToClient BlockB (GenTx BlockB)
instance SerialiseNodeToClient BlockB (GenTxId BlockB)
instance SerialiseNodeToClient BlockB SlotNo

instance SerialiseNodeToClient BlockB Void where
  encodeNodeToClient :: CodecConfig BlockB
-> BlockNodeToClientVersion BlockB -> Void -> Encoding
encodeNodeToClient CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = Void -> Encoding
forall a. Void -> a
absurd
  decodeNodeToClient :: CodecConfig BlockB
-> BlockNodeToClientVersion BlockB -> forall s. Decoder s Void
decodeNodeToClient CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = String -> Decoder s Void
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no ApplyTxErr to be decoded"

instance SerialiseNodeToClient BlockB (SomeSecond BlockQuery BlockB) where
  encodeNodeToClient :: CodecConfig BlockB
-> BlockNodeToClientVersion BlockB
-> SomeSecond BlockQuery BlockB
-> Encoding
encodeNodeToClient CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = \case {}
  decodeNodeToClient :: CodecConfig BlockB
-> BlockNodeToClientVersion BlockB
-> forall s. Decoder s (SomeSecond BlockQuery BlockB)
decodeNodeToClient CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = String -> Decoder s (SomeSecond BlockQuery BlockB)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"there are no queries to be decoded"

instance SerialiseResult BlockB (BlockQuery BlockB) where
  encodeResult :: forall result.
CodecConfig BlockB
-> BlockNodeToClientVersion BlockB
-> BlockQuery BlockB result
-> result
-> Encoding
encodeResult CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = \case {}
  decodeResult :: forall result.
CodecConfig BlockB
-> BlockNodeToClientVersion BlockB
-> BlockQuery BlockB result
-> forall s. Decoder s result
decodeResult CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = \case {}