{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Mock.Node (
CodecConfig (..)
, simpleBlockForging
) where
import Codec.Serialise (Serialise)
import qualified Data.Map.Strict as Map
import Data.Void (Void)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.Ledger.SupportsMempool (txForgetValidated)
import Ouroboros.Consensus.Ledger.SupportsProtocol
import Ouroboros.Consensus.Mock.Ledger
import Ouroboros.Consensus.Mock.Node.Abstract
import Ouroboros.Consensus.Mock.Node.Serialisation ()
import Ouroboros.Consensus.Node.InitStorage
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Node.Run
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Storage.ImmutableDB (simpleChunkInfo)
import Ouroboros.Consensus.Util.RedundantConstraints
instance HasNetworkProtocolVersion (SimpleBlock SimpleMockCrypto ext) where
instance SupportedNetworkProtocolVersion (SimpleBlock SimpleMockCrypto ext) where
supportedNodeToNodeVersions :: Proxy (SimpleBlock SimpleMockCrypto ext)
-> Map
NodeToNodeVersion
(BlockNodeToNodeVersion (SimpleBlock SimpleMockCrypto ext))
supportedNodeToNodeVersions Proxy (SimpleBlock SimpleMockCrypto ext)
_ = NodeToNodeVersion -> () -> Map NodeToNodeVersion ()
forall k a. k -> a -> Map k a
Map.singleton NodeToNodeVersion
forall a. Bounded a => a
maxBound ()
supportedNodeToClientVersions :: Proxy (SimpleBlock SimpleMockCrypto ext)
-> Map
NodeToClientVersion
(BlockNodeToClientVersion (SimpleBlock SimpleMockCrypto ext))
supportedNodeToClientVersions Proxy (SimpleBlock SimpleMockCrypto ext)
_ = NodeToClientVersion -> () -> Map NodeToClientVersion ()
forall k a. k -> a -> Map k a
Map.singleton NodeToClientVersion
forall a. Bounded a => a
maxBound ()
latestReleasedNodeVersion :: Proxy (SimpleBlock SimpleMockCrypto ext)
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersion = Proxy (SimpleBlock SimpleMockCrypto ext)
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersionDefault
instance NodeInitStorage (SimpleBlock SimpleMockCrypto ext) where
nodeImmutableDbChunkInfo :: StorageConfig (SimpleBlock SimpleMockCrypto ext) -> ChunkInfo
nodeImmutableDbChunkInfo (SimpleStorageConfig SecurityParam
secParam) = EpochSize -> ChunkInfo
simpleChunkInfo (EpochSize -> ChunkInfo) -> EpochSize -> ChunkInfo
forall a b. (a -> b) -> a -> b
$
Word64 -> EpochSize
EpochSize (Word64 -> EpochSize) -> Word64 -> EpochSize
forall a b. (a -> b) -> a -> b
$ Word64
10 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* SecurityParam -> Word64
maxRollbacks SecurityParam
secParam
nodeCheckIntegrity :: StorageConfig (SimpleBlock SimpleMockCrypto ext)
-> SimpleBlock SimpleMockCrypto ext -> Bool
nodeCheckIntegrity StorageConfig (SimpleBlock SimpleMockCrypto ext)
_ SimpleBlock SimpleMockCrypto ext
_ = Bool
True
instance BlockSupportsMetrics (SimpleBlock c ext) where
isSelfIssued :: BlockConfig (SimpleBlock c ext)
-> Header (SimpleBlock c ext) -> WhetherSelfIssued
isSelfIssued = BlockConfig (SimpleBlock c ext)
-> Header (SimpleBlock c ext) -> WhetherSelfIssued
forall blk. BlockConfig blk -> Header blk -> WhetherSelfIssued
isSelfIssuedConstUnknown
deriving via SelectViewDiffusionPipelining (SimpleBlock c ext) instance
( BlockSupportsProtocol (SimpleBlock c ext)
, Show (SelectView (BlockProtocol (SimpleBlock c ext)))
) => BlockSupportsDiffusionPipelining (SimpleBlock c ext)
instance ConsensusProtocol (BlockProtocol (SimpleBlock c ext)) => BlockSupportsSanityCheck (SimpleBlock c ext) where
configAllSecurityParams :: TopLevelConfig (SimpleBlock c ext) -> NonEmpty SecurityParam
configAllSecurityParams = SecurityParam -> NonEmpty SecurityParam
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecurityParam -> NonEmpty SecurityParam)
-> (TopLevelConfig (SimpleBlock c ext) -> SecurityParam)
-> TopLevelConfig (SimpleBlock c ext)
-> NonEmpty SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevelConfig (SimpleBlock c ext) -> SecurityParam
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk -> SecurityParam
configSecurityParam
instance ( LedgerSupportsProtocol (SimpleBlock SimpleMockCrypto ext)
, Show (CannotForge (SimpleBlock SimpleMockCrypto ext))
, Show (ForgeStateInfo (SimpleBlock SimpleMockCrypto ext))
, Show (ForgeStateUpdateError (SimpleBlock SimpleMockCrypto ext))
, Serialise ext
, RunMockBlock SimpleMockCrypto ext
) => RunNode (SimpleBlock SimpleMockCrypto ext)
simpleBlockForging ::
forall c ext m.
( RunMockBlock c ext
, CannotForge (SimpleBlock c ext) ~ Void
, ForgeStateInfo (SimpleBlock c ext) ~ ()
, ForgeStateUpdateError (SimpleBlock c ext) ~ Void
, Monad m
)
=> CanBeLeader (BlockProtocol (SimpleBlock c ext))
-> ForgeExt c ext
-> BlockForging m (SimpleBlock c ext)
simpleBlockForging :: forall c ext (m :: * -> *).
(RunMockBlock c ext, CannotForge (SimpleBlock c ext) ~ Void,
ForgeStateInfo (SimpleBlock c ext) ~ (),
ForgeStateUpdateError (SimpleBlock c ext) ~ Void, Monad m) =>
CanBeLeader (BlockProtocol (SimpleBlock c ext))
-> ForgeExt c ext -> BlockForging m (SimpleBlock c ext)
simpleBlockForging CanBeLeader (BlockProtocol (SimpleBlock c ext))
aCanBeLeader ForgeExt c ext
aForgeExt = BlockForging {
forgeLabel :: Text
forgeLabel = Text
"simpleBlockForging"
, canBeLeader :: CanBeLeader (BlockProtocol (SimpleBlock c ext))
canBeLeader = CanBeLeader (BlockProtocol (SimpleBlock c ext))
aCanBeLeader
, updateForgeState :: TopLevelConfig (SimpleBlock c ext)
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (SimpleBlock c ext)))
-> m (ForgeStateUpdateInfo (SimpleBlock c ext))
updateForgeState = \TopLevelConfig (SimpleBlock c ext)
_ SlotNo
_ Ticked (ChainDepState (BlockProtocol (SimpleBlock c ext)))
_ -> ForgeStateUpdateInfo (SimpleBlock c ext)
-> m (ForgeStateUpdateInfo (SimpleBlock c ext))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForgeStateUpdateInfo (SimpleBlock c ext)
-> m (ForgeStateUpdateInfo (SimpleBlock c ext)))
-> ForgeStateUpdateInfo (SimpleBlock c ext)
-> m (ForgeStateUpdateInfo (SimpleBlock c ext))
forall a b. (a -> b) -> a -> b
$ ForgeStateInfo (SimpleBlock c ext)
-> ForgeStateUpdateInfo (SimpleBlock c ext)
forall blk. ForgeStateInfo blk -> ForgeStateUpdateInfo blk
ForgeStateUpdated ()
, checkCanForge :: TopLevelConfig (SimpleBlock c ext)
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol (SimpleBlock c ext)))
-> IsLeader (BlockProtocol (SimpleBlock c ext))
-> ForgeStateInfo (SimpleBlock c ext)
-> Either (CannotForge (SimpleBlock c ext)) ()
checkCanForge = \TopLevelConfig (SimpleBlock c ext)
_ SlotNo
_ Ticked (ChainDepState (BlockProtocol (SimpleBlock c ext)))
_ IsLeader (BlockProtocol (SimpleBlock c ext))
_ ForgeStateInfo (SimpleBlock c ext)
_ -> () -> Either Void ()
forall a. a -> Either Void a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, forgeBlock :: TopLevelConfig (SimpleBlock c ext)
-> BlockNo
-> SlotNo
-> TickedLedgerState (SimpleBlock c ext)
-> [Validated (GenTx (SimpleBlock c ext))]
-> IsLeader (BlockProtocol (SimpleBlock c ext))
-> m (SimpleBlock c ext)
forgeBlock = \TopLevelConfig (SimpleBlock c ext)
cfg BlockNo
bno SlotNo
slot TickedLedgerState (SimpleBlock c ext)
lst [Validated (GenTx (SimpleBlock c ext))]
txs IsLeader (BlockProtocol (SimpleBlock c ext))
proof ->
SimpleBlock c ext -> m (SimpleBlock c ext)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(SimpleBlock c ext -> m (SimpleBlock c ext))
-> SimpleBlock c ext -> m (SimpleBlock c ext)
forall a b. (a -> b) -> a -> b
$ ForgeExt c ext
-> TopLevelConfig (SimpleBlock c ext)
-> BlockNo
-> SlotNo
-> TickedLedgerState (SimpleBlock c ext)
-> [GenTx (SimpleBlock c ext)]
-> IsLeader (BlockProtocol (SimpleBlock c ext))
-> SimpleBlock c ext
forall c ext.
SimpleCrypto c =>
ForgeExt c ext
-> TopLevelConfig (SimpleBlock c ext)
-> BlockNo
-> SlotNo
-> TickedLedgerState (SimpleBlock c ext)
-> [GenTx (SimpleBlock c ext)]
-> IsLeader (BlockProtocol (SimpleBlock c ext))
-> SimpleBlock c ext
forgeSimple
ForgeExt c ext
aForgeExt
TopLevelConfig (SimpleBlock c ext)
cfg
BlockNo
bno
SlotNo
slot
TickedLedgerState (SimpleBlock c ext)
lst
((Validated (GenTx (SimpleBlock c ext))
-> GenTx (SimpleBlock c ext))
-> [Validated (GenTx (SimpleBlock c ext))]
-> [GenTx (SimpleBlock c ext)]
forall a b. (a -> b) -> [a] -> [b]
map Validated (GenTx (SimpleBlock c ext)) -> GenTx (SimpleBlock c ext)
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated [Validated (GenTx (SimpleBlock c ext))]
txs)
IsLeader (BlockProtocol (SimpleBlock c ext))
proof
}
where
()
_ = Proxy (ForgeStateUpdateError (SimpleBlock c ext) ~ Void) -> ()
forall (c :: Constraint) (proxy :: Constraint -> *).
c =>
proxy c -> ()
keepRedundantConstraint (forall {k} (t :: k). Proxy t
forall (t :: Constraint). Proxy t
Proxy @(ForgeStateUpdateError (SimpleBlock c ext) ~ Void))