Skip to content

Commit 55c16cf

Browse files
nfrisbyclaude
authored and
ch1bo
committed
Leios N: BearerBytes class replaces dataSize on ProtocolSizeLimits
Replace the `dataSize :: bytes -> Word` field of `ProtocolSizeLimits` with a `BearerBytes` class: class BearerBytes bytes where bearerBytesSize :: bytes -> Word Default instances cover `BS.ByteString`, `BL.ByteString`, `[Char]` and `AnyMessage msg` (for tests). Driver/Limits gains a `BearerBytes bytes` constraint on the public entry points (`runPeerWithLimits` and friends). The seven `byteLimits*` codec helpers no longer take a `(bytes -> Word)` argument — call sites drop the `(fromIntegral . LBS.length)` boilerplate. Two test predicates that previously used `dataSize` now call `bearerBytesSize` directly. Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
1 parent ebc8eac commit 55c16cf

19 files changed

Lines changed: 84 additions & 52 deletions

File tree

‎cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet/Simulation.hs‎

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1222,13 +1222,13 @@ diffusionSimulationM
12221222
limitsAndTimeouts
12231223
= Node.LimitsAndTimeouts
12241224
{ Node.chainSyncLimits = defaultMiniProtocolsLimit
1225-
, Node.chainSyncSizeLimits = byteLimitsChainSync (fromIntegral . BL.length)
1225+
, Node.chainSyncSizeLimits = byteLimitsChainSync
12261226
, Node.chainSyncTimeLimits = timeLimitsChainSync Cardano.defaultChainSyncIdleTimeout
12271227
, Node.blockFetchLimits = defaultMiniProtocolsLimit
1228-
, Node.blockFetchSizeLimits = byteLimitsBlockFetch (fromIntegral . BL.length)
1228+
, Node.blockFetchSizeLimits = byteLimitsBlockFetch
12291229
, Node.blockFetchTimeLimits = timeLimitsBlockFetch
12301230
, Node.keepAliveLimits = defaultMiniProtocolsLimit
1231-
, Node.keepAliveSizeLimits = byteLimitsKeepAlive (fromIntegral . BL.length)
1231+
, Node.keepAliveSizeLimits = byteLimitsKeepAlive
12321232
, Node.keepAliveTimeLimits = timeLimitsKeepAlive
12331233
, Node.pingPongLimits = defaultMiniProtocolsLimit
12341234
, Node.pingPongSizeLimits = byteLimitsPingPong
@@ -1238,15 +1238,14 @@ diffusionSimulationM
12381238
ProtocolTimeLimits (const shortWait)
12391239
, Node.handhsakeSizeLimits =
12401240
ProtocolSizeLimits (const (4 * 1440))
1241-
(fromIntegral . BL.length)
12421241
, Node.peerSharingLimits = defaultMiniProtocolsLimit
12431242
, Node.peerSharingTimeLimits =
12441243
timeLimitsPeerSharing
12451244
, Node.peerSharingSizeLimits =
1246-
byteLimitsPeerSharing (fromIntegral . BL.length)
1245+
byteLimitsPeerSharing
12471246
, Node.txSubmissionLimits = defaultMiniProtocolsLimit
12481247
, Node.txSubmissionTimeLimits = timeLimitsTxSubmission2
1249-
, Node.txSubmissionSizeLimits = byteLimitsTxSubmission2 (fromIntegral . BL.length)
1248+
, Node.txSubmissionSizeLimits = byteLimitsTxSubmission2
12501249
}
12511250

12521251
interfaces :: Node.Interfaces (Cardano.LedgerPeersConsensusInterface m) m
@@ -1574,7 +1573,7 @@ diffusionSimulationM
15741573
--
15751574

15761575
byteLimitsPingPong :: ProtocolSizeLimits PingPong.PingPong BL.ByteString
1577-
byteLimitsPingPong = ProtocolSizeLimits (const smallByteLimit) (fromIntegral . BL.length)
1576+
byteLimitsPingPong = ProtocolSizeLimits (const smallByteLimit)
15781577

15791578
timeLimitsPingPong :: ProtocolTimeLimits PingPong.PingPong
15801579
timeLimitsPingPong = ProtocolTimeLimits $ \case

‎ouroboros-network/api/lib/Ouroboros/Network/Protocol/Limits.hs‎

Lines changed: 26 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE DataKinds #-}
22
{-# LANGUAGE DeriveAnyClass #-}
33
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE FlexibleInstances #-}
45
{-# LANGUAGE GADTs #-}
56
{-# LANGUAGE LambdaCase #-}
67
{-# LANGUAGE PolyKinds #-}
@@ -15,20 +16,42 @@ module Ouroboros.Network.Protocol.Limits where
1516
import Control.DeepSeq (NFData (..))
1617
import Control.Exception
1718
import Control.Monad.Class.MonadTime.SI
19+
import Data.ByteString qualified as BS
20+
import Data.ByteString.Lazy qualified as BL
1821
import System.Random (StdGen)
1922

23+
import Network.TypedProtocol.Codec (AnyMessage)
2024
import Network.TypedProtocol.Core
2125

2226
import Ouroboros.Network.Util.ShowProxy
2327

2428

2529
data ProtocolSizeLimits ps bytes = ProtocolSizeLimits {
2630
sizeLimitForState :: forall (st :: ps). ActiveState st
27-
=> StateToken st -> Word,
28-
29-
dataSize :: bytes -> Word
31+
=> StateToken st -> Word
3032
}
3133

34+
-- | Compute the on-the-wire size of a chunk of bytes from a 'Bearer'.
35+
--
36+
-- Used by the driver-layer size-limit machinery in place of the prior
37+
-- @dataSize :: bytes -> Word@ field of 'ProtocolSizeLimits' — making it a
38+
-- class lets every 'Codec' producer skip wiring the size function through.
39+
class BearerBytes bytes where
40+
bearerBytesSize :: bytes -> Word
41+
42+
instance BearerBytes BS.ByteString where
43+
bearerBytesSize = fromIntegral . BS.length
44+
45+
instance BearerBytes BL.ByteString where
46+
bearerBytesSize = fromIntegral . BL.length
47+
48+
instance BearerBytes [Char] where
49+
bearerBytesSize = fromIntegral . length
50+
51+
instance BearerBytes (AnyMessage msg) where
52+
-- AnyMessage is used in tests where messages are not actually serialised.
53+
bearerBytesSize = const 1
54+
3255
newtype ProtocolTimeLimits ps = ProtocolTimeLimits {
3356
timeLimitForState :: forall (st :: ps). ActiveState st
3457
=> StateToken st -> Maybe DiffTime

‎ouroboros-network/demo/tx-submission/main.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -357,7 +357,7 @@ codec = Tx.anncodecTxSubmission2' (\bs tx -> tx { txSize = fromIntegral (LBS.len
357357
byteLimits
358358
:: Driver.ProtocolSizeLimits TxSubmission LBS.ByteString
359359
byteLimits =
360-
Tx.byteLimitsTxSubmission2 (fromIntegral . LBS.length)
360+
Tx.byteLimitsTxSubmission2
361361

362362
prettyWithBearer :: (a -> String) -> Mx.WithBearer Socket.SockAddr a -> String
363363
prettyWithBearer pretty (Mx.WithBearer addr a) =

‎ouroboros-network/framework/io-tests/Test/Ouroboros/Network/Driver.hs‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -99,7 +99,7 @@ byteLimitsReqResp
9999
:: forall req resp.
100100
Word
101101
-> ProtocolSizeLimits (ReqResp req resp) String
102-
byteLimitsReqResp limit = ProtocolSizeLimits stateToLimit (fromIntegral . length)
102+
byteLimitsReqResp limit = ProtocolSizeLimits stateToLimit
103103
where
104104
stateToLimit :: forall (st :: ReqResp req resp). ActiveState st
105105
=> StateToken st -> Word
@@ -535,8 +535,7 @@ prop_channel_ping_pong_with_limits_ST a@(ArbDelaysAndTimeouts delay delay' timel
535535

536536
slimits :: ProtocolSizeLimits PingPong String
537537
slimits = ProtocolSizeLimits {
538-
sizeLimitForState = \_ -> toSize sizelimit,
539-
dataSize = fromIntegral . List.length
538+
sizeLimitForState = \_ -> toSize sizelimit
540539
}
541540

542541
tlimits :: ProtocolTimeLimits PingPong

‎ouroboros-network/framework/lib/Ouroboros/Network/Driver/Limits.hs‎

Lines changed: 27 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -78,7 +78,6 @@ mkDriverWithLimits
7878
)
7979
=> (forall a.
8080
Word
81-
-> (bytes -> Word)
8281
-> Channel m bytes
8382
-> Maybe bytes
8483
-> DecodeStep bytes failure m (f a)
@@ -101,7 +100,7 @@ mkDriverWithLimits
101100
mkDriverWithLimits runDecodeStep nat tracer
102101
timeoutFn
103102
Codec{encode, decode}
104-
ProtocolSizeLimits{sizeLimitForState, dataSize}
103+
ProtocolSizeLimits{sizeLimitForState}
105104
ProtocolTimeLimits{timeLimitForState}
106105
channel@Channel{send} =
107106
Driver { sendMessage, recvMessage, initialDState = Nothing }
@@ -129,7 +128,7 @@ mkDriverWithLimits runDecodeStep nat tracer
129128
let sizeLimit = sizeLimitForState @st stateToken
130129
timeLimit = fromMaybe (-1) (timeLimitForState @st stateToken)
131130
result <- timeoutFn timeLimit $
132-
runDecodeStep sizeLimit dataSize
131+
runDecodeStep sizeLimit
133132
channel trailing (nat <$> decoder)
134133

135134
case result of
@@ -149,6 +148,7 @@ driverWithLimits
149148
, forall (st' :: ps) tok. tok ~ StateToken st' => Show tok
150149
, NFData failure
151150
, Show failure
151+
, BearerBytes bytes
152152
)
153153
=> Tracer m (TraceSendRecv ps)
154154
-> TimeoutFn m
@@ -169,6 +169,7 @@ annotatedDriverWithLimits
169169
, forall (st' :: ps) tok. tok ~ StateToken st' => Show tok
170170
, NFData failure
171171
, Show failure
172+
, BearerBytes bytes
172173
)
173174
=> Tracer m (TraceSendRecv ps)
174175
-> TimeoutFn m
@@ -191,7 +192,6 @@ mkDriverWithLimitsRnd
191192
=> (forall a.
192193
HasCallStack
193194
=> Word
194-
-> (bytes -> Word)
195195
-> Channel m bytes
196196
-> Maybe bytes
197197
-> DecodeStep bytes failure m (f a)
@@ -214,7 +214,7 @@ mkDriverWithLimitsRnd
214214
-> Driver ps pr (Maybe bytes, StdGen) m
215215
mkDriverWithLimitsRnd runDecodeStep nat tracer timeoutFn rnd0
216216
Codec{encode, decode}
217-
ProtocolSizeLimits{sizeLimitForState, dataSize}
217+
ProtocolSizeLimits{sizeLimitForState}
218218
ProtocolTimeLimitsWithRnd{timeLimitForStateWithRnd}
219219
channel@Channel{send} =
220220
Driver { sendMessage, recvMessage, initialDState = (Nothing, rnd0) }
@@ -243,7 +243,7 @@ mkDriverWithLimitsRnd runDecodeStep nat tracer timeoutFn rnd0
243243
(timeLimit, rnd') = first (fromMaybe (-1))
244244
$ timeLimitForStateWithRnd @st stateToken rnd
245245
result <- timeoutFn timeLimit $
246-
runDecodeStep sizeLimit dataSize
246+
runDecodeStep sizeLimit
247247
channel trailing (nat <$> decoder)
248248

249249
case result of
@@ -266,6 +266,7 @@ driverWithLimitsRnd :: forall ps (pr :: PeerRole) failure bytes m.
266266
, Show failure
267267
, NFData failure
268268
, HasCallStack
269+
, BearerBytes bytes
269270
)
270271
=> Tracer m (TraceSendRecv ps)
271272
-> TimeoutFn m
@@ -283,18 +284,20 @@ runDecoderWithLimit
283284
( Monad m
284285
, MonadEvaluate m
285286
, NFData failure
287+
, BearerBytes bytes
286288
)
287289
=> Word
288290
-- ^ message size limit
289-
-> (bytes -> Word)
290-
-- ^ byte size
291291
-> Channel m bytes
292292
-> Maybe bytes
293293
-> DecodeStep bytes failure m (Identity a)
294294
-> m (Either (Maybe failure) (a, Maybe bytes))
295-
runDecoderWithLimit limit size Channel{recv} trailing0 step =
295+
runDecoderWithLimit limit Channel{recv} trailing0 step =
296296
go 0 trailing0 step
297297
where
298+
size :: bytes -> Word
299+
size = bearerBytesSize
300+
298301
-- Our strategy here is as follows...
299302
--
300303
-- We of course want to enforce the maximum data limit, but we also want to
@@ -337,18 +340,20 @@ runAnnotatedDecoderWithLimit
337340
, MonadEvaluate m
338341
, Monoid bytes
339342
, NFData failure
343+
, BearerBytes bytes
340344
)
341345
=> Word
342346
-- ^ message size limit
343-
-> (bytes -> Word)
344-
-- ^ byte size
345347
-> Channel m bytes
346348
-> Maybe bytes
347349
-> DecodeStep bytes failure m (bytes -> a)
348350
-> m (Either (Maybe failure) (a, Maybe bytes))
349-
runAnnotatedDecoderWithLimit limit size Channel{recv} =
351+
runAnnotatedDecoderWithLimit limit Channel{recv} =
350352
go mempty 0
351353
where
354+
size :: bytes -> Word
355+
size = bearerBytesSize
356+
352357
-- Our strategy here is as follows...
353358
--
354359
-- We of course want to enforce the maximum data limit, but we also want to
@@ -410,6 +415,7 @@ runPeerWithLimits
410415
, NFData a
411416
, NFData failure
412417
, Show failure
418+
, BearerBytes bytes
413419
)
414420
=> Tracer m (TraceSendRecv ps)
415421
-> Codec ps failure m bytes
@@ -440,6 +446,7 @@ runAnnotatedPeerWithLimits
440446
, NFData a
441447
, NFData failure
442448
, Show failure
449+
, BearerBytes bytes
443450
)
444451
=> Tracer m (TraceSendRecv ps)
445452
-> AnnotatedCodec ps failure m bytes
@@ -471,6 +478,7 @@ runPeerWithLimitsRnd
471478
, NFData failure
472479
, Show failure
473480
, HasCallStack
481+
, BearerBytes bytes
474482
)
475483
=> Tracer m (TraceSendRecv ps)
476484
-> StdGen
@@ -507,6 +515,7 @@ runPipelinedPeerWithLimits
507515
, NFData a
508516
, NFData failure
509517
, Show failure
518+
, BearerBytes bytes
510519
)
511520
=> Tracer m (TraceSendRecv ps)
512521
-> Codec ps failure m bytes
@@ -535,6 +544,7 @@ runPipelinedAnnotatedPeerWithLimits
535544
, NFData a
536545
, NFData failure
537546
, Show failure
547+
, BearerBytes bytes
538548
)
539549
=> Tracer m (TraceSendRecv ps)
540550
-> AnnotatedCodec ps failure m bytes
@@ -565,6 +575,7 @@ runPipelinedPeerWithLimitsRnd
565575
, NFData a
566576
, NFData failure
567577
, Show failure
578+
, BearerBytes bytes
568579
)
569580
=> Tracer m (TraceSendRecv ps)
570581
-> StdGen
@@ -603,6 +614,7 @@ runConnectedPeersWithLimits
603614
, NFData failure
604615
, ShowProxy ps
605616
, forall (st' :: ps) sing. sing ~ StateToken st' => Show sing
617+
, BearerBytes bytes
606618
)
607619
=> m (Channel m bytes, Channel m bytes)
608620
-> Tracer m (Role, TraceSendRecv ps)
@@ -642,6 +654,7 @@ runConnectedPeersWithLimitsRnd
642654
, ShowProxy ps
643655
, forall (st' :: ps) sing. sing ~ StateToken st' => Show sing
644656
, HasCallStack
657+
, BearerBytes bytes
645658
)
646659
=> m (Channel m bytes, Channel m bytes)
647660
-> Tracer m (Role, TraceSendRecv ps)
@@ -689,6 +702,7 @@ runConnectedPipelinedPeersWithLimits
689702
, NFData failure
690703
, ShowProxy ps
691704
, forall (st' :: ps) sing. sing ~ StateToken st' => Show sing
705+
, BearerBytes bytes
692706
)
693707
=> m (Channel m bytes, Channel m bytes)
694708
-> Tracer m (Role, TraceSendRecv ps)
@@ -725,6 +739,7 @@ runConnectedPipelinedPeersWithLimitsRnd
725739
, NFData failure
726740
, ShowProxy ps
727741
, forall (st' :: ps) sing. sing ~ StateToken st' => Show sing
742+
, BearerBytes bytes
728743
)
729744
=> m (Channel m bytes, Channel m bytes)
730745
-> Tracer m (Role, TraceSendRecv ps)

‎ouroboros-network/framework/lib/Ouroboros/Network/Protocol/Handshake/Codec.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -78,7 +78,7 @@ maxTransmissionUnit = 4 * 1440
7878

7979
-- | Byte limits
8080
byteLimitsHandshake :: forall vNumber. ProtocolSizeLimits (Handshake vNumber CBOR.Term) ByteString
81-
byteLimitsHandshake = ProtocolSizeLimits stateToLimit (fromIntegral . BL.length)
81+
byteLimitsHandshake = ProtocolSizeLimits stateToLimit
8282
where
8383
stateToLimit :: forall (st :: Handshake vNumber CBOR.Term).
8484
ActiveState st

‎ouroboros-network/framework/tests-lib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -635,7 +635,6 @@ reqRespSizeLimits :: forall req resp. ProtocolSizeLimits (ReqResp req resp)
635635
ByteString
636636
reqRespSizeLimits = ProtocolSizeLimits
637637
{ sizeLimitForState
638-
, dataSize = fromIntegral . LBS.length
639638
}
640639
where
641640
sizeLimitForState :: forall (st :: ReqResp req resp).

‎ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/BlockFetch/Codec.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -31,8 +31,7 @@ import Ouroboros.Network.Protocol.Limits
3131

3232
-- | Byte Limit.
3333
byteLimitsBlockFetch :: forall bytes (block :: Type) (point :: Type).
34-
(bytes -> Word) -- ^ compute size of bytes
35-
-> ProtocolSizeLimits (BlockFetch block point) bytes
34+
ProtocolSizeLimits (BlockFetch block point) bytes
3635
byteLimitsBlockFetch = ProtocolSizeLimits stateToLimit
3736
where
3837
stateToLimit :: forall (st :: BlockFetch block point).

‎ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/ChainSync/Codec.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -36,8 +36,7 @@ import Text.Printf
3636

3737
-- | Byte Limits
3838
byteLimitsChainSync :: forall bytes (header :: Type) (point :: Type) (tip :: Type) .
39-
(bytes -> Word) -- ^ compute size of `bytes`
40-
-> ProtocolSizeLimits (ChainSync header point tip) bytes
39+
ProtocolSizeLimits (ChainSync header point tip) bytes
4140
byteLimitsChainSync = ProtocolSizeLimits stateToLimit
4241
where
4342
stateToLimit :: forall (st :: ChainSync header point tip).

‎ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/KeepAlive/Codec.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -75,7 +75,7 @@ codecKeepAlive_v2 = mkCodecCborLazyBS encodeMsg decodeMsg
7575
fail (printf "codecKeepAlive (%s, %s) unexpected key (%d, %d)" (show (activeAgency :: ActiveAgency st)) (show stok) key len)
7676

7777

78-
byteLimitsKeepAlive :: (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
78+
byteLimitsKeepAlive :: ProtocolSizeLimits KeepAlive bytes
7979
byteLimitsKeepAlive = ProtocolSizeLimits sizeLimitForState
8080
where
8181
sizeLimitForState :: ActiveState st

0 commit comments

Comments
 (0)