Skip to content

Commit d20cd7a

Browse files
cootcoot
committed
tx-submission: put common types in one place
This allows us to have just one tracer for tx-submission decision logic.
1 parent 0e6d25c commit d20cd7a

File tree

11 files changed

+282
-278
lines changed

11 files changed

+282
-278
lines changed

‎ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs

Lines changed: 6 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -107,10 +107,9 @@ import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSLookupType)
107107
import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency,
108108
WarmValency)
109109
import Ouroboros.Network.TxSubmission.Inbound.Policy (TxDecisionPolicy)
110-
import Ouroboros.Network.TxSubmission.Inbound.Registry (DebugTxLogic,
111-
decisionLogicThread)
112-
import Ouroboros.Network.TxSubmission.Inbound.State (DebugSharedTxState)
113-
import Ouroboros.Network.TxSubmission.Inbound.Types (TraceTxSubmissionInbound)
110+
import Ouroboros.Network.TxSubmission.Inbound.Registry (decisionLogicThread)
111+
import Ouroboros.Network.TxSubmission.Inbound.Types (TraceTxLogic,
112+
TraceTxSubmissionInbound)
114113
import Test.Ouroboros.Network.Diffusion.Node.ChainDB (addBlock,
115114
getBlockPointSet)
116115
import Test.Ouroboros.Network.Diffusion.Node.MiniProtocols qualified as Node
@@ -205,10 +204,9 @@ run :: forall resolver m.
205204
ResolverException m
206205
-> Tracer m (TraceLabelPeer NtNAddr (TraceFetchClientState BlockHeader))
207206
-> Tracer m (TraceTxSubmissionInbound Int (Tx Int))
208-
-> Tracer m (DebugSharedTxState NtNAddr Int (Tx Int))
209-
-> Tracer m (DebugTxLogic NtNAddr Int (Tx Int))
207+
-> Tracer m (TraceTxLogic NtNAddr Int (Tx Int))
210208
-> m Void
211-
run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch tracerTxSubmissionInbound tracerTxSubmissionDebug tracerTxLogic =
209+
run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch tracerTxSubmissionInbound tracerTxLogic =
212210
Node.withNodeKernelThread blockGeneratorArgs (aTxs na)
213211
$ \ nodeKernel nodeKernelThread -> do
214212
dnsTimeoutScriptVar <- newTVarIO (aDNSTimeoutScript na)
@@ -282,7 +280,7 @@ run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch tracerTxSubmis
282280
, Diff.P2P.daPeerSharingRegistry = nkPeerSharingRegistry nodeKernel
283281
}
284282

285-
let apps = Node.applications (aDebugTracer na) tracerTxSubmissionInbound tracerTxSubmissionDebug nodeKernel Node.cborCodecs limits appArgs blockHeader
283+
let apps = Node.applications (aDebugTracer na) tracerTxSubmissionInbound tracerTxLogic nodeKernel Node.cborCodecs limits appArgs blockHeader
286284

287285
withAsync
288286
(Diff.P2P.runM interfaces

‎ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -105,8 +105,8 @@ import Ouroboros.Network.TxSubmission.Inbound.Policy (TxDecisionPolicy (..))
105105
import Ouroboros.Network.TxSubmission.Inbound.Registry (SharedTxStateVar,
106106
TxChannelsVar, withPeer)
107107
import Ouroboros.Network.TxSubmission.Inbound.Server (txSubmissionInboundV2)
108-
import Ouroboros.Network.TxSubmission.Inbound.State (DebugSharedTxState)
109-
import Ouroboros.Network.TxSubmission.Inbound.Types (TraceTxSubmissionInbound)
108+
import Ouroboros.Network.TxSubmission.Inbound.Types (TraceTxLogic,
109+
TraceTxSubmissionInbound)
110110
import Ouroboros.Network.TxSubmission.Outbound (txSubmissionOutbound)
111111
import Test.Ouroboros.Network.Diffusion.Node.NodeKernel
112112
import Test.Ouroboros.Network.TxSubmission.Common (Mempool, Tx,
@@ -261,7 +261,7 @@ applications :: forall block header s m.
261261
)
262262
=> Tracer m String
263263
-> Tracer m (TraceTxSubmissionInbound Int (Tx Int))
264-
-> Tracer m (DebugSharedTxState NtNAddr Int (Tx Int))
264+
-> Tracer m (TraceTxLogic NtNAddr Int (Tx Int))
265265
-> NodeKernel header block s Int m
266266
-> Codecs NtNAddr header block m
267267
-> LimitsAndTimeouts header block

‎ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -107,10 +107,9 @@ import Ouroboros.Network.PeerSelection.Bootstrap (requiresBootstrapPeers)
107107
import Ouroboros.Network.PeerSelection.LedgerPeers
108108
import Ouroboros.Network.TxSubmission.Inbound.Policy (defaultTxDecisionPolicy,
109109
txInflightMultiplicity)
110-
import Ouroboros.Network.TxSubmission.Inbound.State (DebugSharedTxState (..),
111-
inflightTxs)
112-
import Ouroboros.Network.TxSubmission.Inbound.Types
113-
(TraceTxSubmissionInbound (..))
110+
import Ouroboros.Network.TxSubmission.Inbound.State (inflightTxs)
111+
import Ouroboros.Network.TxSubmission.Inbound.Types (TraceTxLogic (..),
112+
TraceTxSubmissionInbound (..))
114113
import Ouroboros.Network.TxSubmission.Outbound (TxSubmissionProtocolError (..))
115114
import Test.Ouroboros.Network.TxSubmission.Common (ArbTxDecisionPolicy (..),
116115
Tx (..))
@@ -661,8 +660,8 @@ prop_check_inflight_ratio bi ds@(DiffusionScript simArgs _ _) =
661660
$ Signal.eventsToList
662661
$ Signal.selectEvents
663662
(\case
664-
DiffusionTxSubmissionDebug (DebugSharedTxState _ d) -> Just (inflightTxs d)
665-
_ -> Nothing
663+
DiffusionTxLogic (TraceSharedTxState _ d) -> Just (inflightTxs d)
664+
_ -> Nothing
666665
)
667666
$ events
668667

‎ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet/Simulation/Node.hs

Lines changed: 4 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -144,9 +144,8 @@ import Ouroboros.Network.Protocol.PeerSharing.Codec (byteLimitsPeerSharing,
144144
import Ouroboros.Network.Protocol.TxSubmission2.Codec (byteLimitsTxSubmission2,
145145
timeLimitsTxSubmission2)
146146
import Ouroboros.Network.TxSubmission.Inbound.Policy (TxDecisionPolicy)
147-
import Ouroboros.Network.TxSubmission.Inbound.Registry (DebugTxLogic)
148-
import Ouroboros.Network.TxSubmission.Inbound.State (DebugSharedTxState)
149-
import Ouroboros.Network.TxSubmission.Inbound.Types (TraceTxSubmissionInbound)
147+
import Ouroboros.Network.TxSubmission.Inbound.Types (TraceTxLogic,
148+
TraceTxSubmissionInbound)
150149
import Test.Ouroboros.Network.LedgerPeers (LedgerPools (..), genLedgerPoolsFrom)
151150
import Test.Ouroboros.Network.PeerSelection.LocalRootPeers ()
152151
import Test.Ouroboros.Network.TxSubmission.Common (ArbTxDecisionPolicy (..),
@@ -1004,8 +1003,7 @@ data DiffusionTestTrace =
10041003
| DiffusionServerTrace (ServerTrace NtNAddr)
10051004
| DiffusionFetchTrace (TraceFetchClientState BlockHeader)
10061005
| DiffusionTxSubmissionInbound (TraceTxSubmissionInbound Int (Tx Int))
1007-
| DiffusionTxSubmissionDebug (DebugSharedTxState NtNAddr Int (Tx Int))
1008-
| DiffusionTxLogicDebug (DebugTxLogic NtNAddr Int (Tx Int))
1006+
| DiffusionTxLogic (TraceTxLogic NtNAddr Int (Tx Int))
10091007
| DiffusionDebugTrace String
10101008
deriving (Show)
10111009

@@ -1305,11 +1303,7 @@ diffusionSimulation
13051303
. tracerWithName addr
13061304
. tracerWithTime
13071305
$ nodeTracer)
1308-
( contramap DiffusionTxSubmissionDebug
1309-
. tracerWithName addr
1310-
. tracerWithTime
1311-
$ nodeTracer)
1312-
( contramap DiffusionTxLogicDebug
1306+
( contramap DiffusionTxLogic
13131307
. tracerWithName addr
13141308
. tracerWithTime
13151309
$ nodeTracer)

‎ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/TxSubmission/TxSubmissionV2.hs

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,7 @@ import Ouroboros.Network.Protocol.TxSubmission2.Type
5454
import Ouroboros.Network.TxSubmission.Inbound.Policy
5555
import Ouroboros.Network.TxSubmission.Inbound.Registry
5656
import Ouroboros.Network.TxSubmission.Inbound.Server (txSubmissionInboundV2)
57-
import Ouroboros.Network.TxSubmission.Inbound.State
57+
import Ouroboros.Network.TxSubmission.Inbound.Types (TraceTxLogic)
5858
import Ouroboros.Network.TxSubmission.Outbound
5959
import Ouroboros.Network.Util.ShowProxy
6060

@@ -132,16 +132,15 @@ runTxSubmission
132132
, txid ~ Int
133133
)
134134
=> Tracer m (String, TraceSendRecv (TxSubmission2 txid (Tx txid)))
135-
-> Tracer m (DebugSharedTxState peeraddr txid (Tx txid))
136-
-> Tracer m (DebugTxLogic peeraddr txid (Tx txid))
135+
-> Tracer m (TraceTxLogic peeraddr txid (Tx txid))
137136
-> Map peeraddr ( [Tx txid]
138137
, ControlMessageSTM m
139138
, Maybe DiffTime
140139
, Maybe DiffTime
141140
)
142141
-> TxDecisionPolicy
143142
-> m ([Tx txid], [[Tx txid]])
144-
runTxSubmission tracer tracerDST tracerTxLogic state txDecisionPolicy = do
143+
runTxSubmission tracer tracerTxLogic state txDecisionPolicy = do
145144

146145
state' <- traverse (\(b, c, d, e) -> do
147146
mempool <- newMempool b
@@ -209,7 +208,7 @@ runTxSubmission tracer tracerDST tracerTxLogic state txDecisionPolicy = do
209208

210209
-- Construct txSubmission inbound server
211210
servers = (\(addr, (_, _, _, inDelay, _, inChannel)) ->
212-
withPeer tracerDST
211+
withPeer tracerTxLogic
213212
txChannelsVar
214213
sharedTxStateVar
215214
(getMempoolReader inboundMempool)
@@ -274,7 +273,7 @@ txSubmissionSimulation (TxSubmissionState state txDecisionPolicy) = do
274273

275274
let tracer :: forall a. Show a => Tracer (IOSim s) a
276275
tracer = verboseTracer <> debugTracer
277-
runTxSubmission tracer tracer tracer state'' txDecisionPolicy
276+
runTxSubmission tracer tracer state'' txDecisionPolicy
278277

279278
-- | Tests overall tx submission semantics. The properties checked in this
280279
-- property test are the same as for tx submission v1. We need this to know we

‎ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,9 @@ import Ouroboros.Network.NodeToNode.Version (NodeToNodeVersion)
4545
import Ouroboros.Network.Protocol.Limits
4646
import Ouroboros.Network.Protocol.TxSubmission2.Server
4747
import Ouroboros.Network.Protocol.TxSubmission2.Type
48-
import Ouroboros.Network.TxSubmission.Inbound.Types
48+
import Ouroboros.Network.TxSubmission.Inbound.Types (ProcessedTxCount (..),
49+
TxSubmissionMempoolWriter (..), TraceTxSubmissionInbound (..),
50+
TxSubmissionProtocolError (..))
4951
import Ouroboros.Network.TxSubmission.Mempool.Reader (MempoolSnapshot (..),
5052
TxSubmissionMempoolReader (..))
5153

‎ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound/Decision.hs

Lines changed: 1 addition & 78 deletions
Original file line numberDiff line numberDiff line change
@@ -34,86 +34,9 @@ import Ouroboros.Network.DeltaQ (PeerGSV (..), defaultGSV,
3434
import Ouroboros.Network.Protocol.TxSubmission2.Type
3535
import Ouroboros.Network.TxSubmission.Inbound.Policy
3636
import Ouroboros.Network.TxSubmission.Inbound.State
37+
import Ouroboros.Network.TxSubmission.Inbound.Types
3738

3839

39-
-- | Decision made by the decision logic. Each peer will receive a 'Decision'.
40-
--
41-
-- /note:/ it is rather non-standard to represent a choice between requesting
42-
-- `txid`s and `tx`'s as a product rather than a sum type. The client will
43-
-- need to download `tx`s first and then send a request for more txids (and
44-
-- acknowledge some `txid`s). Due to pipelining each client will request
45-
-- decision from the decision logic quite often (every two pipelined requests),
46-
-- but with this design a decision once taken will make the peer non-active
47-
-- (e.g. it won't be returned by `filterActivePeers`) for longer, and thus the
48-
-- expensive `makeDecision` computation will not need to take that peer into
49-
-- account.
50-
--
51-
data TxDecision txid tx = TxDecision {
52-
txdTxIdsToAcknowledge :: !NumTxIdsToAck,
53-
-- ^ txid's to acknowledge
54-
55-
txdTxIdsToRequest :: !NumTxIdsToReq,
56-
-- ^ number of txid's to request
57-
58-
txdPipelineTxIds :: !Bool,
59-
-- ^ the tx-submission protocol only allows to pipeline `txid`'s requests
60-
-- if we have non-acknowledged `txid`s.
61-
62-
txdTxsToRequest :: !(Set txid),
63-
-- ^ txid's to download.
64-
65-
txdTxsToMempool :: ![tx]
66-
-- ^ list of `tx`s to submit to the mempool.
67-
}
68-
deriving (Show, Eq)
69-
70-
-- | A non-commutative semigroup instance.
71-
--
72-
-- /note:/ this instance must be consistent with `pickTxsToDownload` and how
73-
-- `PeerTxState` is updated. It is designed to work with `TMergeVar`s.
74-
--
75-
instance Ord txid => Semigroup (TxDecision txid tx) where
76-
TxDecision { txdTxIdsToAcknowledge,
77-
txdTxIdsToRequest,
78-
txdPipelineTxIds = _ignored,
79-
txdTxsToRequest,
80-
txdTxsToMempool }
81-
<>
82-
TxDecision { txdTxIdsToAcknowledge = txdTxIdsToAcknowledge',
83-
txdTxIdsToRequest = txdTxIdsToRequest',
84-
txdPipelineTxIds = txdPipelineTxIds',
85-
txdTxsToRequest = txdTxsToRequest',
86-
txdTxsToMempool = txdTxsToMempool' }
87-
=
88-
TxDecision { txdTxIdsToAcknowledge = txdTxIdsToAcknowledge + txdTxIdsToAcknowledge',
89-
txdTxIdsToRequest = txdTxIdsToRequest + txdTxIdsToRequest',
90-
txdPipelineTxIds = txdPipelineTxIds',
91-
txdTxsToRequest = txdTxsToRequest <> txdTxsToRequest',
92-
txdTxsToMempool = txdTxsToMempool ++ txdTxsToMempool'
93-
}
94-
95-
-- | A no-op decision.
96-
emptyTxDecision :: TxDecision txid tx
97-
emptyTxDecision = TxDecision {
98-
txdTxIdsToAcknowledge = 0,
99-
txdTxIdsToRequest = 0,
100-
txdPipelineTxIds = False,
101-
txdTxsToRequest = Set.empty,
102-
txdTxsToMempool = []
103-
}
104-
105-
data SharedDecisionContext peeraddr txid tx = SharedDecisionContext {
106-
-- TODO: check how to access it.
107-
sdcPeerGSV :: !(Map peeraddr PeerGSV),
108-
109-
sdcSharedTxState :: !(SharedTxState peeraddr txid tx)
110-
}
111-
deriving Show
112-
113-
--
114-
-- Decision Logic
115-
--
116-
11740
-- | Make download decisions.
11841
--
11942
makeDecisions

‎ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound/Registry.hs

Lines changed: 5 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,6 @@ module Ouroboros.Network.TxSubmission.Inbound.Registry
1212
, newTxChannelsVar
1313
, PeerTxAPI (..)
1414
, decisionLogicThread
15-
, DebugTxLogic (..)
1615
, withPeer
1716
) where
1817

@@ -38,6 +37,7 @@ import Ouroboros.Network.Protocol.TxSubmission2.Type
3837
import Ouroboros.Network.TxSubmission.Inbound.Decision
3938
import Ouroboros.Network.TxSubmission.Inbound.Policy
4039
import Ouroboros.Network.TxSubmission.Inbound.State
40+
import Ouroboros.Network.TxSubmission.Inbound.Types
4141
import Ouroboros.Network.TxSubmission.Mempool.Reader
4242

4343
-- | Communication channels between `TxSubmission` client mini-protocol and
@@ -75,10 +75,6 @@ data PeerTxAPI m txid tx = PeerTxAPI {
7575
}
7676

7777

78-
data TraceDecision peeraddr txid tx =
79-
TraceDecisions (Map peeraddr (TxDecision txid tx))
80-
deriving (Eq, Show)
81-
8278
-- | A bracket function which registers / de-registers a new peer in
8379
-- `SharedTxStateVar` and `PeerTxStateVar`s, which exposes `PeerTxStateAPI`.
8480
-- `PeerTxStateAPI` is only safe inside the `withPeer` scope.
@@ -92,7 +88,7 @@ withPeer
9288
, Ord peeraddr
9389
, Show peeraddr
9490
)
95-
=> Tracer m (DebugSharedTxState peeraddr txid tx)
91+
=> Tracer m (TraceTxLogic peeraddr txid tx)
9692
-> TxChannelsVar m peeraddr txid tx
9793
-> SharedTxStateVar m peeraddr txid tx
9894
-> TxSubmissionMempoolReader txid tx idx m
@@ -213,13 +209,6 @@ withPeer tracer
213209
collectTxs tracer sharedStateVar peeraddr txids txs
214210

215211

216-
-- | TODO: reorganise modules so there's just one `Debug` tracer.
217-
data DebugTxLogic peeraddr txid tx =
218-
DebugTxLogicSharedTxState (SharedTxState peeraddr txid tx)
219-
| DebugTxLogicDecisions (Map peeraddr (TxDecision txid tx))
220-
deriving Show
221-
222-
223212
decisionLogicThread
224213
:: forall m peeraddr txid tx.
225214
( MonadDelay m
@@ -230,7 +219,7 @@ decisionLogicThread
230219
, Ord peeraddr
231220
, Ord txid
232221
)
233-
=> Tracer m (DebugTxLogic peeraddr txid tx)
222+
=> Tracer m (TraceTxLogic peeraddr txid tx)
234223
-> TxDecisionPolicy
235224
-> STM m (Map peeraddr PeerGSV)
236225
-> TxChannelsVar m peeraddr txid tx
@@ -259,8 +248,8 @@ decisionLogicThread tracer policy readGSVVar txChannelsVar sharedStateVar = do
259248
let (sharedState, decisions) = makeDecisions policy sharedCtx activePeers
260249
writeTVar sharedStateVar sharedState
261250
return (decisions, sharedState)
262-
traceWith tracer (DebugTxLogicSharedTxState st)
263-
traceWith tracer (DebugTxLogicDecisions decisions)
251+
traceWith tracer (TraceSharedTxState "decisionLogicThread" st)
252+
traceWith tracer (TraceTxDecisions decisions)
264253
TxChannels { txChannelMap } <- readMVar txChannelsVar
265254
traverse_
266255
(\(mvar, d) -> modifyMVarWithDefault_ mvar d (\d' -> pure (d' <> d)))

‎ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound/Server.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,6 @@ import Network.TypedProtocol.Pipelined
2222

2323
import Control.Monad (unless)
2424
import Ouroboros.Network.Protocol.TxSubmission2.Server
25-
import Ouroboros.Network.TxSubmission.Inbound.Decision (TxDecision (..))
2625
import Ouroboros.Network.TxSubmission.Inbound.Registry (PeerTxAPI (..))
2726
import Ouroboros.Network.TxSubmission.Inbound.Types
2827

0 commit comments

Comments
 (0)