Skip to content

Commit 85350e2

Browse files
amesgenamesgen
committed
Mock block: add optional per-tx size limit
1 parent fe778a3 commit 85350e2

File tree

9 files changed

+159
-74
lines changed

9 files changed

+159
-74
lines changed

‎ouroboros-consensus/changelog.d/20240827_160651_alexander.esgen_test_empty_mempool_nonblocking.md‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
### Non-Breaking
2+
3+
- Added a `Serialise ByteSize32` instance.

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ module Ouroboros.Consensus.Ledger.SupportsMempool (
2323
, WhetherToIntervene (..)
2424
) where
2525

26+
import Codec.Serialise (Serialise)
2627
import Control.DeepSeq (NFData)
2728
import Control.Monad.Except
2829
import Data.ByteString.Short (ShortByteString)
@@ -238,6 +239,7 @@ newtype ByteSize32 = ByteSize32 { unByteSize32 :: Word32 }
238239
deriving stock (Show)
239240
deriving newtype (Eq, Ord)
240241
deriving newtype (NFData)
242+
deriving newtype (Serialise)
241243
deriving (Monoid, Semigroup)
242244
via (InstantiatedAt Measure (IgnoringOverflow ByteSize32))
243245
deriving (NoThunks)

‎ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs‎

Lines changed: 28 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -49,8 +49,8 @@ module Ouroboros.Consensus.Mock.Ledger.Block (
4949
, GenTx (..)
5050
, TxId (..)
5151
, Validated (..)
52+
, genTxSize
5253
, mkSimpleGenTx
53-
, txSize
5454
-- * Crypto
5555
, SimpleCrypto
5656
, SimpleMockCrypto
@@ -95,7 +95,7 @@ import qualified Ouroboros.Consensus.Mock.Ledger.UTxO as Mock
9595
import Ouroboros.Consensus.Storage.Common (BinaryBlockInfo (..),
9696
SizeInBytes)
9797
import Ouroboros.Consensus.Util (ShowProxy (..), hashFromBytesShortE,
98-
(..:), (.:))
98+
(..:))
9999
import Ouroboros.Consensus.Util.Condense
100100
import Test.Util.Orphans.Serialise ()
101101

@@ -328,6 +328,8 @@ data SimpleLedgerConfig c ext = SimpleLedgerConfig {
328328

329329
-- | Era parameters
330330
, simpleLedgerEraParams :: !HardFork.EraParams
331+
332+
, simpleLedgerMockConfig :: !MockConfig
331333
}
332334
deriving (Generic)
333335

@@ -353,7 +355,7 @@ instance MockProtocolSpecific c ext
353355

354356
instance MockProtocolSpecific c ext
355357
=> ApplyBlock (LedgerState (SimpleBlock c ext)) (SimpleBlock c ext) where
356-
applyBlockLedgerResult _ = fmap pureLedgerResult .: updateSimpleLedgerState
358+
applyBlockLedgerResult = fmap pureLedgerResult ..: updateSimpleLedgerState
357359

358360
reapplyBlockLedgerResult =
359361
(mustSucceed . runExcept) ..: applyBlockLedgerResult
@@ -377,21 +379,27 @@ newtype instance Ticked (LedgerState (SimpleBlock c ext)) = TickedSimpleLedgerSt
377379
instance MockProtocolSpecific c ext => UpdateLedger (SimpleBlock c ext)
378380

379381
updateSimpleLedgerState :: (SimpleCrypto c, Typeable ext)
380-
=> SimpleBlock c ext
382+
=> LedgerConfig (SimpleBlock c ext)
383+
-> SimpleBlock c ext
381384
-> TickedLedgerState (SimpleBlock c ext)
382385
-> Except (MockError (SimpleBlock c ext))
383386
(LedgerState (SimpleBlock c ext))
384-
updateSimpleLedgerState b (TickedSimpleLedgerState (SimpleLedgerState st)) =
385-
SimpleLedgerState <$> updateMockState b st
387+
updateSimpleLedgerState cfg b (TickedSimpleLedgerState (SimpleLedgerState st)) =
388+
SimpleLedgerState <$> updateMockState mockCfg b st
389+
where
390+
mockCfg = simpleLedgerMockConfig cfg
386391

387392
updateSimpleUTxO :: Mock.HasMockTxs a
388-
=> SlotNo
393+
=> LedgerConfig (SimpleBlock c ext)
394+
-> SlotNo
389395
-> a
390396
-> TickedLedgerState (SimpleBlock c ext)
391397
-> Except (MockError (SimpleBlock c ext))
392398
(TickedLedgerState (SimpleBlock c ext))
393-
updateSimpleUTxO x slot (TickedSimpleLedgerState (SimpleLedgerState st)) =
394-
TickedSimpleLedgerState . SimpleLedgerState <$> updateMockUTxO x slot st
399+
updateSimpleUTxO cfg x slot (TickedSimpleLedgerState (SimpleLedgerState st)) =
400+
TickedSimpleLedgerState . SimpleLedgerState <$> updateMockUTxO mockCfg x slot st
401+
where
402+
mockCfg = simpleLedgerMockConfig cfg
395403

396404
genesisSimpleLedgerState :: AddrDist -> LedgerState (SimpleBlock c ext)
397405
genesisSimpleLedgerState = SimpleLedgerState . genesisMockState
@@ -427,11 +435,11 @@ type instance ApplyTxErr (SimpleBlock c ext) = MockError (SimpleBlock c ext)
427435

428436
instance MockProtocolSpecific c ext
429437
=> LedgerSupportsMempool (SimpleBlock c ext) where
430-
applyTx _cfg _wti slot tx st = do
431-
st' <- updateSimpleUTxO slot tx st
438+
applyTx cfg _wti slot tx st = do
439+
st' <- updateSimpleUTxO cfg slot tx st
432440
return (st', ValidatedSimpleGenTx tx)
433-
reapplyTx _cfg slot vtx st =
434-
updateSimpleUTxO slot (forgetValidatedSimpleGenTx vtx) st
441+
reapplyTx cfg slot vtx st =
442+
updateSimpleUTxO cfg slot (forgetValidatedSimpleGenTx vtx) st
435443

436444
txForgetValidated = forgetValidatedSimpleGenTx
437445

@@ -443,7 +451,11 @@ instance TxLimits (SimpleBlock c ext) where
443451
--
444452
-- But not 'maxbound'!, since the mempool sometimes holds multiple blocks worth.
445453
blockCapacityTxMeasure _cfg _st = IgnoringOverflow simpleBlockCapacity
446-
txMeasure _cfg _st = pure . IgnoringOverflow . txSize
454+
455+
txMeasure cfg _st =
456+
fmap IgnoringOverflow
457+
. checkTxSize (simpleLedgerMockConfig cfg)
458+
. simpleGenTx
447459

448460
simpleBlockCapacity :: ByteSize32
449461
simpleBlockCapacity = ByteSize32 512
@@ -490,8 +502,8 @@ mkSimpleGenTx tx = SimpleGenTx
490502
, simpleGenTxId = Hash.hashWithSerialiser toCBOR tx
491503
}
492504

493-
txSize :: GenTx (SimpleBlock c ext) -> ByteSize32
494-
txSize = ByteSize32 . fromIntegral . Lazy.length . serialise
505+
genTxSize :: GenTx (SimpleBlock c ext) -> ByteSize32
506+
genTxSize = txSize . simpleGenTx
495507

496508
{-------------------------------------------------------------------------------
497509
Support for QueryLedger

‎ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/State.hs‎

Lines changed: 56 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,35 +1,61 @@
11
{-# LANGUAGE DeriveAnyClass #-}
22
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE DerivingStrategies #-}
34
{-# LANGUAGE FlexibleContexts #-}
45
{-# LANGUAGE ScopedTypeVariables #-}
56
{-# LANGUAGE StandaloneDeriving #-}
67
{-# LANGUAGE UndecidableInstances #-}
78

89
module Ouroboros.Consensus.Mock.Ledger.State (
10+
-- * Config for the mock ledger
11+
MockConfig (..)
12+
, defaultMockConfig
913
-- * State of the mock ledger
10-
MockError (..)
14+
, MockError (..)
1115
, MockState (..)
1216
, updateMockState
1317
, updateMockTip
1418
, updateMockUTxO
19+
-- * Supporting definitions
20+
, checkTxSize
21+
, txSize
1522
-- * Genesis state
1623
, genesisMockState
1724
) where
1825

1926
import Cardano.Binary (toCBOR)
2027
import Cardano.Crypto.Hash
21-
import Codec.Serialise (Serialise)
28+
import Codec.Serialise (Serialise, serialise)
2229
import Control.Monad (guard)
2330
import Control.Monad.Except (Except, throwError, withExcept)
31+
import qualified Data.ByteString.Lazy as BL
2432
import Data.Set (Set)
2533
import qualified Data.Set as Set
2634
import Data.Typeable (Typeable)
2735
import GHC.Generics (Generic)
2836
import NoThunks.Class (NoThunks)
2937
import Ouroboros.Consensus.Block
38+
import Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32 (..))
3039
import Ouroboros.Consensus.Mock.Ledger.Address
3140
import Ouroboros.Consensus.Mock.Ledger.UTxO
3241
import Ouroboros.Consensus.Util (ShowProxy (..), repeatedlyM)
42+
import Test.Util.Orphans.Serialise ()
43+
44+
{-------------------------------------------------------------------------------
45+
State of the mock cnfig
46+
-------------------------------------------------------------------------------}
47+
48+
-- | Parameters needed to validate blocks/txs
49+
data MockConfig = MockConfig {
50+
mockCfgMaxTxSize :: !(Maybe ByteSize32)
51+
}
52+
deriving stock (Show, Eq, Generic)
53+
deriving anyclass (NoThunks)
54+
55+
defaultMockConfig :: MockConfig
56+
defaultMockConfig = MockConfig {
57+
mockCfgMaxTxSize = Nothing
58+
}
3359

3460
{-------------------------------------------------------------------------------
3561
State of the mock ledger
@@ -50,6 +76,7 @@ data MockError blk =
5076
-- validate in the second 'SlotNo'.
5177
| MockUtxoError UtxoError
5278
| MockInvalidHash (ChainHash blk) (ChainHash blk)
79+
| MockTxSizeTooBig ByteSize32 ByteSize32
5380
deriving (Generic, NoThunks)
5481

5582
deriving instance StandardHash blk => Show (MockError blk)
@@ -59,13 +86,14 @@ deriving instance Serialise (HeaderHash blk) => Serialise (MockError blk)
5986
instance Typeable blk => ShowProxy (MockError blk) where
6087

6188
updateMockState :: (GetPrevHash blk, HasMockTxs blk)
62-
=> blk
89+
=> MockConfig
90+
-> blk
6391
-> MockState blk
6492
-> Except (MockError blk) (MockState blk)
65-
updateMockState blk st = do
93+
updateMockState cfg blk st = do
6694
let hdr = getHeader blk
6795
st' <- updateMockTip hdr st
68-
updateMockUTxO (blockSlot hdr) blk st'
96+
updateMockUTxO cfg (blockSlot hdr) blk st'
6997

7098
updateMockTip :: GetPrevHash blk
7199
=> Header blk
@@ -78,20 +106,23 @@ updateMockTip hdr (MockState u c t)
78106
= throwError $ MockInvalidHash (headerPrevHash hdr) (pointHash t)
79107

80108
updateMockUTxO :: HasMockTxs a
81-
=> SlotNo
109+
=> MockConfig
110+
-> SlotNo
82111
-> a
83112
-> MockState blk
84113
-> Except (MockError blk) (MockState blk)
85-
updateMockUTxO now = repeatedlyM (updateMockUTxO1 now) . getMockTxs
114+
updateMockUTxO cfg now = repeatedlyM (updateMockUTxO1 cfg now) . getMockTxs
86115

87116
updateMockUTxO1 :: forall blk.
88-
SlotNo
117+
MockConfig
118+
-> SlotNo
89119
-> Tx
90120
-> MockState blk
91121
-> Except (MockError blk) (MockState blk)
92-
updateMockUTxO1 now tx (MockState u c t) = case hasExpired of
122+
updateMockUTxO1 cfg now tx (MockState u c t) = case hasExpired of
93123
Just e -> throwError e
94124
Nothing -> do
125+
_ <- checkTxSize cfg tx
95126
u' <- withExcept MockUtxoError $ updateUtxo tx u
96127
return $ MockState u' (c `Set.union` confirmed tx) t
97128
where
@@ -104,6 +135,22 @@ updateMockUTxO1 now tx (MockState u c t) = case hasExpired of
104135
guard $ s <= now
105136
Just $ MockExpired s now
106137

138+
checkTxSize :: MockConfig -> Tx -> Except (MockError blk) ByteSize32
139+
checkTxSize cfg tx
140+
| Just maxTxSize <- mockCfgMaxTxSize cfg
141+
, actualTxSize > maxTxSize =
142+
throwError $ MockTxSizeTooBig actualTxSize maxTxSize
143+
| otherwise = pure actualTxSize
144+
where
145+
actualTxSize = txSize tx
146+
147+
{-------------------------------------------------------------------------------
148+
Supporting definitions
149+
-------------------------------------------------------------------------------}
150+
151+
txSize :: Tx -> ByteSize32
152+
txSize = ByteSize32 . fromIntegral . BL.length . serialise
153+
107154
{-------------------------------------------------------------------------------
108155
Genesis
109156
-------------------------------------------------------------------------------}

‎ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/BFT.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ protocolInfoBft numCoreNodes nid securityParam eraParams =
3838
| n <- enumCoreNodes numCoreNodes
3939
]
4040
}
41-
, topLevelConfigLedger = SimpleLedgerConfig () eraParams
41+
, topLevelConfigLedger = SimpleLedgerConfig () eraParams defaultMockConfig
4242
, topLevelConfigBlock = SimpleBlockConfig
4343
, topLevelConfigCodec = SimpleCodecConfig
4444
, topLevelConfigStorage = SimpleStorageConfig securityParam

‎ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/PBFT.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ protocolInfoMockPBFT params eraParams =
3737
topLevelConfigProtocol = PBftConfig {
3838
pbftParams = params
3939
}
40-
, topLevelConfigLedger = SimpleLedgerConfig ledgerView eraParams
40+
, topLevelConfigLedger = SimpleLedgerConfig ledgerView eraParams defaultMockConfig
4141
, topLevelConfigBlock = SimpleBlockConfig
4242
, topLevelConfigCodec = SimpleCodecConfig
4343
, topLevelConfigStorage = SimpleStorageConfig (pbftSecurityParam params)

‎ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/Praos.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,7 @@ protocolInfoPraos numCoreNodes nid params eraParams eta0 evolvingStakeDist =
4848
, praosEvolvingStake = evolvingStakeDist
4949
, praosVerKeys = verKeys
5050
}
51-
, topLevelConfigLedger = SimpleLedgerConfig addrDist eraParams
51+
, topLevelConfigLedger = SimpleLedgerConfig addrDist eraParams defaultMockConfig
5252
, topLevelConfigBlock = SimpleBlockConfig
5353
, topLevelConfigCodec = SimpleCodecConfig
5454
, topLevelConfigStorage = SimpleStorageConfig (praosSecurityParam params)

‎ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/PraosRule.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,7 @@ protocolInfoPraosRule numCoreNodes
5050
}
5151
, wlsConfigNodeId = nid
5252
}
53-
, topLevelConfigLedger = SimpleLedgerConfig () eraParams
53+
, topLevelConfigLedger = SimpleLedgerConfig () eraParams defaultMockConfig
5454
, topLevelConfigBlock = SimpleBlockConfig
5555
, topLevelConfigCodec = SimpleCodecConfig
5656
, topLevelConfigStorage = SimpleStorageConfig (praosSecurityParam params)

0 commit comments

Comments
 (0)