Skip to content

Commit 388cc69

Browse files
committed
tx-submission: verify tx sizes
1 parent d900a38 commit 388cc69

File tree

8 files changed

+169
-68
lines changed

8 files changed

+169
-68
lines changed

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

+2-1
Original file line numberDiff line numberDiff line change
@@ -109,7 +109,7 @@ import Ouroboros.Network.TxSubmission.Inbound.Types (TraceTxLogic,
109109
TraceTxSubmissionInbound)
110110
import Ouroboros.Network.TxSubmission.Outbound (txSubmissionOutbound)
111111
import Test.Ouroboros.Network.Diffusion.Node.NodeKernel
112-
import Test.Ouroboros.Network.TxSubmission.Types (Mempool, Tx, getMempoolReader,
112+
import Test.Ouroboros.Network.TxSubmission.Types (Mempool, Tx (..), getMempoolReader,
113113
getMempoolWriter, txSubmissionCodec2)
114114

115115

@@ -684,6 +684,7 @@ applications debugTracer txSubmissionInboundTracer txSubmissionInboundDebug node
684684
txChannelsVar
685685
sharedTxStateVar
686686
(getMempoolReader mempool)
687+
getTxSize
687688
them $ \api -> do
688689
let server = txSubmissionInboundV2
689690
txSubmissionInboundTracer

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

+1
Original file line numberDiff line numberDiff line change
@@ -213,6 +213,7 @@ runTxSubmission tracer tracerTxLogic state txDecisionPolicy = do
213213
txChannelsVar
214214
sharedTxStateVar
215215
(getMempoolReader inboundMempool)
216+
getTxSize
216217
addr $ \api -> do
217218
let server = txSubmissionInboundV2 verboseTracer
218219
(getMempoolWriter inboundMempool)

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

+63-28
Original file line numberDiff line numberDiff line change
@@ -34,12 +34,14 @@ import Data.Monoid (Sum (..))
3434
import Data.Sequence.Strict qualified as StrictSeq
3535
import Data.Set (Set)
3636
import Data.Set qualified as Set
37+
import Data.Typeable
3738

3839
import NoThunks.Class
3940

4041
import Ouroboros.Network.Protocol.TxSubmission2.Type
4142
import Ouroboros.Network.TxSubmission.Inbound.Decision
4243
(SharedDecisionContext (..), TxDecision (..))
44+
import Ouroboros.Network.TxSubmission.Inbound.Types qualified as TXS
4345
import Ouroboros.Network.TxSubmission.Inbound.Decision qualified as TXS
4446
import Ouroboros.Network.TxSubmission.Inbound.Policy
4547
import Ouroboros.Network.TxSubmission.Inbound.State (PeerTxState (..),
@@ -305,7 +307,7 @@ mkArbPeerTxState mempoolHasTxFun txIdsInflight unacked txMaskMap =
305307
where
306308
mempoolHasTx = apply mempoolHasTxFun
307309
availableTxIds = Map.fromList
308-
[ (txid, getTxSize tx) | (txid, TxAvailable tx _) <- Map.assocs txMaskMap
310+
[ (txid, getTxAdvSize tx) | (txid, TxAvailable tx _) <- Map.assocs txMaskMap
309311
, not (mempoolHasTx txid)
310312
]
311313
unknownTxs = Set.fromList
@@ -314,7 +316,7 @@ mkArbPeerTxState mempoolHasTxFun txIdsInflight unacked txMaskMap =
314316
]
315317

316318
requestedTxIdsInflight = fromIntegral txIdsInflight
317-
requestedTxsInflightSize = foldMap getTxSize inflightMap
319+
requestedTxsInflightSize = foldMap getTxAdvSize inflightMap
318320
requestedTxsInflight = Map.keysSet inflightMap
319321

320322
-- exclude `txid`s which are already in the mempool, we never request such
@@ -758,12 +760,20 @@ instance Arbitrary ArbCollectTxs where
758760

759761
receivedTx <- sublistOf requestedTxIds'
760762
>>= traverse (\txid -> do
763+
-- real size, which might be different from
764+
-- the advertised size
765+
size <- frequency [ (9, pure (availableTxIds Map.! txid))
766+
, (1, chooseEnum (0, maxTxSize))
767+
]
768+
761769
valid <- frequency [(4, pure True), (1, pure False)]
762-
pure $ Tx { getTxId = txid,
763-
getTxSize = availableTxIds Map.! txid,
764-
getTxValid = valid })
770+
pure $ Tx { getTxId = txid,
771+
getTxSize = size,
772+
-- `availableTxIds` contains advertised sizes
773+
getTxAdvSize = availableTxIds Map.! txid,
774+
getTxValid = valid })
765775

766-
pure $ assert (foldMap getTxSize receivedTx <= requestedTxsInflightSize)
776+
pure $ assert (foldMap getTxAdvSize receivedTx <= requestedTxsInflightSize)
767777
$ ArbCollectTxs mempoolHasTxFun
768778
(Set.fromList requestedTxIds')
769779
(Map.fromList [ (getTxId tx, tx) | tx <- receivedTx ])
@@ -855,24 +865,49 @@ prop_collectTxsImpl (ArbCollectTxs _mempoolHasTxFun txidsRequested txsReceived p
855865
label ("number of txids inflight " ++ labelInt 25 5 (Map.size $ inflightTxs st)) $
856866
label ("number of txids requested " ++ labelInt 25 5 (Set.size txidsRequested)) $
857867
label ("number of txids received " ++ labelInt 10 2 (Map.size txsReceived)) $
858-
859-
-- InboundState invariant
860-
counterexample
861-
( "InboundState invariant violation:\n" ++ show st' ++ "\n"
862-
++ show ps'
863-
)
864-
(sharedTxStateInvariant st')
865-
866-
.&&.
867-
-- `collectTxsImpl` doesn't modify unacknowledged TxId's
868-
counterexample "acknowledged property violation"
869-
( let unacked = toList $ unacknowledgedTxIds ps
870-
unacked' = toList $ unacknowledgedTxIds ps'
871-
in unacked === unacked'
872-
)
868+
label ("hasTxSizeError " ++ show hasTxSizeErr) $
869+
870+
case TXS.collectTxsImpl getTxSize peeraddr txidsRequested txsReceived st of
871+
Right st' | not hasTxSizeErr ->
872+
let ps' = peerTxStates st' Map.! peeraddr in
873+
-- InboundState invariant
874+
counterexample
875+
( "InboundState invariant violation:\n" ++ show st' ++ "\n"
876+
++ show ps'
877+
)
878+
(sharedTxStateInvariant st')
879+
880+
.&&.
881+
-- `collectTxsImpl` doesn't modify unacknowledged TxId's
882+
counterexample "acknowledged property violation"
883+
( let unacked = toList $ unacknowledgedTxIds ps
884+
unacked' = toList $ unacknowledgedTxIds ps'
885+
in unacked === unacked'
886+
)
887+
888+
Right _ ->
889+
counterexample "collectTxsImpl should return Left"
890+
. counterexample (show txsReceived)
891+
$ False
892+
Left _ | not hasTxSizeErr ->
893+
counterexample "collectTxsImpl should return Right" False
894+
895+
Left (TXS.ProtocolErrorTxSizeError as) ->
896+
counterexample (show as)
897+
$ Set.fromList ((\(txid, _, _) -> coerceTxId txid) `map` as)
898+
===
899+
Map.keysSet (Map.filter (\tx -> getTxSize tx /= getTxAdvSize tx) txsReceived)
900+
Left e ->
901+
counterexample ("unexpected error: " ++ show e) False
873902
where
874-
st' = TXS.collectTxsImpl peeraddr txidsRequested txsReceived st
875-
ps' = peerTxStates st' Map.! peeraddr
903+
hasTxSizeErr = any (\tx -> getTxSize tx /= getTxAdvSize tx) txsReceived
904+
905+
-- The `ProtocolErrorTxSizeError` type is an existential type. We know that
906+
-- the type of `txid` is `TxId`, we just don't have evidence for it.
907+
coerceTxId :: Typeable txid => txid -> TxId
908+
coerceTxId txid = case cast txid of
909+
Just a -> a
910+
Nothing -> error "impossible happened! Is the test still using `TxId` for `txid`?"
876911

877912

878913
-- | Verify that `SharedTxState` returned by `collectTxsImpl` if evaluated to
@@ -882,11 +917,11 @@ prop_collectTxsImpl_nothunks
882917
:: ArbCollectTxs
883918
-> Property
884919
prop_collectTxsImpl_nothunks (ArbCollectTxs _mempoolHasTxFun txidsRequested txsReceived peeraddr _ st) =
885-
case unsafeNoThunks $! st' of
886-
Nothing -> property True
887-
Just ctx -> counterexample (show ctx) False
888-
where
889-
st' = TXS.collectTxsImpl peeraddr txidsRequested txsReceived st
920+
case TXS.collectTxsImpl getTxSize peeraddr txidsRequested txsReceived st of
921+
Right st' -> case unsafeNoThunks $! st' of
922+
Nothing -> property True
923+
Just ctx -> counterexample (show ctx) False
924+
Left _ -> property True
890925

891926

892927
newtype ArbTxDecisionPolicy = ArbTxDecisionPolicy TxDecisionPolicy

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

+18-11
Original file line numberDiff line numberDiff line change
@@ -55,12 +55,13 @@ import Text.Printf
5555

5656

5757
data Tx txid = Tx {
58-
getTxId :: !txid,
59-
getTxSize :: !SizeInBytes,
58+
getTxId :: !txid,
59+
getTxSize :: !SizeInBytes,
60+
getTxAdvSize :: !SizeInBytes,
6061
-- | If false this means that when this tx will be submitted to a remote
6162
-- mempool it will not be valid. The outbound mempool might contain
6263
-- invalid tx's in this sense.
63-
getTxValid :: !Bool
64+
getTxValid :: !Bool
6465
}
6566
deriving (Eq, Ord, Show, Generic)
6667

@@ -69,13 +70,17 @@ instance ShowProxy txid => ShowProxy (Tx txid) where
6970
showProxy _ = "Tx " ++ showProxy (Proxy :: Proxy txid)
7071

7172
instance Arbitrary txid => Arbitrary (Tx txid) where
72-
arbitrary =
73+
arbitrary = do
74+
-- note:
75+
-- generating small tx sizes avoids overflow error when semigroup
76+
-- instance of `SizeInBytes` is used (summing up all inflight tx
77+
-- sizes).
78+
(size, advSize) <- frequency [ (9, (\a -> (a,a)) <$> chooseEnum (0, maxTxSize))
79+
, (1, (,) <$> chooseEnum (0, maxTxSize) <*> chooseEnum (0, maxTxSize))
80+
]
7381
Tx <$> arbitrary
74-
<*> chooseEnum (0, maxTxSize)
75-
-- note:
76-
-- generating small tx sizes avoids overflow error when semigroup
77-
-- instance of `SizeInBytes` is used (summing up all inflight tx
78-
-- sizes).
82+
<*> pure size
83+
<*> pure advSize
7984
<*> frequency [ (3, pure True)
8085
, (1, pure False)
8186
]
@@ -167,15 +172,17 @@ txSubmissionCodec2 =
167172
codecTxSubmission2 CBOR.encodeInt CBOR.decodeInt
168173
encodeTx decodeTx
169174
where
170-
encodeTx Tx {getTxId, getTxSize, getTxValid} =
171-
CBOR.encodeListLen 3
175+
encodeTx Tx {getTxId, getTxSize, getTxAdvSize, getTxValid} =
176+
CBOR.encodeListLen 4
172177
<> CBOR.encodeInt getTxId
173178
<> CBOR.encodeWord32 (getSizeInBytes getTxSize)
179+
<> CBOR.encodeWord32 (getSizeInBytes getTxAdvSize)
174180
<> CBOR.encodeBool getTxValid
175181

176182
decodeTx = do
177183
_ <- CBOR.decodeListLen
178184
Tx <$> CBOR.decodeInt
185+
<*> (SizeInBytes <$> CBOR.decodeWord32)
179186
<*> (SizeInBytes <$> CBOR.decodeWord32)
180187
<*> CBOR.decodeBool
181188

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

+8-3
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ import Data.Foldable (traverse_
2727
, foldl'
2828
#endif
2929
)
30+
import Data.Typeable (Typeable)
3031
import Data.Map.Strict (Map)
3132
import Data.Map.Strict qualified as Map
3233
import Data.Maybe (fromMaybe)
@@ -75,7 +76,7 @@ data PeerTxAPI m txid tx = PeerTxAPI {
7576
-- ^ requested txids
7677
-> Map txid tx
7778
-- ^ received txs
78-
-> m ()
79+
-> m (Maybe TxSubmissionProtocolError)
7980
-- ^ handle received txs
8081
}
8182

@@ -90,13 +91,16 @@ withPeer
9091
, MonadMVar m
9192
, MonadSTM m
9293
, Ord txid
94+
, Typeable txid
95+
, Show txid
9396
, Ord peeraddr
9497
, Show peeraddr
9598
)
9699
=> Tracer m (TraceTxLogic peeraddr txid tx)
97100
-> TxChannelsVar m peeraddr txid tx
98101
-> SharedTxStateVar m peeraddr txid tx
99102
-> TxSubmissionMempoolReader txid tx idx m
103+
-> (tx -> SizeInBytes)
100104
-> peeraddr
101105
-- ^ new peer
102106
-> (PeerTxAPI m txid tx -> m a)
@@ -106,6 +110,7 @@ withPeer tracer
106110
channelsVar
107111
sharedStateVar
108112
TxSubmissionMempoolReader { mempoolGetSnapshot }
113+
txSize
109114
peeraddr io =
110115
bracket
111116
(do -- create a communication channel
@@ -209,9 +214,9 @@ withPeer tracer
209214
-- ^ requested txids
210215
-> Map txid tx
211216
-- ^ received txs
212-
-> m ()
217+
-> m (Maybe TxSubmissionProtocolError)
213218
handleReceivedTxs txids txs =
214-
collectTxs tracer sharedStateVar peeraddr txids txs
219+
collectTxs tracer txSize sharedStateVar peeraddr txids txs
215220

216221

217222
decisionLogicThread

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

+5-4
Original file line numberDiff line numberDiff line change
@@ -182,8 +182,9 @@ txSubmissionInboundV2
182182

183183
unless (Map.keysSet received `Set.isSubsetOf` requested) $
184184
throwIO ProtocolErrorTxNotRequested
185-
-- TODO: all sizes of txs which were announced earlier with
186-
-- `MsgReplyTxIds` must be verified.
187185

188-
handleReceivedTxs requested received
189-
k
186+
mbe <- handleReceivedTxs requested received
187+
case mbe of
188+
-- one of `tx`s had a wrong size
189+
Just e -> throwIO e
190+
Nothing -> k

0 commit comments

Comments
 (0)