{-# 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)

{-------------------------------------------------------------------------------
  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 sizes.
toTuples :: TxSeq sz tx -> [(tx, TicketNo, sz)]
toTuples :: forall sz tx. TxSeq sz tx -> [(tx, TicketNo, sz)]
toTuples (TxSeq StrictFingerTree (TxSeqMeasure sz) (TxTicket sz tx)
ftree) = (TxTicket sz tx -> (tx, TicketNo, sz))
-> [TxTicket sz tx] -> [(tx, TicketNo, sz)]
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
       , 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