Skip to content

Commit 1fe9d57

Browse files
cootcoot
committed
tx-submission: newtype wrappers NumTxIdsTo{Ack,Req}
1 parent fe0a0dc commit 1fe9d57

File tree

10 files changed

+90
-56
lines changed

10 files changed

+90
-56
lines changed

‎ouroboros-network-protocols/ouroboros-network-protocols.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -98,8 +98,10 @@ library
9898
bytestring >=0.10 && <0.13,
9999
cborg >=0.2.1 && <0.3,
100100
deepseq,
101+
quiet,
101102

102103
io-classes ^>=1.5.0,
104+
nothunks,
103105
si-timers,
104106

105107
ouroboros-network-api

‎ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Client.hs

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,6 @@ module Ouroboros.Network.Protocol.TxSubmission2.Client
2727
, txSubmissionClientPeer
2828
) where
2929

30-
import Data.Word (Word16)
31-
3230
import Network.TypedProtocol.Core
3331

3432
import Ouroboros.Network.Protocol.TxSubmission2.Type
@@ -56,8 +54,8 @@ data ClientStIdle txid tx m a = ClientStIdle {
5654

5755
recvMsgRequestTxIds :: forall blocking.
5856
TokBlockingStyle blocking
59-
-> Word16
60-
-> Word16
57+
-> NumTxIdsToAck
58+
-> NumTxIdsToReq
6159
-> m (ClientStTxIds blocking txid tx m a),
6260

6361
recvMsgRequestTxs :: [txid]

‎ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Codec.hs

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -102,7 +102,10 @@ encodeTxSubmission2 encodeTxId encodeTx = encode
102102
encode (ClientAgency TokInit) MsgInit =
103103
CBOR.encodeListLen 1
104104
<> CBOR.encodeWord 6
105-
encode (ServerAgency TokIdle) (MsgRequestTxIds blocking ackNo reqNo) =
105+
encode (ServerAgency TokIdle) (MsgRequestTxIds
106+
blocking
107+
(NumTxIdsToAck ackNo)
108+
(NumTxIdsToReq reqNo)) =
106109
CBOR.encodeListLen 4
107110
<> CBOR.encodeWord 0
108111
<> CBOR.encodeBool (case blocking of
@@ -167,8 +170,8 @@ decodeTxSubmission2 decodeTxId decodeTx = decode
167170
return (SomeMessage MsgInit)
168171
(ServerAgency TokIdle, 4, 0) -> do
169172
blocking <- CBOR.decodeBool
170-
ackNo <- CBOR.decodeWord16
171-
reqNo <- CBOR.decodeWord16
173+
ackNo <- NumTxIdsToAck <$> CBOR.decodeWord16
174+
reqNo <- NumTxIdsToReq <$> CBOR.decodeWord16
172175
return $!
173176
if blocking
174177
then SomeMessage (MsgRequestTxIds TokBlocking ackNo reqNo)

‎ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Server.hs

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,6 @@ module Ouroboros.Network.Protocol.TxSubmission2.Server
2424
) where
2525

2626
import Data.List.NonEmpty (NonEmpty)
27-
import Data.Word (Word16)
2827

2928
import Network.TypedProtocol.Core
3029
import Network.TypedProtocol.Pipelined
@@ -45,7 +44,7 @@ data TxSubmissionServerPipelined txid tx m a where
4544
data Collect txid tx =
4645
-- | The result of 'SendMsgRequestTxIdsPipelined'. It also carries
4746
-- the number of txids originally requested.
48-
CollectTxIds Word16 [(txid, SizeInBytes)]
47+
CollectTxIds NumTxIdsToReq [(txid, SizeInBytes)]
4948

5049
-- | The result of 'SendMsgRequestTxsPipelined'. The actual reply only
5150
-- contains the transactions sent, but this pairs them up with the
@@ -59,8 +58,8 @@ data ServerStIdle (n :: N) txid tx m a where
5958
-- |
6059
--
6160
SendMsgRequestTxIdsBlocking
62-
:: Word16 -- ^ number of txids to acknowledge
63-
-> Word16 -- ^ number of txids to request
61+
:: NumTxIdsToAck -- ^ number of txids to acknowledge
62+
-> NumTxIdsToReq -- ^ number of txids to request
6463
-> m a -- ^ Result if done
6564
-> (NonEmpty (txid, SizeInBytes)
6665
-> m (ServerStIdle Z txid tx m a))
@@ -69,8 +68,8 @@ data ServerStIdle (n :: N) txid tx m a where
6968
-- |
7069
--
7170
SendMsgRequestTxIdsPipelined
72-
:: Word16
73-
-> Word16
71+
:: NumTxIdsToAck
72+
-> NumTxIdsToReq
7473
-> m (ServerStIdle (S n) txid tx m a)
7574
-> ServerStIdle n txid tx m a
7675

‎ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Type.hs

Lines changed: 36 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,15 @@
1-
{-# LANGUAGE DataKinds #-}
2-
{-# LANGUAGE EmptyCase #-}
3-
{-# LANGUAGE FlexibleInstances #-}
4-
{-# LANGUAGE GADTs #-}
5-
{-# LANGUAGE PolyKinds #-}
6-
{-# LANGUAGE ScopedTypeVariables #-}
7-
{-# LANGUAGE StandaloneDeriving #-}
8-
{-# LANGUAGE TypeFamilies #-}
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE DerivingVia #-}
4+
{-# LANGUAGE DerivingStrategies #-}
5+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6+
{-# LANGUAGE EmptyCase #-}
7+
{-# LANGUAGE FlexibleInstances #-}
8+
{-# LANGUAGE GADTs #-}
9+
{-# LANGUAGE PolyKinds #-}
10+
{-# LANGUAGE ScopedTypeVariables #-}
11+
{-# LANGUAGE StandaloneDeriving #-}
12+
{-# LANGUAGE TypeFamilies #-}
913

1014
-- | The type of the transaction submission protocol.
1115
--
@@ -20,6 +24,8 @@ module Ouroboros.Network.Protocol.TxSubmission2.Type
2024
, TokBlockingStyle (..)
2125
, StBlockingStyle (..)
2226
, BlockingReplyList (..)
27+
, NumTxIdsToAck (..)
28+
, NumTxIdsToReq (..)
2329
-- re-exports
2430
, SizeInBytes (..)
2531
-- deprecated API
@@ -28,7 +34,12 @@ module Ouroboros.Network.Protocol.TxSubmission2.Type
2834

2935
import Control.DeepSeq
3036
import Data.List.NonEmpty (NonEmpty)
37+
import Data.Monoid (Sum (..))
3138
import Data.Word (Word16)
39+
import GHC.Generics
40+
import NoThunks.Class (NoThunks (..))
41+
42+
import Quiet (Quiet (..))
3243

3344
import Network.TypedProtocol.Core
3445

@@ -111,6 +122,21 @@ data StBlockingStyle where
111122
StNonBlocking :: StBlockingStyle
112123

113124

125+
newtype NumTxIdsToAck = NumTxIdsToAck { getNumTxIdsToAck :: Word16 }
126+
deriving (Eq, Ord, NFData, Generic)
127+
deriving newtype (Num, Enum, Real, Integral, Bounded, NoThunks)
128+
deriving Semigroup via (Sum Word16)
129+
deriving Monoid via (Sum Word16)
130+
deriving Show via (Quiet NumTxIdsToAck)
131+
132+
newtype NumTxIdsToReq = NumTxIdsToReq { getNumTxIdsToReq :: Word16 }
133+
deriving (Eq, Ord, NFData, Generic)
134+
deriving newtype (Num, Enum, Real, Integral, Bounded, NoThunks)
135+
deriving Semigroup via (Sum Word16)
136+
deriving Monoid via (Sum Word16)
137+
deriving Show via (Quiet NumTxIdsToReq)
138+
139+
114140
-- | There are some constraints of the protocol that are not captured in the
115141
-- types of the messages, but are documented with the messages. Violation
116142
-- of these constraints is also a protocol error. The constraints are intended
@@ -184,8 +210,8 @@ instance Protocol (TxSubmission2 txid tx) where
184210
--
185211
MsgRequestTxIds
186212
:: TokBlockingStyle blocking
187-
-> Word16 -- ^ Acknowledge this number of outstanding txids
188-
-> Word16 -- ^ Request up to this number of txids.
213+
-> NumTxIdsToAck -- ^ Acknowledge this number of outstanding txids
214+
-> NumTxIdsToReq -- ^ Request up to this number of txids.
189215
-> Message (TxSubmission2 txid tx) StIdle (StTxIds blocking)
190216

191217
-- | Reply with a list of transaction identifiers for available

‎ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/TxSubmission2/Examples.hs

Lines changed: 13 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -28,17 +28,17 @@ import Control.Tracer (Tracer, traceWith)
2828

2929
import Network.TypedProtocol.Pipelined (N, Nat (..))
3030

31+
import Ouroboros.Network.Protocol.TxSubmission2.Type
3132
import Ouroboros.Network.Protocol.TxSubmission2.Client
3233
import Ouroboros.Network.Protocol.TxSubmission2.Server
33-
import Ouroboros.Network.SizeInBytes (SizeInBytes)
3434

3535

3636
--
3737
-- Example client
3838
--
3939

4040
data TraceEventClient txid tx =
41-
EventRecvMsgRequestTxIds (StrictSeq txid) (Map txid tx) [tx] Word16 Word16
41+
EventRecvMsgRequestTxIds (StrictSeq txid) (Map txid tx) [tx] NumTxIdsToAck NumTxIdsToReq
4242
| EventRecvMsgRequestTxs (StrictSeq txid) (Map txid tx) [tx] [txid]
4343
deriving Show
4444

@@ -82,8 +82,8 @@ txSubmissionClient tracer txId txSize maxUnacked =
8282

8383
recvMsgRequestTxIds :: forall blocking.
8484
TokBlockingStyle blocking
85-
-> Word16
86-
-> Word16
85+
-> NumTxIdsToAck
86+
-> NumTxIdsToReq
8787
-> m (ClientStTxIds blocking txid tx m ())
8888
recvMsgRequestTxIds blocking ackNo reqNo = do
8989
traceWith tracer (EventRecvMsgRequestTxIds unackedSeq unackedMap
@@ -93,8 +93,8 @@ txSubmissionClient tracer txId txSize maxUnacked =
9393
++ "peer acknowledged more txids than possible"
9494

9595
when ( fromIntegral (Seq.length unackedSeq)
96-
- ackNo
97-
+ fromIntegral reqNo
96+
- getNumTxIdsToAck ackNo
97+
+ getNumTxIdsToReq reqNo
9898
> maxUnacked) $
9999
error $ "txSubmissionClientConst.recvMsgRequestTxIds: "
100100
++ "peer requested more txids than permitted"
@@ -158,8 +158,8 @@ txSubmissionClient tracer txId txSize maxUnacked =
158158
--
159159

160160
data TraceEventServer txid tx =
161-
EventRequestTxIdsBlocking (ServerState txid tx) Word16 Word16
162-
| EventRequestTxIdsPipelined (ServerState txid tx) Word16 Word16
161+
EventRequestTxIdsBlocking (ServerState txid tx) NumTxIdsToAck NumTxIdsToReq
162+
| EventRequestTxIdsPipelined (ServerState txid tx) NumTxIdsToAck NumTxIdsToReq
163163
| EventRequestTxsPipelined (ServerState txid tx) [txid]
164164

165165
deriving instance (Show txid, Show tx) => Show (TraceEventServer txid tx)
@@ -169,7 +169,7 @@ data ServerState txid tx = ServerState {
169169
-- which have not yet been replied to. We need to track this it keep
170170
-- our requests within the limit on the number of unacknowledged txids.
171171
--
172-
requestedTxIdsInFlight :: Word16,
172+
requestedTxIdsInFlight :: NumTxIdsToReq,
173173

174174
-- | Those transactions (by their identifier) that the client has told
175175
-- us about, and which we have not yet acknowledged. This is kept in
@@ -196,7 +196,7 @@ data ServerState txid tx = ServerState {
196196
-- for more transactions. The number here have already been removed from
197197
-- 'unacknowledgedTxIds'.
198198
--
199-
numTxsToAcknowledge :: Word16
199+
numTxsToAcknowledge :: NumTxIdsToAck
200200
}
201201
deriving Show
202202

@@ -239,7 +239,7 @@ txSubmissionServer tracer txId maxUnacked maxTxIdsToRequest maxTxToRequest =
239239
-- so the only remaining thing to do is to ask for more txids. Since
240240
-- this is the only thing to do now, we make this a blocking call.
241241
| otherwise
242-
, let numTxIdsToRequest = maxTxIdsToRequest `min` maxUnacked
242+
, let numTxIdsToRequest = NumTxIdsToReq $ maxTxIdsToRequest `min` maxUnacked
243243
= assert (requestedTxIdsInFlight st == 0
244244
&& Seq.null (unacknowledgedTxIds st)
245245
&& Map.null (availableTxids st)
@@ -390,7 +390,8 @@ txSubmissionServer tracer txId maxUnacked maxTxIdsToRequest maxTxToRequest =
390390
-- This definition is justified by the fact that the
391391
-- 'numTxsToAcknowledge' are not included in the 'unacknowledgedTxIds'.
392392
numTxIdsToRequest =
393+
NumTxIdsToReq $
393394
(maxUnacked
394395
- fromIntegral (Seq.length (unacknowledgedTxIds st))
395-
- requestedTxIdsInFlight st)
396+
- getNumTxIdsToReq (requestedTxIdsInFlight st))
396397
`min` maxTxIdsToRequest

‎ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/TxSubmission2/Test.hs

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DerivingStrategies #-}
23
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE FlexibleInstances #-}
45
{-# LANGUAGE GADTs #-}
@@ -7,6 +8,7 @@
78
{-# LANGUAGE PolyKinds #-}
89
{-# LANGUAGE QuantifiedConstraints #-}
910
{-# LANGUAGE RankNTypes #-}
11+
{-# LANGUAGE StandaloneDeriving #-}
1012
{-# LANGUAGE TypeFamilies #-}
1113

1214
{-# OPTIONS_GHC -Wno-orphans #-}
@@ -241,6 +243,10 @@ prop_pipe_IO params =
241243
ioProperty (prop_channel createPipeConnectedChannels params)
242244

243245

246+
deriving newtype instance Arbitrary NumTxIdsToAck
247+
deriving newtype instance Arbitrary NumTxIdsToReq
248+
249+
244250
instance Arbitrary (AnyMessageAndAgency (TxSubmission2 TxId Tx)) where
245251
arbitrary = oneof
246252
[ pure $ AnyMessageAndAgency (ClientAgency TokInit) MsgInit

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -217,7 +217,7 @@ txSubmissionSimulation
217217

218218
, txid ~ Int
219219
)
220-
=> Word16
220+
=> NumTxIdsToAck
221221
-> [Tx txid]
222222
-> ControlMessageSTM m
223223
-> Maybe DiffTime
@@ -299,7 +299,7 @@ prop_txSubmission (Positive maxUnacked) (NonEmpty outboundTxs) delay =
299299
* realToFrac (length outboundTxs `div` 4))
300300
atomically (writeTVar controlMessageVar Terminate)
301301
txSubmissionSimulation
302-
maxUnacked outboundTxs
302+
(NumTxIdsToAck maxUnacked) outboundTxs
303303
(readTVar controlMessageVar)
304304
mbDelayTime mbDelayTime
305305
) in

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

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -39,8 +39,8 @@ import Control.Tracer (Tracer, traceWith)
3939
import Network.TypedProtocol.Pipelined (N, Nat (..), natToInt)
4040

4141
import Ouroboros.Network.NodeToNode.Version (NodeToNodeVersion)
42+
import Ouroboros.Network.Protocol.TxSubmission2.Type
4243
import Ouroboros.Network.Protocol.TxSubmission2.Server
43-
import Ouroboros.Network.SizeInBytes (SizeInBytes)
4444
import Ouroboros.Network.TxSubmission.Mempool.Reader (MempoolSnapshot (..),
4545
TxSubmissionMempoolReader (..))
4646

@@ -178,12 +178,12 @@ txSubmissionInbound
178178
, MonadThrow m
179179
)
180180
=> Tracer m (TraceTxSubmissionInbound txid tx)
181-
-> Word16 -- ^ Maximum number of unacknowledged txids allowed
181+
-> NumTxIdsToAck -- ^ Maximum number of unacknowledged txids allowed
182182
-> TxSubmissionMempoolReader txid tx idx m
183183
-> TxSubmissionMempoolWriter txid tx idx m
184184
-> NodeToNodeVersion
185185
-> TxSubmissionServerPipelined txid tx m ()
186-
txSubmissionInbound tracer maxUnacked mpReader mpWriter _version =
186+
txSubmissionInbound tracer (NumTxIdsToAck maxUnacked) mpReader mpWriter _version =
187187
TxSubmissionServerPipelined $
188188
continueWithStateM (serverIdle Zero) initialServerState
189189
where
@@ -225,15 +225,15 @@ txSubmissionInbound tracer maxUnacked mpReader mpWriter _version =
225225
&& Map.null (bufferedTxs st)) $
226226
pure $
227227
SendMsgRequestTxIdsBlocking
228-
(numTxsToAcknowledge st)
229-
numTxIdsToRequest
228+
(NumTxIdsToAck (numTxsToAcknowledge st))
229+
(NumTxIdsToReq numTxIdsToRequest)
230230
-- Our result if the client terminates the protocol
231231
(traceWith tracer TraceTxInboundTerminated)
232232
( collectAndContinueWithState (handleReply Zero) st {
233233
numTxsToAcknowledge = 0,
234234
requestedTxIdsInFlight = numTxIdsToRequest
235235
}
236-
. CollectTxIds numTxIdsToRequest
236+
. CollectTxIds (NumTxIdsToReq numTxIdsToRequest)
237237
. NonEmpty.toList)
238238

239239
Succ n' -> if canRequestMoreTxs st
@@ -271,7 +271,7 @@ txSubmissionInbound tracer maxUnacked mpReader mpWriter _version =
271271
Nat n
272272
-> StatefulCollect (ServerState txid tx) n txid tx m
273273
handleReply n = StatefulCollect $ \st collect -> case collect of
274-
CollectTxIds reqNo txids -> do
274+
CollectTxIds (NumTxIdsToReq reqNo) txids -> do
275275
-- Check they didn't send more than we asked for. We don't need to
276276
-- check for a minimum: the blocking case checks for non-zero
277277
-- elsewhere, and for the non-blocking case it is quite normal for
@@ -474,8 +474,8 @@ txSubmissionInbound tracer maxUnacked mpReader mpWriter _version =
474474

475475
if numTxIdsToRequest > 0
476476
then pure $ SendMsgRequestTxIdsPipelined
477-
(numTxsToAcknowledge st)
478-
numTxIdsToRequest
477+
(NumTxIdsToAck (numTxsToAcknowledge st))
478+
(NumTxIdsToReq numTxIdsToRequest)
479479
(continueWithStateM (serverIdle (Succ n)) st {
480480
requestedTxIdsInFlight = requestedTxIdsInFlight st
481481
+ numTxIdsToRequest,

0 commit comments

Comments
 (0)