{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE NumericUnderscores         #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeApplications           #-}

module Ouroboros.Network.TxSubmission.Inbound.V2.Types
  ( -- * Shared state
    SharedTxState (..)
    -- * RetainedTxs with helper functions
  , RetainedTxs
  , retainedEmpty
  , retainedSingleton
  , retainedFromList
  , retainedToList
  , retainedSize
  , retainedLookup
  , retainedMember
  , retainedInsertMax
  , retainedDeleteKeys
  , retainedKeysSet
  , retainedRestrictKeys
  , retainedExpiredKeys
    -- * Traces
  , TraceTxLogic (..)
  , TxSubmissionInitDelay (..)
  , defaultTxSubmissionInitDelay
  , const_MAX_TX_SIZE_DISCREPANCY
    -- * Types shared with V1
    -- ** Various
  , ProcessedTxCount (..)
  , TxSubmissionLogicVersion (..)
    -- ** Mempool API
  , TxSubmissionMempoolWriter (..)
    -- ** Traces
  , TraceTxSubmissionInbound (..)
  , TxSubmissionCounters (..)
    -- ** Protocol Error
  , TxSubmissionProtocolError (..)
  , RequestedTxBatch (..)
  , TxLease (..)
  , TxEntry (..)
  , PeerAction (..)
  , PeerPhase (..)
  , PeerScore (..)
  , PeerTxLocalState (..)
  , PeerTxInFlight (..)
  , emptyPeerTxInFlight
    -- TxKey with helper functions
  , TxKey (..)
  , lookupTxKey
  , resolveTxKey
  , internTxId
  , internTxIds
  , emptyPeerScore
  , emptyPeerTxLocalState
  , emptySharedTxState
  , diffTimeToMilliseconds
  ) where

import Control.DeepSeq (NFData)
import Control.Exception (Exception (..))
import Control.Monad.Class.MonadTime.SI
import NoThunks.Class (NoThunks)
import NoThunks.Class.Orphans ()

import Data.List as List (foldl')
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Sequence.Strict (StrictSeq)
import Data.Time.Clock (diffTimeToPicoseconds)
import Data.Typeable (Typeable, eqT, (:~:) (Refl))
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)

import Ouroboros.Network.Protocol.TxSubmission2.Type
import Ouroboros.Network.Tx (HasRawTxId (..), RawTxId)

import Data.IntMap.Strict (IntMap)
import Data.IntMap.Strict qualified as IntMap
import Data.IntPSQ (IntPSQ)
import Data.IntPSQ qualified as IntPSQ
import Data.IntSet (IntSet)
import Data.IntSet qualified as IntSet
import Data.List (sortOn)
import Data.Sequence.Strict qualified as StrictSeq
import Data.Word (Word64)


-- | We check advertised sizes in a fuzzy way. The advertised and received
-- sizes need to agree up to this discrepancy.
const_MAX_TX_SIZE_DISCREPANCY :: SizeInBytes
const_MAX_TX_SIZE_DISCREPANCY :: SizeInBytes
const_MAX_TX_SIZE_DISCREPANCY = SizeInBytes
32

-- | Compact internal transaction key used by V2 state.
newtype TxKey = TxKey { TxKey -> Int
unTxKey :: Int }
  deriving stock (TxKey -> TxKey -> Bool
(TxKey -> TxKey -> Bool) -> (TxKey -> TxKey -> Bool) -> Eq TxKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxKey -> TxKey -> Bool
== :: TxKey -> TxKey -> Bool
$c/= :: TxKey -> TxKey -> Bool
/= :: TxKey -> TxKey -> Bool
Eq, Eq TxKey
Eq TxKey =>
(TxKey -> TxKey -> Ordering)
-> (TxKey -> TxKey -> Bool)
-> (TxKey -> TxKey -> Bool)
-> (TxKey -> TxKey -> Bool)
-> (TxKey -> TxKey -> Bool)
-> (TxKey -> TxKey -> TxKey)
-> (TxKey -> TxKey -> TxKey)
-> Ord TxKey
TxKey -> TxKey -> Bool
TxKey -> TxKey -> Ordering
TxKey -> TxKey -> TxKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TxKey -> TxKey -> Ordering
compare :: TxKey -> TxKey -> Ordering
$c< :: TxKey -> TxKey -> Bool
< :: TxKey -> TxKey -> Bool
$c<= :: TxKey -> TxKey -> Bool
<= :: TxKey -> TxKey -> Bool
$c> :: TxKey -> TxKey -> Bool
> :: TxKey -> TxKey -> Bool
$c>= :: TxKey -> TxKey -> Bool
>= :: TxKey -> TxKey -> Bool
$cmax :: TxKey -> TxKey -> TxKey
max :: TxKey -> TxKey -> TxKey
$cmin :: TxKey -> TxKey -> TxKey
min :: TxKey -> TxKey -> TxKey
Ord, Int -> TxKey -> ShowS
[TxKey] -> ShowS
TxKey -> String
(Int -> TxKey -> ShowS)
-> (TxKey -> String) -> ([TxKey] -> ShowS) -> Show TxKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxKey -> ShowS
showsPrec :: Int -> TxKey -> ShowS
$cshow :: TxKey -> String
show :: TxKey -> String
$cshowList :: [TxKey] -> ShowS
showList :: [TxKey] -> ShowS
Show, (forall x. TxKey -> Rep TxKey x)
-> (forall x. Rep TxKey x -> TxKey) -> Generic TxKey
forall x. Rep TxKey x -> TxKey
forall x. TxKey -> Rep TxKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxKey -> Rep TxKey x
from :: forall x. TxKey -> Rep TxKey x
$cto :: forall x. Rep TxKey x -> TxKey
to :: forall x. Rep TxKey x -> TxKey
Generic)
  deriving newtype (Int -> TxKey
TxKey -> Int
TxKey -> [TxKey]
TxKey -> TxKey
TxKey -> TxKey -> [TxKey]
TxKey -> TxKey -> TxKey -> [TxKey]
(TxKey -> TxKey)
-> (TxKey -> TxKey)
-> (Int -> TxKey)
-> (TxKey -> Int)
-> (TxKey -> [TxKey])
-> (TxKey -> TxKey -> [TxKey])
-> (TxKey -> TxKey -> [TxKey])
-> (TxKey -> TxKey -> TxKey -> [TxKey])
-> Enum TxKey
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TxKey -> TxKey
succ :: TxKey -> TxKey
$cpred :: TxKey -> TxKey
pred :: TxKey -> TxKey
$ctoEnum :: Int -> TxKey
toEnum :: Int -> TxKey
$cfromEnum :: TxKey -> Int
fromEnum :: TxKey -> Int
$cenumFrom :: TxKey -> [TxKey]
enumFrom :: TxKey -> [TxKey]
$cenumFromThen :: TxKey -> TxKey -> [TxKey]
enumFromThen :: TxKey -> TxKey -> [TxKey]
$cenumFromTo :: TxKey -> TxKey -> [TxKey]
enumFromTo :: TxKey -> TxKey -> [TxKey]
$cenumFromThenTo :: TxKey -> TxKey -> TxKey -> [TxKey]
enumFromThenTo :: TxKey -> TxKey -> TxKey -> [TxKey]
Enum, TxKey -> ()
(TxKey -> ()) -> NFData TxKey
forall a. (a -> ()) -> NFData a
$crnf :: TxKey -> ()
rnf :: TxKey -> ()
NFData, Context -> TxKey -> IO (Maybe ThunkInfo)
Proxy TxKey -> String
(Context -> TxKey -> IO (Maybe ThunkInfo))
-> (Context -> TxKey -> IO (Maybe ThunkInfo))
-> (Proxy TxKey -> String)
-> NoThunks TxKey
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> TxKey -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxKey -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TxKey -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxKey -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy TxKey -> String
showTypeOf :: Proxy TxKey -> String
NoThunks)

-- | The current download lease for a tx body.
--
-- A tx is either currently leased to a peer until a deadline or it is
-- unowned and became claimable at a specific time. Peers use their decayed
-- score as an additional per-peer delay after that claimable time before
-- attempting to steal the lease.
data TxLease peeraddr = TxLeased !peeraddr !Time
                      | TxClaimable !Time
  deriving stock (TxLease peeraddr -> TxLease peeraddr -> Bool
(TxLease peeraddr -> TxLease peeraddr -> Bool)
-> (TxLease peeraddr -> TxLease peeraddr -> Bool)
-> Eq (TxLease peeraddr)
forall peeraddr.
Eq peeraddr =>
TxLease peeraddr -> TxLease peeraddr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall peeraddr.
Eq peeraddr =>
TxLease peeraddr -> TxLease peeraddr -> Bool
== :: TxLease peeraddr -> TxLease peeraddr -> Bool
$c/= :: forall peeraddr.
Eq peeraddr =>
TxLease peeraddr -> TxLease peeraddr -> Bool
/= :: TxLease peeraddr -> TxLease peeraddr -> Bool
Eq, Int -> TxLease peeraddr -> ShowS
[TxLease peeraddr] -> ShowS
TxLease peeraddr -> String
(Int -> TxLease peeraddr -> ShowS)
-> (TxLease peeraddr -> String)
-> ([TxLease peeraddr] -> ShowS)
-> Show (TxLease peeraddr)
forall peeraddr. Show peeraddr => Int -> TxLease peeraddr -> ShowS
forall peeraddr. Show peeraddr => [TxLease peeraddr] -> ShowS
forall peeraddr. Show peeraddr => TxLease peeraddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall peeraddr. Show peeraddr => Int -> TxLease peeraddr -> ShowS
showsPrec :: Int -> TxLease peeraddr -> ShowS
$cshow :: forall peeraddr. Show peeraddr => TxLease peeraddr -> String
show :: TxLease peeraddr -> String
$cshowList :: forall peeraddr. Show peeraddr => [TxLease peeraddr] -> ShowS
showList :: [TxLease peeraddr] -> ShowS
Show, (forall x. TxLease peeraddr -> Rep (TxLease peeraddr) x)
-> (forall x. Rep (TxLease peeraddr) x -> TxLease peeraddr)
-> Generic (TxLease peeraddr)
forall x. Rep (TxLease peeraddr) x -> TxLease peeraddr
forall x. TxLease peeraddr -> Rep (TxLease peeraddr) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall peeraddr x. Rep (TxLease peeraddr) x -> TxLease peeraddr
forall peeraddr x. TxLease peeraddr -> Rep (TxLease peeraddr) x
$cfrom :: forall peeraddr x. TxLease peeraddr -> Rep (TxLease peeraddr) x
from :: forall x. TxLease peeraddr -> Rep (TxLease peeraddr) x
$cto :: forall peeraddr x. Rep (TxLease peeraddr) x -> TxLease peeraddr
to :: forall x. Rep (TxLease peeraddr) x -> TxLease peeraddr
Generic)
  deriving anyclass (TxLease peeraddr -> ()
(TxLease peeraddr -> ()) -> NFData (TxLease peeraddr)
forall peeraddr. NFData peeraddr => TxLease peeraddr -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall peeraddr. NFData peeraddr => TxLease peeraddr -> ()
rnf :: TxLease peeraddr -> ()
NFData, Context -> TxLease peeraddr -> IO (Maybe ThunkInfo)
Proxy (TxLease peeraddr) -> String
(Context -> TxLease peeraddr -> IO (Maybe ThunkInfo))
-> (Context -> TxLease peeraddr -> IO (Maybe ThunkInfo))
-> (Proxy (TxLease peeraddr) -> String)
-> NoThunks (TxLease peeraddr)
forall peeraddr.
NoThunks peeraddr =>
Context -> TxLease peeraddr -> IO (Maybe ThunkInfo)
forall peeraddr.
NoThunks peeraddr =>
Proxy (TxLease peeraddr) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall peeraddr.
NoThunks peeraddr =>
Context -> TxLease peeraddr -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxLease peeraddr -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall peeraddr.
NoThunks peeraddr =>
Context -> TxLease peeraddr -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxLease peeraddr -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall peeraddr.
NoThunks peeraddr =>
Proxy (TxLease peeraddr) -> String
showTypeOf :: Proxy (TxLease peeraddr) -> String
NoThunks)

-- | Shared per-tx state.
--
-- V2 keeps all cross-peer coordination at tx granularity. The first
-- peer that advertises a new txid becomes its initial owner. If the
-- lease expires without a successful outcome, the tx becomes claimable
-- and another eligible advertiser may atomically claim it.
--
-- Per-peer attempt detail is tracked in each peer's 'PeerTxInFlight'
-- TVar (owned by 'withPeer').  The shared entry only carries
-- aggregate counts: how many peers are currently attempting this body
-- and whether any peer is mid mempool submission.
data TxEntry peeraddr = TxEntry {
    -- | Current owner lease for downloading the tx body.  When
    -- 'TxClaimable', the embedded 'Time' also doubles as the
    -- last-activity stamp used by the orphan sweep.
    --
    -- Invariant: while 'TxLeased' to a registered peer, that peer's
    -- 'pifLeased' contains this key (stale leases left behind by
    -- inflight-cap theft are tolerated).
    forall peeraddr. TxEntry peeraddr -> TxLease peeraddr
txLease                        :: !(TxLease peeraddr),

    -- | Number of peers currently attempting the body (claimed lease
    -- and/or buffered locally).  Incremented on claim, decremented on
    -- omit / lease release / 'PeerSubmitTxs' transition (the
    -- submitting peer no longer counts as an attempter).
    --
    -- Invariant: equals the number of registered peers whose
    -- 'pifAttempting' contains this key.
    forall peeraddr. TxEntry peeraddr -> Int
txAttempt                      :: !Int,

    -- | At least one peer is currently inside @mempoolAddTxs@ for this
    -- body.  Other peers skip 'PeerSubmitTxs' for the key while it is
    -- set.  STM serialisation guarantees at most one peer is the
    -- submitter at any moment.
    --
    -- Invariant: true iff some registered peer's 'pifSubmitting'
    -- contains this key.
    forall peeraddr. TxEntry peeraddr -> Bool
txInSubmission                 :: !Bool,

    -- | Effective per-tx inflight multiplicity cap.
    --
    -- Initialised from 'txInflightMultiplicity' of the policy when the
    -- entry is created, and bumped by one when a peer's attempt sits past
    -- 'inflightTimeout' without reaching submission, allowing another
    -- peer to attempt in parallel.
    forall peeraddr. TxEntry peeraddr -> Int
currentMaxInflightMultiplicity :: !Int
  }
  deriving stock (TxEntry peeraddr -> TxEntry peeraddr -> Bool
(TxEntry peeraddr -> TxEntry peeraddr -> Bool)
-> (TxEntry peeraddr -> TxEntry peeraddr -> Bool)
-> Eq (TxEntry peeraddr)
forall peeraddr.
Eq peeraddr =>
TxEntry peeraddr -> TxEntry peeraddr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall peeraddr.
Eq peeraddr =>
TxEntry peeraddr -> TxEntry peeraddr -> Bool
== :: TxEntry peeraddr -> TxEntry peeraddr -> Bool
$c/= :: forall peeraddr.
Eq peeraddr =>
TxEntry peeraddr -> TxEntry peeraddr -> Bool
/= :: TxEntry peeraddr -> TxEntry peeraddr -> Bool
Eq, Int -> TxEntry peeraddr -> ShowS
[TxEntry peeraddr] -> ShowS
TxEntry peeraddr -> String
(Int -> TxEntry peeraddr -> ShowS)
-> (TxEntry peeraddr -> String)
-> ([TxEntry peeraddr] -> ShowS)
-> Show (TxEntry peeraddr)
forall peeraddr. Show peeraddr => Int -> TxEntry peeraddr -> ShowS
forall peeraddr. Show peeraddr => [TxEntry peeraddr] -> ShowS
forall peeraddr. Show peeraddr => TxEntry peeraddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall peeraddr. Show peeraddr => Int -> TxEntry peeraddr -> ShowS
showsPrec :: Int -> TxEntry peeraddr -> ShowS
$cshow :: forall peeraddr. Show peeraddr => TxEntry peeraddr -> String
show :: TxEntry peeraddr -> String
$cshowList :: forall peeraddr. Show peeraddr => [TxEntry peeraddr] -> ShowS
showList :: [TxEntry peeraddr] -> ShowS
Show, (forall x. TxEntry peeraddr -> Rep (TxEntry peeraddr) x)
-> (forall x. Rep (TxEntry peeraddr) x -> TxEntry peeraddr)
-> Generic (TxEntry peeraddr)
forall x. Rep (TxEntry peeraddr) x -> TxEntry peeraddr
forall x. TxEntry peeraddr -> Rep (TxEntry peeraddr) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall peeraddr x. Rep (TxEntry peeraddr) x -> TxEntry peeraddr
forall peeraddr x. TxEntry peeraddr -> Rep (TxEntry peeraddr) x
$cfrom :: forall peeraddr x. TxEntry peeraddr -> Rep (TxEntry peeraddr) x
from :: forall x. TxEntry peeraddr -> Rep (TxEntry peeraddr) x
$cto :: forall peeraddr x. Rep (TxEntry peeraddr) x -> TxEntry peeraddr
to :: forall x. Rep (TxEntry peeraddr) x -> TxEntry peeraddr
Generic)
  deriving anyclass (TxEntry peeraddr -> ()
(TxEntry peeraddr -> ()) -> NFData (TxEntry peeraddr)
forall peeraddr. NFData peeraddr => TxEntry peeraddr -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall peeraddr. NFData peeraddr => TxEntry peeraddr -> ()
rnf :: TxEntry peeraddr -> ()
NFData, Context -> TxEntry peeraddr -> IO (Maybe ThunkInfo)
Proxy (TxEntry peeraddr) -> String
(Context -> TxEntry peeraddr -> IO (Maybe ThunkInfo))
-> (Context -> TxEntry peeraddr -> IO (Maybe ThunkInfo))
-> (Proxy (TxEntry peeraddr) -> String)
-> NoThunks (TxEntry peeraddr)
forall peeraddr.
NoThunks peeraddr =>
Context -> TxEntry peeraddr -> IO (Maybe ThunkInfo)
forall peeraddr.
NoThunks peeraddr =>
Proxy (TxEntry peeraddr) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall peeraddr.
NoThunks peeraddr =>
Context -> TxEntry peeraddr -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxEntry peeraddr -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall peeraddr.
NoThunks peeraddr =>
Context -> TxEntry peeraddr -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxEntry peeraddr -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall peeraddr.
NoThunks peeraddr =>
Proxy (TxEntry peeraddr) -> String
showTypeOf :: Proxy (TxEntry peeraddr) -> String
NoThunks)

-- | Per-peer in-flight tracking, owned by 'withPeer'.
--
-- The peer thread updates this TVar in the same STM transaction as
-- the shared 'TxEntry' so the two stay coherent.  Two readers:
--
-- * On exception, 'withPeer's bracket finalizer reads it and reverses
--   each per-peer contribution: releases any held lease, decrements
--   'txAttempt' for each attempted key, clears 'txInSubmission' for
--   any in-flight submission.
--
-- * The sweep walks every live peer's TVar to compute the union of
--   advertised keys and skips those entries when looking for orphans
--   to retire (the entry is still wanted by an active peer that
--   may simply be slow to claim).
--
-- Invariant: 'pifAttempting' and 'pifSubmitting' are disjoint; a key
-- moves from the former to the latter atomically on the submit
-- transition.  'pifLeased' is a subset of their union.
data PeerTxInFlight = PeerTxInFlight {
    -- | Keys this peer currently has in its advertised window.  Used
    -- by the orphan sweep to know the entry is still wanted, and by
    -- 'nextWakeDelay' to scan for the earliest claim wake.
    --
    -- Invariant: a subset of the live keys (active 'sharedTxTable'
    -- union retained 'sharedRetainedTxs').
    PeerTxInFlight -> IntSet
pifAdvertised  :: !IntSet,

    -- | Keys this peer currently holds 'TxLeased' on.  Cleared on
    -- omit, accept, reject, lease-loss and bracket exit.
    PeerTxInFlight -> IntSet
pifLeased      :: !IntSet,

    -- | Keys this peer currently counts toward 'txAttempt'.  Spans
    -- the @claim -> download -> buffer@ phases; the key moves to
    -- 'pifSubmitting' on the @submit@ transition.
    PeerTxInFlight -> IntSet
pifAttempting  :: !IntSet,

    -- | Keys this peer currently counts toward 'txInSubmission'.
    -- Set on 'PeerSubmitTxs' / 'markSubmittingTxs', cleared on accept
    -- or reject.
    PeerTxInFlight -> IntSet
pifSubmitting  :: !IntSet,

    -- | Keys this peer holds in 'peerUnacknowledgedTxIds'.  A superset
    -- of 'pifAdvertised': also tracks keys the peer learned about via
    -- the retained-or-mempool path of 'handleReceivedTxIds' that are
    -- not advertised for fetch but still pending an ack.  Used by the
    -- sweep to know whether the txid lookup tables can be reclaimed.
    PeerTxInFlight -> IntSet
pifAcksPending :: !IntSet
  }
  deriving stock (PeerTxInFlight -> PeerTxInFlight -> Bool
(PeerTxInFlight -> PeerTxInFlight -> Bool)
-> (PeerTxInFlight -> PeerTxInFlight -> Bool) -> Eq PeerTxInFlight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerTxInFlight -> PeerTxInFlight -> Bool
== :: PeerTxInFlight -> PeerTxInFlight -> Bool
$c/= :: PeerTxInFlight -> PeerTxInFlight -> Bool
/= :: PeerTxInFlight -> PeerTxInFlight -> Bool
Eq, Int -> PeerTxInFlight -> ShowS
[PeerTxInFlight] -> ShowS
PeerTxInFlight -> String
(Int -> PeerTxInFlight -> ShowS)
-> (PeerTxInFlight -> String)
-> ([PeerTxInFlight] -> ShowS)
-> Show PeerTxInFlight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerTxInFlight -> ShowS
showsPrec :: Int -> PeerTxInFlight -> ShowS
$cshow :: PeerTxInFlight -> String
show :: PeerTxInFlight -> String
$cshowList :: [PeerTxInFlight] -> ShowS
showList :: [PeerTxInFlight] -> ShowS
Show, (forall x. PeerTxInFlight -> Rep PeerTxInFlight x)
-> (forall x. Rep PeerTxInFlight x -> PeerTxInFlight)
-> Generic PeerTxInFlight
forall x. Rep PeerTxInFlight x -> PeerTxInFlight
forall x. PeerTxInFlight -> Rep PeerTxInFlight x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PeerTxInFlight -> Rep PeerTxInFlight x
from :: forall x. PeerTxInFlight -> Rep PeerTxInFlight x
$cto :: forall x. Rep PeerTxInFlight x -> PeerTxInFlight
to :: forall x. Rep PeerTxInFlight x -> PeerTxInFlight
Generic)
  deriving anyclass (PeerTxInFlight -> ()
(PeerTxInFlight -> ()) -> NFData PeerTxInFlight
forall a. (a -> ()) -> NFData a
$crnf :: PeerTxInFlight -> ()
rnf :: PeerTxInFlight -> ()
NFData, Context -> PeerTxInFlight -> IO (Maybe ThunkInfo)
Proxy PeerTxInFlight -> String
(Context -> PeerTxInFlight -> IO (Maybe ThunkInfo))
-> (Context -> PeerTxInFlight -> IO (Maybe ThunkInfo))
-> (Proxy PeerTxInFlight -> String)
-> NoThunks PeerTxInFlight
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PeerTxInFlight -> IO (Maybe ThunkInfo)
noThunks :: Context -> PeerTxInFlight -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PeerTxInFlight -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PeerTxInFlight -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PeerTxInFlight -> String
showTypeOf :: Proxy PeerTxInFlight -> String
NoThunks)

emptyPeerTxInFlight :: PeerTxInFlight
emptyPeerTxInFlight :: PeerTxInFlight
emptyPeerTxInFlight = PeerTxInFlight {
    pifAdvertised :: IntSet
pifAdvertised = IntSet
IntSet.empty,
    pifLeased :: IntSet
pifLeased     = IntSet
IntSet.empty,
    pifAttempting :: IntSet
pifAttempting = IntSet
IntSet.empty,
    pifSubmitting :: IntSet
pifSubmitting = IntSet
IntSet.empty,
    pifAcksPending :: IntSet
pifAcksPending = IntSet
IntSet.empty
  }

-- | The next peer-local action chosen by the V2 worker thread.
--
-- V2 drives progress from the peer thread itself. Shared state only decides
-- whether a peer is allowed to perform an action; the peer thread then carries
-- it out directly.
data PeerAction
  = -- | No immediate work is available.  The peer should wait for either a
    -- shared-state generation change or the optional timeout.
    PeerDoNothing !Word64 !(Maybe DiffTime)
  | -- | Send a txid protocol message acknowledging the first argument and
    -- requesting the second argument.
    PeerRequestTxIds !NumTxIdsToAck !NumTxIdsToReq
  | -- | Request tx bodies for the given internally keyed txs from this peer.
    PeerRequestTxs ![TxKey]
  | -- | Submit the buffered txs identified by the given keys to the local
    -- mempool.
    PeerSubmitTxs ![TxKey]
  deriving stock (PeerAction -> PeerAction -> Bool
(PeerAction -> PeerAction -> Bool)
-> (PeerAction -> PeerAction -> Bool) -> Eq PeerAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerAction -> PeerAction -> Bool
== :: PeerAction -> PeerAction -> Bool
$c/= :: PeerAction -> PeerAction -> Bool
/= :: PeerAction -> PeerAction -> Bool
Eq, Int -> PeerAction -> ShowS
[PeerAction] -> ShowS
PeerAction -> String
(Int -> PeerAction -> ShowS)
-> (PeerAction -> String)
-> ([PeerAction] -> ShowS)
-> Show PeerAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerAction -> ShowS
showsPrec :: Int -> PeerAction -> ShowS
$cshow :: PeerAction -> String
show :: PeerAction -> String
$cshowList :: [PeerAction] -> ShowS
showList :: [PeerAction] -> ShowS
Show, (forall x. PeerAction -> Rep PeerAction x)
-> (forall x. Rep PeerAction x -> PeerAction) -> Generic PeerAction
forall x. Rep PeerAction x -> PeerAction
forall x. PeerAction -> Rep PeerAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PeerAction -> Rep PeerAction x
from :: forall x. PeerAction -> Rep PeerAction x
$cto :: forall x. Rep PeerAction x -> PeerAction
to :: forall x. Rep PeerAction x -> PeerAction
Generic)
  deriving anyclass PeerAction -> ()
(PeerAction -> ()) -> NFData PeerAction
forall a. (a -> ()) -> NFData a
$crnf :: PeerAction -> ()
rnf :: PeerAction -> ()
NFData


-- | A batch of transaction body requests sent to a peer.
--
-- Tracks the set of requested txids and the total expected
-- size in bytes for the batch. Used to manage inflight requests and match
-- responses to the original request.
data RequestedTxBatch = RequestedTxBatch {
    -- | The set of transaction keys requested in this batch.
    RequestedTxBatch -> IntSet
requestedTxBatchSet      :: !IntSet

    -- | Total expected size in bytes for all tx bodies in this batch.
  ,     RequestedTxBatch -> SizeInBytes
requestedTxBatchSize :: !SizeInBytes
  }
  deriving stock (RequestedTxBatch -> RequestedTxBatch -> Bool
(RequestedTxBatch -> RequestedTxBatch -> Bool)
-> (RequestedTxBatch -> RequestedTxBatch -> Bool)
-> Eq RequestedTxBatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestedTxBatch -> RequestedTxBatch -> Bool
== :: RequestedTxBatch -> RequestedTxBatch -> Bool
$c/= :: RequestedTxBatch -> RequestedTxBatch -> Bool
/= :: RequestedTxBatch -> RequestedTxBatch -> Bool
Eq, Int -> RequestedTxBatch -> ShowS
[RequestedTxBatch] -> ShowS
RequestedTxBatch -> String
(Int -> RequestedTxBatch -> ShowS)
-> (RequestedTxBatch -> String)
-> ([RequestedTxBatch] -> ShowS)
-> Show RequestedTxBatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestedTxBatch -> ShowS
showsPrec :: Int -> RequestedTxBatch -> ShowS
$cshow :: RequestedTxBatch -> String
show :: RequestedTxBatch -> String
$cshowList :: [RequestedTxBatch] -> ShowS
showList :: [RequestedTxBatch] -> ShowS
Show, (forall x. RequestedTxBatch -> Rep RequestedTxBatch x)
-> (forall x. Rep RequestedTxBatch x -> RequestedTxBatch)
-> Generic RequestedTxBatch
forall x. Rep RequestedTxBatch x -> RequestedTxBatch
forall x. RequestedTxBatch -> Rep RequestedTxBatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RequestedTxBatch -> Rep RequestedTxBatch x
from :: forall x. RequestedTxBatch -> Rep RequestedTxBatch x
$cto :: forall x. Rep RequestedTxBatch x -> RequestedTxBatch
to :: forall x. Rep RequestedTxBatch x -> RequestedTxBatch
Generic)
  deriving anyclass (RequestedTxBatch -> ()
(RequestedTxBatch -> ()) -> NFData RequestedTxBatch
forall a. (a -> ()) -> NFData a
$crnf :: RequestedTxBatch -> ()
rnf :: RequestedTxBatch -> ()
NFData, Context -> RequestedTxBatch -> IO (Maybe ThunkInfo)
Proxy RequestedTxBatch -> String
(Context -> RequestedTxBatch -> IO (Maybe ThunkInfo))
-> (Context -> RequestedTxBatch -> IO (Maybe ThunkInfo))
-> (Proxy RequestedTxBatch -> String)
-> NoThunks RequestedTxBatch
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> RequestedTxBatch -> IO (Maybe ThunkInfo)
noThunks :: Context -> RequestedTxBatch -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RequestedTxBatch -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> RequestedTxBatch -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy RequestedTxBatch -> String
showTypeOf :: Proxy RequestedTxBatch -> String
NoThunks)

-- | Coarse phase of a peer worker thread.
--
-- The phase is used when deciding whether a peer is currently eligible
-- to claim an expired tx lease.
data PeerPhase
  = -- | The peer worker is idle and may claim work for advertised txs.
    PeerIdle
  | -- | The peer worker is waiting for a txid reply from the remote peer.
    PeerWaitingTxIds
  | -- | The peer worker is waiting for a tx-body reply from the remote peer.
    PeerWaitingTxs
  | -- | The peer worker is submitting buffered txs to the local mempool.
    PeerSubmittingToMempool
  deriving stock (PeerPhase -> PeerPhase -> Bool
(PeerPhase -> PeerPhase -> Bool)
-> (PeerPhase -> PeerPhase -> Bool) -> Eq PeerPhase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerPhase -> PeerPhase -> Bool
== :: PeerPhase -> PeerPhase -> Bool
$c/= :: PeerPhase -> PeerPhase -> Bool
/= :: PeerPhase -> PeerPhase -> Bool
Eq, Eq PeerPhase
Eq PeerPhase =>
(PeerPhase -> PeerPhase -> Ordering)
-> (PeerPhase -> PeerPhase -> Bool)
-> (PeerPhase -> PeerPhase -> Bool)
-> (PeerPhase -> PeerPhase -> Bool)
-> (PeerPhase -> PeerPhase -> Bool)
-> (PeerPhase -> PeerPhase -> PeerPhase)
-> (PeerPhase -> PeerPhase -> PeerPhase)
-> Ord PeerPhase
PeerPhase -> PeerPhase -> Bool
PeerPhase -> PeerPhase -> Ordering
PeerPhase -> PeerPhase -> PeerPhase
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PeerPhase -> PeerPhase -> Ordering
compare :: PeerPhase -> PeerPhase -> Ordering
$c< :: PeerPhase -> PeerPhase -> Bool
< :: PeerPhase -> PeerPhase -> Bool
$c<= :: PeerPhase -> PeerPhase -> Bool
<= :: PeerPhase -> PeerPhase -> Bool
$c> :: PeerPhase -> PeerPhase -> Bool
> :: PeerPhase -> PeerPhase -> Bool
$c>= :: PeerPhase -> PeerPhase -> Bool
>= :: PeerPhase -> PeerPhase -> Bool
$cmax :: PeerPhase -> PeerPhase -> PeerPhase
max :: PeerPhase -> PeerPhase -> PeerPhase
$cmin :: PeerPhase -> PeerPhase -> PeerPhase
min :: PeerPhase -> PeerPhase -> PeerPhase
Ord, Int -> PeerPhase -> ShowS
[PeerPhase] -> ShowS
PeerPhase -> String
(Int -> PeerPhase -> ShowS)
-> (PeerPhase -> String)
-> ([PeerPhase] -> ShowS)
-> Show PeerPhase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerPhase -> ShowS
showsPrec :: Int -> PeerPhase -> ShowS
$cshow :: PeerPhase -> String
show :: PeerPhase -> String
$cshowList :: [PeerPhase] -> ShowS
showList :: [PeerPhase] -> ShowS
Show, (forall x. PeerPhase -> Rep PeerPhase x)
-> (forall x. Rep PeerPhase x -> PeerPhase) -> Generic PeerPhase
forall x. Rep PeerPhase x -> PeerPhase
forall x. PeerPhase -> Rep PeerPhase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PeerPhase -> Rep PeerPhase x
from :: forall x. PeerPhase -> Rep PeerPhase x
$cto :: forall x. Rep PeerPhase x -> PeerPhase
to :: forall x. Rep PeerPhase x -> PeerPhase
Generic)
  deriving anyclass PeerPhase -> ()
(PeerPhase -> ()) -> NFData PeerPhase
forall a. (a -> ()) -> NFData a
$crnf :: PeerPhase -> ()
rnf :: PeerPhase -> ()
NFData

instance NoThunks PeerPhase

-- | Peer usefulness score.
--
-- Lower is better. The current score is also interpreted as milliseconds of
-- extra delay before an idle peer may steal a claimable or expired tx lease.
data PeerScore = PeerScore {
    PeerScore -> Double
peerScoreValue :: !Double,
    PeerScore -> Time
peerScoreTs    :: !Time
  }
  deriving stock (PeerScore -> PeerScore -> Bool
(PeerScore -> PeerScore -> Bool)
-> (PeerScore -> PeerScore -> Bool) -> Eq PeerScore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerScore -> PeerScore -> Bool
== :: PeerScore -> PeerScore -> Bool
$c/= :: PeerScore -> PeerScore -> Bool
/= :: PeerScore -> PeerScore -> Bool
Eq, Int -> PeerScore -> ShowS
[PeerScore] -> ShowS
PeerScore -> String
(Int -> PeerScore -> ShowS)
-> (PeerScore -> String)
-> ([PeerScore] -> ShowS)
-> Show PeerScore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerScore -> ShowS
showsPrec :: Int -> PeerScore -> ShowS
$cshow :: PeerScore -> String
show :: PeerScore -> String
$cshowList :: [PeerScore] -> ShowS
showList :: [PeerScore] -> ShowS
Show, (forall x. PeerScore -> Rep PeerScore x)
-> (forall x. Rep PeerScore x -> PeerScore) -> Generic PeerScore
forall x. Rep PeerScore x -> PeerScore
forall x. PeerScore -> Rep PeerScore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PeerScore -> Rep PeerScore x
from :: forall x. PeerScore -> Rep PeerScore x
$cto :: forall x. Rep PeerScore x -> PeerScore
to :: forall x. Rep PeerScore x -> PeerScore
Generic)
  deriving anyclass (PeerScore -> ()
(PeerScore -> ()) -> NFData PeerScore
forall a. (a -> ()) -> NFData a
$crnf :: PeerScore -> ()
rnf :: PeerScore -> ()
NFData, Context -> PeerScore -> IO (Maybe ThunkInfo)
Proxy PeerScore -> String
(Context -> PeerScore -> IO (Maybe ThunkInfo))
-> (Context -> PeerScore -> IO (Maybe ThunkInfo))
-> (Proxy PeerScore -> String)
-> NoThunks PeerScore
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PeerScore -> IO (Maybe ThunkInfo)
noThunks :: Context -> PeerScore -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PeerScore -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PeerScore -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PeerScore -> String
showTypeOf :: Proxy PeerScore -> String
NoThunks)

-- | Low-cost monotonic counters for the V2 peer protocol and coordination path.
--
-- These counters are updated incrementally at the points where V2 performs
-- protocol sends, receives replies, or cheaply classifies received bodies.
-- They are kept separate from 'SharedTxState' so that emission can read a
-- small dedicated counter cell without scanning protocol state.
data TxSubmissionCounters = TxSubmissionCounters {
    TxSubmissionCounters -> Word64
txIdMessagesSent      :: !Word64,
    -- ^ Number of txid request messages sent (@MsgRequestTxIds@, blocking or
    -- pipelined).
    TxSubmissionCounters -> Word64
txIdsRequested        :: !Word64,
    -- ^ Total number of txids requested across all txid request messages (sum
    -- of @NumTxIdsToReq@ values).
    TxSubmissionCounters -> Word64
txIdRepliesReceived   :: !Word64,
    -- ^ Number of txid reply messages received (@MsgReplyTxIds@).
    TxSubmissionCounters -> Word64
txIdsReceived         :: !Word64,
    -- ^ Total number of txid-size pairs received across all txid replies.
    TxSubmissionCounters -> Word64
txMessagesSent        :: !Word64,
    -- ^ Number of tx body request messages sent (@MsgRequestTxs@).
    TxSubmissionCounters -> Word64
txsRequested          :: !Word64,
    -- ^ Total number of tx bodies requested across all body request messages.
    TxSubmissionCounters -> Word64
txRepliesReceived     :: !Word64,
    -- ^ Number of tx body reply messages received (@MsgReplyTxs@).
    TxSubmissionCounters -> Word64
txsReceived           :: !Word64,
    -- ^ Total number of tx bodies received across all body replies.
    TxSubmissionCounters -> Word64
txsOmitted            :: !Word64,
    -- ^ Number of requested tx bodies the peer omitted from its reply.
    TxSubmissionCounters -> Word64
lateBodies            :: !Word64,
    -- ^ Number of tx bodies received after the local state had already
    -- resolved them (txid was found in the mempool before the body arrived).
    TxSubmissionCounters -> Word64
txsAccepted           :: !Word64,
    -- ^ Tx bodies resolved into the mempool (includes txs found already present
    -- before attempting submission).
    TxSubmissionCounters -> Word64
txsRejected           :: !Word64,
    -- ^ Tx bodies rejected by the mempool.
    TxSubmissionCounters -> Word64
txIdBlockingReqsSent  :: !Word64,
    -- ^ Txid request messages sent as blocking requests.
    TxSubmissionCounters -> Word64
txIdPipelinedReqsSent :: !Word64,
    -- ^ Txid request messages sent as pipelined (non-blocking) requests.
    TxSubmissionCounters -> Word64
txIdBlockingWaitMs    :: !Word64,
    -- ^ Cumulative milliseconds spent waiting for replies to blocking txid
    -- requests.  High values indicate the system is mostly idle (no new
    -- transactions available from peers).
    TxSubmissionCounters -> Word64
txPipelineWaitMs      :: !Word64,
    -- ^ Cumulative milliseconds the pipeline was active, measured from the
    -- first 'MsgRequestTxs' send until all pipelined requests (both body and
    -- txid) have been replied to and the pipeline fully drains.  Proxy for
    -- the "loading" state where the peer is actively downloading transactions.
    TxSubmissionCounters -> Word64
txSubmissionWaitMs    :: !Word64
    -- ^ Cumulative milliseconds spent inside 'mempoolAddTxs'.  Covers both
    -- normal submission latency and time blocked due to a full mempool.
    -- High values relative to the other duration fields indicate mempool
    -- backpressure.
  }
  deriving stock (TxSubmissionCounters -> TxSubmissionCounters -> Bool
(TxSubmissionCounters -> TxSubmissionCounters -> Bool)
-> (TxSubmissionCounters -> TxSubmissionCounters -> Bool)
-> Eq TxSubmissionCounters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSubmissionCounters -> TxSubmissionCounters -> Bool
== :: TxSubmissionCounters -> TxSubmissionCounters -> Bool
$c/= :: TxSubmissionCounters -> TxSubmissionCounters -> Bool
/= :: TxSubmissionCounters -> TxSubmissionCounters -> Bool
Eq, Int -> TxSubmissionCounters -> ShowS
[TxSubmissionCounters] -> ShowS
TxSubmissionCounters -> String
(Int -> TxSubmissionCounters -> ShowS)
-> (TxSubmissionCounters -> String)
-> ([TxSubmissionCounters] -> ShowS)
-> Show TxSubmissionCounters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSubmissionCounters -> ShowS
showsPrec :: Int -> TxSubmissionCounters -> ShowS
$cshow :: TxSubmissionCounters -> String
show :: TxSubmissionCounters -> String
$cshowList :: [TxSubmissionCounters] -> ShowS
showList :: [TxSubmissionCounters] -> ShowS
Show, (forall x. TxSubmissionCounters -> Rep TxSubmissionCounters x)
-> (forall x. Rep TxSubmissionCounters x -> TxSubmissionCounters)
-> Generic TxSubmissionCounters
forall x. Rep TxSubmissionCounters x -> TxSubmissionCounters
forall x. TxSubmissionCounters -> Rep TxSubmissionCounters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxSubmissionCounters -> Rep TxSubmissionCounters x
from :: forall x. TxSubmissionCounters -> Rep TxSubmissionCounters x
$cto :: forall x. Rep TxSubmissionCounters x -> TxSubmissionCounters
to :: forall x. Rep TxSubmissionCounters x -> TxSubmissionCounters
Generic)
  deriving anyclass TxSubmissionCounters -> ()
(TxSubmissionCounters -> ()) -> NFData TxSubmissionCounters
forall a. (a -> ()) -> NFData a
$crnf :: TxSubmissionCounters -> ()
rnf :: TxSubmissionCounters -> ()
NFData

instance Semigroup TxSubmissionCounters where
  TxSubmissionCounters
a <> :: TxSubmissionCounters
-> TxSubmissionCounters -> TxSubmissionCounters
<> TxSubmissionCounters
b = TxSubmissionCounters {
    txIdMessagesSent :: Word64
txIdMessagesSent    = TxSubmissionCounters -> Word64
txIdMessagesSent TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txIdMessagesSent TxSubmissionCounters
b,
    txIdsRequested :: Word64
txIdsRequested      = TxSubmissionCounters -> Word64
txIdsRequested TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txIdsRequested TxSubmissionCounters
b,
    txIdRepliesReceived :: Word64
txIdRepliesReceived = TxSubmissionCounters -> Word64
txIdRepliesReceived TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txIdRepliesReceived TxSubmissionCounters
b,
    txIdsReceived :: Word64
txIdsReceived      = TxSubmissionCounters -> Word64
txIdsReceived TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txIdsReceived TxSubmissionCounters
b,
    txMessagesSent :: Word64
txMessagesSent = TxSubmissionCounters -> Word64
txMessagesSent TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txMessagesSent TxSubmissionCounters
b,
    txsRequested :: Word64
txsRequested = TxSubmissionCounters -> Word64
txsRequested TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txsRequested TxSubmissionCounters
b,
    txRepliesReceived :: Word64
txRepliesReceived = TxSubmissionCounters -> Word64
txRepliesReceived TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txRepliesReceived TxSubmissionCounters
b,
    txsReceived :: Word64
txsReceived = TxSubmissionCounters -> Word64
txsReceived TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txsReceived TxSubmissionCounters
b,
    txsOmitted :: Word64
txsOmitted = TxSubmissionCounters -> Word64
txsOmitted TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txsOmitted TxSubmissionCounters
b,
    lateBodies :: Word64
lateBodies = TxSubmissionCounters -> Word64
lateBodies TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
lateBodies TxSubmissionCounters
b,
    txsAccepted :: Word64
txsAccepted = TxSubmissionCounters -> Word64
txsAccepted TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txsAccepted TxSubmissionCounters
b,
    txsRejected :: Word64
txsRejected = TxSubmissionCounters -> Word64
txsRejected TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txsRejected TxSubmissionCounters
b,
    txIdBlockingReqsSent :: Word64
txIdBlockingReqsSent  = TxSubmissionCounters -> Word64
txIdBlockingReqsSent  TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txIdBlockingReqsSent  TxSubmissionCounters
b,
    txIdPipelinedReqsSent :: Word64
txIdPipelinedReqsSent = TxSubmissionCounters -> Word64
txIdPipelinedReqsSent TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txIdPipelinedReqsSent TxSubmissionCounters
b,
    txIdBlockingWaitMs :: Word64
txIdBlockingWaitMs    = TxSubmissionCounters -> Word64
txIdBlockingWaitMs    TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txIdBlockingWaitMs    TxSubmissionCounters
b,
    txPipelineWaitMs :: Word64
txPipelineWaitMs      = TxSubmissionCounters -> Word64
txPipelineWaitMs      TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txPipelineWaitMs      TxSubmissionCounters
b,
    txSubmissionWaitMs :: Word64
txSubmissionWaitMs    = TxSubmissionCounters -> Word64
txSubmissionWaitMs    TxSubmissionCounters
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txSubmissionWaitMs    TxSubmissionCounters
b
    }

instance Monoid TxSubmissionCounters where
  mempty :: TxSubmissionCounters
mempty = TxSubmissionCounters {
    txIdMessagesSent :: Word64
txIdMessagesSent = Word64
0,
    txIdsRequested :: Word64
txIdsRequested = Word64
0,
    txIdRepliesReceived :: Word64
txIdRepliesReceived = Word64
0,
    txIdsReceived :: Word64
txIdsReceived = Word64
0,
    txMessagesSent :: Word64
txMessagesSent = Word64
0,
    txsRequested :: Word64
txsRequested = Word64
0,
    txRepliesReceived :: Word64
txRepliesReceived = Word64
0,
    txsReceived :: Word64
txsReceived = Word64
0,
    txsOmitted :: Word64
txsOmitted = Word64
0,
    lateBodies :: Word64
lateBodies = Word64
0,
    txsAccepted :: Word64
txsAccepted = Word64
0,
    txsRejected :: Word64
txsRejected = Word64
0,
    txIdBlockingReqsSent :: Word64
txIdBlockingReqsSent  = Word64
0,
    txIdPipelinedReqsSent :: Word64
txIdPipelinedReqsSent = Word64
0,
    txIdBlockingWaitMs :: Word64
txIdBlockingWaitMs    = Word64
0,
    txPipelineWaitMs :: Word64
txPipelineWaitMs      = Word64
0,
    txSubmissionWaitMs :: Word64
txSubmissionWaitMs    = Word64
0
  }

-- | Convert a non-negative 'DiffTime' to whole milliseconds (truncated).
--
-- Works directly on the underlying picosecond 'Integer' to avoid the
-- 'realToFrac' detour through 'Rational' and 'Double'.
diffTimeToMilliseconds :: DiffTime -> Word64
diffTimeToMilliseconds :: DiffTime -> Word64
diffTimeToMilliseconds = Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> (DiffTime -> Integer) -> DiffTime -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1_000_000_000) (Integer -> Integer)
-> (DiffTime -> Integer) -> DiffTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToPicoseconds

emptyPeerScore :: Time -> PeerScore
emptyPeerScore :: Time -> PeerScore
emptyPeerScore Time
scoreTs = PeerScore {
    peerScoreValue :: Double
peerScoreValue = Double
0,
    peerScoreTs :: Time
peerScoreTs    = Time
scoreTs
  }

-- | Per-peer protocol state.
--
-- Owned by the worker thread for one peer. Includes the peer's coarse
-- protocol phase ('peerPhase'), which is purely peer-local: only this
-- peer's own scheduler reads and updates it, so it doesn't belong in
-- shared state.
--
-- Invariants (see @peerTxLocalStateInvariant@):
--
-- * 'peerRequestedTxs' is a subset of the 'peerAvailableTxIds' keys,
--   which are a subset of the 'peerUnacknowledgedTxIds' keys.
-- * 'peerDownloadedTxs' keys are a subset of the unacknowledged queue
--   and disjoint from both 'peerAvailableTxIds' and 'peerRequestedTxs':
--   a key leaves available/requested exactly when its body lands in
--   downloaded.
-- * 'peerRequestedTxs' equals the union of every batch's
--   'requestedTxBatchSet', and 'peerRequestedTxsSize' the sum of their
--   'requestedTxBatchSize'.
-- * the 'peerScore' value stays in @[0, scoreMax]@.
data PeerTxLocalState tx = PeerTxLocalState {
    -- | Coarse phase of this peer's worker thread. Updated by
    -- 'nextPeerAction' / 'nextPeerActionPipelined' when an action is
    -- chosen and inspected in 'serverIdle' to decide whether to skip
    -- 'awaitSharedChange' on an Active->Idle transition.
    forall tx. PeerTxLocalState tx -> PeerPhase
peerPhase                 :: !PeerPhase,

    -- | Unacknowledged txids in the order advertised by the peer.
    forall tx. PeerTxLocalState tx -> StrictSeq TxKey
peerUnacknowledgedTxIds   :: !(StrictSeq TxKey),

    -- | Txids this peer currently advertises and that may be requested from
    -- it if the peer becomes the owner.
    forall tx. PeerTxLocalState tx -> IntMap SizeInBytes
peerAvailableTxIds        :: !(IntMap SizeInBytes),

    -- | Requested txids that have not yet been replied to.
    forall tx. PeerTxLocalState tx -> IntSet
peerRequestedTxs          :: !IntSet,

    -- | Outstanding tx-body request batches, in request order.  Their
    -- 'requestedTxBatchSet's union to 'peerRequestedTxs' and their
    -- 'requestedTxBatchSize's sum to 'peerRequestedTxsSize'.
    forall tx. PeerTxLocalState tx -> StrictSeq RequestedTxBatch
peerRequestedTxBatches    :: !(StrictSeq RequestedTxBatch),

    -- | Total serialized size of all outstanding requested tx bodies.
    forall tx. PeerTxLocalState tx -> SizeInBytes
peerRequestedTxsSize      :: !SizeInBytes,

    -- | Number of txids requested from this peer but not yet replied to
    -- (the in-flight txid-request window).
    forall tx. PeerTxLocalState tx -> NumTxIdsToReq
peerRequestedTxIds        :: !NumTxIdsToReq,

    -- | Tx bodies downloaded from this peer and buffered locally until they
    -- are either submitted to the mempool or superseded by shared-state
    -- resolution.
    forall tx. PeerTxLocalState tx -> IntMap tx
peerDownloadedTxs         :: !(IntMap tx),

    -- | Time at which the first outstanding body-request batch was
    -- sent in the current download episode.
    forall tx. PeerTxLocalState tx -> Maybe Time
peerDownloadStartTime     :: !(Maybe Time),

    -- | Usefulness score for this peer, tracking rejection penalties and
    -- time-based decay.
    forall tx. PeerTxLocalState tx -> PeerScore
peerScore                 :: !PeerScore,

    -- | Set on a txid reply that returned zero new txids; cleared on a
    -- non-empty txid reply or when the mempool accepts at least one tx
    -- delivered by this peer.
    forall tx. PeerTxLocalState tx -> Bool
peerLastTxIdReplyWasEmpty :: !Bool
  }
  deriving stock (PeerTxLocalState tx -> PeerTxLocalState tx -> Bool
(PeerTxLocalState tx -> PeerTxLocalState tx -> Bool)
-> (PeerTxLocalState tx -> PeerTxLocalState tx -> Bool)
-> Eq (PeerTxLocalState tx)
forall tx.
Eq tx =>
PeerTxLocalState tx -> PeerTxLocalState tx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tx.
Eq tx =>
PeerTxLocalState tx -> PeerTxLocalState tx -> Bool
== :: PeerTxLocalState tx -> PeerTxLocalState tx -> Bool
$c/= :: forall tx.
Eq tx =>
PeerTxLocalState tx -> PeerTxLocalState tx -> Bool
/= :: PeerTxLocalState tx -> PeerTxLocalState tx -> Bool
Eq, Int -> PeerTxLocalState tx -> ShowS
[PeerTxLocalState tx] -> ShowS
PeerTxLocalState tx -> String
(Int -> PeerTxLocalState tx -> ShowS)
-> (PeerTxLocalState tx -> String)
-> ([PeerTxLocalState tx] -> ShowS)
-> Show (PeerTxLocalState tx)
forall tx. Show tx => Int -> PeerTxLocalState tx -> ShowS
forall tx. Show tx => [PeerTxLocalState tx] -> ShowS
forall tx. Show tx => PeerTxLocalState tx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall tx. Show tx => Int -> PeerTxLocalState tx -> ShowS
showsPrec :: Int -> PeerTxLocalState tx -> ShowS
$cshow :: forall tx. Show tx => PeerTxLocalState tx -> String
show :: PeerTxLocalState tx -> String
$cshowList :: forall tx. Show tx => [PeerTxLocalState tx] -> ShowS
showList :: [PeerTxLocalState tx] -> ShowS
Show, (forall x. PeerTxLocalState tx -> Rep (PeerTxLocalState tx) x)
-> (forall x. Rep (PeerTxLocalState tx) x -> PeerTxLocalState tx)
-> Generic (PeerTxLocalState tx)
forall x. Rep (PeerTxLocalState tx) x -> PeerTxLocalState tx
forall x. PeerTxLocalState tx -> Rep (PeerTxLocalState tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (PeerTxLocalState tx) x -> PeerTxLocalState tx
forall tx x. PeerTxLocalState tx -> Rep (PeerTxLocalState tx) x
$cfrom :: forall tx x. PeerTxLocalState tx -> Rep (PeerTxLocalState tx) x
from :: forall x. PeerTxLocalState tx -> Rep (PeerTxLocalState tx) x
$cto :: forall tx x. Rep (PeerTxLocalState tx) x -> PeerTxLocalState tx
to :: forall x. Rep (PeerTxLocalState tx) x -> PeerTxLocalState tx
Generic)
  deriving anyclass (PeerTxLocalState tx -> ()
(PeerTxLocalState tx -> ()) -> NFData (PeerTxLocalState tx)
forall tx. NFData tx => PeerTxLocalState tx -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall tx. NFData tx => PeerTxLocalState tx -> ()
rnf :: PeerTxLocalState tx -> ()
NFData, Context -> PeerTxLocalState tx -> IO (Maybe ThunkInfo)
Proxy (PeerTxLocalState tx) -> String
(Context -> PeerTxLocalState tx -> IO (Maybe ThunkInfo))
-> (Context -> PeerTxLocalState tx -> IO (Maybe ThunkInfo))
-> (Proxy (PeerTxLocalState tx) -> String)
-> NoThunks (PeerTxLocalState tx)
forall tx.
NoThunks tx =>
Context -> PeerTxLocalState tx -> IO (Maybe ThunkInfo)
forall tx. NoThunks tx => Proxy (PeerTxLocalState tx) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall tx.
NoThunks tx =>
Context -> PeerTxLocalState tx -> IO (Maybe ThunkInfo)
noThunks :: Context -> PeerTxLocalState tx -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall tx.
NoThunks tx =>
Context -> PeerTxLocalState tx -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PeerTxLocalState tx -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall tx. NoThunks tx => Proxy (PeerTxLocalState tx) -> String
showTypeOf :: Proxy (PeerTxLocalState tx) -> String
NoThunks)

emptyPeerTxLocalState :: PeerTxLocalState tx
emptyPeerTxLocalState :: forall tx. PeerTxLocalState tx
emptyPeerTxLocalState = PeerTxLocalState {
    peerPhase :: PeerPhase
peerPhase                 = PeerPhase
PeerIdle,
    peerUnacknowledgedTxIds :: StrictSeq TxKey
peerUnacknowledgedTxIds   = StrictSeq TxKey
forall a. StrictSeq a
StrictSeq.empty,
    peerAvailableTxIds :: IntMap SizeInBytes
peerAvailableTxIds        = IntMap SizeInBytes
forall a. IntMap a
IntMap.empty,
    peerRequestedTxs :: IntSet
peerRequestedTxs          = IntSet
IntSet.empty,
    peerRequestedTxBatches :: StrictSeq RequestedTxBatch
peerRequestedTxBatches    = StrictSeq RequestedTxBatch
forall a. StrictSeq a
StrictSeq.empty,
    peerRequestedTxsSize :: SizeInBytes
peerRequestedTxsSize      = SizeInBytes
0,
    peerRequestedTxIds :: NumTxIdsToReq
peerRequestedTxIds        = NumTxIdsToReq
0,
    peerDownloadedTxs :: IntMap tx
peerDownloadedTxs         = IntMap tx
forall a. IntMap a
IntMap.empty,
    peerDownloadStartTime :: Maybe Time
peerDownloadStartTime     = Maybe Time
forall a. Maybe a
Nothing,
    peerScore :: PeerScore
peerScore                 = Time -> PeerScore
emptyPeerScore (DiffTime -> Time
Time DiffTime
0),
    peerLastTxIdReplyWasEmpty :: Bool
peerLastTxIdReplyWasEmpty = Bool
False
  }

-- | Shared V2 state.
--
-- There is no global decision thread. Peer worker threads coordinate by
-- atomically reading and updating this shared state.
--
-- Invariants (see @sharedTxStateInvariant@):
--
-- * the active ('sharedTxTable') and retained ('sharedRetainedTxs') key
--   sets are disjoint.
-- * 'sharedTxIdToKey' and 'sharedKeyToTxId' are mutual inverses (equal
--   size, round-tripping in both directions).
-- * every live key (active union retained) is present in those two maps.
-- * 'sharedNextTxKey' is strictly greater than every live key, so a
--   freshly interned key never collides with a live one.
--
-- Cross-step (see @sharedGenerationBumpInvariant@): both counters are
-- monotone non-decreasing, and any transition that changes some other
-- field must advance 'sharedGeneration' or 'sharedRevision';
-- @writeSharedStateIfChanged@ silently drops a commit that bumps neither.
data SharedTxState peeraddr txid = SharedTxState {
    -- | Active unresolved txs that still participate in leasing, buffering,
    -- submission and advertiser tracking.
    forall peeraddr txid.
SharedTxState peeraddr txid -> IntMap (TxEntry peeraddr)
sharedTxTable     :: !(IntMap (TxEntry peeraddr)),
    -- | Accepted txs retained locally for a bounded time so later txid
    -- advertisements can be acked without re-requesting the body.
    forall peeraddr txid. SharedTxState peeraddr txid -> RetainedTxs
sharedRetainedTxs :: !RetainedTxs,
    -- | Forward txid interning table: maps a raw txid to its compact
    -- 'TxKey'.  Inverse of 'sharedKeyToTxId'.
    forall peeraddr txid.
SharedTxState peeraddr txid -> Map (RawTxId txid) TxKey
sharedTxIdToKey   :: !(Map (RawTxId txid) TxKey),
    -- | Reverse interning table: maps a 'TxKey' back to its txid.
    -- Inverse of 'sharedTxIdToKey'.
    forall peeraddr txid. SharedTxState peeraddr txid -> IntMap txid
sharedKeyToTxId   :: !(IntMap txid),
    -- | Next fresh 'TxKey' to allocate; stays strictly greater than every
    -- live key.
    forall peeraddr txid. SharedTxState peeraddr txid -> Int
sharedNextTxKey   :: !Int,
    -- | Wake counter.  Bumped on transitions that may grant other peers a
    -- new option (lease release, new entry accepted into the mempool, cap
    -- bump, ...).  Parked peers watch this via 'awaitSharedChange'.
    forall peeraddr txid. SharedTxState peeraddr txid -> Word64
sharedGeneration  :: !Word64,
    -- | Structural dirty bit.  Bumped on most structural changes; used by
    -- 'writeSharedStateIfChanged' (paired with 'sharedGeneration') to skip
    -- redundant TVar writes.  A change to either counter triggers a write.
    forall peeraddr txid. SharedTxState peeraddr txid -> Word64
sharedRevision    :: !Word64
  }
  deriving stock (forall x.
 SharedTxState peeraddr txid -> Rep (SharedTxState peeraddr txid) x)
-> (forall x.
    Rep (SharedTxState peeraddr txid) x -> SharedTxState peeraddr txid)
-> Generic (SharedTxState peeraddr txid)
forall x.
Rep (SharedTxState peeraddr txid) x -> SharedTxState peeraddr txid
forall x.
SharedTxState peeraddr txid -> Rep (SharedTxState peeraddr txid) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall peeraddr txid x.
Rep (SharedTxState peeraddr txid) x -> SharedTxState peeraddr txid
forall peeraddr txid x.
SharedTxState peeraddr txid -> Rep (SharedTxState peeraddr txid) x
$cfrom :: forall peeraddr txid x.
SharedTxState peeraddr txid -> Rep (SharedTxState peeraddr txid) x
from :: forall x.
SharedTxState peeraddr txid -> Rep (SharedTxState peeraddr txid) x
$cto :: forall peeraddr txid x.
Rep (SharedTxState peeraddr txid) x -> SharedTxState peeraddr txid
to :: forall x.
Rep (SharedTxState peeraddr txid) x -> SharedTxState peeraddr txid
Generic

deriving stock instance (Eq peeraddr, Eq txid, HasRawTxId txid) => Eq (SharedTxState peeraddr txid)
deriving stock instance (Show peeraddr, Show txid, HasRawTxId txid) => Show (SharedTxState peeraddr txid)
deriving anyclass instance (NFData peeraddr, NFData txid, HasRawTxId txid) => NFData (SharedTxState peeraddr txid)
deriving anyclass instance (NoThunks peeraddr, NoThunks txid, HasRawTxId txid) => NoThunks (SharedTxState peeraddr txid)

-- | Keys of transactions tx-submission knows are in the mempool, kept for a
-- a limited time.
--
-- A key enters whenever we learns that the tx is in the mempool:
--
-- * a body we submitted is accepted, or
-- * a peer announces a txid, or delivers a body, that the mempool
--   already holds. Could be due to earlier fetches, or the TX may have
--   arrived through the LocalTxSubmission protocol.
--
-- In each case the key is dropped from the active 'sharedTxTable' and
-- inserted here with deadline @now + bufferedTxsMinLifetime@ (re-insert
-- keeps the later deadline).  A key leaves only when that deadline passes
-- and the shared-state sweep removes it, independent of whether peers
-- have acked it yet.
--
-- While retained a key counts as resolved: its txid may be acked to the
-- announcing peers, and a re-announced txid or late-arriving body is
-- treated as already handled rather than re-fetched.  A rejected tx is
-- not retained, it stays claimable in 'sharedTxTable' so peers retry it.
--
-- Backed by two indexes:
--
-- * 'retainedQueue' is keyed on 'Time' for cheap earliest-expiry queries.
-- * 'retainedSet'   shadows the keys for O(min(n, W)) 'retainedMember'
--   queries (the hot path: every received txid is checked here).
--
-- Both are kept in lockstep by the 'retained*' helpers below.
data RetainedTxs = RetainedTxs {
    RetainedTxs -> IntPSQ Time ()
retainedQueue :: !(IntPSQ Time ()),
    RetainedTxs -> IntSet
retainedSet   :: !IntSet
  }
  deriving stock    (RetainedTxs -> RetainedTxs -> Bool
(RetainedTxs -> RetainedTxs -> Bool)
-> (RetainedTxs -> RetainedTxs -> Bool) -> Eq RetainedTxs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RetainedTxs -> RetainedTxs -> Bool
== :: RetainedTxs -> RetainedTxs -> Bool
$c/= :: RetainedTxs -> RetainedTxs -> Bool
/= :: RetainedTxs -> RetainedTxs -> Bool
Eq, Int -> RetainedTxs -> ShowS
[RetainedTxs] -> ShowS
RetainedTxs -> String
(Int -> RetainedTxs -> ShowS)
-> (RetainedTxs -> String)
-> ([RetainedTxs] -> ShowS)
-> Show RetainedTxs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RetainedTxs -> ShowS
showsPrec :: Int -> RetainedTxs -> ShowS
$cshow :: RetainedTxs -> String
show :: RetainedTxs -> String
$cshowList :: [RetainedTxs] -> ShowS
showList :: [RetainedTxs] -> ShowS
Show, (forall x. RetainedTxs -> Rep RetainedTxs x)
-> (forall x. Rep RetainedTxs x -> RetainedTxs)
-> Generic RetainedTxs
forall x. Rep RetainedTxs x -> RetainedTxs
forall x. RetainedTxs -> Rep RetainedTxs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RetainedTxs -> Rep RetainedTxs x
from :: forall x. RetainedTxs -> Rep RetainedTxs x
$cto :: forall x. Rep RetainedTxs x -> RetainedTxs
to :: forall x. Rep RetainedTxs x -> RetainedTxs
Generic)
  deriving anyclass (RetainedTxs -> ()
(RetainedTxs -> ()) -> NFData RetainedTxs
forall a. (a -> ()) -> NFData a
$crnf :: RetainedTxs -> ()
rnf :: RetainedTxs -> ()
NFData, Context -> RetainedTxs -> IO (Maybe ThunkInfo)
Proxy RetainedTxs -> String
(Context -> RetainedTxs -> IO (Maybe ThunkInfo))
-> (Context -> RetainedTxs -> IO (Maybe ThunkInfo))
-> (Proxy RetainedTxs -> String)
-> NoThunks RetainedTxs
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> RetainedTxs -> IO (Maybe ThunkInfo)
noThunks :: Context -> RetainedTxs -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RetainedTxs -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> RetainedTxs -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy RetainedTxs -> String
showTypeOf :: Proxy RetainedTxs -> String
NoThunks)

emptySharedTxState :: SharedTxState peeraddr txid
emptySharedTxState :: forall peeraddr txid. SharedTxState peeraddr txid
emptySharedTxState = SharedTxState {
    sharedTxTable :: IntMap (TxEntry peeraddr)
sharedTxTable          = IntMap (TxEntry peeraddr)
forall a. IntMap a
IntMap.empty,
    sharedRetainedTxs :: RetainedTxs
sharedRetainedTxs      = RetainedTxs
retainedEmpty,
    sharedTxIdToKey :: Map (RawTxId txid) TxKey
sharedTxIdToKey        = Map (RawTxId txid) TxKey
forall k a. Map k a
Map.empty,
    sharedKeyToTxId :: IntMap txid
sharedKeyToTxId        = IntMap txid
forall a. IntMap a
IntMap.empty,
    sharedNextTxKey :: Int
sharedNextTxKey        = Int
0,
    sharedGeneration :: Word64
sharedGeneration       = Word64
0,
    sharedRevision :: Word64
sharedRevision         = Word64
0
  }

retainedEmpty :: RetainedTxs
retainedEmpty :: RetainedTxs
retainedEmpty = IntPSQ Time () -> IntSet -> RetainedTxs
RetainedTxs IntPSQ Time ()
forall p v. IntPSQ p v
IntPSQ.empty IntSet
IntSet.empty

retainedSingleton :: Int -> Time -> RetainedTxs
retainedSingleton :: Int -> Time -> RetainedTxs
retainedSingleton Int
k Time
retainUntil =
    IntPSQ Time () -> IntSet -> RetainedTxs
RetainedTxs (Int -> Time -> () -> IntPSQ Time () -> IntPSQ Time ()
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.insert Int
k Time
retainUntil () IntPSQ Time ()
forall p v. IntPSQ p v
IntPSQ.empty)
                (Int -> IntSet
IntSet.singleton Int
k)

retainedFromList :: [(Int, Time)] -> RetainedTxs
retainedFromList :: [(Int, Time)] -> RetainedTxs
retainedFromList =
    (RetainedTxs -> (Int, Time) -> RetainedTxs)
-> RetainedTxs -> [(Int, Time)] -> RetainedTxs
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\RetainedTxs
retained (Int
k, Time
retainUntil) -> Int -> Time -> RetainedTxs -> RetainedTxs
retainedInsertMax Int
k Time
retainUntil RetainedTxs
retained)
                RetainedTxs
retainedEmpty

retainedToList :: RetainedTxs -> [(Int, Time)]
retainedToList :: RetainedTxs -> [(Int, Time)]
retainedToList =
    ((Int, Time) -> Int) -> [(Int, Time)] -> [(Int, Time)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Time) -> Int
forall a b. (a, b) -> a
fst
  ([(Int, Time)] -> [(Int, Time)])
-> (RetainedTxs -> [(Int, Time)]) -> RetainedTxs -> [(Int, Time)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Time, ()) -> (Int, Time))
-> [(Int, Time, ())] -> [(Int, Time)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
k, Time
retainUntil, ()) -> (Int
k, Time
retainUntil))
  ([(Int, Time, ())] -> [(Int, Time)])
-> (RetainedTxs -> [(Int, Time, ())])
-> RetainedTxs
-> [(Int, Time)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntPSQ Time () -> [(Int, Time, ())]
forall p v. IntPSQ p v -> [(Int, p, v)]
IntPSQ.toList
  (IntPSQ Time () -> [(Int, Time, ())])
-> (RetainedTxs -> IntPSQ Time ())
-> RetainedTxs
-> [(Int, Time, ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetainedTxs -> IntPSQ Time ()
retainedQueue

retainedSize :: RetainedTxs -> Int
retainedSize :: RetainedTxs -> Int
retainedSize = IntSet -> Int
IntSet.size (IntSet -> Int) -> (RetainedTxs -> IntSet) -> RetainedTxs -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetainedTxs -> IntSet
retainedSet
{-# INLINE retainedSize #-}

retainedLookup :: Int -> RetainedTxs -> Maybe Time
retainedLookup :: Int -> RetainedTxs -> Maybe Time
retainedLookup Int
k RetainedTxs
retained =
    ((Time, ()) -> Time) -> Maybe (Time, ()) -> Maybe Time
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Time, ()) -> Time
forall a b. (a, b) -> a
fst (Int -> IntPSQ Time () -> Maybe (Time, ())
forall p v. Int -> IntPSQ p v -> Maybe (p, v)
IntPSQ.lookup Int
k (RetainedTxs -> IntPSQ Time ()
retainedQueue RetainedTxs
retained))
{-# INLINE retainedLookup #-}

retainedMember :: Int -> RetainedTxs -> Bool
retainedMember :: Int -> RetainedTxs -> Bool
retainedMember Int
k = Int -> IntSet -> Bool
IntSet.member Int
k (IntSet -> Bool) -> (RetainedTxs -> IntSet) -> RetainedTxs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetainedTxs -> IntSet
retainedSet
{-# INLINE retainedMember #-}

retainedInsertMax :: Int -> Time -> RetainedTxs -> RetainedTxs
retainedInsertMax :: Int -> Time -> RetainedTxs -> RetainedTxs
retainedInsertMax Int
k Time
retainUntil (RetainedTxs IntPSQ Time ()
queue IntSet
keys) =
    IntPSQ Time () -> IntSet -> RetainedTxs
RetainedTxs (Int -> Time -> () -> IntPSQ Time () -> IntPSQ Time ()
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.insert Int
k Time
retainUntil' () IntPSQ Time ()
queue)
                (Int -> IntSet -> IntSet
IntSet.insert Int
k IntSet
keys)
  where
    retainUntil' :: Time
retainUntil' =
      case Int -> IntPSQ Time () -> Maybe (Time, ())
forall p v. Int -> IntPSQ p v -> Maybe (p, v)
IntPSQ.lookup Int
k IntPSQ Time ()
queue of
        Just (Time
existing, ()) -> Time -> Time -> Time
forall a. Ord a => a -> a -> a
max Time
existing Time
retainUntil
        Maybe (Time, ())
Nothing             -> Time
retainUntil
{-# INLINE retainedInsertMax #-}

retainedDeleteKeys :: IntSet -> RetainedTxs -> RetainedTxs
retainedDeleteKeys :: IntSet -> RetainedTxs -> RetainedTxs
retainedDeleteKeys IntSet
ks (RetainedTxs IntPSQ Time ()
queue IntSet
keys) =
    IntPSQ Time () -> IntSet -> RetainedTxs
RetainedTxs ((IntPSQ Time () -> Int -> IntPSQ Time ())
-> IntPSQ Time () -> IntSet -> IntPSQ Time ()
forall a. (a -> Int -> a) -> a -> IntSet -> a
IntSet.foldl' ((Int -> IntPSQ Time () -> IntPSQ Time ())
-> IntPSQ Time () -> Int -> IntPSQ Time ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> IntPSQ Time () -> IntPSQ Time ()
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v
IntPSQ.delete) IntPSQ Time ()
queue IntSet
ks)
                (IntSet
keys IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
ks)
{-# INLINE retainedDeleteKeys #-}

retainedKeysSet :: RetainedTxs -> IntSet
retainedKeysSet :: RetainedTxs -> IntSet
retainedKeysSet = RetainedTxs -> IntSet
retainedSet
{-# INLINE retainedKeysSet #-}

retainedRestrictKeys :: RetainedTxs -> IntSet -> RetainedTxs
retainedRestrictKeys :: RetainedTxs -> IntSet -> RetainedTxs
retainedRestrictKeys (RetainedTxs IntPSQ Time ()
queue IntSet
keys) IntSet
ks =
    IntPSQ Time () -> IntSet -> RetainedTxs
RetainedTxs ((Int -> Time -> () -> IntPSQ Time () -> IntPSQ Time ())
-> IntPSQ Time () -> IntPSQ Time () -> IntPSQ Time ()
forall p v a. (Int -> p -> v -> a -> a) -> a -> IntPSQ p v -> a
IntPSQ.fold' Int -> Time -> () -> IntPSQ Time () -> IntPSQ Time ()
keep IntPSQ Time ()
forall p v. IntPSQ p v
IntPSQ.empty IntPSQ Time ()
queue)
                (IntSet -> IntSet -> IntSet
IntSet.intersection IntSet
keys IntSet
ks)
  where
    keep :: Int -> Time -> () -> IntPSQ Time () -> IntPSQ Time ()
keep Int
k Time
retainUntil ()
_
      | Int -> IntSet -> Bool
IntSet.member Int
k IntSet
ks = Int -> Time -> () -> IntPSQ Time () -> IntPSQ Time ()
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.insert Int
k Time
retainUntil ()
      | Bool
otherwise          = IntPSQ Time () -> IntPSQ Time ()
forall a. a -> a
id
{-# INLINE retainedRestrictKeys #-}

retainedExpiredKeys :: Time -> RetainedTxs -> IntSet
retainedExpiredKeys :: Time -> RetainedTxs -> IntSet
retainedExpiredKeys Time
currentTime RetainedTxs
retained =
    -- Quick exit if no TX has expired.
    case IntPSQ Time () -> Maybe (Int, Time, ())
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v)
IntPSQ.findMin IntPSQ Time ()
queue of
      Just (Int
_, Time
earliest, ()
_) | Time
earliest Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
currentTime -> IntSet -> IntPSQ Time () -> IntSet
go IntSet
IntSet.empty IntPSQ Time ()
queue
      Maybe (Int, Time, ())
_                                               -> IntSet
IntSet.empty
  where
    queue :: IntPSQ Time ()
queue = RetainedTxs -> IntPSQ Time ()
retainedQueue RetainedTxs
retained
    go :: IntSet -> IntPSQ Time () -> IntSet
go IntSet
expired IntPSQ Time ()
r =
      case IntPSQ Time () -> Maybe (Int, Time, (), IntPSQ Time ())
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
IntPSQ.minView IntPSQ Time ()
r of
        Just (Int
k, Time
retainUntil, (), IntPSQ Time ()
r')
          | Time
retainUntil Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
currentTime ->
              IntSet -> IntPSQ Time () -> IntSet
go (Int -> IntSet -> IntSet
IntSet.insert Int
k IntSet
expired) IntPSQ Time ()
r'
          | Bool
otherwise ->
              IntSet
expired
        Maybe (Int, Time, (), IntPSQ Time ())
Nothing ->
          IntSet
expired
{-# INLINE retainedExpiredKeys #-}

lookupTxKey :: HasRawTxId txid
            => txid
            -> SharedTxState peeraddr txid
            -> Maybe TxKey
lookupTxKey :: forall txid peeraddr.
HasRawTxId txid =>
txid -> SharedTxState peeraddr txid -> Maybe TxKey
lookupTxKey txid
txid SharedTxState { Map (RawTxId txid) TxKey
sharedTxIdToKey :: forall peeraddr txid.
SharedTxState peeraddr txid -> Map (RawTxId txid) TxKey
sharedTxIdToKey :: Map (RawTxId txid) TxKey
sharedTxIdToKey } =
    RawTxId txid -> Map (RawTxId txid) TxKey -> Maybe TxKey
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (txid -> RawTxId txid
forall txid. HasRawTxId txid => txid -> RawTxId txid
getRawTxId txid
txid) Map (RawTxId txid) TxKey
sharedTxIdToKey

resolveTxKey :: HasCallStack
             => SharedTxState peeraddr txid
             -> TxKey
             -> txid
resolveTxKey :: forall peeraddr txid.
HasCallStack =>
SharedTxState peeraddr txid -> TxKey -> txid
resolveTxKey SharedTxState { IntMap txid
sharedKeyToTxId :: forall peeraddr txid. SharedTxState peeraddr txid -> IntMap txid
sharedKeyToTxId :: IntMap txid
sharedKeyToTxId } (TxKey Int
k) =
    case Int -> IntMap txid -> Maybe txid
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k IntMap txid
sharedKeyToTxId of
         Just txid
txid -> txid
txid
         Maybe txid
Nothing   -> String -> txid
forall a. HasCallStack => String -> a
error (String -> txid) -> String -> txid
forall a b. (a -> b) -> a -> b
$
           String
"TxSubmission.V2.resolveTxKey: missing tx key " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k

-- | Intern a txid into the shared lookup tables.  Returns the txid's
-- raw form, its stable 'TxKey' (existing if already interned, freshly
-- allocated otherwise), and the resulting shared state.
internTxId :: HasRawTxId txid
           => txid
           -> SharedTxState peeraddr txid
           -> (RawTxId txid, TxKey, SharedTxState peeraddr txid)
internTxId :: forall txid peeraddr.
HasRawTxId txid =>
txid
-> SharedTxState peeraddr txid
-> (RawTxId txid, TxKey, SharedTxState peeraddr txid)
internTxId txid
txid st :: SharedTxState peeraddr txid
st@SharedTxState { Map (RawTxId txid) TxKey
sharedTxIdToKey :: forall peeraddr txid.
SharedTxState peeraddr txid -> Map (RawTxId txid) TxKey
sharedTxIdToKey :: Map (RawTxId txid) TxKey
sharedTxIdToKey, IntMap txid
sharedKeyToTxId :: forall peeraddr txid. SharedTxState peeraddr txid -> IntMap txid
sharedKeyToTxId :: IntMap txid
sharedKeyToTxId, Int
sharedNextTxKey :: forall peeraddr txid. SharedTxState peeraddr txid -> Int
sharedNextTxKey :: Int
sharedNextTxKey }
  | Just TxKey
key <- RawTxId txid -> Map (RawTxId txid) TxKey -> Maybe TxKey
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RawTxId txid
rawId Map (RawTxId txid) TxKey
sharedTxIdToKey = (RawTxId txid
rawId, TxKey
key, SharedTxState peeraddr txid
st)
  | Bool
otherwise =
      let key :: TxKey
key = Int -> TxKey
TxKey Int
sharedNextTxKey in
      ( RawTxId txid
rawId
      , TxKey
key
      , SharedTxState peeraddr txid
st { sharedTxIdToKey = Map.insert rawId key sharedTxIdToKey
           , sharedKeyToTxId = IntMap.insert sharedNextTxKey txid sharedKeyToTxId
           , sharedNextTxKey = sharedNextTxKey + 1
           }
      )
  where
    rawId :: RawTxId txid
rawId = txid -> RawTxId txid
forall txid. HasRawTxId txid => txid -> RawTxId txid
getRawTxId txid
txid

internTxIds :: (Foldable f, HasRawTxId txid)
            => f txid
            -> SharedTxState peeraddr txid
            -> (Map (RawTxId txid) TxKey, SharedTxState peeraddr txid)
internTxIds :: forall (f :: * -> *) txid peeraddr.
(Foldable f, HasRawTxId txid) =>
f txid
-> SharedTxState peeraddr txid
-> (Map (RawTxId txid) TxKey, SharedTxState peeraddr txid)
internTxIds f txid
txids SharedTxState peeraddr txid
st0 = ((Map (RawTxId txid) TxKey, SharedTxState peeraddr txid)
 -> txid -> (Map (RawTxId txid) TxKey, SharedTxState peeraddr txid))
-> (Map (RawTxId txid) TxKey, SharedTxState peeraddr txid)
-> f txid
-> (Map (RawTxId txid) TxKey, SharedTxState peeraddr txid)
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Map (RawTxId txid) TxKey, SharedTxState peeraddr txid)
-> txid -> (Map (RawTxId txid) TxKey, SharedTxState peeraddr txid)
forall {txid} {peeraddr}.
HasRawTxId txid =>
(Map (RawTxId txid) TxKey, SharedTxState peeraddr txid)
-> txid -> (Map (RawTxId txid) TxKey, SharedTxState peeraddr txid)
step (Map (RawTxId txid) TxKey
forall k a. Map k a
Map.empty, SharedTxState peeraddr txid
st0) f txid
txids
  where
    step :: (Map (RawTxId txid) TxKey, SharedTxState peeraddr txid)
-> txid -> (Map (RawTxId txid) TxKey, SharedTxState peeraddr txid)
step (!Map (RawTxId txid) TxKey
acc, !SharedTxState peeraddr txid
st) txid
txid =
      let (RawTxId txid
rawId, TxKey
key, SharedTxState peeraddr txid
st') = txid
-> SharedTxState peeraddr txid
-> (RawTxId txid, TxKey, SharedTxState peeraddr txid)
forall txid peeraddr.
HasRawTxId txid =>
txid
-> SharedTxState peeraddr txid
-> (RawTxId txid, TxKey, SharedTxState peeraddr txid)
internTxId txid
txid SharedTxState peeraddr txid
st in
      (RawTxId txid
-> TxKey -> Map (RawTxId txid) TxKey -> Map (RawTxId txid) TxKey
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert RawTxId txid
rawId TxKey
key Map (RawTxId txid) TxKey
acc, SharedTxState peeraddr txid
st')

-- | Flag to enable/disable the usage of the new tx-submission logic.
--
data TxSubmissionLogicVersion =
      -- | the legacy `Ouroboros.Network.TxSubmission.Inbound.V1`
      TxSubmissionLogicV1
      -- | the new `Ouroboros.Network.TxSubmission.Inbound.V2`
    | TxSubmissionLogicV2
    deriving (TxSubmissionLogicVersion -> TxSubmissionLogicVersion -> Bool
(TxSubmissionLogicVersion -> TxSubmissionLogicVersion -> Bool)
-> (TxSubmissionLogicVersion -> TxSubmissionLogicVersion -> Bool)
-> Eq TxSubmissionLogicVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSubmissionLogicVersion -> TxSubmissionLogicVersion -> Bool
== :: TxSubmissionLogicVersion -> TxSubmissionLogicVersion -> Bool
$c/= :: TxSubmissionLogicVersion -> TxSubmissionLogicVersion -> Bool
/= :: TxSubmissionLogicVersion -> TxSubmissionLogicVersion -> Bool
Eq, Int -> TxSubmissionLogicVersion -> ShowS
[TxSubmissionLogicVersion] -> ShowS
TxSubmissionLogicVersion -> String
(Int -> TxSubmissionLogicVersion -> ShowS)
-> (TxSubmissionLogicVersion -> String)
-> ([TxSubmissionLogicVersion] -> ShowS)
-> Show TxSubmissionLogicVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSubmissionLogicVersion -> ShowS
showsPrec :: Int -> TxSubmissionLogicVersion -> ShowS
$cshow :: TxSubmissionLogicVersion -> String
show :: TxSubmissionLogicVersion -> String
$cshowList :: [TxSubmissionLogicVersion] -> ShowS
showList :: [TxSubmissionLogicVersion] -> ShowS
Show, Int -> TxSubmissionLogicVersion
TxSubmissionLogicVersion -> Int
TxSubmissionLogicVersion -> [TxSubmissionLogicVersion]
TxSubmissionLogicVersion -> TxSubmissionLogicVersion
TxSubmissionLogicVersion
-> TxSubmissionLogicVersion -> [TxSubmissionLogicVersion]
TxSubmissionLogicVersion
-> TxSubmissionLogicVersion
-> TxSubmissionLogicVersion
-> [TxSubmissionLogicVersion]
(TxSubmissionLogicVersion -> TxSubmissionLogicVersion)
-> (TxSubmissionLogicVersion -> TxSubmissionLogicVersion)
-> (Int -> TxSubmissionLogicVersion)
-> (TxSubmissionLogicVersion -> Int)
-> (TxSubmissionLogicVersion -> [TxSubmissionLogicVersion])
-> (TxSubmissionLogicVersion
    -> TxSubmissionLogicVersion -> [TxSubmissionLogicVersion])
-> (TxSubmissionLogicVersion
    -> TxSubmissionLogicVersion -> [TxSubmissionLogicVersion])
-> (TxSubmissionLogicVersion
    -> TxSubmissionLogicVersion
    -> TxSubmissionLogicVersion
    -> [TxSubmissionLogicVersion])
-> Enum TxSubmissionLogicVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TxSubmissionLogicVersion -> TxSubmissionLogicVersion
succ :: TxSubmissionLogicVersion -> TxSubmissionLogicVersion
$cpred :: TxSubmissionLogicVersion -> TxSubmissionLogicVersion
pred :: TxSubmissionLogicVersion -> TxSubmissionLogicVersion
$ctoEnum :: Int -> TxSubmissionLogicVersion
toEnum :: Int -> TxSubmissionLogicVersion
$cfromEnum :: TxSubmissionLogicVersion -> Int
fromEnum :: TxSubmissionLogicVersion -> Int
$cenumFrom :: TxSubmissionLogicVersion -> [TxSubmissionLogicVersion]
enumFrom :: TxSubmissionLogicVersion -> [TxSubmissionLogicVersion]
$cenumFromThen :: TxSubmissionLogicVersion
-> TxSubmissionLogicVersion -> [TxSubmissionLogicVersion]
enumFromThen :: TxSubmissionLogicVersion
-> TxSubmissionLogicVersion -> [TxSubmissionLogicVersion]
$cenumFromTo :: TxSubmissionLogicVersion
-> TxSubmissionLogicVersion -> [TxSubmissionLogicVersion]
enumFromTo :: TxSubmissionLogicVersion
-> TxSubmissionLogicVersion -> [TxSubmissionLogicVersion]
$cenumFromThenTo :: TxSubmissionLogicVersion
-> TxSubmissionLogicVersion
-> TxSubmissionLogicVersion
-> [TxSubmissionLogicVersion]
enumFromThenTo :: TxSubmissionLogicVersion
-> TxSubmissionLogicVersion
-> TxSubmissionLogicVersion
-> [TxSubmissionLogicVersion]
Enum, TxSubmissionLogicVersion
TxSubmissionLogicVersion
-> TxSubmissionLogicVersion -> Bounded TxSubmissionLogicVersion
forall a. a -> a -> Bounded a
$cminBound :: TxSubmissionLogicVersion
minBound :: TxSubmissionLogicVersion
$cmaxBound :: TxSubmissionLogicVersion
maxBound :: TxSubmissionLogicVersion
Bounded)

-- | TxLogic tracer.
--
data TraceTxLogic peeraddr txid tx =
    TraceSharedTxState (SharedTxState peeraddr txid)
  deriving Int -> TraceTxLogic peeraddr txid tx -> ShowS
[TraceTxLogic peeraddr txid tx] -> ShowS
TraceTxLogic peeraddr txid tx -> String
(Int -> TraceTxLogic peeraddr txid tx -> ShowS)
-> (TraceTxLogic peeraddr txid tx -> String)
-> ([TraceTxLogic peeraddr txid tx] -> ShowS)
-> Show (TraceTxLogic peeraddr txid tx)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall peeraddr txid tx.
(HasRawTxId txid, Show peeraddr, Show txid) =>
Int -> TraceTxLogic peeraddr txid tx -> ShowS
forall peeraddr txid tx.
(HasRawTxId txid, Show peeraddr, Show txid) =>
[TraceTxLogic peeraddr txid tx] -> ShowS
forall peeraddr txid tx.
(HasRawTxId txid, Show peeraddr, Show txid) =>
TraceTxLogic peeraddr txid tx -> String
$cshowsPrec :: forall peeraddr txid tx.
(HasRawTxId txid, Show peeraddr, Show txid) =>
Int -> TraceTxLogic peeraddr txid tx -> ShowS
showsPrec :: Int -> TraceTxLogic peeraddr txid tx -> ShowS
$cshow :: forall peeraddr txid tx.
(HasRawTxId txid, Show peeraddr, Show txid) =>
TraceTxLogic peeraddr txid tx -> String
show :: TraceTxLogic peeraddr txid tx -> String
$cshowList :: forall peeraddr txid tx.
(HasRawTxId txid, Show peeraddr, Show txid) =>
[TraceTxLogic peeraddr txid tx] -> ShowS
showList :: [TraceTxLogic peeraddr txid tx] -> ShowS
Show


data ProcessedTxCount = ProcessedTxCount {
      -- | Just accepted this many transactions.
      ProcessedTxCount -> Int
ptxcAccepted :: Int
      -- | Just rejected this many transactions.
    , ProcessedTxCount -> Int
ptxcRejected :: Int
    , ProcessedTxCount -> Double
ptxcScore    :: Double
    }
  deriving (ProcessedTxCount -> ProcessedTxCount -> Bool
(ProcessedTxCount -> ProcessedTxCount -> Bool)
-> (ProcessedTxCount -> ProcessedTxCount -> Bool)
-> Eq ProcessedTxCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProcessedTxCount -> ProcessedTxCount -> Bool
== :: ProcessedTxCount -> ProcessedTxCount -> Bool
$c/= :: ProcessedTxCount -> ProcessedTxCount -> Bool
/= :: ProcessedTxCount -> ProcessedTxCount -> Bool
Eq, Int -> ProcessedTxCount -> ShowS
[ProcessedTxCount] -> ShowS
ProcessedTxCount -> String
(Int -> ProcessedTxCount -> ShowS)
-> (ProcessedTxCount -> String)
-> ([ProcessedTxCount] -> ShowS)
-> Show ProcessedTxCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessedTxCount -> ShowS
showsPrec :: Int -> ProcessedTxCount -> ShowS
$cshow :: ProcessedTxCount -> String
show :: ProcessedTxCount -> String
$cshowList :: [ProcessedTxCount] -> ShowS
showList :: [ProcessedTxCount] -> ShowS
Show)


-- | The consensus layer functionality that the inbound side of the tx
-- submission logic requires.
--
-- This is provided to the tx submission logic by the consensus layer.
--
data TxSubmissionMempoolWriter txid tx idx m err =
     TxSubmissionMempoolWriter {

       -- | Compute the transaction id from a transaction.
       --
       -- This is used in the protocol handler to verify a full transaction
       -- matches a previously given transaction id.
       --
       forall txid tx idx (m :: * -> *) err.
TxSubmissionMempoolWriter txid tx idx m err -> tx -> txid
txId          :: tx -> txid,

       -- | Supply a batch of transactions to the mempool. They are either
       -- accepted or rejected individually, but in the order supplied.
       --
       -- Return list of valid tx's added to the mempool and a list of invalid
       -- tx's with the corresponding error.
       --
       forall txid tx idx (m :: * -> *) err.
TxSubmissionMempoolWriter txid tx idx m err
-> [tx] -> m ([txid], [(txid, err)])
mempoolAddTxs :: [tx] -> m ([txid], [(txid, err)])
    }


data TraceTxSubmissionInbound txid tx =
    -- | Number of transactions just about to be inserted.
    TraceTxSubmissionCollected [txid]
    -- | Just processed transaction pass/fail breakdown.
  | TraceTxSubmissionProcessed ProcessedTxCount
  | TraceTxInboundCanRequestMoreTxs Int
  | TraceTxInboundCannotRequestMoreTxs Int
  | TraceTxInboundAddedToMempool [txid] DiffTime
  | TraceTxInboundRejectedFromMempool [txid] DiffTime
  | TraceTxInboundError TxSubmissionProtocolError
  | TraceTxInboundRequestTxs [txid]

  --
  -- messages emitted by the new implementation of the server in
  -- "Ouroboros.Network.TxSubmission.Inbound.Server"; some of them are also
  -- used in this module.
  --

  -- | Server received 'MsgDone'
  | TraceTxInboundTerminated
  deriving (TraceTxSubmissionInbound txid tx
-> TraceTxSubmissionInbound txid tx -> Bool
(TraceTxSubmissionInbound txid tx
 -> TraceTxSubmissionInbound txid tx -> Bool)
-> (TraceTxSubmissionInbound txid tx
    -> TraceTxSubmissionInbound txid tx -> Bool)
-> Eq (TraceTxSubmissionInbound txid tx)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall txid tx.
Eq txid =>
TraceTxSubmissionInbound txid tx
-> TraceTxSubmissionInbound txid tx -> Bool
$c== :: forall txid tx.
Eq txid =>
TraceTxSubmissionInbound txid tx
-> TraceTxSubmissionInbound txid tx -> Bool
== :: TraceTxSubmissionInbound txid tx
-> TraceTxSubmissionInbound txid tx -> Bool
$c/= :: forall txid tx.
Eq txid =>
TraceTxSubmissionInbound txid tx
-> TraceTxSubmissionInbound txid tx -> Bool
/= :: TraceTxSubmissionInbound txid tx
-> TraceTxSubmissionInbound txid tx -> Bool
Eq, Int -> TraceTxSubmissionInbound txid tx -> ShowS
[TraceTxSubmissionInbound txid tx] -> ShowS
TraceTxSubmissionInbound txid tx -> String
(Int -> TraceTxSubmissionInbound txid tx -> ShowS)
-> (TraceTxSubmissionInbound txid tx -> String)
-> ([TraceTxSubmissionInbound txid tx] -> ShowS)
-> Show (TraceTxSubmissionInbound txid tx)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall txid tx.
Show txid =>
Int -> TraceTxSubmissionInbound txid tx -> ShowS
forall txid tx.
Show txid =>
[TraceTxSubmissionInbound txid tx] -> ShowS
forall txid tx.
Show txid =>
TraceTxSubmissionInbound txid tx -> String
$cshowsPrec :: forall txid tx.
Show txid =>
Int -> TraceTxSubmissionInbound txid tx -> ShowS
showsPrec :: Int -> TraceTxSubmissionInbound txid tx -> ShowS
$cshow :: forall txid tx.
Show txid =>
TraceTxSubmissionInbound txid tx -> String
show :: TraceTxSubmissionInbound txid tx -> String
$cshowList :: forall txid tx.
Show txid =>
[TraceTxSubmissionInbound txid tx] -> ShowS
showList :: [TraceTxSubmissionInbound txid tx] -> ShowS
Show)


data TxSubmissionProtocolError =
       ProtocolErrorTxNotRequested
     | ProtocolErrorTxIdsNotRequested
     | forall txid. (Typeable txid, Show txid, Eq txid)
       => ProtocolErrorTxSizeError [(txid, SizeInBytes, SizeInBytes)]
     -- ^ a list of txid for which the received size and advertised size didn't
     -- match.

instance Eq   TxSubmissionProtocolError where
    TxSubmissionProtocolError
ProtocolErrorTxNotRequested    == :: TxSubmissionProtocolError -> TxSubmissionProtocolError -> Bool
== TxSubmissionProtocolError
ProtocolErrorTxNotRequested      = Bool
True
    TxSubmissionProtocolError
ProtocolErrorTxNotRequested    == TxSubmissionProtocolError
_                                = Bool
False
    TxSubmissionProtocolError
ProtocolErrorTxIdsNotRequested == TxSubmissionProtocolError
ProtocolErrorTxIdsNotRequested   = Bool
True
    TxSubmissionProtocolError
ProtocolErrorTxIdsNotRequested == TxSubmissionProtocolError
_                                = Bool
False
    ProtocolErrorTxSizeError ([(txid, SizeInBytes, SizeInBytes)]
as :: [(a, SizeInBytes, SizeInBytes)])
      == ProtocolErrorTxSizeError ([(txid, SizeInBytes, SizeInBytes)]
as' :: [(a', SizeInBytes, SizeInBytes)]) =
        case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @a @a' of
          Maybe (txid :~: txid)
Nothing   -> Bool
False
          Just txid :~: txid
Refl -> [(txid, SizeInBytes, SizeInBytes)]
as [(txid, SizeInBytes, SizeInBytes)]
-> [(txid, SizeInBytes, SizeInBytes)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(txid, SizeInBytes, SizeInBytes)]
[(txid, SizeInBytes, SizeInBytes)]
as'
    ProtocolErrorTxSizeError {} == TxSubmissionProtocolError
_ = Bool
False

deriving instance Show TxSubmissionProtocolError

instance Exception TxSubmissionProtocolError where
  displayException :: TxSubmissionProtocolError -> String
displayException TxSubmissionProtocolError
ProtocolErrorTxNotRequested =
      String
"The peer replied with a transaction we did not ask for."
  displayException TxSubmissionProtocolError
ProtocolErrorTxIdsNotRequested =
      String
"The peer replied with more txids than we asked for."
  displayException (ProtocolErrorTxSizeError [(txid, SizeInBytes, SizeInBytes)]
txids) =
      String
"The peer received txs with wrong sizes " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(txid, SizeInBytes, SizeInBytes)] -> String
forall a. Show a => a -> String
show [(txid, SizeInBytes, SizeInBytes)]
txids

data TxSubmissionInitDelay =
     TxSubmissionInitDelay DiffTime
 | NoTxSubmissionInitDelay
 deriving (TxSubmissionInitDelay -> TxSubmissionInitDelay -> Bool
(TxSubmissionInitDelay -> TxSubmissionInitDelay -> Bool)
-> (TxSubmissionInitDelay -> TxSubmissionInitDelay -> Bool)
-> Eq TxSubmissionInitDelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSubmissionInitDelay -> TxSubmissionInitDelay -> Bool
== :: TxSubmissionInitDelay -> TxSubmissionInitDelay -> Bool
$c/= :: TxSubmissionInitDelay -> TxSubmissionInitDelay -> Bool
/= :: TxSubmissionInitDelay -> TxSubmissionInitDelay -> Bool
Eq, Int -> TxSubmissionInitDelay -> ShowS
[TxSubmissionInitDelay] -> ShowS
TxSubmissionInitDelay -> String
(Int -> TxSubmissionInitDelay -> ShowS)
-> (TxSubmissionInitDelay -> String)
-> ([TxSubmissionInitDelay] -> ShowS)
-> Show TxSubmissionInitDelay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSubmissionInitDelay -> ShowS
showsPrec :: Int -> TxSubmissionInitDelay -> ShowS
$cshow :: TxSubmissionInitDelay -> String
show :: TxSubmissionInitDelay -> String
$cshowList :: [TxSubmissionInitDelay] -> ShowS
showList :: [TxSubmissionInitDelay] -> ShowS
Show)

defaultTxSubmissionInitDelay :: TxSubmissionInitDelay
defaultTxSubmissionInitDelay :: TxSubmissionInitDelay
defaultTxSubmissionInitDelay = DiffTime -> TxSubmissionInitDelay
TxSubmissionInitDelay DiffTime
60