{-# LANGUAGE NumericUnderscores #-}

module Ouroboros.Network.TxSubmission.Inbound.V2.Policy
  ( TxDecisionPolicy (..)
  , defaultTxDecisionPolicy
  , saneTxDecisionPolicy
  , max_TX_SIZE
    -- * Re-exports
  , NumTxIdsToReq (..)
  ) where

import Control.DeepSeq
import Control.Monad.Class.MonadTime.SI
import Ouroboros.Network.Protocol.TxSubmission2.Type (NumTxIdsToReq (..))
import Ouroboros.Network.SizeInBytes (SizeInBytes (..))


-- | Maximal tx size.
--
-- Affects:
--
-- * `TxDecisionPolicy`
-- * `maximumIngressQueue` for `tx-submission` mini-protocol, see
--   `Ouroboros.Network.NodeToNode.txSubmissionProtocolLimits`
--
max_TX_SIZE :: SizeInBytes
max_TX_SIZE :: SizeInBytes
max_TX_SIZE = SizeInBytes
65_540


-- | Policy for making decisions
--
data TxDecisionPolicy = TxDecisionPolicy {
      TxDecisionPolicy -> NumTxIdsToReq
maxNumTxIdsToRequest           :: !NumTxIdsToReq,
      -- ^ a maximal number of txids requested at once.

      TxDecisionPolicy -> NumTxIdsToReq
maxUnacknowledgedTxIds         :: !NumTxIdsToReq,
      -- ^ maximal number of unacknowledgedTxIds.  Measured in `NumTxIdsToReq`
      -- since we enforce this policy by requesting not more txids than what
      -- this limit allows.

      --
      -- Configuration of tx decision logic.
      --

      TxDecisionPolicy -> SizeInBytes
txsSizeInflightPerPeer         :: !SizeInBytes,
      -- ^ a limit of tx size in-flight from a single peer.
      -- It can be exceed by max tx size.

      TxDecisionPolicy -> Int
maxOutstandingTxBatchesPerPeer :: !Int,
      -- ^ a limit of outstanding tx-body request batches from a single peer.

      TxDecisionPolicy -> Int
txInflightMultiplicity         :: !Int,
      -- ^ from how many peers download the `txid` simultaneously

      TxDecisionPolicy -> DiffTime
bufferedTxsMinLifetime         :: !DiffTime,
      -- ^ how long TXs that have been added to the mempool will be
      -- kept in the `bufferedTxs` cache.

      TxDecisionPolicy -> Double
scoreRate                      :: !Double,
      -- ^ rate at which "rejected" TXs drain. Unit: TX/seconds.

      TxDecisionPolicy -> Double
scoreMax                       :: !Double,
      -- ^ Maximum number of "rejections". Unit: seconds

      TxDecisionPolicy -> Double
scoreAcceptDecrement           :: !Double,
      -- ^ amount subtracted from the peer's score for each tx body the peer delivered that the mempool accepted.

      TxDecisionPolicy -> DiffTime
interTxSpace                   :: !DiffTime,
      -- ^ space between actual requests for the same TX. This the time a peer has soul ownership
      -- of their TX lease. When it expires other peers may issue additional requests.

      TxDecisionPolicy -> DiffTime
inflightTimeout                :: !DiffTime,
      -- ^ Maximum time a peer's attempt may sit between claim and
      -- entering submission before the per-entry inflight-multiplicity
      -- cap is bumped, allowing another peer to attempt in parallel.
      TxDecisionPolicy -> DiffTime
maxPeerClaimDelay              :: !DiffTime,
      -- ^ Maximum delay penalty for poor performing peers.

      TxDecisionPolicy -> Bool
disablePipelinedTxIdRequests   :: !Bool
      -- ^ When 'True', the txid picker never issues pipelined
      -- @MsgRequestTxIds@ messages; only blocking requests fire (and
      -- only when the unack window has been fully drained). Used
      -- by some benchmarks.
    }
  deriving (TxDecisionPolicy -> TxDecisionPolicy -> Bool
(TxDecisionPolicy -> TxDecisionPolicy -> Bool)
-> (TxDecisionPolicy -> TxDecisionPolicy -> Bool)
-> Eq TxDecisionPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxDecisionPolicy -> TxDecisionPolicy -> Bool
== :: TxDecisionPolicy -> TxDecisionPolicy -> Bool
$c/= :: TxDecisionPolicy -> TxDecisionPolicy -> Bool
/= :: TxDecisionPolicy -> TxDecisionPolicy -> Bool
Eq, Int -> TxDecisionPolicy -> ShowS
[TxDecisionPolicy] -> ShowS
TxDecisionPolicy -> String
(Int -> TxDecisionPolicy -> ShowS)
-> (TxDecisionPolicy -> String)
-> ([TxDecisionPolicy] -> ShowS)
-> Show TxDecisionPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxDecisionPolicy -> ShowS
showsPrec :: Int -> TxDecisionPolicy -> ShowS
$cshow :: TxDecisionPolicy -> String
show :: TxDecisionPolicy -> String
$cshowList :: [TxDecisionPolicy] -> ShowS
showList :: [TxDecisionPolicy] -> ShowS
Show)

instance NFData TxDecisionPolicy where
  rnf :: TxDecisionPolicy -> ()
rnf TxDecisionPolicy{} = ()

defaultTxDecisionPolicy :: TxDecisionPolicy
defaultTxDecisionPolicy :: TxDecisionPolicy
defaultTxDecisionPolicy =
  TxDecisionPolicy {
    maxNumTxIdsToRequest :: NumTxIdsToReq
maxNumTxIdsToRequest   = NumTxIdsToReq
6,
    maxUnacknowledgedTxIds :: NumTxIdsToReq
maxUnacknowledgedTxIds = NumTxIdsToReq
10, -- must be the same as txSubmissionMaxUnacked
    txsSizeInflightPerPeer :: SizeInBytes
txsSizeInflightPerPeer = SizeInBytes
max_TX_SIZE SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
* SizeInBytes
6,
    maxOutstandingTxBatchesPerPeer :: Int
maxOutstandingTxBatchesPerPeer = Int
4,
    txInflightMultiplicity :: Int
txInflightMultiplicity = Int
2,
    bufferedTxsMinLifetime :: DiffTime
bufferedTxsMinLifetime = DiffTime
2,
    scoreRate :: Double
scoreRate              = Double
0.001,
    scoreMax :: Double
scoreMax               = Double
15 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
60,
    scoreAcceptDecrement :: Double
scoreAcceptDecrement   = Double
3,
    interTxSpace :: DiffTime
interTxSpace           = DiffTime
0.250,
    inflightTimeout :: DiffTime
inflightTimeout        = DiffTime
0.600,
    maxPeerClaimDelay :: DiffTime
maxPeerClaimDelay      = DiffTime
0.250,
    disablePipelinedTxIdRequests :: Bool
disablePipelinedTxIdRequests = Bool
False
  }

-- | Sanity check for a 'TxDecisionPolicy': 'True' when every field lies
-- in the range the decision logic assumes.
--
-- The window and per-peer limit fields must be positive (otherwise the
-- peer can make no progress), the rate, score and delay parameters must
-- be non-negative, and 'inflightTimeout' must be at least 'interTxSpace'
-- (their difference is used as a non-negative delay when bumping a stuck
-- entry's inflight-multiplicity cap).  'defaultTxDecisionPolicy' satisfies
-- it.
saneTxDecisionPolicy :: TxDecisionPolicy -> Bool
saneTxDecisionPolicy :: TxDecisionPolicy -> Bool
saneTxDecisionPolicy TxDecisionPolicy
p =
       TxDecisionPolicy -> NumTxIdsToReq
maxNumTxIdsToRequest           TxDecisionPolicy
p NumTxIdsToReq -> NumTxIdsToReq -> Bool
forall a. Ord a => a -> a -> Bool
>= NumTxIdsToReq
1
    Bool -> Bool -> Bool
&& TxDecisionPolicy -> NumTxIdsToReq
maxUnacknowledgedTxIds         TxDecisionPolicy
p NumTxIdsToReq -> NumTxIdsToReq -> Bool
forall a. Ord a => a -> a -> Bool
>= NumTxIdsToReq
1
    Bool -> Bool -> Bool
&& TxDecisionPolicy -> SizeInBytes
txsSizeInflightPerPeer         TxDecisionPolicy
p SizeInBytes -> SizeInBytes -> Bool
forall a. Ord a => a -> a -> Bool
>  SizeInBytes
0
    Bool -> Bool -> Bool
&& TxDecisionPolicy -> Int
maxOutstandingTxBatchesPerPeer TxDecisionPolicy
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
    Bool -> Bool -> Bool
&& TxDecisionPolicy -> Int
txInflightMultiplicity         TxDecisionPolicy
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
    Bool -> Bool -> Bool
&& TxDecisionPolicy -> DiffTime
bufferedTxsMinLifetime         TxDecisionPolicy
p DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
0
    Bool -> Bool -> Bool
&& TxDecisionPolicy -> Double
scoreRate                      TxDecisionPolicy
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0
    Bool -> Bool -> Bool
&& TxDecisionPolicy -> Double
scoreMax                       TxDecisionPolicy
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0
    Bool -> Bool -> Bool
&& TxDecisionPolicy -> Double
scoreAcceptDecrement           TxDecisionPolicy
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0
    Bool -> Bool -> Bool
&& TxDecisionPolicy -> DiffTime
interTxSpace                   TxDecisionPolicy
p DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
0
    Bool -> Bool -> Bool
&& TxDecisionPolicy -> DiffTime
inflightTimeout                TxDecisionPolicy
p DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= TxDecisionPolicy -> DiffTime
interTxSpace TxDecisionPolicy
p
    Bool -> Bool -> Bool
&& TxDecisionPolicy -> DiffTime
maxPeerClaimDelay              TxDecisionPolicy
p DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
0