txWireSize: added tests

Author: coot

ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Serialisation.hs

@@ -31,10 +31,13 @@ import           Test.Tasty.QuickCheck
 import           Test.Util.Corruption
 import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Serialisation.Roundtrip
+import           Test.Util.Serialisation.TxWireSize
 
 tests :: TestTree
 tests = testGroup "Byron"
     [ roundtrip_all testCodecCfg dictNestedHdr
+    , testProperty "GenTx.txWireSize.txSubmission" (prop_txWireSize_txSubmission testCodecCfg)
+    , testProperty "GenTx.txWireSize.tight" (prop_txWireSize (const Nothing) testCodecCfg)
 
     , testProperty "BinaryBlockInfo sanity check" prop_byronBinaryBlockInfo
 

ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Serialisation.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Test.Consensus.Cardano.Serialisation (tests) where
 
@@ -26,10 +27,13 @@ import           Test.Tasty
 import           Test.Tasty.QuickCheck (Property, testProperty, (===))
 import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Serialisation.Roundtrip
+import           Test.Util.Serialisation.TxWireSize
 
 tests :: TestTree
 tests = testGroup "Cardano"
     [ testGroup "Examples roundtrip" $ examplesRoundtrip Cardano.Examples.codecConfig Cardano.Examples.examples
+    , testProperty "GenTx.txWireSize.txSubmission" $ prop_txWireSize_txSubmission testCodecCfg
+    , testProperty "GenTx.txWireSize.tight" $ prop_txWireSize (const Nothing) testCodecCfg
     , roundtrip_all_skipping result testCodecCfg dictNestedHdr
     , testProperty "BinaryBlockInfo sanity check" prop_CardanoBinaryBlockInfo
     ]

ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Serialisation.hs

@@ -26,10 +26,19 @@ import           Test.Tasty.QuickCheck
 import           Test.Util.Corruption
 import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Serialisation.Roundtrip
+import           Test.Util.Serialisation.TxWireSize
+
+import qualified Cardano.Ledger.MemoBytes.Internal as SL
+import qualified Cardano.Ledger.Shelley.Tx.Internal as SL
+
+getTxBytes :: GenTx Block -> Maybe String
+getTxBytes (ShelleyTx _ (SL.TxConstr (SL.Memo _ bytes))) = Just $ show bytes
 
 tests :: TestTree
 tests = testGroup "Shelley"
     [ roundtrip_all testCodecCfg dictNestedHdr
+    , testProperty "GenTx.txWireSize.txSubmission" (prop_txWireSize_txSubmission testCodecCfg)
+    , testProperty "GenTx.txWireSize.tight" (prop_txWireSize getTxBytes testCodecCfg)
 
       -- Test for real crypto too
     , testProperty "hashSize real crypto"       $ prop_hashSize pReal

ouroboros-consensus/ouroboros-consensus.cabal

@@ -412,6 +412,7 @@ library unstable-consensus-testlib
     Test.Util.Serialisation.Golden
     Test.Util.Serialisation.Roundtrip
     Test.Util.Serialisation.SomeResult
+    Test.Util.Serialisation.TxWireSize
     Test.Util.Shrink
     Test.Util.Slots
     Test.Util.Split
@@ -456,6 +457,7 @@ library unstable-consensus-testlib
     nothunks,
     optparse-applicative,
     ouroboros-consensus,
+    ouroboros-network,
     ouroboros-network-api,
     ouroboros-network-mock,
     pretty-simple,

ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/TxWireSize.hs

@@ -0,0 +1,84 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Test.Util.Serialisation.TxWireSize (
+    prop_txWireSize
+  , prop_txWireSize_txSubmission
+  ) where
+
+import           Codec.CBOR.Write (toLazyByteString)
+import           Ouroboros.Consensus.Block.Abstract (CodecConfig)
+import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, TxLimits (..))
+import           Ouroboros.Consensus.Node.NetworkProtocolVersion (BlockNodeToNodeVersion)
+import           Ouroboros.Consensus.Node.Serialisation
+import           Ouroboros.Network.SizeInBytes
+import           Ouroboros.Network.TxSubmission.Inbound.V2.State (config_MAX_TX_SIZE_DISCREPANCY)
+import qualified Data.ByteString.Lazy as BSL
+import           Test.Tasty.QuickCheck
+import           Test.Util.Serialisation.Roundtrip (WithVersion (..))
+
+
+-- | Verify that `txWriteSize` agrees with the encoded `GenTx` size up to
+-- `config_MX_TX_SIZE_DISCREPANCY` allowed by `tx-submission` mini-protocol.
+--
+-- NOTE: `tx`s which do not satisfy this property will terminate connections.
+--
+prop_txWireSize_txSubmission ::
+    ( SerialiseNodeToNode blk (GenTx blk)
+    , TxLimits blk
+    )
+  => CodecConfig blk
+  -> WithVersion (BlockNodeToNodeVersion blk) (GenTx blk)
+  -> Property
+prop_txWireSize_txSubmission ccfg (WithVersion version tx) =
+      counterexample ("encoded size " ++ show encSize ++ ", computed size " ++ show cmpSize)
+    $ counterexample ("diff size " ++ show diffSize)
+    $ label (show diffSize)
+    $ fromIntegral (abs diffSize) <= config_MAX_TX_SIZE_DISCREPANCY
+  where
+    encSize, cmpSize :: SizeInBytes
+
+    encSize  = fromIntegral (BSL.length $ toLazyByteString (encodeNodeToNode ccfg version tx))
+    cmpSize  = txWireSize tx
+
+    diffSize :: Int
+    diffSize = fromIntegral encSize - fromIntegral cmpSize
+
+
+-- | Verify that `txWriteSize` is very close to the real tx size.
+--
+-- The `txWireSize` doesn't take into account if HFC is enabled or not.  If it
+-- is enabled, the `wireTxSize` for `GenTx (HardForkBlock xs)` will agree with
+-- the encoded size, but if it is disabled it will overestimate the value by HFC
+-- envelope (at most 3 bytes, 2 for forcible future)
+--
+prop_txWireSize ::
+    ( SerialiseNodeToNode blk (GenTx blk)
+    , TxLimits blk
+    )
+  => (GenTx blk -> Maybe String)
+  -- ^ show tx bytes
+  -> CodecConfig blk
+  -> WithVersion (BlockNodeToNodeVersion blk) (GenTx blk)
+  -> Property
+prop_txWireSize getTxBytes ccfg (WithVersion version tx) =
+      counterexample ("encoded size " ++ show encSize ++ ", computed size " ++ show cmpSize)
+    $ counterexample ("encoded tx:\n" ++ show encoded)
+    $ label (show diffSize)
+    $ case getTxBytes tx of
+        Just txBytes -> counterexample ("tx bytes:\n" ++ txBytes)
+        Nothing      -> property
+    $ encSize <= cmpSize
+      .&&.
+      encSize + 3 >= cmpSize
+
+
+  where
+    encoded :: BSL.ByteString
+    encoded = toLazyByteString (encodeNodeToNode ccfg version tx)
+
+    encSize, cmpSize :: SizeInBytes
+    encSize  = fromIntegral (BSL.length encoded)
+    cmpSize  = txWireSize tx
+
+    diffSize :: Int
+    diffSize = fromIntegral encSize - fromIntegral cmpSize