{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Mempool capacity, size and transaction size datatypes.
--
-- This module also defines how to manually override the mempool capacity.
--
-- > import           Ouroboros.Consensus.Mempool.Capacity (Capacity)
-- > import qualified Ouroboros.Consensus.Mempool.Capacity as Capacity
module Ouroboros.Consensus.Mempool.Capacity (
    -- * Mempool capacity
    MempoolCapacityBytesOverride (..)
  , computeMempoolCapacity
  , mkCapacityBytesOverride
    -- * Mempool Size
  , MempoolSize (..)
  ) where

import           Data.DerivingVia (InstantiatedAt (..))
import           Data.Measure (Measure)
import           Data.Semigroup (stimes)
import           Data.Word (Word32)
import           Ouroboros.Consensus.Ledger.Basics
import           Ouroboros.Consensus.Ledger.SupportsMempool

{-------------------------------------------------------------------------------
  Mempool capacity in bytes
-------------------------------------------------------------------------------}

-- | An override for the default 'MempoolCapacityBytes' which is 2x the
-- maximum transaction capacity
data MempoolCapacityBytesOverride
  = NoMempoolCapacityBytesOverride
    -- ^ Use 2x the maximum transaction capacity of a block. This will change
    -- dynamically with the protocol parameters adopted in the current ledger.
  | MempoolCapacityBytesOverride !ByteSize32
    -- ^ Use the least multiple of the block capacity that is no less than this
    -- size.
  deriving (MempoolCapacityBytesOverride
-> MempoolCapacityBytesOverride -> Bool
(MempoolCapacityBytesOverride
 -> MempoolCapacityBytesOverride -> Bool)
-> (MempoolCapacityBytesOverride
    -> MempoolCapacityBytesOverride -> Bool)
-> Eq MempoolCapacityBytesOverride
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MempoolCapacityBytesOverride
-> MempoolCapacityBytesOverride -> Bool
== :: MempoolCapacityBytesOverride
-> MempoolCapacityBytesOverride -> Bool
$c/= :: MempoolCapacityBytesOverride
-> MempoolCapacityBytesOverride -> Bool
/= :: MempoolCapacityBytesOverride
-> MempoolCapacityBytesOverride -> Bool
Eq, Int -> MempoolCapacityBytesOverride -> ShowS
[MempoolCapacityBytesOverride] -> ShowS
MempoolCapacityBytesOverride -> String
(Int -> MempoolCapacityBytesOverride -> ShowS)
-> (MempoolCapacityBytesOverride -> String)
-> ([MempoolCapacityBytesOverride] -> ShowS)
-> Show MempoolCapacityBytesOverride
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MempoolCapacityBytesOverride -> ShowS
showsPrec :: Int -> MempoolCapacityBytesOverride -> ShowS
$cshow :: MempoolCapacityBytesOverride -> String
show :: MempoolCapacityBytesOverride -> String
$cshowList :: [MempoolCapacityBytesOverride] -> ShowS
showList :: [MempoolCapacityBytesOverride] -> ShowS
Show)

-- | Create an override for the mempool capacity using the provided number of
-- bytes.
mkCapacityBytesOverride :: ByteSize32 -> MempoolCapacityBytesOverride
mkCapacityBytesOverride :: ByteSize32 -> MempoolCapacityBytesOverride
mkCapacityBytesOverride = ByteSize32 -> MempoolCapacityBytesOverride
MempoolCapacityBytesOverride

-- | If no override is provided, calculate the default mempool capacity as 2x
-- the current ledger's maximum transaction capacity of a block.
--
-- If an override is present, reinterpret it as a number of blocks (rounded
-- up), and then simply multiply the ledger's capacity by that number.
computeMempoolCapacity ::
     LedgerSupportsMempool blk
  => LedgerConfig blk
  -> TickedLedgerState blk
  -> MempoolCapacityBytesOverride
  -> TxMeasure blk
computeMempoolCapacity :: forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> TickedLedgerState blk
-> MempoolCapacityBytesOverride
-> TxMeasure blk
computeMempoolCapacity LedgerConfig blk
cfg TickedLedgerState blk
st MempoolCapacityBytesOverride
override =
    TxMeasure blk
capacity
  where
    oneBlock :: TxMeasure blk
oneBlock                 = LedgerConfig blk -> TickedLedgerState blk -> TxMeasure blk
forall blk.
TxLimits blk =>
LedgerConfig blk -> TickedLedgerState blk -> TxMeasure blk
blockCapacityTxMeasure LedgerConfig blk
cfg TickedLedgerState blk
st
    ByteSize32 Word32
oneBlockBytes = TxMeasure blk -> ByteSize32
forall a. HasByteSize a => a -> ByteSize32
txMeasureByteSize TxMeasure blk
oneBlock

    blockCount :: Word32
blockCount = case MempoolCapacityBytesOverride
override of
      MempoolCapacityBytesOverride
NoMempoolCapacityBytesOverride              -> Word32
2
      MempoolCapacityBytesOverride (ByteSize32 Word32
x) ->
        -- This calculation is happening at Word32. Thus overflow is silently
        -- accepted. Adding one less than the denominator to the numerator
        -- effectively rounds up instead of down.
        Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
max Word32
1 (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ (Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
oneBlockBytes Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1) Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
oneBlockBytes

    SemigroupViaMeasure TxMeasure blk
capacity =
      Word32
-> SemigroupViaMeasure (TxMeasure blk)
-> SemigroupViaMeasure (TxMeasure blk)
forall b.
Integral b =>
b
-> SemigroupViaMeasure (TxMeasure blk)
-> SemigroupViaMeasure (TxMeasure blk)
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Word32
blockCount (TxMeasure blk -> SemigroupViaMeasure (TxMeasure blk)
forall a. a -> SemigroupViaMeasure a
SemigroupViaMeasure TxMeasure blk
oneBlock)

newtype SemigroupViaMeasure a = SemigroupViaMeasure a
  deriving (SemigroupViaMeasure a -> SemigroupViaMeasure a -> Bool
(SemigroupViaMeasure a -> SemigroupViaMeasure a -> Bool)
-> (SemigroupViaMeasure a -> SemigroupViaMeasure a -> Bool)
-> Eq (SemigroupViaMeasure a)
forall a.
Eq a =>
SemigroupViaMeasure a -> SemigroupViaMeasure a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
SemigroupViaMeasure a -> SemigroupViaMeasure a -> Bool
== :: SemigroupViaMeasure a -> SemigroupViaMeasure a -> Bool
$c/= :: forall a.
Eq a =>
SemigroupViaMeasure a -> SemigroupViaMeasure a -> Bool
/= :: SemigroupViaMeasure a -> SemigroupViaMeasure a -> Bool
Eq, Eq (SemigroupViaMeasure a)
SemigroupViaMeasure a
Eq (SemigroupViaMeasure a) =>
SemigroupViaMeasure a
-> (SemigroupViaMeasure a
    -> SemigroupViaMeasure a -> SemigroupViaMeasure a)
-> (SemigroupViaMeasure a
    -> SemigroupViaMeasure a -> SemigroupViaMeasure a)
-> (SemigroupViaMeasure a
    -> SemigroupViaMeasure a -> SemigroupViaMeasure a)
-> Measure (SemigroupViaMeasure a)
SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
forall a.
Eq a =>
a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> Measure a
forall a. Measure a => Eq (SemigroupViaMeasure a)
forall a. Measure a => SemigroupViaMeasure a
forall a.
Measure a =>
SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
$czero :: forall a. Measure a => SemigroupViaMeasure a
zero :: SemigroupViaMeasure a
$cplus :: forall a.
Measure a =>
SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
plus :: SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
$cmin :: forall a.
Measure a =>
SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
min :: SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
$cmax :: forall a.
Measure a =>
SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
max :: SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
Measure)
  deriving NonEmpty (SemigroupViaMeasure a) -> SemigroupViaMeasure a
SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
(SemigroupViaMeasure a
 -> SemigroupViaMeasure a -> SemigroupViaMeasure a)
-> (NonEmpty (SemigroupViaMeasure a) -> SemigroupViaMeasure a)
-> (forall b.
    Integral b =>
    b -> SemigroupViaMeasure a -> SemigroupViaMeasure a)
-> Semigroup (SemigroupViaMeasure a)
forall b.
Integral b =>
b -> SemigroupViaMeasure a -> SemigroupViaMeasure a
forall a.
Measure a =>
NonEmpty (SemigroupViaMeasure a) -> SemigroupViaMeasure a
forall a.
Measure a =>
SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
forall a b.
(Measure a, Integral b) =>
b -> SemigroupViaMeasure a -> SemigroupViaMeasure a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall a.
Measure a =>
SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
<> :: SemigroupViaMeasure a
-> SemigroupViaMeasure a -> SemigroupViaMeasure a
$csconcat :: forall a.
Measure a =>
NonEmpty (SemigroupViaMeasure a) -> SemigroupViaMeasure a
sconcat :: NonEmpty (SemigroupViaMeasure a) -> SemigroupViaMeasure a
$cstimes :: forall a b.
(Measure a, Integral b) =>
b -> SemigroupViaMeasure a -> SemigroupViaMeasure a
stimes :: forall b.
Integral b =>
b -> SemigroupViaMeasure a -> SemigroupViaMeasure a
Semigroup via (InstantiatedAt Measure (SemigroupViaMeasure a))

{-------------------------------------------------------------------------------
  Mempool size
-------------------------------------------------------------------------------}

-- | The size of a mempool.
data MempoolSize = MempoolSize
  { MempoolSize -> Word32
msNumTxs   :: !Word32
    -- ^ The number of transactions in the mempool.
  , MempoolSize -> ByteSize32
msNumBytes :: !ByteSize32
    -- ^ The summed byte size of all the transactions in the mempool.
  } deriving (MempoolSize -> MempoolSize -> Bool
(MempoolSize -> MempoolSize -> Bool)
-> (MempoolSize -> MempoolSize -> Bool) -> Eq MempoolSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MempoolSize -> MempoolSize -> Bool
== :: MempoolSize -> MempoolSize -> Bool
$c/= :: MempoolSize -> MempoolSize -> Bool
/= :: MempoolSize -> MempoolSize -> Bool
Eq, Int -> MempoolSize -> ShowS
[MempoolSize] -> ShowS
MempoolSize -> String
(Int -> MempoolSize -> ShowS)
-> (MempoolSize -> String)
-> ([MempoolSize] -> ShowS)
-> Show MempoolSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MempoolSize -> ShowS
showsPrec :: Int -> MempoolSize -> ShowS
$cshow :: MempoolSize -> String
show :: MempoolSize -> String
$cshowList :: [MempoolSize] -> ShowS
showList :: [MempoolSize] -> ShowS
Show)

instance Semigroup MempoolSize where
  MempoolSize Word32
xt ByteSize32
xb <> :: MempoolSize -> MempoolSize -> MempoolSize
<> MempoolSize Word32
yt ByteSize32
yb = Word32 -> ByteSize32 -> MempoolSize
MempoolSize (Word32
xt Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
yt) (ByteSize32
xb ByteSize32 -> ByteSize32 -> ByteSize32
forall a. Semigroup a => a -> a -> a
<> ByteSize32
yb)

instance Monoid MempoolSize where
  mempty :: MempoolSize
mempty  = MempoolSize { msNumTxs :: Word32
msNumTxs = Word32
0, msNumBytes :: ByteSize32
msNumBytes = Word32 -> ByteSize32
ByteSize32 Word32
0 }
  mappend :: MempoolSize -> MempoolSize -> MempoolSize
mappend = MempoolSize -> MempoolSize -> MempoolSize
forall a. Semigroup a => a -> a -> a
(<>)