{-# 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 (..)
  , LedgerTables (..)
  , NestedCtxt_ (..)
  , StorageConfig (..)
  , TxId (..)
  ) where

import           Cardano.Ledger.BaseTypes (unNonZero)
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.Ledger.Tables.Utils
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.LedgerDB
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.Util.Condense
import           Ouroboros.Consensus.Util.IndexedMemPack
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 mk = LgrB {
      forall (mk :: MapKind). LedgerState BlockB mk -> Point BlockB
lgrB_tip :: Point BlockB
    }
  deriving (Int -> LedgerState BlockB mk -> ShowS
[LedgerState BlockB mk] -> ShowS
LedgerState BlockB mk -> String
(Int -> LedgerState BlockB mk -> ShowS)
-> (LedgerState BlockB mk -> String)
-> ([LedgerState BlockB mk] -> ShowS)
-> Show (LedgerState BlockB mk)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mk :: MapKind). Int -> LedgerState BlockB mk -> ShowS
forall (mk :: MapKind). [LedgerState BlockB mk] -> ShowS
forall (mk :: MapKind). LedgerState BlockB mk -> String
$cshowsPrec :: forall (mk :: MapKind). Int -> LedgerState BlockB mk -> ShowS
showsPrec :: Int -> LedgerState BlockB mk -> ShowS
$cshow :: forall (mk :: MapKind). LedgerState BlockB mk -> String
show :: LedgerState BlockB mk -> String
$cshowList :: forall (mk :: MapKind). [LedgerState BlockB mk] -> ShowS
showList :: [LedgerState BlockB mk] -> ShowS
Show, LedgerState BlockB mk -> LedgerState BlockB mk -> Bool
(LedgerState BlockB mk -> LedgerState BlockB mk -> Bool)
-> (LedgerState BlockB mk -> LedgerState BlockB mk -> Bool)
-> Eq (LedgerState BlockB mk)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mk :: MapKind).
LedgerState BlockB mk -> LedgerState BlockB mk -> Bool
$c== :: forall (mk :: MapKind).
LedgerState BlockB mk -> LedgerState BlockB mk -> Bool
== :: LedgerState BlockB mk -> LedgerState BlockB mk -> Bool
$c/= :: forall (mk :: MapKind).
LedgerState BlockB mk -> LedgerState BlockB mk -> Bool
/= :: LedgerState BlockB mk -> LedgerState BlockB mk -> Bool
Eq, (forall x. LedgerState BlockB mk -> Rep (LedgerState BlockB mk) x)
-> (forall x.
    Rep (LedgerState BlockB mk) x -> LedgerState BlockB mk)
-> Generic (LedgerState BlockB mk)
forall x. Rep (LedgerState BlockB mk) x -> LedgerState BlockB mk
forall x. LedgerState BlockB mk -> Rep (LedgerState BlockB mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mk :: MapKind) x.
Rep (LedgerState BlockB mk) x -> LedgerState BlockB mk
forall (mk :: MapKind) x.
LedgerState BlockB mk -> Rep (LedgerState BlockB mk) x
$cfrom :: forall (mk :: MapKind) x.
LedgerState BlockB mk -> Rep (LedgerState BlockB mk) x
from :: forall x. LedgerState BlockB mk -> Rep (LedgerState BlockB mk) x
$cto :: forall (mk :: MapKind) x.
Rep (LedgerState BlockB mk) x -> LedgerState BlockB mk
to :: forall x. Rep (LedgerState BlockB mk) x -> LedgerState BlockB mk
Generic, [LedgerState BlockB mk] -> Encoding
LedgerState BlockB mk -> Encoding
(LedgerState BlockB mk -> Encoding)
-> (forall s. Decoder s (LedgerState BlockB mk))
-> ([LedgerState BlockB mk] -> Encoding)
-> (forall s. Decoder s [LedgerState BlockB mk])
-> Serialise (LedgerState BlockB mk)
forall s. Decoder s [LedgerState BlockB mk]
forall s. Decoder s (LedgerState BlockB mk)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
forall (mk :: MapKind). [LedgerState BlockB mk] -> Encoding
forall (mk :: MapKind). LedgerState BlockB mk -> Encoding
forall (mk :: MapKind) s. Decoder s [LedgerState BlockB mk]
forall (mk :: MapKind) s. Decoder s (LedgerState BlockB mk)
$cencode :: forall (mk :: MapKind). LedgerState BlockB mk -> Encoding
encode :: LedgerState BlockB mk -> Encoding
$cdecode :: forall (mk :: MapKind) s. Decoder s (LedgerState BlockB mk)
decode :: forall s. Decoder s (LedgerState BlockB mk)
$cencodeList :: forall (mk :: MapKind). [LedgerState BlockB mk] -> Encoding
encodeList :: [LedgerState BlockB mk] -> Encoding
$cdecodeList :: forall (mk :: MapKind) s. Decoder s [LedgerState BlockB mk]
decodeList :: forall s. Decoder s [LedgerState BlockB mk]
Serialise)
  deriving Context -> LedgerState BlockB mk -> IO (Maybe ThunkInfo)
Proxy (LedgerState BlockB mk) -> String
(Context -> LedgerState BlockB mk -> IO (Maybe ThunkInfo))
-> (Context -> LedgerState BlockB mk -> IO (Maybe ThunkInfo))
-> (Proxy (LedgerState BlockB mk) -> String)
-> NoThunks (LedgerState BlockB mk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (mk :: MapKind).
Context -> LedgerState BlockB mk -> IO (Maybe ThunkInfo)
forall (mk :: MapKind). Proxy (LedgerState BlockB mk) -> String
$cnoThunks :: forall (mk :: MapKind).
Context -> LedgerState BlockB mk -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerState BlockB mk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (mk :: MapKind).
Context -> LedgerState BlockB mk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LedgerState BlockB mk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (mk :: MapKind). Proxy (LedgerState BlockB mk) -> String
showTypeOf :: Proxy (LedgerState BlockB mk) -> String
NoThunks via OnlyCheckWhnfNamed "LgrB" (LedgerState BlockB mk)

{-------------------------------------------------------------------------------
  Ledger Tables
-------------------------------------------------------------------------------}

type instance TxIn  (LedgerState BlockB) = Void
type instance TxOut (LedgerState BlockB) = Void

instance LedgerTablesAreTrivial (LedgerState BlockB) where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
LedgerState BlockB mk -> LedgerState BlockB mk'
convertMapKind (LgrB Point BlockB
x) = Point BlockB -> LedgerState BlockB mk'
forall (mk :: MapKind). Point BlockB -> LedgerState BlockB mk
LgrB Point BlockB
x
instance LedgerTablesAreTrivial (Ticked (LedgerState BlockB)) where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
Ticked (LedgerState BlockB) mk -> Ticked (LedgerState BlockB) mk'
convertMapKind (TickedLedgerStateB LedgerState BlockB mk
x) = LedgerState BlockB mk' -> Ticked (LedgerState BlockB) mk'
forall (mk :: MapKind).
LedgerState BlockB mk -> Ticked (LedgerState BlockB) mk
TickedLedgerStateB (LedgerState BlockB mk -> LedgerState BlockB mk'
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState BlockB mk -> LedgerState BlockB mk'
forall (l :: LedgerStateKind) (mk :: MapKind) (mk' :: MapKind).
LedgerTablesAreTrivial l =>
l mk -> l mk'
convertMapKind LedgerState BlockB mk
x)

deriving via TrivialLedgerTables (LedgerState BlockB)
    instance HasLedgerTables (LedgerState BlockB)
deriving via TrivialLedgerTables (Ticked (LedgerState BlockB))
    instance HasLedgerTables (Ticked (LedgerState BlockB))
deriving via TrivialLedgerTables (LedgerState BlockB)
    instance CanStowLedgerTables (LedgerState BlockB)
deriving via TrivialLedgerTables (LedgerState BlockB)
    instance CanUpgradeLedgerTables (LedgerState BlockB)
deriving via TrivialLedgerTables (LedgerState BlockB)
    instance SerializeTablesWithHint (LedgerState BlockB)
deriving via Void
    instance IndexedMemPack (LedgerState BlockB EmptyMK) Void

type PartialLedgerCfgB = ()

type instance LedgerCfg (LedgerState BlockB) = PartialLedgerCfgB

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

instance GetTip (LedgerState BlockB) where
  getTip :: forall (mk :: MapKind).
LedgerState BlockB mk -> 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 mk -> Point BlockB)
-> LedgerState BlockB mk
-> Point (LedgerState BlockB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState BlockB mk -> Point BlockB
forall (mk :: MapKind). LedgerState BlockB mk -> Point BlockB
lgrB_tip

instance GetTip (Ticked (LedgerState BlockB)) where
  getTip :: forall (mk :: MapKind).
Ticked (LedgerState BlockB) mk
-> 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) mk -> Point (LedgerState BlockB))
-> Ticked (LedgerState BlockB) mk
-> Point (Ticked (LedgerState BlockB))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState BlockB mk -> Point (LedgerState BlockB)
forall (mk :: MapKind).
LedgerState BlockB mk -> Point (LedgerState BlockB)
forall (l :: LedgerStateKind) (mk :: MapKind).
GetTip l =>
l mk -> Point l
getTip (LedgerState BlockB mk -> Point (LedgerState BlockB))
-> (Ticked (LedgerState BlockB) mk -> LedgerState BlockB mk)
-> Ticked (LedgerState BlockB) mk
-> Point (LedgerState BlockB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState BlockB) mk -> LedgerState BlockB mk
forall (mk :: MapKind).
Ticked (LedgerState BlockB) mk -> LedgerState BlockB mk
getTickedLedgerStateB

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

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

  applyChainTickLedgerResult :: ComputeLedgerEvents
-> LedgerCfg (LedgerState BlockB)
-> SlotNo
-> LedgerState BlockB EmptyMK
-> LedgerResult
     (LedgerState BlockB) (Ticked (LedgerState BlockB) DiffMK)
applyChainTickLedgerResult ComputeLedgerEvents
_ LedgerCfg (LedgerState BlockB)
_ SlotNo
_ = Ticked (LedgerState BlockB) DiffMK
-> LedgerResult
     (LedgerState BlockB) (Ticked (LedgerState BlockB) DiffMK)
forall a (l :: LedgerStateKind). a -> LedgerResult l a
pureLedgerResult
                                   (Ticked (LedgerState BlockB) DiffMK
 -> LedgerResult
      (LedgerState BlockB) (Ticked (LedgerState BlockB) DiffMK))
-> (LedgerState BlockB EmptyMK
    -> Ticked (LedgerState BlockB) DiffMK)
-> LedgerState BlockB EmptyMK
-> LedgerResult
     (LedgerState BlockB) (Ticked (LedgerState BlockB) DiffMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState BlockB DiffMK -> Ticked (LedgerState BlockB) DiffMK
forall (mk :: MapKind).
LedgerState BlockB mk -> Ticked (LedgerState BlockB) mk
TickedLedgerStateB
                                   (LedgerState BlockB DiffMK -> Ticked (LedgerState BlockB) DiffMK)
-> (LedgerState BlockB EmptyMK -> LedgerState BlockB DiffMK)
-> LedgerState BlockB EmptyMK
-> Ticked (LedgerState BlockB) DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState BlockB EmptyMK -> LedgerState BlockB DiffMK
forall (l :: LedgerStateKind) (any :: MapKind).
HasLedgerTables l =>
l any -> l DiffMK
noNewTickingDiffs

instance ApplyBlock (LedgerState BlockB) BlockB where
  applyBlockLedgerResultWithValidation :: HasCallStack =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState BlockB)
-> BlockB
-> Ticked (LedgerState BlockB) ValuesMK
-> Except
     (LedgerErr (LedgerState BlockB))
     (LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK))
applyBlockLedgerResultWithValidation = \ValidationPolicy
_ ComputeLedgerEvents
_ LedgerCfg (LedgerState BlockB)
_ BlockB
b Ticked (LedgerState BlockB) ValuesMK
_ -> LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK)
-> Except
     (LedgerErr (LedgerState BlockB))
     (LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK))
forall a. a -> ExceptT (LedgerErr (LedgerState BlockB)) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK)
 -> Except
      (LedgerErr (LedgerState BlockB))
      (LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK)))
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK)
-> Except
     (LedgerErr (LedgerState BlockB))
     (LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK))
forall a b. (a -> b) -> a -> b
$ LedgerState BlockB DiffMK
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK)
forall a (l :: LedgerStateKind). a -> LedgerResult l a
pureLedgerResult (LedgerState BlockB DiffMK
 -> LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK))
-> LedgerState BlockB DiffMK
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK)
forall a b. (a -> b) -> a -> b
$ Point BlockB -> LedgerState BlockB DiffMK
forall (mk :: MapKind). Point BlockB -> LedgerState BlockB mk
LgrB (BlockB -> Point BlockB
forall block. HasHeader block => block -> Point block
blockPoint BlockB
b)
  applyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState BlockB)
-> BlockB
-> Ticked (LedgerState BlockB) ValuesMK
-> Except
     (LedgerErr (LedgerState BlockB))
     (LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK))
applyBlockLedgerResult = ComputeLedgerEvents
-> LedgerCfg (LedgerState BlockB)
-> BlockB
-> Ticked (LedgerState BlockB) ValuesMK
-> Except
     (LedgerErr (LedgerState BlockB))
     (LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK))
forall (l :: LedgerStateKind) blk.
(HasCallStack, ApplyBlock l blk) =>
ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l ValuesMK
-> Except (LedgerErr l) (LedgerResult l (l DiffMK))
defaultApplyBlockLedgerResult
  reapplyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState BlockB)
-> BlockB
-> Ticked (LedgerState BlockB) ValuesMK
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK)
reapplyBlockLedgerResult = (LedgerErr (LedgerState BlockB)
 -> LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState BlockB)
-> BlockB
-> Ticked (LedgerState BlockB) ValuesMK
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK)
forall (l :: LedgerStateKind) blk.
(HasCallStack, ApplyBlock l blk) =>
(LedgerErr l -> LedgerResult l (l DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l ValuesMK
-> LedgerResult l (l DiffMK)
defaultReapplyBlockLedgerResult Void
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK)
LedgerErr (LedgerState BlockB)
-> LedgerResult (LedgerState BlockB) (LedgerState BlockB DiffMK)
forall a. Void -> a
absurd

  getBlockKeySets :: BlockB -> LedgerTables (LedgerState BlockB) KeysMK
getBlockKeySets BlockB
_blk = LedgerTables (LedgerState BlockB) KeysMK
forall (mk :: MapKind) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTablesAreTrivial l) =>
LedgerTables l mk
trivialLedgerTables

instance UpdateLedger BlockB

instance CommonProtocolParams BlockB where
  maxHeaderSize :: forall (mk :: MapKind). LedgerState BlockB mk -> Word32
maxHeaderSize LedgerState BlockB mk
_ = Word32
forall a. Bounded a => a
maxBound
  maxTxSize :: forall (mk :: MapKind). LedgerState BlockB mk -> Word32
maxTxSize     LedgerState BlockB mk
_ = 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 :: forall (mk :: MapKind).
LedgerCfg (LedgerState BlockB)
-> Ticked (LedgerState BlockB) mk
-> LedgerView (BlockProtocol BlockB)
protocolLedgerView   LedgerCfg (LedgerState BlockB)
_ Ticked (LedgerState BlockB) mk
_ = ()
  ledgerViewForecastAt :: forall (mk :: MapKind).
HasCallStack =>
LedgerCfg (LedgerState BlockB)
-> LedgerState BlockB mk
-> Forecast (LedgerView (BlockProtocol BlockB))
ledgerViewForecastAt LedgerCfg (LedgerState BlockB)
_   = LedgerState BlockB mk -> Forecast ()
LedgerState BlockB mk
-> Forecast (LedgerView (BlockProtocol BlockB))
forall (b :: LedgerStateKind) (mk :: MapKind).
GetTip b =>
b mk -> 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 mk
  -> [GenTx BlockB]
  -> IsLeader (BlockProtocol BlockB)
  -> BlockB
forgeBlockB :: forall (mk :: MapKind).
TopLevelConfig BlockB
-> BlockNo
-> SlotNo
-> TickedLedgerState BlockB mk
-> [GenTx BlockB]
-> IsLeader (BlockProtocol BlockB)
-> BlockB
forgeBlockB TopLevelConfig BlockB
_ BlockNo
bno SlotNo
sno (TickedLedgerStateB LedgerState BlockB mk
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    = LazyByteString -> ByteString
LazyByteString -> HeaderHash BlockB
Lazy.toStrict (LazyByteString -> HeaderHash BlockB)
-> (Word64 -> LazyByteString) -> Word64 -> HeaderHash BlockB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> LazyByteString
forall a. Binary a => a -> LazyByteString
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 mk -> ChainHash BlockB
forall blk (mk :: MapKind).
UpdateLedger blk =>
LedgerState blk mk -> ChainHash blk
ledgerTipHash LedgerState BlockB mk
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
-> TickedLedgerState BlockB EmptyMK
-> [Validated (GenTx BlockB)]
-> IsLeader (BlockProtocol BlockB)
-> m BlockB
forgeBlock       = \TopLevelConfig BlockB
cfg BlockNo
bno SlotNo
slot TickedLedgerState BlockB EmptyMK
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
-> TickedLedgerState BlockB EmptyMK
-> [GenTx BlockB]
-> IsLeader (BlockProtocol BlockB)
-> BlockB
forall (mk :: MapKind).
TopLevelConfig BlockB
-> BlockNo
-> SlotNo
-> TickedLedgerState BlockB mk
-> [GenTx BlockB]
-> IsLeader (BlockProtocol BlockB)
-> BlockB
forgeBlockB TopLevelConfig BlockB
cfg BlockNo
bno SlotNo
slot TickedLedgerState BlockB EmptyMK
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 NonZero Word64
k) = Word64 -> SafeZone
History.StandardSafeZone (Word64 -> SafeZone) -> Word64 -> SafeZone
forall a b. (a -> b) -> a -> b
$ NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero 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) ValuesMK
-> Except
     (ApplyTxErr BlockB)
     (Ticked (LedgerState BlockB) DiffMK, Validated (GenTx BlockB))
applyTx   = \LedgerCfg (LedgerState BlockB)
_ WhetherToIntervene
_ SlotNo
_wti GenTx BlockB
tx -> case GenTx BlockB
tx of {}
  reapplyTx :: HasCallStack =>
ComputeDiffs
-> LedgerCfg (LedgerState BlockB)
-> SlotNo
-> Validated (GenTx BlockB)
-> Ticked (LedgerState BlockB) ValuesMK
-> Except (ApplyTxErr BlockB) (TickedLedgerState BlockB TrackingMK)
reapplyTx = \ComputeDiffs
_ LedgerCfg (LedgerState BlockB)
_ SlotNo
_ Validated (GenTx BlockB)
vtx -> case Validated (GenTx BlockB)
vtx of {}

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

  getTransactionKeySets :: GenTx BlockB -> LedgerTables (LedgerState BlockB) KeysMK
getTransactionKeySets GenTx BlockB
_tx = LedgerTables (LedgerState BlockB) KeysMK
forall (mk :: MapKind) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTablesAreTrivial l) =>
LedgerTables l mk
trivialLedgerTables

instance TxLimits BlockB where
  type TxMeasure BlockB = IgnoringOverflow ByteSize32
  blockCapacityTxMeasure :: forall (mk :: MapKind).
LedgerCfg (LedgerState BlockB)
-> TickedLedgerState BlockB mk -> TxMeasure BlockB
blockCapacityTxMeasure LedgerCfg (LedgerState BlockB)
_cfg TickedLedgerState BlockB mk
_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) ValuesMK
-> GenTx BlockB
-> Except (ApplyTxErr BlockB) (TxMeasure BlockB)
txMeasure              LedgerCfg (LedgerState BlockB)
_cfg Ticked (LedgerState BlockB) ValuesMK
_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 fp) where
  showResult :: forall result. BlockQuery BlockB fp result -> result -> String
showResult BlockQuery BlockB fp result
qry = case BlockQuery BlockB fp result
qry of {}

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

instance BlockSupportsLedgerQuery BlockB where
  answerPureBlockQuery :: forall result.
ExtLedgerCfg BlockB
-> BlockQuery BlockB 'QFNoTables result
-> ExtLedgerState BlockB EmptyMK
-> result
answerPureBlockQuery ExtLedgerCfg BlockB
_ BlockQuery BlockB 'QFNoTables result
qry = case BlockQuery BlockB 'QFNoTables result
qry of {}
  answerBlockQueryLookup :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg BlockB
-> BlockQuery BlockB 'QFLookupTables result
-> ReadOnlyForker' m BlockB
-> m result
answerBlockQueryLookup ExtLedgerCfg BlockB
_ BlockQuery BlockB 'QFLookupTables result
qry = case BlockQuery BlockB 'QFLookupTables result
qry of {}
  answerBlockQueryTraverse :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg BlockB
-> BlockQuery BlockB 'QFTraverseTables result
-> ReadOnlyForker' m BlockB
-> m result
answerBlockQueryTraverse ExtLedgerCfg BlockB
_ BlockQuery BlockB 'QFTraverseTables result
qry = case BlockQuery BlockB 'QFTraverseTables result
qry of {}
  blockQueryIsSupportedOnVersion :: forall (fp :: QueryFootprint) result.
BlockQuery BlockB fp result
-> BlockNodeToClientVersion BlockB -> Bool
blockQueryIsSupportedOnVersion BlockQuery BlockB fp result
qry BlockNodeToClientVersion BlockB
_ = case BlockQuery BlockB fp result
qry of {}

instance SameDepIndex2 (BlockQuery BlockB) where
  sameDepIndex2 :: forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
BlockQuery BlockB x a
-> BlockQuery BlockB y b -> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 BlockQuery BlockB x a
qry BlockQuery BlockB y b
_qry' = case BlockQuery BlockB x 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 (LazyByteString -> Header BlockB)
decodeDisk CodecConfig BlockB
_ = Header BlockB -> LazyByteString -> Header BlockB
forall a b. a -> b -> a
const (Header BlockB -> LazyByteString -> Header BlockB)
-> Decoder s (Header BlockB)
-> Decoder s (LazyByteString -> 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 :: forall (mk :: MapKind).
LedgerState BlockB mk -> [(PoolStake, NonEmpty StakePoolRelay)]
getPeers = [(PoolStake, NonEmpty StakePoolRelay)]
-> LedgerState BlockB mk -> [(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 :: forall (mk :: MapKind).
PartialLedgerConfig BlockB
-> EraParams -> Bound -> LedgerState BlockB mk -> Maybe EpochNo
singleEraTransition = \PartialLedgerConfig BlockB
_ EraParams
_ Bound
_ LedgerState BlockB mk
_ -> 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
$ LazyByteString -> Int64
Lazy.length (Header BlockB -> LazyByteString
forall a. Serialise a => a -> LazyByteString
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 EmptyMK)
instance DecodeDisk BlockB (LedgerState BlockB EmptyMK)

instance EncodeDisk BlockB BlockB
instance DecodeDisk BlockB (Lazy.ByteString -> BlockB) where
  decodeDisk :: CodecConfig BlockB
-> forall s. Decoder s (LazyByteString -> BlockB)
decodeDisk CodecConfig BlockB
_ = BlockB -> LazyByteString -> BlockB
forall a b. a -> b -> a
const (BlockB -> LazyByteString -> BlockB)
-> Decoder s BlockB -> Decoder s (LazyByteString -> 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 (LazyByteString -> Header BlockB))
-> forall s. Decoder s (Header BlockB)
forall a.
(forall s. Decoder s (LazyByteString -> a))
-> forall s. Decoder s a
unwrapCBORinCBOR (Header BlockB -> LazyByteString -> Header BlockB
forall a b. a -> b -> a
const (Header BlockB -> LazyByteString -> Header BlockB)
-> Decoder s (Header BlockB)
-> Decoder s (LazyByteString -> 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 PartialLedgerCfgB where
  encodeNodeToClient :: CodecConfig BlockB
-> BlockNodeToClientVersion BlockB -> () -> Encoding
encodeNodeToClient CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = () -> Encoding
forall a. Serialise a => a -> Encoding
encode
  decodeNodeToClient :: CodecConfig BlockB
-> BlockNodeToClientVersion BlockB -> forall s. Decoder s ()
decodeNodeToClient CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = Decoder s ()
forall s. Decoder s ()
forall a s. Serialise a => Decoder s a
decode

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 (SomeBlockQuery (BlockQuery BlockB)) where
  encodeNodeToClient :: CodecConfig BlockB
-> BlockNodeToClientVersion BlockB
-> SomeBlockQuery (BlockQuery BlockB)
-> Encoding
encodeNodeToClient CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = \case {}
  decodeNodeToClient :: CodecConfig BlockB
-> BlockNodeToClientVersion BlockB
-> forall s. Decoder s (SomeBlockQuery (BlockQuery BlockB))
decodeNodeToClient CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = String -> Decoder s (SomeBlockQuery (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 SerialiseBlockQueryResult BlockB BlockQuery where
  encodeBlockQueryResult :: forall (fp :: QueryFootprint) result.
CodecConfig BlockB
-> BlockNodeToClientVersion BlockB
-> BlockQuery BlockB fp result
-> result
-> Encoding
encodeBlockQueryResult CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = \case {}
  decodeBlockQueryResult :: forall (fp :: QueryFootprint) result.
CodecConfig BlockB
-> BlockNodeToClientVersion BlockB
-> BlockQuery BlockB fp result
-> forall s. Decoder s result
decodeBlockQueryResult CodecConfig BlockB
_ BlockNodeToClientVersion BlockB
_ = \case {}