Skip to content
Permalink
Browse files

Abstract over block production

  • Loading branch information...
edsko committed May 15, 2019
1 parent e152b4e commit 3abac52fc419c365eb9872d8be70e8e749bcd045
@@ -111,12 +111,12 @@ handleSimpleNode p CLI{..} (TopologyInfo myNodeId topologyFile) = do
lift . lift $ writeTVar nodeMempool mp'
return ts

Mock.forgeBlock pInfoConfig
slot
curNo
prevHash
txs
proof
demoForgeBlock pInfoConfig
slot
curNo
prevHash
txs
proof

, produceDRG = drgNew
}
@@ -18,6 +18,7 @@ module Ouroboros.Consensus.Demo (
, DemoLeaderSchedule
, DemoMockPBFT
, DemoRealPBFT
, DemoForgeBlock(..)
, Block
, Header
, NumCoreNodes(..)
@@ -35,6 +36,7 @@ module Ouroboros.Consensus.Demo (

import Codec.Serialise (Serialise)
import Control.Monad.Except
import Crypto.Random (MonadRandom)
import qualified Data.Bimap as Bimap
import qualified Data.ByteString as BS
import Data.Either (fromRight)
@@ -50,6 +52,8 @@ import qualified Cardano.Chain.Genesis as Cardano.Genesis
import qualified Cardano.Crypto as Cardano
import qualified Cardano.Crypto.Signing as Cardano.KeyGen

import Ouroboros.Network.Block (BlockNo, ChainHash, SlotNo)

import Ouroboros.Consensus.Crypto.DSIGN
import Ouroboros.Consensus.Crypto.DSIGN.Mock (verKeyIdFromSigned)
import Ouroboros.Consensus.Crypto.Hash
@@ -136,6 +140,7 @@ type DemoProtocolConstraints p = (
, Eq (Payload p (PreHeader (Block p)))
, Serialise (Payload p (PreHeader (Block p)))
, Show (Payload p (PreHeader (Block p)))
, DemoForgeBlock p
)

demoProtocolConstraints :: DemoProtocol p -> Dict (DemoProtocolConstraints p)
@@ -391,3 +396,32 @@ instance HasCreator DemoRealPBFT where
key = Cardano.Block.headerGenesisKey
. Cardano.Block.blockHeader
$ b

{-------------------------------------------------------------------------------
Forging blocks
-------------------------------------------------------------------------------}

class DemoForgeBlock p where
demoForgeBlock :: (HasNodeState p m, MonadRandom m)
=> NodeConfig p
-> SlotNo -- ^ Current slot
-> BlockNo -- ^ Current block number
-> ChainHash (Header p) -- ^ Previous hash
-> Map (Hash ShortHash Tx) Tx -- ^ Txs to add in the block
-> IsLeader p
-> m (Block p)

instance DemoForgeBlock DemoBFT where
demoForgeBlock = forgeSimpleBlock

instance DemoForgeBlock DemoPraos where
demoForgeBlock = forgeSimpleBlock

instance DemoForgeBlock DemoLeaderSchedule where
demoForgeBlock = forgeSimpleBlock

instance DemoForgeBlock DemoMockPBFT where
demoForgeBlock = forgeSimpleBlock

instance DemoForgeBlock DemoRealPBFT where
demoForgeBlock = error "TODO (Nick)"
@@ -31,7 +31,7 @@ module Ouroboros.Consensus.Ledger.Mock (
, SimpleHeader(..)
, SimplePreHeader(..)
, SimpleBody(..)
, forgeBlock
, forgeSimpleBlock
, blockMatchesHeader
-- * Updating the Ledger state
, LedgerState(..)
@@ -315,23 +315,23 @@ instance (Typeable p, SimpleBlockCrypto c) => StandardHash (SimpleBlock p c)
Creating blocks
-------------------------------------------------------------------------------}

forgeBlock :: forall m p c.
( HasNodeState p m
, MonadRandom m
, OuroborosTag p
, SimpleBlockCrypto c
, Serialise (Payload p (SimplePreHeader p c))
-- TODO Decide whether we want to fix this constraint here.
, SupportedPreHeader p ~ Empty
)
=> NodeConfig p
-> SlotNo -- ^ Current slot
-> BlockNo -- ^ Current block number
-> ChainHash (SimpleHeader p c) -- ^ Previous hash
-> Map (Hash ShortHash Tx) Tx -- ^ Txs to add in the block
-> IsLeader p
-> m (SimpleBlock p c)
forgeBlock cfg curSlot curNo prevHash txs proof = do
forgeSimpleBlock :: forall m p c.
( HasNodeState p m
, MonadRandom m
, OuroborosTag p
, SimpleBlockCrypto c
, Serialise (Payload p (SimplePreHeader p c))
-- TODO Decide whether we want to fix this constraint here.
, SupportedPreHeader p ~ Empty
)
=> NodeConfig p
-> SlotNo -- ^ Current slot
-> BlockNo -- ^ Current block number
-> ChainHash (SimpleHeader p c) -- ^ Previous hash
-> Map (Hash ShortHash Tx) Tx -- ^ Txs to add in the block
-> IsLeader p
-> m (SimpleBlock p c)
forgeSimpleBlock cfg curSlot curNo prevHash txs proof = do
ouroborosPayload <- mkPayload encode cfg proof preHeader
return $ SimpleBlock {
simpleHeader = mkSimpleHeader preHeader ouroborosPayload

0 comments on commit 3abac52

Please sign in to comment.
You can’t perform that action at this time.