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 index d0c271d055..c211fb97a6 100644 --- 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 index 9e010b3dbc..bbbe9b5531 100644 --- 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,6 +264,7 @@ 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) @@ -272,12 +272,6 @@ instance Measure (IgnoringOverflow ByteSize32) where 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 index d7b67a125b..324c477443 100644 --- 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/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalTxMonitor/Server.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalTxMonitor/Server.hs index 6a510d2275..a132663394 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalTxMonitor/Server.hs +++ b/ouroboros-consensus/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