{-# 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.A
  ( BlockA (..)
  , ProtocolA
  , blockForgingA
  , safeFromTipA
  , stabilityWindowA

    -- * Additional types
  , PartialLedgerConfigA (..)
  , TxPayloadA (..)

    -- * Type family instances
  , BlockConfig (..)
  , CodecConfig (..)
  , ConsensusConfig (..)
  , GenTx (..)
  , Header (..)
  , LedgerState (..)
  , LedgerTables (..)
  , NestedCtxt_ (..)
  , StorageConfig (..)
  , TxId (..)
  ) where

import Cardano.Ledger.BaseTypes.NonZero
import Cardano.Slotting.EpochInfo
import Codec.Serialise
import Control.Monad (guard)
import qualified Data.Binary as B
import Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Short as SBS
import Data.Functor.Identity
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Void
import Data.Word
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 Ouroboros.Consensus.HardFork.History
  ( Bound (..)
  , EraParams (..)
  )
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 (repeatedlyM)
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)

{-------------------------------------------------------------------------------
  BlockA
-------------------------------------------------------------------------------}

data ProtocolA

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

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

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

  protocolSecurityParam :: ConsensusConfig ProtocolA -> SecurityParam
protocolSecurityParam = ConsensusConfig ProtocolA -> SecurityParam
cfgA_k

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

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

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

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

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

type instance BlockProtocol BlockA = ProtocolA
type instance HeaderHash BlockA = Strict.ByteString

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

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

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

instance StandardHash BlockA

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

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

instance GetPrevHash BlockA where
  headerPrevHash :: Header BlockA -> ChainHash BlockA
headerPrevHash = Header BlockA -> ChainHash BlockA
hdrA_prev

instance HasAnnTip BlockA

instance BasicEnvelopeValidation BlockA

-- Use defaults

instance ValidateEnvelope BlockA

data instance LedgerState BlockA mk = LgrA
  { forall (mk :: MapKind). LedgerState BlockA mk -> Point BlockA
lgrA_tip :: Point BlockA
  , forall (mk :: MapKind). LedgerState BlockA mk -> Maybe SlotNo
lgrA_transition :: Maybe SlotNo
  -- ^ The 'SlotNo' of the block containing the 'InitiateAtoB' transaction
  }
  deriving (Int -> LedgerState BlockA mk -> ShowS
[LedgerState BlockA mk] -> ShowS
LedgerState BlockA mk -> String
(Int -> LedgerState BlockA mk -> ShowS)
-> (LedgerState BlockA mk -> String)
-> ([LedgerState BlockA mk] -> ShowS)
-> Show (LedgerState BlockA mk)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mk :: MapKind). Int -> LedgerState BlockA mk -> ShowS
forall (mk :: MapKind). [LedgerState BlockA mk] -> ShowS
forall (mk :: MapKind). LedgerState BlockA mk -> String
$cshowsPrec :: forall (mk :: MapKind). Int -> LedgerState BlockA mk -> ShowS
showsPrec :: Int -> LedgerState BlockA mk -> ShowS
$cshow :: forall (mk :: MapKind). LedgerState BlockA mk -> String
show :: LedgerState BlockA mk -> String
$cshowList :: forall (mk :: MapKind). [LedgerState BlockA mk] -> ShowS
showList :: [LedgerState BlockA mk] -> ShowS
Show, LedgerState BlockA mk -> LedgerState BlockA mk -> Bool
(LedgerState BlockA mk -> LedgerState BlockA mk -> Bool)
-> (LedgerState BlockA mk -> LedgerState BlockA mk -> Bool)
-> Eq (LedgerState BlockA mk)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mk :: MapKind).
LedgerState BlockA mk -> LedgerState BlockA mk -> Bool
$c== :: forall (mk :: MapKind).
LedgerState BlockA mk -> LedgerState BlockA mk -> Bool
== :: LedgerState BlockA mk -> LedgerState BlockA mk -> Bool
$c/= :: forall (mk :: MapKind).
LedgerState BlockA mk -> LedgerState BlockA mk -> Bool
/= :: LedgerState BlockA mk -> LedgerState BlockA mk -> Bool
Eq, (forall x. LedgerState BlockA mk -> Rep (LedgerState BlockA mk) x)
-> (forall x.
    Rep (LedgerState BlockA mk) x -> LedgerState BlockA mk)
-> Generic (LedgerState BlockA mk)
forall x. Rep (LedgerState BlockA mk) x -> LedgerState BlockA mk
forall x. LedgerState BlockA mk -> Rep (LedgerState BlockA mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mk :: MapKind) x.
Rep (LedgerState BlockA mk) x -> LedgerState BlockA mk
forall (mk :: MapKind) x.
LedgerState BlockA mk -> Rep (LedgerState BlockA mk) x
$cfrom :: forall (mk :: MapKind) x.
LedgerState BlockA mk -> Rep (LedgerState BlockA mk) x
from :: forall x. LedgerState BlockA mk -> Rep (LedgerState BlockA mk) x
$cto :: forall (mk :: MapKind) x.
Rep (LedgerState BlockA mk) x -> LedgerState BlockA mk
to :: forall x. Rep (LedgerState BlockA mk) x -> LedgerState BlockA mk
Generic, [LedgerState BlockA mk] -> Encoding
LedgerState BlockA mk -> Encoding
(LedgerState BlockA mk -> Encoding)
-> (forall s. Decoder s (LedgerState BlockA mk))
-> ([LedgerState BlockA mk] -> Encoding)
-> (forall s. Decoder s [LedgerState BlockA mk])
-> Serialise (LedgerState BlockA mk)
forall s. Decoder s [LedgerState BlockA mk]
forall s. Decoder s (LedgerState BlockA mk)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
forall (mk :: MapKind). [LedgerState BlockA mk] -> Encoding
forall (mk :: MapKind). LedgerState BlockA mk -> Encoding
forall (mk :: MapKind) s. Decoder s [LedgerState BlockA mk]
forall (mk :: MapKind) s. Decoder s (LedgerState BlockA mk)
$cencode :: forall (mk :: MapKind). LedgerState BlockA mk -> Encoding
encode :: LedgerState BlockA mk -> Encoding
$cdecode :: forall (mk :: MapKind) s. Decoder s (LedgerState BlockA mk)
decode :: forall s. Decoder s (LedgerState BlockA mk)
$cencodeList :: forall (mk :: MapKind). [LedgerState BlockA mk] -> Encoding
encodeList :: [LedgerState BlockA mk] -> Encoding
$cdecodeList :: forall (mk :: MapKind) s. Decoder s [LedgerState BlockA mk]
decodeList :: forall s. Decoder s [LedgerState BlockA mk]
Serialise)
  deriving Context -> LedgerState BlockA mk -> IO (Maybe ThunkInfo)
Proxy (LedgerState BlockA mk) -> String
(Context -> LedgerState BlockA mk -> IO (Maybe ThunkInfo))
-> (Context -> LedgerState BlockA mk -> IO (Maybe ThunkInfo))
-> (Proxy (LedgerState BlockA mk) -> String)
-> NoThunks (LedgerState BlockA mk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (mk :: MapKind).
Context -> LedgerState BlockA mk -> IO (Maybe ThunkInfo)
forall (mk :: MapKind). Proxy (LedgerState BlockA mk) -> String
$cnoThunks :: forall (mk :: MapKind).
Context -> LedgerState BlockA mk -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerState BlockA mk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (mk :: MapKind).
Context -> LedgerState BlockA mk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LedgerState BlockA mk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (mk :: MapKind). Proxy (LedgerState BlockA mk) -> String
showTypeOf :: Proxy (LedgerState BlockA mk) -> String
NoThunks via OnlyCheckWhnfNamed "LgrA" (LedgerState BlockA mk)

-- | Ticking has no state on the A ledger state
newtype instance Ticked (LedgerState BlockA) mk = TickedLedgerStateA
  { forall (mk :: MapKind).
Ticked (LedgerState BlockA) mk -> LedgerState BlockA mk
getTickedLedgerStateA :: LedgerState BlockA mk
  }
  deriving stock ((forall x.
 Ticked (LedgerState BlockA) mk
 -> Rep (Ticked (LedgerState BlockA) mk) x)
-> (forall x.
    Rep (Ticked (LedgerState BlockA) mk) x
    -> Ticked (LedgerState BlockA) mk)
-> Generic (Ticked (LedgerState BlockA) mk)
forall x.
Rep (Ticked (LedgerState BlockA) mk) x
-> Ticked (LedgerState BlockA) mk
forall x.
Ticked (LedgerState BlockA) mk
-> Rep (Ticked (LedgerState BlockA) mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mk :: MapKind) x.
Rep (Ticked (LedgerState BlockA) mk) x
-> Ticked (LedgerState BlockA) mk
forall (mk :: MapKind) x.
Ticked (LedgerState BlockA) mk
-> Rep (Ticked (LedgerState BlockA) mk) x
$cfrom :: forall (mk :: MapKind) x.
Ticked (LedgerState BlockA) mk
-> Rep (Ticked (LedgerState BlockA) mk) x
from :: forall x.
Ticked (LedgerState BlockA) mk
-> Rep (Ticked (LedgerState BlockA) mk) x
$cto :: forall (mk :: MapKind) x.
Rep (Ticked (LedgerState BlockA) mk) x
-> Ticked (LedgerState BlockA) mk
to :: forall x.
Rep (Ticked (LedgerState BlockA) mk) x
-> Ticked (LedgerState BlockA) mk
Generic, Int -> Ticked (LedgerState BlockA) mk -> ShowS
[Ticked (LedgerState BlockA) mk] -> ShowS
Ticked (LedgerState BlockA) mk -> String
(Int -> Ticked (LedgerState BlockA) mk -> ShowS)
-> (Ticked (LedgerState BlockA) mk -> String)
-> ([Ticked (LedgerState BlockA) mk] -> ShowS)
-> Show (Ticked (LedgerState BlockA) mk)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mk :: MapKind).
Int -> Ticked (LedgerState BlockA) mk -> ShowS
forall (mk :: MapKind). [Ticked (LedgerState BlockA) mk] -> ShowS
forall (mk :: MapKind). Ticked (LedgerState BlockA) mk -> String
$cshowsPrec :: forall (mk :: MapKind).
Int -> Ticked (LedgerState BlockA) mk -> ShowS
showsPrec :: Int -> Ticked (LedgerState BlockA) mk -> ShowS
$cshow :: forall (mk :: MapKind). Ticked (LedgerState BlockA) mk -> String
show :: Ticked (LedgerState BlockA) mk -> String
$cshowList :: forall (mk :: MapKind). [Ticked (LedgerState BlockA) mk] -> ShowS
showList :: [Ticked (LedgerState BlockA) mk] -> ShowS
Show, Ticked (LedgerState BlockA) mk
-> Ticked (LedgerState BlockA) mk -> Bool
(Ticked (LedgerState BlockA) mk
 -> Ticked (LedgerState BlockA) mk -> Bool)
-> (Ticked (LedgerState BlockA) mk
    -> Ticked (LedgerState BlockA) mk -> Bool)
-> Eq (Ticked (LedgerState BlockA) mk)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mk :: MapKind).
Ticked (LedgerState BlockA) mk
-> Ticked (LedgerState BlockA) mk -> Bool
$c== :: forall (mk :: MapKind).
Ticked (LedgerState BlockA) mk
-> Ticked (LedgerState BlockA) mk -> Bool
== :: Ticked (LedgerState BlockA) mk
-> Ticked (LedgerState BlockA) mk -> Bool
$c/= :: forall (mk :: MapKind).
Ticked (LedgerState BlockA) mk
-> Ticked (LedgerState BlockA) mk -> Bool
/= :: Ticked (LedgerState BlockA) mk
-> Ticked (LedgerState BlockA) mk -> Bool
Eq)
  deriving Context -> Ticked (LedgerState BlockA) mk -> IO (Maybe ThunkInfo)
Proxy (Ticked (LedgerState BlockA) mk) -> String
(Context -> Ticked (LedgerState BlockA) mk -> IO (Maybe ThunkInfo))
-> (Context
    -> Ticked (LedgerState BlockA) mk -> IO (Maybe ThunkInfo))
-> (Proxy (Ticked (LedgerState BlockA) mk) -> String)
-> NoThunks (Ticked (LedgerState BlockA) mk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (mk :: MapKind).
Context -> Ticked (LedgerState BlockA) mk -> IO (Maybe ThunkInfo)
forall (mk :: MapKind).
Proxy (Ticked (LedgerState BlockA) mk) -> String
$cnoThunks :: forall (mk :: MapKind).
Context -> Ticked (LedgerState BlockA) mk -> IO (Maybe ThunkInfo)
noThunks :: Context -> Ticked (LedgerState BlockA) mk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (mk :: MapKind).
Context -> Ticked (LedgerState BlockA) mk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Ticked (LedgerState BlockA) mk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (mk :: MapKind).
Proxy (Ticked (LedgerState BlockA) mk) -> String
showTypeOf :: Proxy (Ticked (LedgerState BlockA) mk) -> String
NoThunks via OnlyCheckWhnfNamed "TickedLgrA" (Ticked (LedgerState BlockA) mk)

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

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

instance LedgerTablesAreTrivial (LedgerState BlockA) where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
LedgerState BlockA mk -> LedgerState BlockA mk'
convertMapKind (LgrA Point BlockA
x Maybe SlotNo
y) = Point BlockA -> Maybe SlotNo -> LedgerState BlockA mk'
forall (mk :: MapKind).
Point BlockA -> Maybe SlotNo -> LedgerState BlockA mk
LgrA Point BlockA
x Maybe SlotNo
y
instance LedgerTablesAreTrivial (Ticked (LedgerState BlockA)) where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
Ticked (LedgerState BlockA) mk -> Ticked (LedgerState BlockA) mk'
convertMapKind (TickedLedgerStateA LedgerState BlockA mk
x) = LedgerState BlockA mk' -> Ticked (LedgerState BlockA) mk'
forall (mk :: MapKind).
LedgerState BlockA mk -> Ticked (LedgerState BlockA) mk
TickedLedgerStateA (LedgerState BlockA mk -> LedgerState BlockA mk'
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState BlockA mk -> LedgerState BlockA mk'
forall (l :: MapKind -> *) (mk :: MapKind) (mk' :: MapKind).
LedgerTablesAreTrivial l =>
l mk -> l mk'
convertMapKind LedgerState BlockA mk
x)
deriving via
  Void
  instance
    IndexedMemPack (LedgerState BlockA EmptyMK) Void
deriving via
  TrivialLedgerTables (LedgerState BlockA)
  instance
    HasLedgerTables (LedgerState BlockA)
deriving via
  TrivialLedgerTables (Ticked (LedgerState BlockA))
  instance
    HasLedgerTables (Ticked (LedgerState BlockA))
deriving via
  TrivialLedgerTables (LedgerState BlockA)
  instance
    CanStowLedgerTables (LedgerState BlockA)
deriving via
  TrivialLedgerTables (LedgerState BlockA)
  instance
    CanUpgradeLedgerTables (LedgerState BlockA)
deriving via
  TrivialLedgerTables (LedgerState BlockA)
  instance
    SerializeTablesWithHint (LedgerState BlockA)

data PartialLedgerConfigA = LCfgA
  { PartialLedgerConfigA -> SecurityParam
lcfgA_k :: SecurityParam
  , PartialLedgerConfigA -> SystemStart
lcfgA_systemStart :: SystemStart
  , PartialLedgerConfigA -> Map SlotNo [GenTx BlockA]
lcfgA_forgeTxs :: Map SlotNo [GenTx BlockA]
  }
  deriving Int -> PartialLedgerConfigA -> ShowS
[PartialLedgerConfigA] -> ShowS
PartialLedgerConfigA -> String
(Int -> PartialLedgerConfigA -> ShowS)
-> (PartialLedgerConfigA -> String)
-> ([PartialLedgerConfigA] -> ShowS)
-> Show PartialLedgerConfigA
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PartialLedgerConfigA -> ShowS
showsPrec :: Int -> PartialLedgerConfigA -> ShowS
$cshow :: PartialLedgerConfigA -> String
show :: PartialLedgerConfigA -> String
$cshowList :: [PartialLedgerConfigA] -> ShowS
showList :: [PartialLedgerConfigA] -> ShowS
Show
  deriving Context -> PartialLedgerConfigA -> IO (Maybe ThunkInfo)
Proxy PartialLedgerConfigA -> String
(Context -> PartialLedgerConfigA -> IO (Maybe ThunkInfo))
-> (Context -> PartialLedgerConfigA -> IO (Maybe ThunkInfo))
-> (Proxy PartialLedgerConfigA -> String)
-> NoThunks PartialLedgerConfigA
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PartialLedgerConfigA -> IO (Maybe ThunkInfo)
noThunks :: Context -> PartialLedgerConfigA -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PartialLedgerConfigA -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PartialLedgerConfigA -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PartialLedgerConfigA -> String
showTypeOf :: Proxy PartialLedgerConfigA -> String
NoThunks via OnlyCheckWhnfNamed "LCfgA" PartialLedgerConfigA
  deriving (forall x. PartialLedgerConfigA -> Rep PartialLedgerConfigA x)
-> (forall x. Rep PartialLedgerConfigA x -> PartialLedgerConfigA)
-> Generic PartialLedgerConfigA
forall x. Rep PartialLedgerConfigA x -> PartialLedgerConfigA
forall x. PartialLedgerConfigA -> Rep PartialLedgerConfigA x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PartialLedgerConfigA -> Rep PartialLedgerConfigA x
from :: forall x. PartialLedgerConfigA -> Rep PartialLedgerConfigA x
$cto :: forall x. Rep PartialLedgerConfigA x -> PartialLedgerConfigA
to :: forall x. Rep PartialLedgerConfigA x -> PartialLedgerConfigA
Generic
  deriving [PartialLedgerConfigA] -> Encoding
PartialLedgerConfigA -> Encoding
(PartialLedgerConfigA -> Encoding)
-> (forall s. Decoder s PartialLedgerConfigA)
-> ([PartialLedgerConfigA] -> Encoding)
-> (forall s. Decoder s [PartialLedgerConfigA])
-> Serialise PartialLedgerConfigA
forall s. Decoder s [PartialLedgerConfigA]
forall s. Decoder s PartialLedgerConfigA
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: PartialLedgerConfigA -> Encoding
encode :: PartialLedgerConfigA -> Encoding
$cdecode :: forall s. Decoder s PartialLedgerConfigA
decode :: forall s. Decoder s PartialLedgerConfigA
$cencodeList :: [PartialLedgerConfigA] -> Encoding
encodeList :: [PartialLedgerConfigA] -> Encoding
$cdecodeList :: forall s. Decoder s [PartialLedgerConfigA]
decodeList :: forall s. Decoder s [PartialLedgerConfigA]
Serialise

deriving newtype instance Serialise SecurityParam
instance (HasZero a, Serialise a) => Serialise (NonZero a) where
  encode :: NonZero a -> Encoding
encode = a -> Encoding
forall a. Serialise a => a -> Encoding
encode (a -> Encoding) -> (NonZero a -> a) -> NonZero a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero a -> a
forall a. NonZero a -> a
unNonZero
  decode :: forall s. Decoder s (NonZero a)
decode = do
    a <- Decoder s a
forall s. Decoder s a
forall a s. Serialise a => Decoder s a
decode
    case nonZero a of
      Maybe (NonZero a)
Nothing -> String -> Decoder s (NonZero a)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected non zero but found zero!"
      Just NonZero a
a' -> NonZero a -> Decoder s (NonZero a)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonZero a
a'

type instance
  LedgerCfg (LedgerState BlockA) =
    (EpochInfo Identity, PartialLedgerConfigA)

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

instance GetTip (Ticked (LedgerState BlockA)) where
  getTip :: forall (mk :: MapKind).
Ticked (LedgerState BlockA) mk
-> Point (Ticked (LedgerState BlockA))
getTip = Point (LedgerState BlockA) -> Point (Ticked (LedgerState BlockA))
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (LedgerState BlockA) -> Point (Ticked (LedgerState BlockA)))
-> (Ticked (LedgerState BlockA) mk -> Point (LedgerState BlockA))
-> Ticked (LedgerState BlockA) mk
-> Point (Ticked (LedgerState BlockA))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState BlockA mk -> Point (LedgerState BlockA)
forall (mk :: MapKind).
LedgerState BlockA mk -> Point (LedgerState BlockA)
forall (l :: MapKind -> *) (mk :: MapKind).
GetTip l =>
l mk -> Point l
getTip (LedgerState BlockA mk -> Point (LedgerState BlockA))
-> (Ticked (LedgerState BlockA) mk -> LedgerState BlockA mk)
-> Ticked (LedgerState BlockA) mk
-> Point (LedgerState BlockA)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState BlockA) mk -> LedgerState BlockA mk
forall (mk :: MapKind).
Ticked (LedgerState BlockA) mk -> LedgerState BlockA mk
getTickedLedgerStateA

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

  type
    AuxLedgerEvent (LedgerState BlockA) =
      VoidLedgerEvent (LedgerState BlockA)

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

instance ApplyBlock (LedgerState BlockA) BlockA where
  applyBlockLedgerResultWithValidation :: HasCallStack =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState BlockA)
-> BlockA
-> Ticked (LedgerState BlockA) ValuesMK
-> Except
     (LedgerErr (LedgerState BlockA))
     (LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
_ ComputeLedgerEvents
_ LedgerCfg (LedgerState BlockA)
cfg BlockA
blk =
    (Ticked (LedgerState BlockA) ValuesMK
 -> LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK))
-> ExceptT Void Identity (Ticked (LedgerState BlockA) ValuesMK)
-> ExceptT
     Void
     Identity
     (LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK))
forall a b.
(a -> b) -> ExceptT Void Identity a -> ExceptT Void Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LedgerState BlockA DiffMK
-> LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK)
forall a (l :: MapKind -> *). a -> LedgerResult l a
pureLedgerResult (LedgerState BlockA DiffMK
 -> LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK))
-> (Ticked (LedgerState BlockA) ValuesMK
    -> LedgerState BlockA DiffMK)
-> Ticked (LedgerState BlockA) ValuesMK
-> LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState BlockA ValuesMK -> LedgerState BlockA DiffMK
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState BlockA mk -> LedgerState BlockA mk'
forall (l :: MapKind -> *) (mk :: MapKind) (mk' :: MapKind).
LedgerTablesAreTrivial l =>
l mk -> l mk'
convertMapKind (LedgerState BlockA ValuesMK -> LedgerState BlockA DiffMK)
-> (Ticked (LedgerState BlockA) ValuesMK
    -> LedgerState BlockA ValuesMK)
-> Ticked (LedgerState BlockA) ValuesMK
-> LedgerState BlockA DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState BlockA) ValuesMK -> LedgerState BlockA ValuesMK
forall (mk :: MapKind).
Ticked (LedgerState BlockA) mk -> LedgerState BlockA mk
setTip)
      (ExceptT Void Identity (Ticked (LedgerState BlockA) ValuesMK)
 -> ExceptT
      Void
      Identity
      (LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK)))
-> (Ticked (LedgerState BlockA) ValuesMK
    -> ExceptT Void Identity (Ticked (LedgerState BlockA) ValuesMK))
-> Ticked (LedgerState BlockA) ValuesMK
-> ExceptT
     Void
     Identity
     (LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenTx BlockA
 -> Ticked (LedgerState BlockA) ValuesMK
 -> ExceptT Void Identity (Ticked (LedgerState BlockA) ValuesMK))
-> [GenTx BlockA]
-> Ticked (LedgerState BlockA) ValuesMK
-> ExceptT Void Identity (Ticked (LedgerState BlockA) ValuesMK)
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m b) -> [a] -> b -> m b
repeatedlyM
        (((Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
 -> Ticked (LedgerState BlockA) ValuesMK)
-> ExceptT
     Void
     Identity
     (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
-> ExceptT Void Identity (Ticked (LedgerState BlockA) ValuesMK)
forall a b.
(a -> b) -> ExceptT Void Identity a -> ExceptT Void Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ticked (LedgerState BlockA) DiffMK
-> Ticked (LedgerState BlockA) ValuesMK
forall (mk :: MapKind) (mk' :: MapKind).
Ticked (LedgerState BlockA) mk -> Ticked (LedgerState BlockA) mk'
forall (l :: MapKind -> *) (mk :: MapKind) (mk' :: MapKind).
LedgerTablesAreTrivial l =>
l mk -> l mk'
convertMapKind (Ticked (LedgerState BlockA) DiffMK
 -> Ticked (LedgerState BlockA) ValuesMK)
-> ((Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
    -> Ticked (LedgerState BlockA) DiffMK)
-> (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
-> Ticked (LedgerState BlockA) ValuesMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
-> Ticked (LedgerState BlockA) DiffMK
forall a b. (a, b) -> a
fst) (ExceptT
   Void
   Identity
   (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
 -> ExceptT Void Identity (Ticked (LedgerState BlockA) ValuesMK))
-> (GenTx BlockA
    -> Ticked (LedgerState BlockA) ValuesMK
    -> ExceptT
         Void
         Identity
         (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA)))
-> GenTx BlockA
-> Ticked (LedgerState BlockA) ValuesMK
-> ExceptT Void Identity (Ticked (LedgerState BlockA) ValuesMK)
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: LedgerCfg (LedgerState BlockA)
-> WhetherToIntervene
-> SlotNo
-> GenTx BlockA
-> Ticked (LedgerState BlockA) ValuesMK
-> Except
     (ApplyTxErr BlockA)
     (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk ValuesMK
-> Except
     (ApplyTxErr blk)
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
applyTx LedgerCfg (LedgerState BlockA)
cfg WhetherToIntervene
DoNotIntervene (BlockA -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot BlockA
blk))
        (BlockA -> [GenTx BlockA]
blkA_body BlockA
blk)
   where
    setTip :: TickedLedgerState BlockA mk -> LedgerState BlockA mk
    setTip :: forall (mk :: MapKind).
Ticked (LedgerState BlockA) mk -> LedgerState BlockA mk
setTip (TickedLedgerStateA LedgerState BlockA mk
st) = LedgerState BlockA mk
st{lgrA_tip = blockPoint blk}

  applyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState BlockA)
-> BlockA
-> Ticked (LedgerState BlockA) ValuesMK
-> Except
     (LedgerErr (LedgerState BlockA))
     (LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK))
applyBlockLedgerResult = ComputeLedgerEvents
-> LedgerCfg (LedgerState BlockA)
-> BlockA
-> Ticked (LedgerState BlockA) ValuesMK
-> Except
     (LedgerErr (LedgerState BlockA))
     (LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK))
forall (l :: MapKind -> *) 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 BlockA)
-> BlockA
-> Ticked (LedgerState BlockA) ValuesMK
-> LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK)
reapplyBlockLedgerResult =
    (LedgerErr (LedgerState BlockA)
 -> LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState BlockA)
-> BlockA
-> Ticked (LedgerState BlockA) ValuesMK
-> LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK)
forall (l :: MapKind -> *) 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 BlockA) (LedgerState BlockA DiffMK)
LedgerErr (LedgerState BlockA)
-> LedgerResult (LedgerState BlockA) (LedgerState BlockA DiffMK)
forall a. Void -> a
absurd

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

instance UpdateLedger BlockA

instance CommonProtocolParams BlockA where
  maxHeaderSize :: forall (mk :: MapKind). LedgerState BlockA mk -> Word32
maxHeaderSize LedgerState BlockA mk
_ = Word32
forall a. Bounded a => a
maxBound
  maxTxSize :: forall (mk :: MapKind). LedgerState BlockA mk -> Word32
maxTxSize LedgerState BlockA mk
_ = Word32
forall a. Bounded a => a
maxBound

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

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

instance HasPartialConsensusConfig ProtocolA

instance HasPartialLedgerConfig BlockA where
  type PartialLedgerConfig BlockA = PartialLedgerConfigA

  completeLedgerConfig :: forall (proxy :: * -> *).
proxy BlockA
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig BlockA
-> LedgerCfg (LedgerState BlockA)
completeLedgerConfig proxy BlockA
_ EpochInfo (Except PastHorizonException)
ei PartialLedgerConfig BlockA
pcfg = (EpochInfo (Except PastHorizonException) -> EpochInfo Identity
History.toPureEpochInfo EpochInfo (Except PastHorizonException)
ei, PartialLedgerConfig BlockA
PartialLedgerConfigA
pcfg)

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

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

forgeBlockA ::
  TopLevelConfig BlockA ->
  BlockNo ->
  SlotNo ->
  TickedLedgerState BlockA mk ->
  [GenTx BlockA] ->
  IsLeader (BlockProtocol BlockA) ->
  BlockA
forgeBlockA :: forall (mk :: MapKind).
TopLevelConfig BlockA
-> BlockNo
-> SlotNo
-> TickedLedgerState BlockA mk
-> [GenTx BlockA]
-> IsLeader (BlockProtocol BlockA)
-> BlockA
forgeBlockA TopLevelConfig BlockA
tlc BlockNo
bno SlotNo
sno (TickedLedgerStateA LedgerState BlockA mk
st) [GenTx BlockA]
_txs IsLeader (BlockProtocol BlockA)
_ =
  BlkA
    { blkA_header :: Header BlockA
blkA_header =
        HdrA
          { hdrA_fields :: HeaderFields BlockA
hdrA_fields =
              HeaderFields
                { headerFieldHash :: HeaderHash BlockA
headerFieldHash = LazyByteString -> ByteString
LazyByteString -> HeaderHash BlockA
Lazy.toStrict (LazyByteString -> HeaderHash BlockA)
-> (Word64 -> LazyByteString) -> Word64 -> HeaderHash BlockA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> LazyByteString
forall a. Binary a => a -> LazyByteString
B.encode (Word64 -> HeaderHash BlockA) -> Word64 -> HeaderHash BlockA
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
sno
                , headerFieldSlot :: SlotNo
headerFieldSlot = SlotNo
sno
                , headerFieldBlockNo :: BlockNo
headerFieldBlockNo = BlockNo
bno
                }
          , hdrA_prev :: ChainHash BlockA
hdrA_prev = LedgerState BlockA mk -> ChainHash BlockA
forall blk (mk :: MapKind).
UpdateLedger blk =>
LedgerState blk mk -> ChainHash blk
ledgerTipHash LedgerState BlockA mk
st
          }
    , blkA_body :: [GenTx BlockA]
blkA_body = [GenTx BlockA]
-> SlotNo -> Map SlotNo [GenTx BlockA] -> [GenTx BlockA]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] SlotNo
sno (PartialLedgerConfigA -> Map SlotNo [GenTx BlockA]
lcfgA_forgeTxs PartialLedgerConfig BlockA
PartialLedgerConfigA
ledgerConfig)
    }
 where
  ledgerConfig :: PartialLedgerConfig BlockA
  ledgerConfig :: PartialLedgerConfig BlockA
ledgerConfig = (EpochInfo Identity, PartialLedgerConfig BlockA)
-> PartialLedgerConfig BlockA
forall a b. (a, b) -> b
snd ((EpochInfo Identity, PartialLedgerConfig BlockA)
 -> PartialLedgerConfig BlockA)
-> (EpochInfo Identity, PartialLedgerConfig BlockA)
-> PartialLedgerConfig BlockA
forall a b. (a -> b) -> a -> b
$ TopLevelConfig BlockA -> LedgerCfg (LedgerState BlockA)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig BlockA
tlc

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

-- | See 'Ouroboros.Consensus.HardFork.History.EraParams.safeFromTip'
safeFromTipA :: SecurityParam -> Word64
safeFromTipA :: SecurityParam -> Word64
safeFromTipA (SecurityParam NonZero Word64
k) = NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
k

-- | This mock ledger assumes that every node is honest and online, every slot
-- has a single leader, and ever message arrives before the next slot. So a run
-- of @k@ slots is guaranteed to extend the chain by @k@ blocks.
stabilityWindowA :: SecurityParam -> Word64
stabilityWindowA :: SecurityParam -> Word64
stabilityWindowA (SecurityParam NonZero Word64
k) = NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
k

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

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

type instance ApplyTxErr BlockA = Void

instance LedgerSupportsMempool BlockA where
  applyTx :: LedgerCfg (LedgerState BlockA)
-> WhetherToIntervene
-> SlotNo
-> GenTx BlockA
-> Ticked (LedgerState BlockA) ValuesMK
-> Except
     (ApplyTxErr BlockA)
     (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
applyTx LedgerCfg (LedgerState BlockA)
_ WhetherToIntervene
_wti SlotNo
sno tx :: GenTx BlockA
tx@(TxA TxId (GenTx BlockA)
_ TxPayloadA
payload) (TickedLedgerStateA LedgerState BlockA ValuesMK
st) =
    case TxPayloadA
payload of
      TxPayloadA
InitiateAtoB -> do
        (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
-> ExceptT
     Void
     Identity
     (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
forall a. a -> ExceptT Void Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerState BlockA DiffMK -> Ticked (LedgerState BlockA) DiffMK
forall (mk :: MapKind).
LedgerState BlockA mk -> Ticked (LedgerState BlockA) mk
TickedLedgerStateA (LedgerState BlockA DiffMK -> Ticked (LedgerState BlockA) DiffMK)
-> LedgerState BlockA DiffMK -> Ticked (LedgerState BlockA) DiffMK
forall a b. (a -> b) -> a -> b
$ LedgerState BlockA ValuesMK
st{lgrA_transition = Just sno}, GenTx BlockA -> Validated (GenTx BlockA)
ValidatedGenTxA GenTx BlockA
tx)

  reapplyTx :: HasCallStack =>
ComputeDiffs
-> LedgerCfg (LedgerState BlockA)
-> SlotNo
-> Validated (GenTx BlockA)
-> Ticked (LedgerState BlockA) ValuesMK
-> Except (ApplyTxErr BlockA) (TickedLedgerState BlockA TrackingMK)
reapplyTx ComputeDiffs
_ LedgerCfg (LedgerState BlockA)
cfg SlotNo
slot Validated (GenTx BlockA)
tx Ticked (LedgerState BlockA) ValuesMK
st =
    Ticked (LedgerState BlockA) ValuesMK
-> Ticked (LedgerState BlockA) DiffMK
-> TickedLedgerState BlockA TrackingMK
forall (l :: MapKind -> *) (l' :: MapKind -> *).
(SameUtxoTypes l l', HasLedgerTables l, HasLedgerTables l') =>
l ValuesMK -> l' DiffMK -> l' TrackingMK
attachAndApplyDiffs Ticked (LedgerState BlockA) ValuesMK
st (Ticked (LedgerState BlockA) DiffMK
 -> TickedLedgerState BlockA TrackingMK)
-> ((Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
    -> Ticked (LedgerState BlockA) DiffMK)
-> (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
-> TickedLedgerState BlockA TrackingMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
-> Ticked (LedgerState BlockA) DiffMK
forall a b. (a, b) -> a
fst ((Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
 -> TickedLedgerState BlockA TrackingMK)
-> ExceptT
     Void
     Identity
     (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
-> ExceptT Void Identity (TickedLedgerState BlockA TrackingMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LedgerCfg (LedgerState BlockA)
-> WhetherToIntervene
-> SlotNo
-> GenTx BlockA
-> Ticked (LedgerState BlockA) ValuesMK
-> Except
     (ApplyTxErr BlockA)
     (Ticked (LedgerState BlockA) DiffMK, Validated (GenTx BlockA))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk ValuesMK
-> Except
     (ApplyTxErr blk)
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
applyTx LedgerCfg (LedgerState BlockA)
cfg WhetherToIntervene
DoNotIntervene SlotNo
slot (Validated (GenTx BlockA) -> GenTx BlockA
forgetValidatedGenTxA Validated (GenTx BlockA)
tx) Ticked (LedgerState BlockA) ValuesMK
st

  txForgetValidated :: Validated (GenTx BlockA) -> GenTx BlockA
txForgetValidated = Validated (GenTx BlockA) -> GenTx BlockA
forgetValidatedGenTxA

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

instance TxLimits BlockA where
  type TxMeasure BlockA = IgnoringOverflow ByteSize32
  blockCapacityTxMeasure :: forall (mk :: MapKind).
LedgerCfg (LedgerState BlockA)
-> TickedLedgerState BlockA mk -> TxMeasure BlockA
blockCapacityTxMeasure LedgerCfg (LedgerState BlockA)
_cfg TickedLedgerState BlockA 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 BlockA)
-> Ticked (LedgerState BlockA) ValuesMK
-> GenTx BlockA
-> Except (ApplyTxErr BlockA) (TxMeasure BlockA)
txMeasure LedgerCfg (LedgerState BlockA)
_cfg Ticked (LedgerState BlockA) ValuesMK
_st GenTx BlockA
_tx = TxMeasure BlockA -> Except (ApplyTxErr BlockA) (TxMeasure BlockA)
forall a. a -> ExceptT (ApplyTxErr BlockA) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxMeasure BlockA -> Except (ApplyTxErr BlockA) (TxMeasure BlockA))
-> TxMeasure BlockA
-> Except (ApplyTxErr BlockA) (TxMeasure BlockA)
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

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

instance HasTxId (GenTx BlockA) where
  txId :: GenTx BlockA -> TxId (GenTx BlockA)
txId = GenTx BlockA -> TxId (GenTx BlockA)
txA_id

instance ConvertRawTxId (GenTx BlockA) where
  toRawTxIdHash :: TxId (GenTx BlockA) -> ShortByteString
toRawTxIdHash = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (TxId (GenTx BlockA) -> ByteString)
-> TxId (GenTx BlockA)
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteString
Lazy.toStrict (LazyByteString -> ByteString)
-> (TxId (GenTx BlockA) -> LazyByteString)
-> TxId (GenTx BlockA)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId (GenTx BlockA) -> LazyByteString
forall a. Serialise a => a -> LazyByteString
serialise

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

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

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

instance SameDepIndex2 (BlockQuery BlockA) where
  sameDepIndex2 :: forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
BlockQuery BlockA x a
-> BlockQuery BlockA y b -> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 BlockQuery BlockA x a
qry BlockQuery BlockA y b
_qry' = case BlockQuery BlockA x a
qry of {}

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

data instance NestedCtxt_ BlockA f a where
  CtxtA :: NestedCtxt_ BlockA f (f BlockA)

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

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

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

instance EncodeDiskDepIx (NestedCtxt Header) BlockA
instance EncodeDiskDep (NestedCtxt Header) BlockA

instance DecodeDiskDepIx (NestedCtxt Header) BlockA
instance DecodeDiskDep (NestedCtxt Header) BlockA

instance HasNestedContent Header BlockA

-- Use defaults

instance ReconstructNestedCtxt Header BlockA

-- Use defaults

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

data UpdateA
  = ProposalSubmitted
  | ProposalStable
  deriving (Int -> UpdateA -> ShowS
[UpdateA] -> ShowS
UpdateA -> String
(Int -> UpdateA -> ShowS)
-> (UpdateA -> String) -> ([UpdateA] -> ShowS) -> Show UpdateA
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateA -> ShowS
showsPrec :: Int -> UpdateA -> ShowS
$cshow :: UpdateA -> String
show :: UpdateA -> String
$cshowList :: [UpdateA] -> ShowS
showList :: [UpdateA] -> ShowS
Show, UpdateA -> UpdateA -> Bool
(UpdateA -> UpdateA -> Bool)
-> (UpdateA -> UpdateA -> Bool) -> Eq UpdateA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateA -> UpdateA -> Bool
== :: UpdateA -> UpdateA -> Bool
$c/= :: UpdateA -> UpdateA -> Bool
/= :: UpdateA -> UpdateA -> Bool
Eq)

instance Condense UpdateA where
  condense :: UpdateA -> String
condense = UpdateA -> String
forall a. Show a => a -> String
show

instance InspectLedger BlockA where
  type LedgerWarning BlockA = Void
  type LedgerUpdate BlockA = UpdateA

  inspectLedger :: forall (mk1 :: MapKind) (mk2 :: MapKind).
TopLevelConfig BlockA
-> LedgerState BlockA mk1
-> LedgerState BlockA mk2
-> [LedgerEvent BlockA]
inspectLedger TopLevelConfig BlockA
cfg LedgerState BlockA mk1
before LedgerState BlockA mk2
after =
    case (LedgerState BlockA mk1 -> Maybe (SlotNo, Word64)
forall (mk :: MapKind).
LedgerState BlockA mk -> Maybe (SlotNo, Word64)
getConfirmationDepth LedgerState BlockA mk1
before, LedgerState BlockA mk2 -> Maybe (SlotNo, Word64)
forall (mk :: MapKind).
LedgerState BlockA mk -> Maybe (SlotNo, Word64)
getConfirmationDepth LedgerState BlockA mk2
after) of
      (Maybe (SlotNo, Word64)
Nothing, Just (SlotNo, Word64)
_) ->
        LedgerEvent BlockA -> [LedgerEvent BlockA]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerEvent BlockA -> [LedgerEvent BlockA])
-> LedgerEvent BlockA -> [LedgerEvent BlockA]
forall a b. (a -> b) -> a -> b
$ LedgerUpdate BlockA -> LedgerEvent BlockA
forall blk. LedgerUpdate blk -> LedgerEvent blk
LedgerUpdate LedgerUpdate BlockA
UpdateA
ProposalSubmitted
      (Just (SlotNo
_, Word64
d), Just (SlotNo
_, Word64
d')) -> do
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Word64
d Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
k Bool -> Bool -> Bool
&& Word64
d' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
k
        LedgerEvent BlockA -> [LedgerEvent BlockA]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerEvent BlockA -> [LedgerEvent BlockA])
-> LedgerEvent BlockA -> [LedgerEvent BlockA]
forall a b. (a -> b) -> a -> b
$ LedgerUpdate BlockA -> LedgerEvent BlockA
forall blk. LedgerUpdate blk -> LedgerEvent blk
LedgerUpdate LedgerUpdate BlockA
UpdateA
ProposalStable
      (Maybe (SlotNo, Word64), Maybe (SlotNo, Word64))
_otherwise ->
        []
   where
    k :: Word64
k = SecurityParam -> Word64
stabilityWindowA (PartialLedgerConfigA -> SecurityParam
lcfgA_k ((EpochInfo Identity, PartialLedgerConfigA) -> PartialLedgerConfigA
forall a b. (a, b) -> b
snd (TopLevelConfig BlockA -> LedgerCfg (LedgerState BlockA)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig BlockA
cfg)))

getConfirmationDepth :: LedgerState BlockA mk -> Maybe (SlotNo, Word64)
getConfirmationDepth :: forall (mk :: MapKind).
LedgerState BlockA mk -> Maybe (SlotNo, Word64)
getConfirmationDepth LedgerState BlockA mk
st = do
  confirmedInSlot <- LedgerState BlockA mk -> Maybe SlotNo
forall (mk :: MapKind). LedgerState BlockA mk -> Maybe SlotNo
lgrA_transition LedgerState BlockA mk
st
  return $ case ledgerTipSlot st of
    WithOrigin SlotNo
Origin -> String -> (SlotNo, Word64)
forall a. HasCallStack => String -> a
error String
"impossible"
    NotOrigin SlotNo
s ->
      if SlotNo
s SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
confirmedInSlot
        then String -> (SlotNo, Word64)
forall a. HasCallStack => String -> a
error String
"impossible"
        else
          ( SlotNo
confirmedInSlot
          , HasCallStack => SlotNo -> SlotNo -> Word64
SlotNo -> SlotNo -> Word64
History.countSlots SlotNo
s SlotNo
confirmedInSlot
          )

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

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

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

deriving via
  SelectViewDiffusionPipelining BlockA
  instance
    BlockSupportsDiffusionPipelining BlockA

instance SingleEraBlock BlockA where
  singleEraInfo :: forall (proxy :: * -> *). proxy BlockA -> SingleEraInfo BlockA
singleEraInfo proxy BlockA
_ = Text -> SingleEraInfo BlockA
forall blk. Text -> SingleEraInfo blk
SingleEraInfo Text
"A"

  singleEraTransition :: forall (mk :: MapKind).
PartialLedgerConfig BlockA
-> EraParams -> Bound -> LedgerState BlockA mk -> Maybe EpochNo
singleEraTransition PartialLedgerConfig BlockA
cfg EraParams{EpochSize
SlotLength
GenesisWindow
SafeZone
eraEpochSize :: EpochSize
eraSlotLength :: SlotLength
eraSafeZone :: SafeZone
eraGenesisWin :: GenesisWindow
eraGenesisWin :: EraParams -> GenesisWindow
eraSafeZone :: EraParams -> SafeZone
eraSlotLength :: EraParams -> SlotLength
eraEpochSize :: EraParams -> EpochSize
..} Bound
eraStart LedgerState BlockA mk
st = do
    (confirmedInSlot, confirmationDepth) <- LedgerState BlockA mk -> Maybe (SlotNo, Word64)
forall (mk :: MapKind).
LedgerState BlockA mk -> Maybe (SlotNo, Word64)
getConfirmationDepth LedgerState BlockA mk
st

    -- The ledger must report the scheduled transition to the next era as soon
    -- as the block containing this transaction is immutable (that is, at
    -- least @k@ blocks have come after) -- this happens elsewhere in the
    -- corresponding 'SingleEraBlock' instance. It must not report it sooner
    -- than that because the consensus layer requires that conversions about
    -- time (when successful) must not be subject to rollback.
    guard $ confirmationDepth >= stabilityWindowA (lcfgA_k cfg)

    -- Consensus /also/ insists that as long as the transition to the next era
    -- is not yet known (ie not yet determined by an immutable block), there
    -- is a safe zone that extends past the tip of the ledger in which we
    -- guarantee the next era will not begin. This means that we must have an
    -- additional @safeFromTipA k@ blocks /after/ reporting the transition and
    -- /before/ the start of the next era.
    --
    -- Thus, we schedule the next era to begin with the first upcoming epoch
    -- that starts /after/ we're guaranteed to see both the aforementioned @k@
    -- additional blocks and also a further @safeFromTipA k@ slots after the
    -- last of those.

    let
      -- The last slot that must be in the current era
      firstPossibleLastSlotThisEra =
        Word64 -> SlotNo -> SlotNo
History.addSlots
          (SecurityParam -> Word64
stabilityWindowA SecurityParam
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ SecurityParam -> Word64
safeFromTipA SecurityParam
k)
          SlotNo
confirmedInSlot

      -- The 'EpochNo' corresponding to 'firstPossibleLastSlotThisEra'
      lastEpochThisEra = SlotNo -> EpochNo
slotToEpoch SlotNo
firstPossibleLastSlotThisEra

      -- The first epoch that may be in the next era
      -- (recall: eras are epoch-aligned)
      firstEpochNextEra = EpochNo -> EpochNo
forall a. Enum a => a -> a
succ EpochNo
lastEpochThisEra

    return firstEpochNextEra
   where
    k :: SecurityParam
k = PartialLedgerConfigA -> SecurityParam
lcfgA_k PartialLedgerConfig BlockA
PartialLedgerConfigA
cfg

    -- Slot conversion (valid for slots in this era only)
    slotToEpoch :: SlotNo -> EpochNo
    slotToEpoch :: SlotNo -> EpochNo
slotToEpoch SlotNo
s =
      Word64 -> EpochNo -> EpochNo
History.addEpochs
        (HasCallStack => SlotNo -> SlotNo -> Word64
SlotNo -> SlotNo -> Word64
History.countSlots SlotNo
s (Bound -> SlotNo
boundSlot Bound
eraStart) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` EpochSize -> Word64
unEpochSize EpochSize
eraEpochSize)
        (Bound -> EpochNo
boundEpoch Bound
eraStart)

instance HasTxs BlockA where
  extractTxs :: BlockA -> [GenTx BlockA]
extractTxs = BlockA -> [GenTx BlockA]
blkA_body

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

instance CondenseConstraints BlockA

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

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

instance HasBinaryBlockInfo BlockA where
  -- Standard cborg generic serialisation is:
  --
  -- > [number of fields in the product]
  -- >   [tag of the constructor]
  -- >   field1
  -- >   ..
  -- >   fieldN
  getBinaryBlockInfo :: BlockA -> BinaryBlockInfo
getBinaryBlockInfo BlkA{[GenTx BlockA]
Header BlockA
blkA_header :: BlockA -> Header BlockA
blkA_body :: BlockA -> [GenTx BlockA]
blkA_header :: Header BlockA
blkA_body :: [GenTx BlockA]
..} =
    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 BlockA -> LazyByteString
forall a. Serialise a => a -> LazyByteString
serialise Header BlockA
blkA_header)
      }

instance SerialiseNodeToClient BlockA PartialLedgerConfigA

-- NOTE: we will never use BlockA as a SingleEraBlock, however in order to fulfill the
-- constraints we need to be able to provide this instance.
--
-- We could follow what is done for Shelley and serialise a fixed EpochInfo, but it is
-- not worth the effort, we will never call these methods.
instance SerialiseNodeToClient BlockA (EpochInfo Identity, PartialLedgerConfigA) where
  encodeNodeToClient :: CodecConfig BlockA
-> BlockNodeToClientVersion BlockA
-> (EpochInfo Identity, PartialLedgerConfigA)
-> Encoding
encodeNodeToClient = String
-> CodecConfig BlockA
-> ()
-> (EpochInfo Identity, PartialLedgerConfigA)
-> Encoding
forall a. HasCallStack => String -> a
error String
"BlockA being used as a SingleEraBlock"
  decodeNodeToClient :: CodecConfig BlockA
-> BlockNodeToClientVersion BlockA
-> forall s. Decoder s (EpochInfo Identity, PartialLedgerConfigA)
decodeNodeToClient = String
-> CodecConfig BlockA
-> ()
-> Decoder s (EpochInfo Identity, PartialLedgerConfigA)
forall a. HasCallStack => String -> a
error String
"BlockA being used as a SingleEraBlock"

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

{-------------------------------------------------------------------------------
  SerialiseDiskConstraints
-------------------------------------------------------------------------------}

deriving instance Serialise (AnnTip BlockA)

instance EncodeDisk BlockA (LedgerState BlockA EmptyMK)
instance DecodeDisk BlockA (LedgerState BlockA EmptyMK)

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

instance EncodeDisk BlockA (AnnTip BlockA)
instance DecodeDisk BlockA (AnnTip BlockA)

instance EncodeDisk BlockA ()
instance DecodeDisk BlockA ()

instance HasNetworkProtocolVersion BlockA

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

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

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

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

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

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

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