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

import           Cardano.Slotting.EpochInfo
import           Codec.Serialise
import           Control.Monad (guard)
import           Control.Monad.Except (runExcept)
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 (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.Node.InitStorage
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Node.Serialisation
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.Storage.ImmutableDB (simpleChunkInfo)
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.Util (repeatedlyM, (..:), (.:))
import           Ouroboros.Consensus.Util.Condense
import           Ouroboros.Consensus.Util.Orphans ()
import           Ouroboros.Network.Block (Serialised, unwrapCBORinCBOR,
                     wrapCBORinCBOR)
import           Ouroboros.Network.Magic
import           Test.Cardano.Slotting.Numeric ()
import           Test.Util.Time (dawnOfTime)

{-------------------------------------------------------------------------------
  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 where

instance BasicEnvelopeValidation BlockA where
  -- Use defaults

instance ValidateEnvelope BlockA where

data instance LedgerState BlockA = LgrA {
      LedgerState BlockA -> Point BlockA
lgrA_tip :: Point BlockA

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

-- | Ticking has no state on the A ledger state
newtype instance Ticked (LedgerState BlockA) = TickedLedgerStateA {
      Ticked (LedgerState BlockA) -> LedgerState BlockA
getTickedLedgerStateA :: LedgerState BlockA
    }
  deriving Context -> Ticked (LedgerState BlockA) -> IO (Maybe ThunkInfo)
Proxy (Ticked (LedgerState BlockA)) -> String
(Context -> Ticked (LedgerState BlockA) -> IO (Maybe ThunkInfo))
-> (Context -> Ticked (LedgerState BlockA) -> IO (Maybe ThunkInfo))
-> (Proxy (Ticked (LedgerState BlockA)) -> String)
-> NoThunks (Ticked (LedgerState BlockA))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Ticked (LedgerState BlockA) -> IO (Maybe ThunkInfo)
noThunks :: Context -> Ticked (LedgerState BlockA) -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Ticked (LedgerState BlockA) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Ticked (LedgerState BlockA) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (Ticked (LedgerState BlockA)) -> String
showTypeOf :: Proxy (Ticked (LedgerState BlockA)) -> String
NoThunks via OnlyCheckWhnfNamed "TickedLgrA" (Ticked (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 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

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

instance GetTip (LedgerState BlockA) where
  getTip :: LedgerState BlockA -> 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 -> Point BlockA)
-> LedgerState BlockA
-> Point (LedgerState BlockA)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState BlockA -> Point BlockA
lgrA_tip

instance GetTip (Ticked (LedgerState BlockA)) where
  getTip :: Ticked (LedgerState BlockA) -> 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) -> Point (LedgerState BlockA))
-> Ticked (LedgerState BlockA)
-> Point (Ticked (LedgerState BlockA))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState BlockA -> Point (LedgerState BlockA)
forall l. GetTip l => l -> Point l
getTip (LedgerState BlockA -> Point (LedgerState BlockA))
-> (Ticked (LedgerState BlockA) -> LedgerState BlockA)
-> Ticked (LedgerState BlockA)
-> Point (LedgerState BlockA)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState BlockA) -> LedgerState BlockA
getTickedLedgerStateA

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

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

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

instance ApplyBlock (LedgerState BlockA) BlockA where
  applyBlockLedgerResult :: HasCallStack =>
LedgerCfg (LedgerState BlockA)
-> BlockA
-> Ticked (LedgerState BlockA)
-> Except
     (LedgerErr (LedgerState BlockA))
     (LedgerResult (LedgerState BlockA) (LedgerState BlockA))
applyBlockLedgerResult LedgerCfg (LedgerState BlockA)
cfg BlockA
blk =
        (Ticked (LedgerState BlockA)
 -> LedgerResult (LedgerState BlockA) (LedgerState BlockA))
-> ExceptT Void Identity (Ticked (LedgerState BlockA))
-> ExceptT
     Void
     Identity
     (LedgerResult (LedgerState BlockA) (LedgerState BlockA))
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
-> LedgerResult (LedgerState BlockA) (LedgerState BlockA)
forall a l. a -> LedgerResult l a
pureLedgerResult (LedgerState BlockA
 -> LedgerResult (LedgerState BlockA) (LedgerState BlockA))
-> (Ticked (LedgerState BlockA) -> LedgerState BlockA)
-> Ticked (LedgerState BlockA)
-> LedgerResult (LedgerState BlockA) (LedgerState BlockA)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState BlockA) -> LedgerState BlockA
setTip)
      (ExceptT Void Identity (Ticked (LedgerState BlockA))
 -> ExceptT
      Void
      Identity
      (LedgerResult (LedgerState BlockA) (LedgerState BlockA)))
-> (Ticked (LedgerState BlockA)
    -> ExceptT Void Identity (Ticked (LedgerState BlockA)))
-> Ticked (LedgerState BlockA)
-> ExceptT
     Void
     Identity
     (LedgerResult (LedgerState BlockA) (LedgerState BlockA))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenTx BlockA
 -> Ticked (LedgerState BlockA)
 -> ExceptT Void Identity (Ticked (LedgerState BlockA)))
-> [GenTx BlockA]
-> Ticked (LedgerState BlockA)
-> ExceptT Void Identity (Ticked (LedgerState BlockA))
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m b) -> [a] -> b -> m b
repeatedlyM
          (((Ticked (LedgerState BlockA), Validated (GenTx BlockA))
 -> Ticked (LedgerState BlockA))
-> ExceptT
     Void
     Identity
     (Ticked (LedgerState BlockA), Validated (GenTx BlockA))
-> ExceptT Void Identity (Ticked (LedgerState BlockA))
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), Validated (GenTx BlockA))
-> Ticked (LedgerState BlockA)
forall a b. (a, b) -> a
fst (ExceptT
   Void
   Identity
   (Ticked (LedgerState BlockA), Validated (GenTx BlockA))
 -> ExceptT Void Identity (Ticked (LedgerState BlockA)))
-> (GenTx BlockA
    -> Ticked (LedgerState BlockA)
    -> ExceptT
         Void
         Identity
         (Ticked (LedgerState BlockA), Validated (GenTx BlockA)))
-> GenTx BlockA
-> Ticked (LedgerState BlockA)
-> ExceptT Void Identity (Ticked (LedgerState BlockA))
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: LedgerCfg (LedgerState BlockA)
-> WhetherToIntervene
-> SlotNo
-> GenTx BlockA
-> Ticked (LedgerState BlockA)
-> Except
     (ApplyTxErr BlockA)
     (Ticked (LedgerState BlockA), Validated (GenTx BlockA))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk
-> Except
     (ApplyTxErr blk) (TickedLedgerState blk, 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 -> LedgerState BlockA
      setTip :: Ticked (LedgerState BlockA) -> LedgerState BlockA
setTip (TickedLedgerStateA LedgerState BlockA
st) = LedgerState BlockA
st { lgrA_tip = blockPoint blk }

  reapplyBlockLedgerResult :: HasCallStack =>
LedgerCfg (LedgerState BlockA)
-> BlockA
-> Ticked (LedgerState BlockA)
-> LedgerResult (LedgerState BlockA) (LedgerState BlockA)
reapplyBlockLedgerResult =
      ExceptT
  Void
  Identity
  (LedgerResult (LedgerState BlockA) (LedgerState BlockA))
-> LedgerResult (LedgerState BlockA) (LedgerState BlockA)
forall a b. Except a b -> b
dontExpectError (ExceptT
   Void
   Identity
   (LedgerResult (LedgerState BlockA) (LedgerState BlockA))
 -> LedgerResult (LedgerState BlockA) (LedgerState BlockA))
-> ((EpochInfo Identity, PartialLedgerConfigA)
    -> BlockA
    -> Ticked (LedgerState BlockA)
    -> ExceptT
         Void
         Identity
         (LedgerResult (LedgerState BlockA) (LedgerState BlockA)))
-> (EpochInfo Identity, PartialLedgerConfigA)
-> BlockA
-> Ticked (LedgerState BlockA)
-> LedgerResult (LedgerState BlockA) (LedgerState BlockA)
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: (EpochInfo Identity, PartialLedgerConfigA)
-> BlockA
-> Ticked (LedgerState BlockA)
-> ExceptT
     Void
     Identity
     (LedgerResult (LedgerState BlockA) (LedgerState BlockA))
LedgerCfg (LedgerState BlockA)
-> BlockA
-> Ticked (LedgerState BlockA)
-> Except
     (LedgerErr (LedgerState BlockA))
     (LedgerResult (LedgerState BlockA) (LedgerState BlockA))
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
LedgerCfg l
-> blk -> Ticked l -> Except (LedgerErr l) (LedgerResult l l)
applyBlockLedgerResult
    where
      dontExpectError :: Except a b -> b
      dontExpectError :: forall a b. Except a b -> b
dontExpectError Except a b
mb = case Except a b -> Either a b
forall e a. Except e a -> Either e a
runExcept Except a b
mb of
        Left  a
_ -> String -> b
forall a. HasCallStack => String -> a
error String
"reapplyBlockLedgerResult: unexpected error"
        Right b
b -> b
b

instance UpdateLedger BlockA

instance CommonProtocolParams BlockA where
  maxHeaderSize :: LedgerState BlockA -> Word32
maxHeaderSize LedgerState BlockA
_ = Word32
forall a. Bounded a => a
maxBound
  maxTxSize :: LedgerState BlockA -> Word32
maxTxSize     LedgerState BlockA
_ = 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 :: LedgerCfg (LedgerState BlockA)
-> Ticked (LedgerState BlockA) -> LedgerView (BlockProtocol BlockA)
protocolLedgerView   LedgerCfg (LedgerState BlockA)
_ Ticked (LedgerState BlockA)
_  = ()
  ledgerViewForecastAt :: HasCallStack =>
LedgerCfg (LedgerState BlockA)
-> LedgerState BlockA
-> Forecast (LedgerView (BlockProtocol BlockA))
ledgerViewForecastAt LedgerCfg (LedgerState BlockA)
_    = LedgerState BlockA -> Forecast ()
LedgerState BlockA -> Forecast (LedgerView (BlockProtocol BlockA))
forall b. GetTip b => b -> 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
  -> [GenTx BlockA]
  -> IsLeader (BlockProtocol BlockA)
  -> BlockA
forgeBlockA :: TopLevelConfig BlockA
-> BlockNo
-> SlotNo
-> Ticked (LedgerState BlockA)
-> [GenTx BlockA]
-> IsLeader (BlockProtocol BlockA)
-> BlockA
forgeBlockA TopLevelConfig BlockA
tlc BlockNo
bno SlotNo
sno (TickedLedgerStateA LedgerState BlockA
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    = ByteString -> ByteString
ByteString -> HeaderHash BlockA
Lazy.toStrict (ByteString -> HeaderHash BlockA)
-> (Word64 -> ByteString) -> Word64 -> HeaderHash BlockA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ByteString
forall a. Binary a => a -> ByteString
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 -> ChainHash BlockA
forall blk. UpdateLedger blk => LedgerState blk -> ChainHash blk
ledgerTipHash LedgerState BlockA
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
-> Ticked (LedgerState BlockA)
-> [Validated (GenTx BlockA)]
-> IsLeader (BlockProtocol BlockA)
-> m BlockA
forgeBlock       = \TopLevelConfig BlockA
cfg BlockNo
bno SlotNo
slot Ticked (LedgerState BlockA)
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
-> Ticked (LedgerState BlockA)
-> [GenTx BlockA]
-> IsLeader (BlockProtocol BlockA)
-> BlockA
forgeBlockA TopLevelConfig BlockA
cfg BlockNo
bno SlotNo
slot Ticked (LedgerState BlockA)
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 Word64
k) = 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 Word64
k) = 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)
-> Except
     (ApplyTxErr BlockA)
     (Ticked (LedgerState BlockA), Validated (GenTx BlockA))
applyTx LedgerCfg (LedgerState BlockA)
_ WhetherToIntervene
_wti SlotNo
sno tx :: GenTx BlockA
tx@(TxA TxId (GenTx BlockA)
_ TxPayloadA
payload) (TickedLedgerStateA LedgerState BlockA
st) =
      case TxPayloadA
payload of
        TxPayloadA
InitiateAtoB -> do
          (Ticked (LedgerState BlockA), Validated (GenTx BlockA))
-> ExceptT
     Void
     Identity
     (Ticked (LedgerState BlockA), Validated (GenTx BlockA))
forall a. a -> ExceptT Void Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerState BlockA -> Ticked (LedgerState BlockA)
TickedLedgerStateA (LedgerState BlockA -> Ticked (LedgerState BlockA))
-> LedgerState BlockA -> Ticked (LedgerState BlockA)
forall a b. (a -> b) -> a -> b
$ LedgerState BlockA
st { lgrA_transition = Just sno }, GenTx BlockA -> Validated (GenTx BlockA)
ValidatedGenTxA GenTx BlockA
tx)

  reapplyTx :: HasCallStack =>
LedgerCfg (LedgerState BlockA)
-> SlotNo
-> Validated (GenTx BlockA)
-> Ticked (LedgerState BlockA)
-> Except (ApplyTxErr BlockA) (Ticked (LedgerState BlockA))
reapplyTx LedgerCfg (LedgerState BlockA)
cfg SlotNo
slot = ((Ticked (LedgerState BlockA), Validated (GenTx BlockA))
 -> Ticked (LedgerState BlockA))
-> ExceptT
     Void
     Identity
     (Ticked (LedgerState BlockA), Validated (GenTx BlockA))
-> ExceptT Void Identity (Ticked (LedgerState BlockA))
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), Validated (GenTx BlockA))
-> Ticked (LedgerState BlockA)
forall a b. (a, b) -> a
fst (ExceptT
   Void
   Identity
   (Ticked (LedgerState BlockA), Validated (GenTx BlockA))
 -> ExceptT Void Identity (Ticked (LedgerState BlockA)))
-> (Validated (GenTx BlockA)
    -> Ticked (LedgerState BlockA)
    -> ExceptT
         Void
         Identity
         (Ticked (LedgerState BlockA), Validated (GenTx BlockA)))
-> Validated (GenTx BlockA)
-> Ticked (LedgerState BlockA)
-> ExceptT Void Identity (Ticked (LedgerState BlockA))
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: (LedgerCfg (LedgerState BlockA)
-> WhetherToIntervene
-> SlotNo
-> GenTx BlockA
-> Ticked (LedgerState BlockA)
-> Except
     (ApplyTxErr BlockA)
     (Ticked (LedgerState BlockA), Validated (GenTx BlockA))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk
-> Except
     (ApplyTxErr blk) (TickedLedgerState blk, Validated (GenTx blk))
applyTx LedgerCfg (LedgerState BlockA)
cfg WhetherToIntervene
DoNotIntervene SlotNo
slot (GenTx BlockA
 -> Ticked (LedgerState BlockA)
 -> ExceptT
      Void
      Identity
      (Ticked (LedgerState BlockA), Validated (GenTx BlockA)))
-> (Validated (GenTx BlockA) -> GenTx BlockA)
-> Validated (GenTx BlockA)
-> Ticked (LedgerState BlockA)
-> ExceptT
     Void
     Identity
     (Ticked (LedgerState BlockA), Validated (GenTx BlockA))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx BlockA) -> GenTx BlockA
forgetValidatedGenTxA)

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

instance TxLimits BlockA where
  type TxMeasure BlockA = IgnoringOverflow ByteSize32
  blockCapacityTxMeasure :: LedgerCfg (LedgerState BlockA)
-> Ticked (LedgerState BlockA) -> TxMeasure BlockA
blockCapacityTxMeasure LedgerCfg (LedgerState BlockA)
_cfg Ticked (LedgerState BlockA)
_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)
-> GenTx BlockA
-> Except (ApplyTxErr BlockA) (TxMeasure BlockA)
txMeasure              LedgerCfg (LedgerState BlockA)
_cfg Ticked (LedgerState BlockA)
_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
. ByteString -> ByteString
Lazy.toStrict (ByteString -> ByteString)
-> (TxId (GenTx BlockA) -> ByteString)
-> TxId (GenTx BlockA)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId (GenTx BlockA) -> ByteString
forall a. Serialise a => a -> ByteString
serialise

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

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

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

instance SameDepIndex (BlockQuery BlockA) where
  sameDepIndex :: forall a b.
BlockQuery BlockA a -> BlockQuery BlockA b -> Maybe (a :~: b)
sameDepIndex BlockQuery BlockA a
qry BlockQuery BlockA b
_qry' = case BlockQuery BlockA 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 (ByteString -> Header BlockA)
decodeDisk CodecConfig BlockA
_ = Header BlockA -> ByteString -> Header BlockA
forall a b. a -> b -> a
const (Header BlockA -> ByteString -> Header BlockA)
-> Decoder s (Header BlockA)
-> Decoder s (ByteString -> 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 where
  -- Use defaults

instance ReconstructNestedCtxt Header BlockA
  -- Use defaults

instance LedgerSupportsPeerSelection BlockA where
  getPeers :: LedgerState BlockA -> [(PoolStake, NonEmpty StakePoolRelay)]
getPeers = [(PoolStake, NonEmpty StakePoolRelay)]
-> LedgerState BlockA -> [(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 :: TopLevelConfig BlockA
-> LedgerState BlockA -> LedgerState BlockA -> [LedgerEvent BlockA]
inspectLedger TopLevelConfig BlockA
cfg LedgerState BlockA
before LedgerState BlockA
after =
     case (LedgerState BlockA -> Maybe (SlotNo, Word64)
getConfirmationDepth LedgerState BlockA
before, LedgerState BlockA -> Maybe (SlotNo, Word64)
getConfirmationDepth LedgerState BlockA
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 -> Maybe (SlotNo, Word64)
getConfirmationDepth :: LedgerState BlockA -> Maybe (SlotNo, Word64)
getConfirmationDepth LedgerState BlockA
st = do
    SlotNo
confirmedInSlot <- LedgerState BlockA -> Maybe SlotNo
lgrA_transition LedgerState BlockA
st
    (SlotNo, Word64) -> Maybe (SlotNo, Word64)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SlotNo, Word64) -> Maybe (SlotNo, Word64))
-> (SlotNo, Word64) -> Maybe (SlotNo, Word64)
forall a b. (a -> b) -> a -> b
$ case LedgerState BlockA -> WithOrigin SlotNo
forall blk.
UpdateLedger blk =>
LedgerState blk -> WithOrigin SlotNo
ledgerTipSlot LedgerState BlockA
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 :: PartialLedgerConfig BlockA
-> EraParams -> Bound -> LedgerState BlockA -> Maybe EpochNo
singleEraTransition PartialLedgerConfig BlockA
cfg EraParams{EpochSize
SlotLength
GenesisWindow
SafeZone
eraEpochSize :: EpochSize
eraSlotLength :: SlotLength
eraSafeZone :: SafeZone
eraGenesisWin :: GenesisWindow
eraEpochSize :: EraParams -> EpochSize
eraSlotLength :: EraParams -> SlotLength
eraSafeZone :: EraParams -> SafeZone
eraGenesisWin :: EraParams -> GenesisWindow
..} Bound
eraStart LedgerState BlockA
st = do
      (SlotNo
confirmedInSlot, Word64
confirmationDepth) <- LedgerState BlockA -> Maybe (SlotNo, Word64)
getConfirmationDepth LedgerState BlockA
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.
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Word64
confirmationDepth Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= SecurityParam -> Word64
stabilityWindowA (PartialLedgerConfigA -> SecurityParam
lcfgA_k PartialLedgerConfig BlockA
PartialLedgerConfigA
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 :: SlotNo
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 :: EpochNo
lastEpochThisEra = SlotNo -> EpochNo
slotToEpoch SlotNo
firstPossibleLastSlotThisEra

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

      EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return EpochNo
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
$ ByteString -> Int64
Lazy.length (Header BlockA -> ByteString
forall a. Serialise a => a -> ByteString
serialise Header BlockA
blkA_header)
      }


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)
instance DecodeDisk BlockA (LedgerState BlockA)

instance EncodeDisk BlockA BlockA
instance DecodeDisk BlockA (Lazy.ByteString -> BlockA) where
  decodeDisk :: CodecConfig BlockA -> forall s. Decoder s (ByteString -> BlockA)
decodeDisk CodecConfig BlockA
_ = BlockA -> ByteString -> BlockA
forall a b. a -> b -> a
const (BlockA -> ByteString -> BlockA)
-> Decoder s BlockA -> Decoder s (ByteString -> 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 (ByteString -> Header BlockA))
-> forall s. Decoder s (Header BlockA)
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR (Header BlockA -> ByteString -> Header BlockA
forall a b. a -> b -> a
const (Header BlockA -> ByteString -> Header BlockA)
-> Decoder s (Header BlockA)
-> Decoder s (ByteString -> 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 (SomeSecond BlockQuery BlockA) where
  encodeNodeToClient :: CodecConfig BlockA
-> BlockNodeToClientVersion BlockA
-> SomeSecond BlockQuery BlockA
-> Encoding
encodeNodeToClient CodecConfig BlockA
_ BlockNodeToClientVersion BlockA
_ = \case {}
  decodeNodeToClient :: CodecConfig BlockA
-> BlockNodeToClientVersion BlockA
-> forall s. Decoder s (SomeSecond BlockQuery BlockA)
decodeNodeToClient CodecConfig BlockA
_ BlockNodeToClientVersion BlockA
_ = String -> Decoder s (SomeSecond 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 SerialiseResult BlockA (BlockQuery BlockA) where
  encodeResult :: forall result.
CodecConfig BlockA
-> BlockNodeToClientVersion BlockA
-> BlockQuery BlockA result
-> result
-> Encoding
encodeResult CodecConfig BlockA
_ BlockNodeToClientVersion BlockA
_ = \case {}
  decodeResult :: forall result.
CodecConfig BlockA
-> BlockNodeToClientVersion BlockA
-> BlockQuery BlockA result
-> forall s. Decoder s result
decodeResult CodecConfig BlockA
_ BlockNodeToClientVersion BlockA
_ = \case {}