{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

-- | Intended for qualified import.
--
-- > import           Ouroboros.Consensus.Mempool.TxSeq (TxSeq (..))
-- > import qualified Ouroboros.Consensus.Mempool.TxSeq as TxSeq
module Ouroboros.Consensus.Mempool.TxSeq (
    TicketNo (..)
  , TxSeq (Empty, (:>), (:<))
  , TxTicket (..)
  , fromList
  , lookupByTicketNo
  , splitAfterTicketNo
  , splitAfterTxSize
  , toList
  , toSize
  , toTuples
  , zeroTicketNo
    -- * Reference implementations for testing
  , splitAfterTxSizeSpec
  ) where

import           Control.Arrow ((***))
import           Data.FingerTree.Strict (StrictFingerTree)
import qualified Data.FingerTree.Strict as FingerTree
import qualified Data.Foldable as Foldable
import           Data.Measure (Measure)
import qualified Data.Measure as Measure
import           Data.Word (Word64)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import           Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32,
                     HasByteSize, txMeasureByteSize)

{-------------------------------------------------------------------------------
  Mempool transaction sequence as a finger tree
-------------------------------------------------------------------------------}

-- | We allocate each transaction a (monotonically increasing) ticket number
-- as it enters the mempool.
--
newtype TicketNo = TicketNo Word64
  deriving stock (TicketNo -> TicketNo -> Bool
(TicketNo -> TicketNo -> Bool)
-> (TicketNo -> TicketNo -> Bool) -> Eq TicketNo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TicketNo -> TicketNo -> Bool
== :: TicketNo -> TicketNo -> Bool
$c/= :: TicketNo -> TicketNo -> Bool
/= :: TicketNo -> TicketNo -> Bool
Eq, Eq TicketNo
Eq TicketNo =>
(TicketNo -> TicketNo -> Ordering)
-> (TicketNo -> TicketNo -> Bool)
-> (TicketNo -> TicketNo -> Bool)
-> (TicketNo -> TicketNo -> Bool)
-> (TicketNo -> TicketNo -> Bool)
-> (TicketNo -> TicketNo -> TicketNo)
-> (TicketNo -> TicketNo -> TicketNo)
-> Ord TicketNo
TicketNo -> TicketNo -> Bool
TicketNo -> TicketNo -> Ordering
TicketNo -> TicketNo -> TicketNo
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 :: TicketNo -> TicketNo -> Ordering
compare :: TicketNo -> TicketNo -> Ordering
$c< :: TicketNo -> TicketNo -> Bool
< :: TicketNo -> TicketNo -> Bool
$c<= :: TicketNo -> TicketNo -> Bool
<= :: TicketNo -> TicketNo -> Bool
$c> :: TicketNo -> TicketNo -> Bool
> :: TicketNo -> TicketNo -> Bool
$c>= :: TicketNo -> TicketNo -> Bool
>= :: TicketNo -> TicketNo -> Bool
$cmax :: TicketNo -> TicketNo -> TicketNo
max :: TicketNo -> TicketNo -> TicketNo
$cmin :: TicketNo -> TicketNo -> TicketNo
min :: TicketNo -> TicketNo -> TicketNo
Ord, Int -> TicketNo -> ShowS
[TicketNo] -> ShowS
TicketNo -> String
(Int -> TicketNo -> ShowS)
-> (TicketNo -> String) -> ([TicketNo] -> ShowS) -> Show TicketNo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TicketNo -> ShowS
showsPrec :: Int -> TicketNo -> ShowS
$cshow :: TicketNo -> String
show :: TicketNo -> String
$cshowList :: [TicketNo] -> ShowS
showList :: [TicketNo] -> ShowS
Show)
  deriving newtype (Int -> TicketNo
TicketNo -> Int
TicketNo -> [TicketNo]
TicketNo -> TicketNo
TicketNo -> TicketNo -> [TicketNo]
TicketNo -> TicketNo -> TicketNo -> [TicketNo]
(TicketNo -> TicketNo)
-> (TicketNo -> TicketNo)
-> (Int -> TicketNo)
-> (TicketNo -> Int)
-> (TicketNo -> [TicketNo])
-> (TicketNo -> TicketNo -> [TicketNo])
-> (TicketNo -> TicketNo -> [TicketNo])
-> (TicketNo -> TicketNo -> TicketNo -> [TicketNo])
-> Enum TicketNo
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 :: TicketNo -> TicketNo
succ :: TicketNo -> TicketNo
$cpred :: TicketNo -> TicketNo
pred :: TicketNo -> TicketNo
$ctoEnum :: Int -> TicketNo
toEnum :: Int -> TicketNo
$cfromEnum :: TicketNo -> Int
fromEnum :: TicketNo -> Int
$cenumFrom :: TicketNo -> [TicketNo]
enumFrom :: TicketNo -> [TicketNo]
$cenumFromThen :: TicketNo -> TicketNo -> [TicketNo]
enumFromThen :: TicketNo -> TicketNo -> [TicketNo]
$cenumFromTo :: TicketNo -> TicketNo -> [TicketNo]
enumFromTo :: TicketNo -> TicketNo -> [TicketNo]
$cenumFromThenTo :: TicketNo -> TicketNo -> TicketNo -> [TicketNo]
enumFromThenTo :: TicketNo -> TicketNo -> TicketNo -> [TicketNo]
Enum, TicketNo
TicketNo -> TicketNo -> Bounded TicketNo
forall a. a -> a -> Bounded a
$cminBound :: TicketNo
minBound :: TicketNo
$cmaxBound :: TicketNo
maxBound :: TicketNo
Bounded, Context -> TicketNo -> IO (Maybe ThunkInfo)
Proxy TicketNo -> String
(Context -> TicketNo -> IO (Maybe ThunkInfo))
-> (Context -> TicketNo -> IO (Maybe ThunkInfo))
-> (Proxy TicketNo -> String)
-> NoThunks TicketNo
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> TicketNo -> IO (Maybe ThunkInfo)
noThunks :: Context -> TicketNo -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TicketNo -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TicketNo -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy TicketNo -> String
showTypeOf :: Proxy TicketNo -> String
NoThunks)

-- | The transaction ticket number from which our counter starts.
zeroTicketNo :: TicketNo
zeroTicketNo :: TicketNo
zeroTicketNo = Word64 -> TicketNo
TicketNo Word64
0

-- | We associate transactions in the mempool with their ticket number and
-- size in bytes.
--
data TxTicket sz tx = TxTicket
  { forall sz tx. TxTicket sz tx -> tx
txTicketTx   :: !tx
    -- ^ The transaction associated with this ticket.
  , forall sz tx. TxTicket sz tx -> TicketNo
txTicketNo   :: !TicketNo
    -- ^ The ticket number.
  , forall sz tx. TxTicket sz tx -> sz
txTicketSize :: !sz
    -- ^ The size of 'txTicketTx'.
  } deriving (TxTicket sz tx -> TxTicket sz tx -> Bool
(TxTicket sz tx -> TxTicket sz tx -> Bool)
-> (TxTicket sz tx -> TxTicket sz tx -> Bool)
-> Eq (TxTicket sz tx)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall sz tx.
(Eq tx, Eq sz) =>
TxTicket sz tx -> TxTicket sz tx -> Bool
$c== :: forall sz tx.
(Eq tx, Eq sz) =>
TxTicket sz tx -> TxTicket sz tx -> Bool
== :: TxTicket sz tx -> TxTicket sz tx -> Bool
$c/= :: forall sz tx.
(Eq tx, Eq sz) =>
TxTicket sz tx -> TxTicket sz tx -> Bool
/= :: TxTicket sz tx -> TxTicket sz tx -> Bool
Eq, Int -> TxTicket sz tx -> ShowS
[TxTicket sz tx] -> ShowS
TxTicket sz tx -> String
(Int -> TxTicket sz tx -> ShowS)
-> (TxTicket sz tx -> String)
-> ([TxTicket sz tx] -> ShowS)
-> Show (TxTicket sz tx)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall sz tx. (Show tx, Show sz) => Int -> TxTicket sz tx -> ShowS
forall sz tx. (Show tx, Show sz) => [TxTicket sz tx] -> ShowS
forall sz tx. (Show tx, Show sz) => TxTicket sz tx -> String
$cshowsPrec :: forall sz tx. (Show tx, Show sz) => Int -> TxTicket sz tx -> ShowS
showsPrec :: Int -> TxTicket sz tx -> ShowS
$cshow :: forall sz tx. (Show tx, Show sz) => TxTicket sz tx -> String
show :: TxTicket sz tx -> String
$cshowList :: forall sz tx. (Show tx, Show sz) => [TxTicket sz tx] -> ShowS
showList :: [TxTicket sz tx] -> ShowS
Show, (forall x. TxTicket sz tx -> Rep (TxTicket sz tx) x)
-> (forall x. Rep (TxTicket sz tx) x -> TxTicket sz tx)
-> Generic (TxTicket sz tx)
forall x. Rep (TxTicket sz tx) x -> TxTicket sz tx
forall x. TxTicket sz tx -> Rep (TxTicket sz tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall sz tx x. Rep (TxTicket sz tx) x -> TxTicket sz tx
forall sz tx x. TxTicket sz tx -> Rep (TxTicket sz tx) x
$cfrom :: forall sz tx x. TxTicket sz tx -> Rep (TxTicket sz tx) x
from :: forall x. TxTicket sz tx -> Rep (TxTicket sz tx) x
$cto :: forall sz tx x. Rep (TxTicket sz tx) x -> TxTicket sz tx
to :: forall x. Rep (TxTicket sz tx) x -> TxTicket sz tx
Generic, Context -> TxTicket sz tx -> IO (Maybe ThunkInfo)
Proxy (TxTicket sz tx) -> String
(Context -> TxTicket sz tx -> IO (Maybe ThunkInfo))
-> (Context -> TxTicket sz tx -> IO (Maybe ThunkInfo))
-> (Proxy (TxTicket sz tx) -> String)
-> NoThunks (TxTicket sz tx)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall sz tx.
(NoThunks tx, NoThunks sz) =>
Context -> TxTicket sz tx -> IO (Maybe ThunkInfo)
forall sz tx.
(NoThunks tx, NoThunks sz) =>
Proxy (TxTicket sz tx) -> String
$cnoThunks :: forall sz tx.
(NoThunks tx, NoThunks sz) =>
Context -> TxTicket sz tx -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxTicket sz tx -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall sz tx.
(NoThunks tx, NoThunks sz) =>
Context -> TxTicket sz tx -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxTicket sz tx -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall sz tx.
(NoThunks tx, NoThunks sz) =>
Proxy (TxTicket sz tx) -> String
showTypeOf :: Proxy (TxTicket sz tx) -> String
NoThunks)

-- | The mempool is a sequence of transactions with their ticket numbers and
-- size in bytes.
--
-- Transactions are allocated monotonically increasing ticket numbers as they
-- are appended to the mempool sequence. Transactions can be removed from any
-- position, not just the front.
--
-- The sequence is thus ordered by the ticket numbers. We can use the ticket
-- numbers as a compact representation for a \"reader\" location in the
-- sequence. If a reader knows it has seen all txs with a lower ticket number
-- then it is only interested in transactions with higher ticket numbers.
--
-- The mempool sequence is represented by a fingertree. We use a fingertree
-- measure to allow not just normal sequence operations but also efficient
-- splitting and indexing by the ticket number.
--
newtype TxSeq sz tx =
    TxSeq (StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx))
  deriving stock   (Int -> TxSeq sz tx -> ShowS
[TxSeq sz tx] -> ShowS
TxSeq sz tx -> String
(Int -> TxSeq sz tx -> ShowS)
-> (TxSeq sz tx -> String)
-> ([TxSeq sz tx] -> ShowS)
-> Show (TxSeq sz tx)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall sz tx. (Show tx, Show sz) => Int -> TxSeq sz tx -> ShowS
forall sz tx. (Show tx, Show sz) => [TxSeq sz tx] -> ShowS
forall sz tx. (Show tx, Show sz) => TxSeq sz tx -> String
$cshowsPrec :: forall sz tx. (Show tx, Show sz) => Int -> TxSeq sz tx -> ShowS
showsPrec :: Int -> TxSeq sz tx -> ShowS
$cshow :: forall sz tx. (Show tx, Show sz) => TxSeq sz tx -> String
show :: TxSeq sz tx -> String
$cshowList :: forall sz tx. (Show tx, Show sz) => [TxSeq sz tx] -> ShowS
showList :: [TxSeq sz tx] -> ShowS
Show)
  deriving newtype (Context -> TxSeq sz tx -> IO (Maybe ThunkInfo)
Proxy (TxSeq sz tx) -> String
(Context -> TxSeq sz tx -> IO (Maybe ThunkInfo))
-> (Context -> TxSeq sz tx -> IO (Maybe ThunkInfo))
-> (Proxy (TxSeq sz tx) -> String)
-> NoThunks (TxSeq sz tx)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall sz tx.
(NoThunks tx, NoThunks sz) =>
Context -> TxSeq sz tx -> IO (Maybe ThunkInfo)
forall sz tx.
(NoThunks tx, NoThunks sz) =>
Proxy (TxSeq sz tx) -> String
$cnoThunks :: forall sz tx.
(NoThunks tx, NoThunks sz) =>
Context -> TxSeq sz tx -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxSeq sz tx -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall sz tx.
(NoThunks tx, NoThunks sz) =>
Context -> TxSeq sz tx -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxSeq sz tx -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall sz tx.
(NoThunks tx, NoThunks sz) =>
Proxy (TxSeq sz tx) -> String
showTypeOf :: Proxy (TxSeq sz tx) -> String
NoThunks)

instance Measure sz => Foldable (TxSeq sz) where
  foldMap :: forall m a. Monoid m => (a -> m) -> TxSeq sz a -> m
foldMap a -> m
f (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz a)
txs) = (TxTicket sz a -> m)
-> StrictFingerTree (TxSeqMeasure sz) (TxTicket sz a) -> m
forall m a.
Monoid m =>
(a -> m) -> StrictFingerTree (TxSeqMeasure sz) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (a -> m
f (a -> m) -> (TxTicket sz a -> a) -> TxTicket sz a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxTicket sz a -> a
forall sz tx. TxTicket sz tx -> tx
txTicketTx) StrictFingerTree (TxSeqMeasure sz) (TxTicket sz a)
txs
  null :: forall a. TxSeq sz a -> Bool
null      (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz a)
txs) = StrictFingerTree (TxSeqMeasure sz) (TxTicket sz a) -> Bool
forall a. StrictFingerTree (TxSeqMeasure sz) a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Foldable.null StrictFingerTree (TxSeqMeasure sz) (TxTicket sz a)
txs
  length :: forall a. TxSeq sz a -> Int
length    (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz a)
txs) = TxSeqMeasure sz -> Int
forall sz. TxSeqMeasure sz -> Int
mCount (TxSeqMeasure sz -> Int) -> TxSeqMeasure sz -> Int
forall a b. (a -> b) -> a -> b
$ StrictFingerTree (TxSeqMeasure sz) (TxTicket sz a)
-> TxSeqMeasure sz
forall v a. Measured v a => a -> v
FingerTree.measure StrictFingerTree (TxSeqMeasure sz) (TxTicket sz a)
txs

-- | The 'StrictFingerTree' relies on a \"measure\" for subsequences in the
-- tree. A measure of the size of the subsequence allows for efficient
-- sequence operations. Also measuring the min and max ticket number allows
-- for efficient operations based on the ticket number (assuming the sequence
-- is ordered by ticket number).
--
-- To use a 'StrictFingerTree' with a 'TxSeqMeasure' we have to provide a way
-- to measure individual elements of the sequence (i.e. 'TxTicket's), via a
-- 'Measured' instance, and also a way to combine the measures, via a 'Monoid'
-- instance.
--
data TxSeqMeasure sz = TxSeqMeasure {
       forall sz. TxSeqMeasure sz -> Int
mCount     :: !Int,
       forall sz. TxSeqMeasure sz -> TicketNo
mMinTicket :: !TicketNo,
       forall sz. TxSeqMeasure sz -> TicketNo
mMaxTicket :: !TicketNo,
       forall sz. TxSeqMeasure sz -> sz
mSize      :: !sz
     }
  deriving Int -> TxSeqMeasure sz -> ShowS
[TxSeqMeasure sz] -> ShowS
TxSeqMeasure sz -> String
(Int -> TxSeqMeasure sz -> ShowS)
-> (TxSeqMeasure sz -> String)
-> ([TxSeqMeasure sz] -> ShowS)
-> Show (TxSeqMeasure sz)
forall sz. Show sz => Int -> TxSeqMeasure sz -> ShowS
forall sz. Show sz => [TxSeqMeasure sz] -> ShowS
forall sz. Show sz => TxSeqMeasure sz -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall sz. Show sz => Int -> TxSeqMeasure sz -> ShowS
showsPrec :: Int -> TxSeqMeasure sz -> ShowS
$cshow :: forall sz. Show sz => TxSeqMeasure sz -> String
show :: TxSeqMeasure sz -> String
$cshowList :: forall sz. Show sz => [TxSeqMeasure sz] -> ShowS
showList :: [TxSeqMeasure sz] -> ShowS
Show

instance Measure sz => FingerTree.Measured (TxSeqMeasure sz) (TxTicket sz tx) where
  measure :: TxTicket sz tx -> TxSeqMeasure sz
measure TxTicket sz tx
ticket = TxSeqMeasure {
      mCount :: Int
mCount = Int
1
    , mMinTicket :: TicketNo
mMinTicket = TicketNo
txTicketNo
    , mMaxTicket :: TicketNo
mMaxTicket = TicketNo
txTicketNo
    , mSize :: sz
mSize      = sz
txTicketSize
    }
    where
      TxTicket{TicketNo
txTicketNo :: forall sz tx. TxTicket sz tx -> TicketNo
txTicketNo :: TicketNo
txTicketNo, sz
txTicketSize :: forall sz tx. TxTicket sz tx -> sz
txTicketSize :: sz
txTicketSize} = TxTicket sz tx
ticket

instance Measure sz => Semigroup (TxSeqMeasure sz) where
  TxSeqMeasure sz
vl <> :: TxSeqMeasure sz -> TxSeqMeasure sz -> TxSeqMeasure sz
<> TxSeqMeasure sz
vr = Int -> TicketNo -> TicketNo -> sz -> TxSeqMeasure sz
forall sz. Int -> TicketNo -> TicketNo -> sz -> TxSeqMeasure sz
TxSeqMeasure
               (TxSeqMeasure sz -> Int
forall sz. TxSeqMeasure sz -> Int
mCount     TxSeqMeasure sz
vl Int -> Int -> Int
forall a. Num a => a -> a -> a
+              TxSeqMeasure sz -> Int
forall sz. TxSeqMeasure sz -> Int
mCount     TxSeqMeasure sz
vr)
               (TxSeqMeasure sz -> TicketNo
forall sz. TxSeqMeasure sz -> TicketNo
mMinTicket TxSeqMeasure sz
vl TicketNo -> TicketNo -> TicketNo
forall a. Ord a => a -> a -> a
`min`          TxSeqMeasure sz -> TicketNo
forall sz. TxSeqMeasure sz -> TicketNo
mMinTicket TxSeqMeasure sz
vr)
               (TxSeqMeasure sz -> TicketNo
forall sz. TxSeqMeasure sz -> TicketNo
mMaxTicket TxSeqMeasure sz
vl TicketNo -> TicketNo -> TicketNo
forall a. Ord a => a -> a -> a
`max`          TxSeqMeasure sz -> TicketNo
forall sz. TxSeqMeasure sz -> TicketNo
mMaxTicket TxSeqMeasure sz
vr)
               (TxSeqMeasure sz -> sz
forall sz. TxSeqMeasure sz -> sz
mSize      TxSeqMeasure sz
vl sz -> sz -> sz
forall a. Measure a => a -> a -> a
`Measure.plus` TxSeqMeasure sz -> sz
forall sz. TxSeqMeasure sz -> sz
mSize      TxSeqMeasure sz
vr)

instance Measure sz => Monoid (TxSeqMeasure sz) where
  mempty :: TxSeqMeasure sz
mempty  = TxSeqMeasure {
        mCount :: Int
mCount     = Int
0
      , mMinTicket :: TicketNo
mMinTicket = TicketNo
forall a. Bounded a => a
maxBound   -- note the inversion!
      , mMaxTicket :: TicketNo
mMaxTicket = TicketNo
forall a. Bounded a => a
minBound
      , mSize :: sz
mSize      = sz
forall a. Measure a => a
Measure.zero
      }
  mappend :: TxSeqMeasure sz -> TxSeqMeasure sz -> TxSeqMeasure sz
mappend = TxSeqMeasure sz -> TxSeqMeasure sz -> TxSeqMeasure sz
forall a. Semigroup a => a -> a -> a
(<>)

-- | A helper function for the ':>' pattern.
--
viewBack :: Measure sz => TxSeq sz tx -> Maybe (TxSeq sz tx, TxTicket sz tx)
viewBack :: forall sz tx.
Measure sz =>
TxSeq sz tx -> Maybe (TxSeq sz tx, TxTicket sz tx)
viewBack (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs) = case StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
-> ViewR (StrictFingerTree (TxSeqMeasure sz)) (TxTicket sz tx)
forall v a.
Measured v a =>
StrictFingerTree v a -> ViewR (StrictFingerTree v) a
FingerTree.viewr StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs of
                         ViewR (StrictFingerTree (TxSeqMeasure sz)) (TxTicket sz tx)
FingerTree.EmptyR     -> Maybe (TxSeq sz tx, TxTicket sz tx)
forall a. Maybe a
Nothing
                         StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs' FingerTree.:> TxTicket sz tx
tx -> (TxSeq sz tx, TxTicket sz tx)
-> Maybe (TxSeq sz tx, TxTicket sz tx)
forall a. a -> Maybe a
Just (StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
forall sz tx.
StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs', TxTicket sz tx
tx)

-- | A helper function for the ':<' pattern.
--
viewFront :: Measure sz => TxSeq sz tx -> Maybe (TxTicket sz tx, TxSeq sz tx)
viewFront :: forall sz tx.
Measure sz =>
TxSeq sz tx -> Maybe (TxTicket sz tx, TxSeq sz tx)
viewFront (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs) = case StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
-> ViewL (StrictFingerTree (TxSeqMeasure sz)) (TxTicket sz tx)
forall v a.
Measured v a =>
StrictFingerTree v a -> ViewL (StrictFingerTree v) a
FingerTree.viewl StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs of
                          ViewL (StrictFingerTree (TxSeqMeasure sz)) (TxTicket sz tx)
FingerTree.EmptyL     -> Maybe (TxTicket sz tx, TxSeq sz tx)
forall a. Maybe a
Nothing
                          TxTicket sz tx
tx FingerTree.:< StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs' -> (TxTicket sz tx, TxSeq sz tx)
-> Maybe (TxTicket sz tx, TxSeq sz tx)
forall a. a -> Maybe a
Just (TxTicket sz tx
tx, StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
forall sz tx.
StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs')

-- | An empty mempool sequence.
--
pattern Empty :: Measure sz => TxSeq sz tx
pattern $mEmpty :: forall {r} {sz} {tx}.
Measure sz =>
TxSeq sz tx -> ((# #) -> r) -> ((# #) -> r) -> r
$bEmpty :: forall sz tx. Measure sz => TxSeq sz tx
Empty <- (viewFront -> Nothing) where
  Empty = StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
forall sz tx.
StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
forall v a. Measured v a => StrictFingerTree v a
FingerTree.empty

-- | \( O(1) \). Access or add a tx at the back of the mempool sequence.
--
-- New txs are always added at the back.
--
pattern (:>) :: Measure sz => TxSeq sz tx -> TxTicket sz tx -> TxSeq sz tx
pattern txs $m:> :: forall {r} {sz} {tx}.
Measure sz =>
TxSeq sz tx
-> (TxSeq sz tx -> TxTicket sz tx -> r) -> ((# #) -> r) -> r
$b:> :: forall sz tx.
Measure sz =>
TxSeq sz tx -> TxTicket sz tx -> TxSeq sz tx
:> tx <- (viewBack -> Just (txs, tx)) where
  TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs :> TxTicket sz tx
tx = StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
forall sz tx.
StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
TxSeq (StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
-> TxTicket sz tx
-> StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
forall v a.
Measured v a =>
StrictFingerTree v a -> a -> StrictFingerTree v a
FingerTree.|> TxTicket sz tx
tx)  --TODO: assert ordered by ticket no

-- | \( O(1) \). Access a tx at the front of the mempool sequence.
--
-- Note that we never add txs at the front. We access txs from front to back
-- when forwarding txs to other peers, or when adding txs to blocks.
--
pattern (:<) :: Measure sz => TxTicket sz tx -> TxSeq sz tx -> TxSeq sz tx
pattern tx $m:< :: forall {r} {sz} {tx}.
Measure sz =>
TxSeq sz tx
-> (TxTicket sz tx -> TxSeq sz tx -> r) -> ((# #) -> r) -> r
:< txs <- (viewFront -> Just (tx, txs))

infixl 5 :>, :<

{-# COMPLETE Empty, (:>) #-}
{-# COMPLETE Empty, (:<) #-}

-- | \( O(\log(n)) \). Look up a transaction in the sequence by its 'TicketNo'.
--
lookupByTicketNo :: Measure sz => TxSeq sz tx -> TicketNo -> Maybe tx
lookupByTicketNo :: forall sz tx. Measure sz => TxSeq sz tx -> TicketNo -> Maybe tx
lookupByTicketNo (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs) TicketNo
n =
    case (TxSeqMeasure sz -> TxSeqMeasure sz -> Bool)
-> StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
-> SearchResult (TxSeqMeasure sz) (TxTicket sz tx)
forall v a.
Measured v a =>
(v -> v -> Bool) -> StrictFingerTree v a -> SearchResult v a
FingerTree.search (\TxSeqMeasure sz
ml TxSeqMeasure sz
mr -> TxSeqMeasure sz -> TicketNo
forall sz. TxSeqMeasure sz -> TicketNo
mMaxTicket TxSeqMeasure sz
ml TicketNo -> TicketNo -> Bool
forall a. Ord a => a -> a -> Bool
>= TicketNo
n
                                   Bool -> Bool -> Bool
&& TxSeqMeasure sz -> TicketNo
forall sz. TxSeqMeasure sz -> TicketNo
mMinTicket TxSeqMeasure sz
mr TicketNo -> TicketNo -> Bool
forall a. Ord a => a -> a -> Bool
>  TicketNo
n) StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs of
      FingerTree.Position StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
_ (TxTicket tx
tx TicketNo
n' sz
_) StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
_ | TicketNo
n' TicketNo -> TicketNo -> Bool
forall a. Eq a => a -> a -> Bool
== TicketNo
n -> tx -> Maybe tx
forall a. a -> Maybe a
Just tx
tx
      SearchResult (TxSeqMeasure sz) (TxTicket sz tx)
_                                                    -> Maybe tx
forall a. Maybe a
Nothing

-- | \( O(\log(n)) \). Split the sequence of transactions into two parts
-- based on the given 'TicketNo'. The first part has transactions with tickets
-- less than or equal to the given ticket, and the second part has transactions
-- with tickets strictly greater than the given ticket.
--
splitAfterTicketNo ::
     Measure sz
  => TxSeq sz tx
  -> TicketNo
  -> (TxSeq sz tx, TxSeq sz tx)
splitAfterTicketNo :: forall sz tx.
Measure sz =>
TxSeq sz tx -> TicketNo -> (TxSeq sz tx, TxSeq sz tx)
splitAfterTicketNo (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs) TicketNo
n =
    case (TxSeqMeasure sz -> Bool)
-> StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
-> (StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx),
    StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx))
forall v a.
Measured v a =>
(v -> Bool)
-> StrictFingerTree v a
-> (StrictFingerTree v a, StrictFingerTree v a)
FingerTree.split (\TxSeqMeasure sz
m -> TxSeqMeasure sz -> TicketNo
forall sz. TxSeqMeasure sz -> TicketNo
mMaxTicket TxSeqMeasure sz
m TicketNo -> TicketNo -> Bool
forall a. Ord a => a -> a -> Bool
> TicketNo
n) StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs of
      (StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
l, StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
r) -> (StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
forall sz tx.
StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
l, StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
forall sz tx.
StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
r)

-- | \( O(\log(n)) \). Split the sequence of transactions into two parts based
-- on the given @sz@. The first part has transactions whose summed @sz@ is less
-- than or equal to the given @sz@, and the second part has the remaining
-- transactions in the sequence.
--
splitAfterTxSize ::
     Measure sz
  => TxSeq sz tx
  -> sz
  -> (TxSeq sz tx, TxSeq sz tx)
splitAfterTxSize :: forall sz tx.
Measure sz =>
TxSeq sz tx -> sz -> (TxSeq sz tx, TxSeq sz tx)
splitAfterTxSize (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs) sz
n =
    case (TxSeqMeasure sz -> Bool)
-> StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
-> (StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx),
    StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx))
forall v a.
Measured v a =>
(v -> Bool)
-> StrictFingerTree v a
-> (StrictFingerTree v a, StrictFingerTree v a)
FingerTree.split (\TxSeqMeasure sz
m -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TxSeqMeasure sz -> sz
forall sz. TxSeqMeasure sz -> sz
mSize TxSeqMeasure sz
m sz -> sz -> Bool
forall a. Measure a => a -> a -> Bool
Measure.<= sz
n) StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
txs of
      (StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
l, StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
r) -> (StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
forall sz tx.
StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
l, StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
forall sz tx.
StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx) -> TxSeq sz tx
TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
r)

-- | \( O(n) \). Specification of 'splitAfterTxSize'.
--
-- Use 'splitAfterTxSize' as it should be faster.
--
-- This function is used to verify whether 'splitAfterTxSize' behaves as
-- expected.
splitAfterTxSizeSpec :: forall sz tx.
     Measure sz
  => TxSeq sz tx
  -> sz
  -> (TxSeq sz tx, TxSeq sz tx)
splitAfterTxSizeSpec :: forall sz tx.
Measure sz =>
TxSeq sz tx -> sz -> (TxSeq sz tx, TxSeq sz tx)
splitAfterTxSizeSpec TxSeq sz tx
txseq sz
n =
    ([TxTicket sz tx] -> TxSeq sz tx
forall sz tx. Measure sz => [TxTicket sz tx] -> TxSeq sz tx
fromList ([TxTicket sz tx] -> TxSeq sz tx)
-> ([TxTicket sz tx] -> TxSeq sz tx)
-> ([TxTicket sz tx], [TxTicket sz tx])
-> (TxSeq sz tx, TxSeq sz tx)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [TxTicket sz tx] -> TxSeq sz tx
forall sz tx. Measure sz => [TxTicket sz tx] -> TxSeq sz tx
fromList)
  (([TxTicket sz tx], [TxTicket sz tx])
 -> (TxSeq sz tx, TxSeq sz tx))
-> ([TxTicket sz tx], [TxTicket sz tx])
-> (TxSeq sz tx, TxSeq sz tx)
forall a b. (a -> b) -> a -> b
$ sz
-> [TxTicket sz tx]
-> [TxTicket sz tx]
-> ([TxTicket sz tx], [TxTicket sz tx])
go sz
forall a. Measure a => a
Measure.zero []
  ([TxTicket sz tx] -> ([TxTicket sz tx], [TxTicket sz tx]))
-> [TxTicket sz tx] -> ([TxTicket sz tx], [TxTicket sz tx])
forall a b. (a -> b) -> a -> b
$ TxSeq sz tx -> [TxTicket sz tx]
forall sz tx. TxSeq sz tx -> [TxTicket sz tx]
toList TxSeq sz tx
txseq
  where
    go :: sz
       -> [TxTicket sz tx]
       -> [TxTicket sz tx]
       -> ([TxTicket sz tx], [TxTicket sz tx])
    go :: sz
-> [TxTicket sz tx]
-> [TxTicket sz tx]
-> ([TxTicket sz tx], [TxTicket sz tx])
go sz
accSize [TxTicket sz tx]
accTickets = \case
      []
        -> ([TxTicket sz tx] -> [TxTicket sz tx]
forall a. [a] -> [a]
reverse [TxTicket sz tx]
accTickets, [])
      TxTicket sz tx
t:[TxTicket sz tx]
ts
        | let accSize' :: sz
accSize' = sz
accSize sz -> sz -> sz
forall a. Measure a => a -> a -> a
`Measure.plus` TxTicket sz tx -> sz
forall sz tx. TxTicket sz tx -> sz
txTicketSize TxTicket sz tx
t
        , sz
accSize' sz -> sz -> Bool
forall a. Measure a => a -> a -> Bool
Measure.<= sz
n
        -> sz
-> [TxTicket sz tx]
-> [TxTicket sz tx]
-> ([TxTicket sz tx], [TxTicket sz tx])
go sz
accSize' (TxTicket sz tx
tTxTicket sz tx -> [TxTicket sz tx] -> [TxTicket sz tx]
forall a. a -> [a] -> [a]
:[TxTicket sz tx]
accTickets) [TxTicket sz tx]
ts
        | Bool
otherwise
        -> ([TxTicket sz tx] -> [TxTicket sz tx]
forall a. [a] -> [a]
reverse [TxTicket sz tx]
accTickets, TxTicket sz tx
tTxTicket sz tx -> [TxTicket sz tx] -> [TxTicket sz tx]
forall a. a -> [a] -> [a]
:[TxTicket sz tx]
ts)

-- | Given a list of 'TxTicket's, construct a 'TxSeq'.
fromList :: Measure sz => [TxTicket sz tx] -> TxSeq sz tx
fromList :: forall sz tx. Measure sz => [TxTicket sz tx] -> TxSeq sz tx
fromList = (TxSeq sz tx -> TxTicket sz tx -> TxSeq sz tx)
-> TxSeq sz tx -> [TxTicket sz tx] -> TxSeq sz tx
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' TxSeq sz tx -> TxTicket sz tx -> TxSeq sz tx
forall sz tx.
Measure sz =>
TxSeq sz tx -> TxTicket sz tx -> TxSeq sz tx
(:>) TxSeq sz tx
forall sz tx. Measure sz => TxSeq sz tx
Empty

-- | Convert a 'TxSeq' to a list of 'TxTicket's.
toList :: TxSeq sz tx -> [TxTicket sz tx]
toList :: forall sz tx. TxSeq sz tx -> [TxTicket sz tx]
toList (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
ftree) = StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
-> [TxTicket sz tx]
forall a. StrictFingerTree (TxSeqMeasure sz) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
ftree

-- | Convert a 'TxSeq' to a list of pairs of transactions and their
-- associated 'TicketNo's and 'ByteSize32's.
toTuples :: HasByteSize sz => TxSeq sz tx -> [(tx, TicketNo, ByteSize32)]
toTuples :: forall sz tx.
HasByteSize sz =>
TxSeq sz tx -> [(tx, TicketNo, ByteSize32)]
toTuples (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
ftree) = (TxTicket sz tx -> (tx, TicketNo, ByteSize32))
-> [TxTicket sz tx] -> [(tx, TicketNo, ByteSize32)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\TxTicket sz tx
ticket ->
       ( TxTicket sz tx -> tx
forall sz tx. TxTicket sz tx -> tx
txTicketTx TxTicket sz tx
ticket
       , TxTicket sz tx -> TicketNo
forall sz tx. TxTicket sz tx -> TicketNo
txTicketNo TxTicket sz tx
ticket
       , sz -> ByteSize32
forall a. HasByteSize a => a -> ByteSize32
txMeasureByteSize (TxTicket sz tx -> sz
forall sz tx. TxTicket sz tx -> sz
txTicketSize TxTicket sz tx
ticket)
       )
    )
    (StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
-> [TxTicket sz tx]
forall a. StrictFingerTree (TxSeqMeasure sz) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
ftree)

-- | \( O(1) \). Return the total size of the given 'TxSeq'.
toSize :: Measure sz => TxSeq sz tx -> sz
toSize :: forall sz tx. Measure sz => TxSeq sz tx -> sz
toSize (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
ftree) = sz
mSize
  where
    TxSeqMeasure { sz
mSize :: forall sz. TxSeqMeasure sz -> sz
mSize :: sz
mSize } = StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
-> TxSeqMeasure sz
forall v a. Measured v a => a -> v
FingerTree.measure StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
ftree