{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoFieldSelectors #-}

module Haskoin.Store.Common
  ( Limits (..),
    Start (..),
    StoreReadBase (..),
    StoreReadExtra (..),
    StoreWrite (..),
    StoreEvent (..),
    getActiveBlock,
    getActiveTxData,
    getDefaultBalance,
    getTransaction,
    getNumTransaction,
    blockAtOrAfter,
    blockAtOrBefore,
    blockAtOrAfterMTP,
    xPubSummary,
    deriveAddresses,
    deriveFunction,
    deOffset,
    applyLimits,
    applyLimitsC,
    applyLimit,
    applyLimitC,
    sortTxs,
    nub',
    microseconds,
    streamThings,
    joinDescStreams,
  )
where

import Conduit
  ( ConduitT,
    await,
    dropC,
    mapC,
    sealConduitT,
    takeC,
    yield,
    ($$++),
  )
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Control.Monad.Trans.Reader (runReaderT)
import Data.ByteString (ByteString)
import Data.Default (Default (..))
import Data.HashSet qualified as H
import Data.Hashable (Hashable)
import Data.Map.Strict qualified as Map
import Data.Maybe (mapMaybe)
import Data.Time.Clock.System
  ( getSystemTime,
    systemNanoseconds,
    systemSeconds,
  )
import Data.Word (Word32, Word64)
import Haskoin
import Haskoin.Node (Chain, Peer)
import Haskoin.Store.Data
  ( Balance (..),
    BlockData (..),
    DeriveType (..),
    Spender,
    Transaction (..),
    TxData (..),
    TxRef (..),
    UnixTime,
    Unspent (..),
    XPubBal (..),
    XPubSpec (..),
    XPubSummary (..),
    XPubUnspent (..),
    nullBalance,
    toTransaction,
    zeroBalance,
  )
import UnliftIO (MonadIO, liftIO)

type DeriveAddr = XPubKey -> KeyIndex -> Address

type Offset = Word32

type Limit = Word32

data Start
  = AtTx !TxHash
  | AtBlock !BlockHeight
  deriving (Start -> Start -> Bool
(Start -> Start -> Bool) -> (Start -> Start -> Bool) -> Eq Start
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Start -> Start -> Bool
== :: Start -> Start -> Bool
$c/= :: Start -> Start -> Bool
/= :: Start -> Start -> Bool
Eq, Int -> Start -> ShowS
[Start] -> ShowS
Start -> String
(Int -> Start -> ShowS)
-> (Start -> String) -> ([Start] -> ShowS) -> Show Start
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Start -> ShowS
showsPrec :: Int -> Start -> ShowS
$cshow :: Start -> String
show :: Start -> String
$cshowList :: [Start] -> ShowS
showList :: [Start] -> ShowS
Show)

data Limits = Limits
  { Limits -> Word32
limit :: !Word32,
    Limits -> Word32
offset :: !Word32,
    Limits -> Maybe Start
start :: !(Maybe Start)
  }
  deriving (Limits -> Limits -> Bool
(Limits -> Limits -> Bool)
-> (Limits -> Limits -> Bool) -> Eq Limits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Limits -> Limits -> Bool
== :: Limits -> Limits -> Bool
$c/= :: Limits -> Limits -> Bool
/= :: Limits -> Limits -> Bool
Eq, Int -> Limits -> ShowS
[Limits] -> ShowS
Limits -> String
(Int -> Limits -> ShowS)
-> (Limits -> String) -> ([Limits] -> ShowS) -> Show Limits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Limits -> ShowS
showsPrec :: Int -> Limits -> ShowS
$cshow :: Limits -> String
show :: Limits -> String
$cshowList :: [Limits] -> ShowS
showList :: [Limits] -> ShowS
Show)

defaultLimits :: Limits
defaultLimits :: Limits
defaultLimits = Limits {$sel:limit:Limits :: Word32
limit = Word32
0, $sel:offset:Limits :: Word32
offset = Word32
0, $sel:start:Limits :: Maybe Start
start = Maybe Start
forall a. Maybe a
Nothing}

instance Default Limits where
  def :: Limits
def = Limits
defaultLimits

class (Monad m) => StoreReadBase m where
  getNetwork :: m Network
  getCtx :: m Ctx
  getBestBlock :: m (Maybe BlockHash)
  getBlocksAtHeight :: BlockHeight -> m [BlockHash]
  getBlock :: BlockHash -> m (Maybe BlockData)
  getTxData :: TxHash -> m (Maybe TxData)
  getSpender :: OutPoint -> m (Maybe Spender)
  getBalance :: Address -> m (Maybe Balance)
  getUnspent :: OutPoint -> m (Maybe Unspent)
  getMempool :: m [(UnixTime, TxHash)]

class (StoreReadBase m) => StoreReadExtra m where
  getAddressesTxs :: [Address] -> Limits -> m [TxRef]
  getAddressesUnspents :: [Address] -> Limits -> m [Unspent]
  getInitialGap :: m Word32
  getMaxGap :: m Word32
  getNumTxData :: Word64 -> m [TxData]
  getBalances :: [Address] -> m [Balance]
  getAddressTxs :: Address -> Limits -> m [TxRef]
  getAddressUnspents :: Address -> Limits -> m [Unspent]
  xPubBals :: XPubSpec -> m [XPubBal]
  xPubUnspents :: XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
  xPubTxs :: XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
  xPubTxCount :: XPubSpec -> [XPubBal] -> m Word32

class StoreWrite m where
  setBest :: BlockHash -> m ()
  insertBlock :: BlockData -> m ()
  setBlocksAtHeight :: [BlockHash] -> BlockHeight -> m ()
  insertTx :: TxData -> m ()
  insertAddrTx :: Address -> TxRef -> m ()
  deleteAddrTx :: Address -> TxRef -> m ()
  insertAddrUnspent :: Address -> Unspent -> m ()
  deleteAddrUnspent :: Address -> Unspent -> m ()
  addToMempool :: TxHash -> UnixTime -> m ()
  deleteFromMempool :: TxHash -> m ()
  setBalance :: Balance -> m ()
  insertUnspent :: Unspent -> m ()
  deleteUnspent :: OutPoint -> m ()

getActiveBlock :: (StoreReadExtra m) => BlockHash -> m (Maybe BlockData)
getActiveBlock :: forall (m :: * -> *).
StoreReadExtra m =>
BlockHash -> m (Maybe BlockData)
getActiveBlock BlockHash
bh =
  BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh m (Maybe BlockData)
-> (Maybe BlockData -> m (Maybe BlockData)) -> m (Maybe BlockData)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just BlockData
b | BlockData
b.main -> Maybe BlockData -> m (Maybe BlockData)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockData -> Maybe BlockData
forall a. a -> Maybe a
Just BlockData
b)
    Maybe BlockData
_ -> Maybe BlockData -> m (Maybe BlockData)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BlockData
forall a. Maybe a
Nothing

getActiveTxData :: (StoreReadBase m) => TxHash -> m (Maybe TxData)
getActiveTxData :: forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData TxHash
th =
  TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
th m (Maybe TxData)
-> (Maybe TxData -> m (Maybe TxData)) -> m (Maybe TxData)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just TxData
td | Bool -> Bool
not TxData
td.deleted -> Maybe TxData -> m (Maybe TxData)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxData -> Maybe TxData
forall a. a -> Maybe a
Just TxData
td)
    Maybe TxData
_ -> Maybe TxData -> m (Maybe TxData)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TxData
forall a. Maybe a
Nothing

getDefaultBalance :: (StoreReadBase m) => Address -> m Balance
getDefaultBalance :: forall (m :: * -> *). StoreReadBase m => Address -> m Balance
getDefaultBalance Address
a =
  Address -> m (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a m (Maybe Balance) -> (Maybe Balance -> m Balance) -> m Balance
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Balance
Nothing -> Balance -> m Balance
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Balance -> m Balance) -> Balance -> m Balance
forall a b. (a -> b) -> a -> b
$ Address -> Balance
zeroBalance Address
a
    Just Balance
b -> Balance -> m Balance
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Balance
b

deriveAddresses :: DeriveAddr -> XPubKey -> Word32 -> [(Word32, Address)]
deriveAddresses :: DeriveAddr -> XPubKey -> Word32 -> [(Word32, Address)]
deriveAddresses DeriveAddr
derive XPubKey
xpub Word32
start = (Word32 -> (Word32, Address)) -> [Word32] -> [(Word32, Address)]
forall a b. (a -> b) -> [a] -> [b]
map (\Word32
i -> (Word32
i, DeriveAddr
derive XPubKey
xpub Word32
i)) [Word32
start ..]

deriveFunction :: Ctx -> DeriveType -> DeriveAddr
deriveFunction :: Ctx -> DeriveType -> DeriveAddr
deriveFunction Ctx
ctx DeriveType
DeriveNormal XPubKey
i = (Address, PubKey) -> Address
forall a b. (a, b) -> a
fst ((Address, PubKey) -> Address)
-> (Word32 -> (Address, PubKey)) -> Word32 -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> XPubKey -> Word32 -> (Address, PubKey)
deriveAddr Ctx
ctx XPubKey
i
deriveFunction Ctx
ctx DeriveType
DeriveP2SH XPubKey
i = (Address, PubKey) -> Address
forall a b. (a, b) -> a
fst ((Address, PubKey) -> Address)
-> (Word32 -> (Address, PubKey)) -> Word32 -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> XPubKey -> Word32 -> (Address, PubKey)
deriveCompatWitnessAddr Ctx
ctx XPubKey
i
deriveFunction Ctx
ctx DeriveType
DeriveP2WPKH XPubKey
i = (Address, PubKey) -> Address
forall a b. (a, b) -> a
fst ((Address, PubKey) -> Address)
-> (Word32 -> (Address, PubKey)) -> Word32 -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> XPubKey -> Word32 -> (Address, PubKey)
deriveWitnessAddr Ctx
ctx XPubKey
i

xPubSummary :: XPubSpec -> [XPubBal] -> XPubSummary
xPubSummary :: XPubSpec -> [XPubBal] -> XPubSummary
xPubSummary XPubSpec
_xspec [XPubBal]
xbals =
  XPubSummary
    { $sel:confirmed:XPubSummary :: Word64
confirmed = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.balance.confirmed) [XPubBal]
bs),
      $sel:unconfirmed:XPubSummary :: Word64
unconfirmed = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.balance.unconfirmed) [XPubBal]
bs),
      $sel:received:XPubSummary :: Word64
received = Word64
rx,
      $sel:utxo:XPubSummary :: Word64
utxo = Word64
uc,
      $sel:change:XPubSummary :: Word32
change = Word32
ch,
      $sel:external:XPubSummary :: Word32
external = Word32
ex
    }
  where
    bs :: [XPubBal]
bs = (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (XPubBal -> Bool) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Bool
nullBalance (Balance -> Bool) -> (XPubBal -> Balance) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.balance)) [XPubBal]
xbals
    ex :: Word32
ex = (Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> Word32
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
max Word32
0 [Word32
i | XPubBal {$sel:path:XPubBal :: XPubBal -> [Word32]
path = [Word32
0, Word32
i]} <- [XPubBal]
bs]
    ch :: Word32
ch = (Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> Word32
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
max Word32
0 [Word32
i | XPubBal {$sel:path:XPubBal :: XPubBal -> [Word32]
path = [Word32
1, Word32
i]} <- [XPubBal]
bs]
    uc :: Word64
uc = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [XPubBal
b.balance.utxo | XPubBal
b <- [XPubBal]
bs]
    xt :: [XPubBal]
xt = [XPubBal
b | b :: XPubBal
b@XPubBal {$sel:path:XPubBal :: XPubBal -> [Word32]
path = [Word32
0, Word32
_]} <- [XPubBal]
bs]
    rx :: Word64
rx = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [XPubBal
b.balance.received | XPubBal
b <- [XPubBal]
xt]

getTransaction ::
  ( StoreReadBase m) =>TxHash -> m (Maybe Transaction)
getTransaction :: forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
h = do
  Ctx
ctx <- m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
  (TxData -> Transaction) -> Maybe TxData -> Maybe Transaction
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ctx -> TxData -> Transaction
toTransaction Ctx
ctx) (Maybe TxData -> Maybe Transaction)
-> m (Maybe TxData) -> m (Maybe Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
h

getNumTransaction ::
  ( StoreReadExtra m) =>Word64 -> m [Transaction]
getNumTransaction :: forall (m :: * -> *). StoreReadExtra m => Word64 -> m [Transaction]
getNumTransaction Word64
i =
  m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx m Ctx -> (Ctx -> m [Transaction]) -> m [Transaction]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ctx
ctx ->
    (TxData -> Transaction) -> [TxData] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (Ctx -> TxData -> Transaction
toTransaction Ctx
ctx) ([TxData] -> [Transaction]) -> m [TxData] -> m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> m [TxData]
forall (m :: * -> *). StoreReadExtra m => Word64 -> m [TxData]
getNumTxData Word64
i

blockAtOrAfter ::
  (MonadIO m, StoreReadExtra m) =>
  Chain ->
  UnixTime ->
  m (Maybe BlockData)
blockAtOrAfter :: forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrAfter Chain
ch Word64
q = MaybeT m BlockData -> m (Maybe BlockData)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m BlockData -> m (Maybe BlockData))
-> MaybeT m BlockData -> m (Maybe BlockData)
forall a b. (a -> b) -> a -> b
$ do
  Network
net <- m Network -> MaybeT m Network
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
  BlockNode
x <- m (Maybe BlockNode) -> MaybeT m BlockNode
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockNode) -> MaybeT m BlockNode)
-> m (Maybe BlockNode) -> MaybeT m BlockNode
forall a b. (a -> b) -> a -> b
$ IO (Maybe BlockNode) -> m (Maybe BlockNode)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BlockNode) -> m (Maybe BlockNode))
-> IO (Maybe BlockNode) -> m (Maybe BlockNode)
forall a b. (a -> b) -> a -> b
$ ReaderT Chain IO (Maybe BlockNode) -> Chain -> IO (Maybe BlockNode)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Network
-> (BlockNode -> ReaderT Chain IO Ordering)
-> ReaderT Chain IO (Maybe BlockNode)
forall (m :: * -> *).
BlockHeaders m =>
Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
firstGreaterOrEqual Network
net BlockNode -> ReaderT Chain IO Ordering
forall {m :: * -> *} {a} {r} {p}.
(Monad m, Integral a, HasField "timestamp" r a,
 HasField "header" p r) =>
p -> m Ordering
f) Chain
ch
  m (Maybe BlockData) -> MaybeT m BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockData) -> MaybeT m BlockData)
-> m (Maybe BlockData) -> MaybeT m BlockData
forall a b. (a -> b) -> a -> b
$ BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock (BlockHash -> m (Maybe BlockData))
-> BlockHash -> m (Maybe BlockData)
forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHash
headerHash BlockNode
x.header
  where
    f :: p -> m Ordering
f p
x =
      let t :: Word64
t = a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
x.header.timestamp
       in Ordering -> m Ordering
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ordering -> m Ordering) -> Ordering -> m Ordering
forall a b. (a -> b) -> a -> b
$ Word64
t Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Word64
q

blockAtOrBefore ::
  (MonadIO m, StoreReadExtra m) =>
  Chain ->
  UnixTime ->
  m (Maybe BlockData)
blockAtOrBefore :: forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
q = MaybeT m BlockData -> m (Maybe BlockData)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m BlockData -> m (Maybe BlockData))
-> MaybeT m BlockData -> m (Maybe BlockData)
forall a b. (a -> b) -> a -> b
$ do
  Network
net <- m Network -> MaybeT m Network
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
  BlockNode
x <- m (Maybe BlockNode) -> MaybeT m BlockNode
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockNode) -> MaybeT m BlockNode)
-> m (Maybe BlockNode) -> MaybeT m BlockNode
forall a b. (a -> b) -> a -> b
$ IO (Maybe BlockNode) -> m (Maybe BlockNode)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BlockNode) -> m (Maybe BlockNode))
-> IO (Maybe BlockNode) -> m (Maybe BlockNode)
forall a b. (a -> b) -> a -> b
$ ReaderT Chain IO (Maybe BlockNode) -> Chain -> IO (Maybe BlockNode)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Network
-> (BlockNode -> ReaderT Chain IO Ordering)
-> ReaderT Chain IO (Maybe BlockNode)
forall (m :: * -> *).
BlockHeaders m =>
Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
lastSmallerOrEqual Network
net BlockNode -> ReaderT Chain IO Ordering
forall {m :: * -> *} {a} {r} {p}.
(Monad m, Integral a, HasField "timestamp" r a,
 HasField "header" p r) =>
p -> m Ordering
f) Chain
ch
  m (Maybe BlockData) -> MaybeT m BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockData) -> MaybeT m BlockData)
-> m (Maybe BlockData) -> MaybeT m BlockData
forall a b. (a -> b) -> a -> b
$ BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock (BlockHash -> m (Maybe BlockData))
-> BlockHash -> m (Maybe BlockData)
forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHash
headerHash BlockNode
x.header
  where
    f :: p -> m Ordering
f p
x =
      let t :: Word64
t = a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
x.header.timestamp
       in Ordering -> m Ordering
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ordering -> m Ordering) -> Ordering -> m Ordering
forall a b. (a -> b) -> a -> b
$ Word64
t Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Word64
q

blockAtOrAfterMTP ::
  (MonadIO m, StoreReadExtra m) =>
  Chain ->
  UnixTime ->
  m (Maybe BlockData)
blockAtOrAfterMTP :: forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrAfterMTP Chain
ch Word64
q = MaybeT m BlockData -> m (Maybe BlockData)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m BlockData -> m (Maybe BlockData))
-> MaybeT m BlockData -> m (Maybe BlockData)
forall a b. (a -> b) -> a -> b
$ do
  Network
net <- m Network -> MaybeT m Network
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
  BlockNode
x <- m (Maybe BlockNode) -> MaybeT m BlockNode
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockNode) -> MaybeT m BlockNode)
-> m (Maybe BlockNode) -> MaybeT m BlockNode
forall a b. (a -> b) -> a -> b
$ IO (Maybe BlockNode) -> m (Maybe BlockNode)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BlockNode) -> m (Maybe BlockNode))
-> IO (Maybe BlockNode) -> m (Maybe BlockNode)
forall a b. (a -> b) -> a -> b
$ ReaderT Chain IO (Maybe BlockNode) -> Chain -> IO (Maybe BlockNode)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Network
-> (BlockNode -> ReaderT Chain IO Ordering)
-> ReaderT Chain IO (Maybe BlockNode)
forall (m :: * -> *).
BlockHeaders m =>
Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
firstGreaterOrEqual Network
net BlockNode -> ReaderT Chain IO Ordering
forall {m :: * -> *}. BlockHeaders m => BlockNode -> m Ordering
f) Chain
ch
  m (Maybe BlockData) -> MaybeT m BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockData) -> MaybeT m BlockData)
-> m (Maybe BlockData) -> MaybeT m BlockData
forall a b. (a -> b) -> a -> b
$ BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock (BlockHash -> m (Maybe BlockData))
-> BlockHash -> m (Maybe BlockData)
forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHash
headerHash BlockNode
x.header
  where
    f :: BlockNode -> m Ordering
f BlockNode
x = do
      Word64
t <- Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> m Word32 -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockNode -> m Word32
forall (m :: * -> *). BlockHeaders m => BlockNode -> m Word32
mtp BlockNode
x
      Ordering -> m Ordering
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ordering -> m Ordering) -> Ordering -> m Ordering
forall a b. (a -> b) -> a -> b
$ Word64
t Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Word64
q

-- | Events that the store can generate.
data StoreEvent
  = StoreBestBlock !BlockHash
  | StoreMempoolNew !TxHash
  | StoreMempoolDelete !TxHash
  | StorePeerConnected !Peer
  | StorePeerDisconnected !Peer
  | StorePeerPong !Peer !Word64
  | StoreTxAnnounce !Peer ![TxHash]
  | StoreTxReject !Peer !TxHash !RejectCode !ByteString

applyLimits :: Limits -> [a] -> [a]
applyLimits :: forall a. Limits -> [a] -> [a]
applyLimits Limits {Maybe Start
Word32
$sel:limit:Limits :: Limits -> Word32
$sel:offset:Limits :: Limits -> Word32
$sel:start:Limits :: Limits -> Maybe Start
limit :: Word32
offset :: Word32
start :: Maybe Start
..} = Word32 -> [a] -> [a]
forall a. Word32 -> [a] -> [a]
applyLimit Word32
limit ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> [a] -> [a]
forall a. Word32 -> [a] -> [a]
applyOffset Word32
offset

applyOffset :: Offset -> [a] -> [a]
applyOffset :: forall a. Word32 -> [a] -> [a]
applyOffset = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int -> [a] -> [a]) -> (Word32 -> Int) -> Word32 -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

applyLimit :: Limit -> [a] -> [a]
applyLimit :: forall a. Word32 -> [a] -> [a]
applyLimit Word32
0 = [a] -> [a]
forall a. a -> a
id
applyLimit Word32
l = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l)

deOffset :: Limits -> Limits
deOffset :: Limits -> Limits
deOffset Limits
l = case Limits
l.limit of
  Word32
0 -> Limits
l {offset = 0}
  Word32
_ -> Limits
l {limit = l.limit + l.offset, offset = 0}

applyLimitsC :: (Monad m) => Limits -> ConduitT i i m ()
applyLimitsC :: forall (m :: * -> *) i. Monad m => Limits -> ConduitT i i m ()
applyLimitsC Limits {Maybe Start
Word32
$sel:limit:Limits :: Limits -> Word32
$sel:offset:Limits :: Limits -> Word32
$sel:start:Limits :: Limits -> Maybe Start
limit :: Word32
offset :: Word32
start :: Maybe Start
..} = Word32 -> ConduitT i i m ()
forall (m :: * -> *) i. Monad m => Word32 -> ConduitT i i m ()
applyOffsetC Word32
offset ConduitT i i m () -> ConduitT i i m () -> ConduitT i i m ()
forall a b.
ConduitT i i m a -> ConduitT i i m b -> ConduitT i i m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> ConduitT i i m ()
forall (m :: * -> *) i. Monad m => Word32 -> ConduitT i i m ()
applyLimitC Word32
limit

applyOffsetC :: (Monad m) => Offset -> ConduitT i i m ()
applyOffsetC :: forall (m :: * -> *) i. Monad m => Word32 -> ConduitT i i m ()
applyOffsetC = Int -> ConduitT i i m ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC (Int -> ConduitT i i m ())
-> (Word32 -> Int) -> Word32 -> ConduitT i i m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

applyLimitC :: (Monad m) => Limit -> ConduitT i i m ()
applyLimitC :: forall (m :: * -> *) i. Monad m => Word32 -> ConduitT i i m ()
applyLimitC Word32
0 = (i -> i) -> ConduitT i i m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC i -> i
forall a. a -> a
id
applyLimitC Word32
l = Int -> ConduitT i i m ()
forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l)

sortTxs :: [Tx] -> [(Word32, Tx)]
sortTxs :: [Tx] -> [(Word32, Tx)]
sortTxs [Tx]
txs = [(Word32, Tx)]
-> HashSet TxHash -> [(Word32, Tx)] -> [(Word32, Tx)]
forall {a}. [(a, Tx)] -> HashSet TxHash -> [(a, Tx)] -> [(a, Tx)]
go [] HashSet TxHash
thset ([(Word32, Tx)] -> [(Word32, Tx)])
-> [(Word32, Tx)] -> [(Word32, Tx)]
forall a b. (a -> b) -> a -> b
$ [Word32] -> [Tx] -> [(Word32, Tx)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] [Tx]
txs
  where
    thset :: HashSet TxHash
thset = [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList ((Tx -> TxHash) -> [Tx] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map Tx -> TxHash
txHash [Tx]
txs)
    go :: [(a, Tx)] -> HashSet TxHash -> [(a, Tx)] -> [(a, Tx)]
go [] HashSet TxHash
_ [] = []
    go [(a, Tx)]
orphans HashSet TxHash
ths [] = [(a, Tx)] -> HashSet TxHash -> [(a, Tx)] -> [(a, Tx)]
go [] HashSet TxHash
ths [(a, Tx)]
orphans
    go [(a, Tx)]
orphans HashSet TxHash
ths ((a
i, Tx
tx) : [(a, Tx)]
xs) =
      let ops :: [TxHash]
ops = (TxIn -> TxHash) -> [TxIn] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (.outpoint.hash) Tx
tx.inputs
          orp :: Bool
orp = (TxHash -> Bool) -> [TxHash] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TxHash -> HashSet TxHash -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`H.member` HashSet TxHash
ths) [TxHash]
ops
       in if Bool
orp
            then [(a, Tx)] -> HashSet TxHash -> [(a, Tx)] -> [(a, Tx)]
go ((a
i, Tx
tx) (a, Tx) -> [(a, Tx)] -> [(a, Tx)]
forall a. a -> [a] -> [a]
: [(a, Tx)]
orphans) HashSet TxHash
ths [(a, Tx)]
xs
            else (a
i, Tx
tx) (a, Tx) -> [(a, Tx)] -> [(a, Tx)]
forall a. a -> [a] -> [a]
: [(a, Tx)] -> HashSet TxHash -> [(a, Tx)] -> [(a, Tx)]
go [(a, Tx)]
orphans (Tx -> TxHash
txHash Tx
tx TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
`H.delete` HashSet TxHash
ths) [(a, Tx)]
xs

nub' :: (Hashable a) => [a] -> [a]
nub' :: forall a. Hashable a => [a] -> [a]
nub' = HashSet a -> [a]
forall a. HashSet a -> [a]
H.toList (HashSet a -> [a]) -> ([a] -> HashSet a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList

microseconds :: (MonadIO m) => m Integer
microseconds :: forall (m :: * -> *). MonadIO m => m Integer
microseconds =
  let f :: SystemTime -> Integer
f SystemTime
t =
        Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (SystemTime -> Int64
systemSeconds SystemTime
t) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000000
          Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (SystemTime -> Word32
systemNanoseconds SystemTime
t) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000
   in IO Integer -> m Integer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> m Integer) -> IO Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ SystemTime -> Integer
f (SystemTime -> Integer) -> IO SystemTime -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime
getSystemTime

streamThings ::
  (Monad m) =>
  (Limits -> m [a]) ->
  Maybe (a -> TxHash) ->
  Limits ->
  ConduitT () a m ()
streamThings :: forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings Limits -> m [a]
getit Maybe (a -> TxHash)
gettx Limits
limits =
  m [a] -> ConduitT () a m [a]
forall (m :: * -> *) a. Monad m => m a -> ConduitT () a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Limits -> m [a]
getit Limits
limits) ConduitT () a m [a]
-> ([a] -> ConduitT () a m ()) -> ConduitT () a m ()
forall a b.
ConduitT () a m a -> (a -> ConduitT () a m b) -> ConduitT () a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [] -> () -> ConduitT () a m ()
forall a. a -> ConduitT () a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [a]
ls -> (a -> ConduitT () a m ()) -> [a] -> ConduitT () a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> ConduitT () a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [a]
ls ConduitT () a m () -> ConduitT () a m () -> ConduitT () a m ()
forall a b.
ConduitT () a m a -> ConduitT () a m b -> ConduitT () a m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Limits -> a -> ConduitT () a m ()
forall {i}. Limits -> a -> ConduitT i a m ()
go Limits
limits ([a] -> a
forall a. HasCallStack => [a] -> a
last [a]
ls)
  where
    h :: Limits -> a -> Maybe Limits
h Limits
l a
x = case Maybe (a -> TxHash)
gettx of
      Just a -> TxHash
g -> Limits -> Maybe Limits
forall a. a -> Maybe a
Just Limits
l {offset = 1, start = Just (AtTx (g x))}
      Maybe (a -> TxHash)
Nothing -> case Limits
l.limit of
        Word32
0 -> Maybe Limits
forall a. Maybe a
Nothing
        Word32
_ -> Limits -> Maybe Limits
forall a. a -> Maybe a
Just Limits
l {offset = l.offset + l.limit}
    go :: Limits -> a -> ConduitT i a m ()
go Limits
l a
x = case Limits -> a -> Maybe Limits
h Limits
l a
x of
      Maybe Limits
Nothing -> () -> ConduitT i a m ()
forall a. a -> ConduitT i a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Limits
l' ->
        m [a] -> ConduitT i a m [a]
forall (m :: * -> *) a. Monad m => m a -> ConduitT i a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Limits -> m [a]
getit Limits
l') ConduitT i a m [a]
-> ([a] -> ConduitT i a m ()) -> ConduitT i a m ()
forall a b.
ConduitT i a m a -> (a -> ConduitT i a m b) -> ConduitT i a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          [] -> () -> ConduitT i a m ()
forall a. a -> ConduitT i a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          [a]
ls -> (a -> ConduitT i a m ()) -> [a] -> ConduitT i a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> ConduitT i a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [a]
ls ConduitT i a m () -> ConduitT i a m () -> ConduitT i a m ()
forall a b.
ConduitT i a m a -> ConduitT i a m b -> ConduitT i a m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Limits -> a -> ConduitT i a m ()
go Limits
l' ([a] -> a
forall a. HasCallStack => [a] -> a
last [a]
ls)

joinDescStreams ::
  (Monad m, Ord a) =>
  [ConduitT () a m ()] ->
  ConduitT () a m ()
joinDescStreams :: forall (m :: * -> *) a.
(Monad m, Ord a) =>
[ConduitT () a m ()] -> ConduitT () a m ()
joinDescStreams [ConduitT () a m ()]
xs = do
  let ss :: [SealedConduitT () a m ()]
ss = (ConduitT () a m () -> SealedConduitT () a m ())
-> [ConduitT () a m ()] -> [SealedConduitT () a m ()]
forall a b. (a -> b) -> [a] -> [b]
map ConduitT () a m () -> SealedConduitT () a m ()
forall i o (m :: * -> *) r.
ConduitT i o m r -> SealedConduitT i o m r
sealConduitT [ConduitT () a m ()]
xs
  Maybe a -> Map a [SealedConduitT () a m ()] -> ConduitT () a m ()
forall {m :: * -> *} {a} {i}.
(Monad m, Ord a) =>
Maybe a -> Map a [SealedConduitT () a m ()] -> ConduitT i a m ()
go Maybe a
forall a. Maybe a
Nothing (Map a [SealedConduitT () a m ()] -> ConduitT () a m ())
-> ConduitT () a m (Map a [SealedConduitT () a m ()])
-> ConduitT () a m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [SealedConduitT () a m ()]
-> ConduitT () a m (Map a [SealedConduitT () a m ()])
forall {k} {t :: (* -> *) -> * -> *} {m :: * -> *}.
(Ord k, MonadTrans t, Monad m, Functor (t m)) =>
[SealedConduitT () k m ()]
-> t m (Map k [SealedConduitT () k m ()])
g [SealedConduitT () a m ()]
ss
  where
    j :: (a, f a) -> f (a, [a])
j (a
x, f a
y) = (,[a
x]) (a -> (a, [a])) -> f a -> f (a, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
y
    g :: [SealedConduitT () k m ()]
-> t m (Map k [SealedConduitT () k m ()])
g [SealedConduitT () k m ()]
ss =
      let l :: t m [(k, [SealedConduitT () k m ()])]
l = ((SealedConduitT () k m (), Maybe k)
 -> Maybe (k, [SealedConduitT () k m ()]))
-> [(SealedConduitT () k m (), Maybe k)]
-> [(k, [SealedConduitT () k m ()])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SealedConduitT () k m (), Maybe k)
-> Maybe (k, [SealedConduitT () k m ()])
forall {f :: * -> *} {a} {a}. Functor f => (a, f a) -> f (a, [a])
j ([(SealedConduitT () k m (), Maybe k)]
 -> [(k, [SealedConduitT () k m ()])])
-> t m [(SealedConduitT () k m (), Maybe k)]
-> t m [(k, [SealedConduitT () k m ()])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [(SealedConduitT () k m (), Maybe k)]
-> t m [(SealedConduitT () k m (), Maybe k)]
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((SealedConduitT () k m () -> m (SealedConduitT () k m (), Maybe k))
-> [SealedConduitT () k m ()]
-> m [(SealedConduitT () k m (), Maybe k)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (SealedConduitT () k m ()
-> ConduitT k Void m (Maybe k)
-> m (SealedConduitT () k m (), Maybe k)
forall (m :: * -> *) a b.
Monad m =>
SealedConduitT () a m ()
-> ConduitT a Void m b -> m (SealedConduitT () a m (), b)
$$++ ConduitT k Void m (Maybe k)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await) [SealedConduitT () k m ()]
ss)
       in ([SealedConduitT () k m ()]
 -> [SealedConduitT () k m ()] -> [SealedConduitT () k m ()])
-> [(k, [SealedConduitT () k m ()])]
-> Map k [SealedConduitT () k m ()]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [SealedConduitT () k m ()]
-> [SealedConduitT () k m ()] -> [SealedConduitT () k m ()]
forall a. [a] -> [a] -> [a]
(++) ([(k, [SealedConduitT () k m ()])]
 -> Map k [SealedConduitT () k m ()])
-> t m [(k, [SealedConduitT () k m ()])]
-> t m (Map k [SealedConduitT () k m ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t m [(k, [SealedConduitT () k m ()])]
l
    go :: Maybe a -> Map a [SealedConduitT () a m ()] -> ConduitT i a m ()
go Maybe a
m Map a [SealedConduitT () a m ()]
mp = case Map a [SealedConduitT () a m ()]
-> Maybe (a, [SealedConduitT () a m ()])
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map a [SealedConduitT () a m ()]
mp of
      Maybe (a, [SealedConduitT () a m ()])
Nothing -> () -> ConduitT i a m ()
forall a. a -> ConduitT i a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (a
x, [SealedConduitT () a m ()]
ss) -> do
        case Maybe a
m of
          Maybe a
Nothing -> a -> ConduitT i a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield a
x
          Just a
x'
            | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x' -> () -> ConduitT i a m ()
forall a. a -> ConduitT i a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bool
otherwise -> a -> ConduitT i a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield a
x
        Map a [SealedConduitT () a m ()]
mp1 <- [SealedConduitT () a m ()]
-> ConduitT i a m (Map a [SealedConduitT () a m ()])
forall {k} {t :: (* -> *) -> * -> *} {m :: * -> *}.
(Ord k, MonadTrans t, Monad m, Functor (t m)) =>
[SealedConduitT () k m ()]
-> t m (Map k [SealedConduitT () k m ()])
g [SealedConduitT () a m ()]
ss
        let mp2 :: Map a [SealedConduitT () a m ()]
mp2 = Map a [SealedConduitT () a m ()]
-> Map a [SealedConduitT () a m ()]
forall k a. Map k a -> Map k a
Map.deleteMax Map a [SealedConduitT () a m ()]
mp
            mp' :: Map a [SealedConduitT () a m ()]
mp' = ([SealedConduitT () a m ()]
 -> [SealedConduitT () a m ()] -> [SealedConduitT () a m ()])
-> Map a [SealedConduitT () a m ()]
-> Map a [SealedConduitT () a m ()]
-> Map a [SealedConduitT () a m ()]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [SealedConduitT () a m ()]
-> [SealedConduitT () a m ()] -> [SealedConduitT () a m ()]
forall a. [a] -> [a] -> [a]
(++) Map a [SealedConduitT () a m ()]
mp1 Map a [SealedConduitT () a m ()]
mp2
        Maybe a -> Map a [SealedConduitT () a m ()] -> ConduitT i a m ()
go (a -> Maybe a
forall a. a -> Maybe a
Just a
x) Map a [SealedConduitT () a m ()]
mp'