Skip to content
Permalink
Browse files

Integrate the node-to-node TxSubmission protocol in the Node

  • Loading branch information...
mrBliss committed Jul 12, 2019
1 parent 3521396 commit 95bf56b8d2b16818e391b4828d894e6664e2b3bb
@@ -243,7 +243,7 @@ instance (SimpleCrypto c, Typeable ext, SupportedBlock (SimpleBlock c ext))

newtype GenTxId (SimpleBlock c ext) = SimpleGenTxId
{ simpleGenTxId :: TxId
} deriving (Eq, Ord)
} deriving (Show, Eq, Ord)

computeGenTxId = SimpleGenTxId . hash . simpleGenTx

@@ -1,13 +1,12 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -Wredundant-constraints -Werror=missing-fields #-}

@@ -18,6 +17,8 @@ module Ouroboros.Consensus.Node (
, NodeParams (..)
, TraceConstraints
, nodeKernel
, getMempoolReader
, getMempoolWriter
-- * Auxiliary functions
, tracePrefix
) where
@@ -26,6 +27,8 @@ import Control.Monad (void)
import Crypto.Random (ChaChaDRG)
import Data.Functor.Contravariant (contramap)
import Data.Map.Strict (Map)
import Data.Maybe (isNothing)
import Data.Word (Word16)

import Control.Monad.Class.MonadAsync
import Control.Monad.Class.MonadFork (MonadFork)
@@ -39,6 +42,10 @@ import Ouroboros.Network.Block
import Ouroboros.Network.BlockFetch
import Ouroboros.Network.BlockFetch.State (FetchMode (..))
import qualified Ouroboros.Network.Chain as Chain
import Ouroboros.Network.TxSubmission.Inbound
import Ouroboros.Network.TxSubmission.Outbound hiding
(MempoolSnapshot)
import qualified Ouroboros.Network.TxSubmission.Outbound as Outbound

import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime
@@ -119,6 +126,8 @@ data NodeParams m peer blk = NodeParams {
, mempoolTracer :: Tracer m (TraceEventMempool blk)
, decisionTracer :: Tracer m [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
, fetchClientTracer :: Tracer m (TraceLabelPeer peer (TraceFetchClientState (Header blk)))
, txInboundTracer :: Tracer m (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
, txOutboundTracer :: Tracer m (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
, threadRegistry :: ThreadRegistry m
, maxClockSkew :: ClockSkew
, cfg :: NodeConfig (BlockProtocol blk)
@@ -128,6 +137,7 @@ data NodeParams m peer blk = NodeParams {
, callbacks :: NodeCallbacks m blk
, blockFetchSize :: Header blk -> SizeInBytes
, blockMatchesHeader :: Header blk -> blk -> Bool
, maxUnackTxs :: Word16
}

nodeKernel
@@ -376,3 +386,37 @@ forkBlockProduction IS{..} =
$ simChaChaT varDRG
$ id


{-------------------------------------------------------------------------------
TxSubmission integration
-------------------------------------------------------------------------------}

getMempoolReader
:: forall m blk.
(MonadSTM m, ApplyTx blk)
=> Mempool m blk TicketNo
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
getMempoolReader mempool = TxSubmissionMempoolReader
{ mempoolZeroIdx = zeroIdx mempool
, mempoolGetSnapshot = convertSnapshot <$> getSnapshot mempool
}
where
convertSnapshot
:: MempoolSnapshot blk TicketNo
-> Outbound.MempoolSnapshot (GenTxId blk) (GenTx blk) TicketNo
convertSnapshot MempoolSnapshot{getTxsAfter, getTx} = Outbound.MempoolSnapshot
{ mempoolTxIdsAfter = \idx ->
[(computeGenTxId tx, idx', size) | (tx, idx', size) <- getTxsAfter idx]
, mempoolLookupTx = getTx
}

getMempoolWriter
:: (Monad m, ApplyTx blk)
=> Mempool m blk TicketNo
-> TxSubmissionMempoolWriter (GenTxId blk) (GenTx blk) TicketNo m
getMempoolWriter mempool = TxSubmissionMempoolWriter
{ txId = computeGenTxId
, mempoolAddTxs = \txs ->
map (computeGenTxId . fst) . filter (isNothing . snd) <$>
addTxs mempool txs
}

0 comments on commit 95bf56b

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