merge changes from nick's branch

IntersectMBO · Sep 3, 2024 · 159d33f · 159d33f
1 parent 1475242
commit 159d33f
Show file tree

Hide file tree

Showing 4 changed files with 20 additions and 26 deletions.
diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs
@@ -432,7 +432,7 @@ instance TxMeasureMetrics AlonzoMeasure where
   txMeasureMetricTxSizeBytes = txMeasureMetricTxSizeBytes . byteSize
   txMeasureMetricExUnitsMemory = exUnitsMem' . exUnits
   txMeasureMetricExUnitsSteps = exUnitsSteps' . exUnits
-  txMeasureMetricRefScriptsSizeBytes _ = 0
+  txMeasureMetricRefScriptsSizeBytes _ = mempty
 
 fromExUnits :: ExUnits -> ExUnits' Natural
 fromExUnits = unWrapExUnits
@@ -536,7 +536,8 @@ instance TxMeasureMetrics ConwayMeasure where
   txMeasureMetricTxSizeBytes = txMeasureMetricTxSizeBytes . alonzoMeasure
   txMeasureMetricExUnitsMemory = txMeasureMetricExUnitsMemory . alonzoMeasure
   txMeasureMetricExUnitsSteps = txMeasureMetricExUnitsSteps . alonzoMeasure
-  txMeasureMetricRefScriptsSizeBytes = unByteSize . refScriptsSize
+  txMeasureMetricRefScriptsSizeBytes =
+    unIgnoringOverflow . refScriptsSize
 
 blockCapacityConwayMeasure ::
      forall proto era.

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs
@@ -9,7 +9,6 @@
 module Ouroboros.Consensus.Ledger.SupportsMempool (
     ApplyTxErr
   , ByteSize32 (..)
-  , fromByteSize32
   , ConvertRawTxId (..)
   , GenTx
   , GenTxId
@@ -23,7 +22,6 @@ module Ouroboros.Consensus.Ledger.SupportsMempool (
   , TxMeasureMetrics (..)
   , Validated
   , WhetherToIntervene (..)
-  , fromByteSize32
   ) where
 
 import           Control.DeepSeq (NFData)
@@ -37,6 +35,7 @@ import qualified Data.Measure
 import           Data.Word (Word32)
 import           GHC.Stack (HasCallStack)
 import           NoThunks.Class
+import           Numeric.Natural
 import           Ouroboros.Consensus.Block.Abstract
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ticked
@@ -265,19 +264,14 @@ newtype IgnoringOverflow a = IgnoringOverflow { unIgnoringOverflow :: a }
   deriving newtype  (Monoid, Semigroup)
   deriving newtype  (NoThunks)
   deriving newtype  (HasByteSize)
+  deriving newtype  (TxMeasureMetrics)
 
 instance Measure (IgnoringOverflow ByteSize32) where
   zero = coerce (0 :: Word32)
   plus = coerce $ (+) @Word32
   min  = coerce $ min @Word32
   max  = coerce $ max @Word32
 
--- BIG WARNING: THIS FUNCTION IS LIKELY TO OVERFLOW AND SHOULD BE REMOVED AND
--- HAVE ALL OF ITS USE SITES CHANGED TO SOMETHING LESS OVERFLOW-Y
-fromByteSize32 :: Num a => ByteSize32 -> a
-fromByteSize32 = fromIntegral . unByteSize32
-{-# WARNING fromByteSize "THIS FUNCTION WILL ALMOST CERTAINLY OVERFLOW" #-}
-
 class HasByteSize a where
   -- | The byte size component (of 'TxMeasure')
   txMeasureByteSize :: a -> ByteSize32
@@ -286,13 +280,13 @@ instance HasByteSize ByteSize32 where
   txMeasureByteSize = id
 
 class TxMeasureMetrics msr where
-  txMeasureMetricTxSizeBytes :: msr -> Natural
+  txMeasureMetricTxSizeBytes :: msr -> ByteSize32
   txMeasureMetricExUnitsMemory :: msr -> Natural
   txMeasureMetricExUnitsSteps :: msr -> Natural
-  txMeasureMetricRefScriptsSizeBytes :: msr -> Natural
+  txMeasureMetricRefScriptsSizeBytes :: msr -> ByteSize32
 
-instance TxMeasureMetrics ByteSize where
-  txMeasureMetricTxSizeBytes = fromByteSize
+instance TxMeasureMetrics ByteSize32 where
+  txMeasureMetricTxSizeBytes = id
   txMeasureMetricExUnitsMemory _ = 0
   txMeasureMetricExUnitsSteps _ = 0
-  txMeasureMetricRefScriptsSizeBytes _ = 0
+  txMeasureMetricRefScriptsSizeBytes _ = mempty
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/TxSeq.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/TxSeq.hs
@@ -37,8 +37,6 @@ import qualified Data.Measure as Measure
 import           Data.Word (Word64)
 import           GHC.Generics (Generic)
 import           NoThunks.Class (NoThunks)
-import           Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32,
-                     HasByteSize, txMeasureByteSize)
 
 {-------------------------------------------------------------------------------
   Mempool transaction sequence as a finger tree

diff --git a/...nsensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalTxMonitor/Server.hs b/...nsensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalTxMonitor/Server.hs
@@ -9,7 +9,6 @@ module Ouroboros.Consensus.MiniProtocol.LocalTxMonitor.Server (localTxMonitorSer
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import qualified Data.Measure as Measure
-import           Data.Word (Word32)
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Ledger.SupportsMempool
 import           Ouroboros.Consensus.Mempool
@@ -108,12 +107,14 @@ mkMeasuresMap :: TxMeasureMetrics (TxMeasure blk)
               => Proxy blk
               -> TxMeasure blk
               -> TxMeasure blk
-              -> Map MeasureName (SizeAndCapacity Word32)
+              -> Map MeasureName (SizeAndCapacity Integer)
 mkMeasuresMap Proxy size capacity =
-  fmap (fmap fromIntegral) $ -- oof oof ow ouch oo ow
-    Map.fromList
-      [ (TransactionBytes, SizeAndCapacity (txMeasureMetricTxSizeBytes size) (txMeasureMetricTxSizeBytes capacity))
-      , (ExUnitsMemory, SizeAndCapacity (txMeasureMetricExUnitsMemory size) (txMeasureMetricExUnitsMemory capacity))
-      , (ExUnitsSteps, SizeAndCapacity (txMeasureMetricExUnitsSteps size) (txMeasureMetricExUnitsSteps capacity))
-      , (ReferenceScriptsBytes, SizeAndCapacity (txMeasureMetricRefScriptsSizeBytes size) (txMeasureMetricRefScriptsSizeBytes capacity))
-      ]
+  Map.fromList
+    [ (TransactionBytes, SizeAndCapacity (byteSizeInteger $ txMeasureMetricTxSizeBytes size) (byteSizeInteger $ txMeasureMetricTxSizeBytes capacity))
+    , (ExUnitsMemory, SizeAndCapacity (fromIntegral $ txMeasureMetricExUnitsMemory size) (fromIntegral $ txMeasureMetricExUnitsMemory capacity))
+    , (ExUnitsSteps, SizeAndCapacity (fromIntegral $ txMeasureMetricExUnitsSteps size) (fromIntegral $ txMeasureMetricExUnitsSteps capacity))
+    , (ReferenceScriptsBytes, SizeAndCapacity (byteSizeInteger $ txMeasureMetricRefScriptsSizeBytes size) (byteSizeInteger $ txMeasureMetricRefScriptsSizeBytes capacity))
+    ]
+  where
+    byteSizeInteger :: ByteSize32 -> Integer
+    byteSizeInteger = fromIntegral . unByteSize32