{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Haskoin.Store.Common
( Limits (..),
Start (..),
StoreReadBase (..),
StoreReadExtra (..),
StoreWrite (..),
StoreEvent (..),
PubExcept (..),
DataMetrics (..),
getActiveBlock,
getActiveTxData,
getDefaultBalance,
getTransaction,
getNumTransaction,
blockAtOrAfter,
blockAtOrBefore,
blockAtOrAfterMTP,
xPubSummary,
deriveAddresses,
deriveFunction,
deOffset,
applyLimits,
applyLimitsC,
applyLimit,
applyLimitC,
sortTxs,
nub',
microseconds,
streamThings,
joinDescStreams,
createDataMetrics,
)
where
import Conduit
( ConduitT,
await,
dropC,
mapC,
sealConduitT,
takeC,
yield,
($$++),
)
import Control.DeepSeq (NFData)
import Control.Exception (Exception)
import Control.Monad (forM)
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 qualified Data.HashSet as H
import Data.Hashable (Hashable)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as I
import Data.List (sortOn)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, mapMaybe)
import Data.Ord (Down (..))
import Data.Serialize (Serialize (..))
import Data.Time.Clock.System
( getSystemTime,
systemNanoseconds,
systemSeconds,
)
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import Haskoin
( Address,
BlockHash,
BlockHeader (..),
BlockHeight,
BlockNode (..),
KeyIndex,
Network (..),
OutPoint (..),
RejectCode (..),
Tx (..),
TxHash (..),
TxIn (..),
XPubKey (..),
deriveAddr,
deriveCompatWitnessAddr,
deriveWitnessAddr,
firstGreaterOrEqual,
headerHash,
lastSmallerOrEqual,
mtp,
pubSubKey,
txHash,
)
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 qualified System.Metrics as Metrics
import System.Metrics.Counter (Counter)
import qualified System.Metrics.Counter as Counter
import UnliftIO (MonadIO, liftIO)
type DeriveAddr = XPubKey -> KeyIndex -> Address
type Offset = Word32
type Limit = Word32
data Start
= AtTx {Start -> TxHash
atTxHash :: !TxHash}
| AtBlock {Start -> Word32
atBlockHeight :: !BlockHeight}
deriving (Start -> Start -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Start -> Start -> Bool
$c/= :: Start -> Start -> Bool
== :: Start -> Start -> Bool
$c== :: Start -> Start -> Bool
Eq, Int -> Start -> ShowS
[Start] -> ShowS
Start -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Start] -> ShowS
$cshowList :: [Start] -> ShowS
show :: Start -> String
$cshow :: Start -> String
showsPrec :: Int -> Start -> ShowS
$cshowsPrec :: Int -> Start -> ShowS
Show)
data Limits = Limits
{ Limits -> Word32
limit :: !Word32,
Limits -> Word32
offset :: !Word32,
Limits -> Maybe Start
start :: !(Maybe Start)
}
deriving (Limits -> Limits -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Limits -> Limits -> Bool
$c/= :: Limits -> Limits -> Bool
== :: Limits -> Limits -> Bool
$c== :: Limits -> Limits -> Bool
Eq, Int -> Limits -> ShowS
[Limits] -> ShowS
Limits -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limits] -> ShowS
$cshowList :: [Limits] -> ShowS
show :: Limits -> String
$cshow :: Limits -> String
showsPrec :: Int -> Limits -> ShowS
$cshowsPrec :: Int -> Limits -> ShowS
Show)
defaultLimits :: Limits
defaultLimits :: Limits
defaultLimits = Limits {limit :: Word32
limit = Word32
0, offset :: Word32
offset = Word32
0, start :: Maybe Start
start = forall a. Maybe a
Nothing}
instance Default Limits where
def :: Limits
def = Limits
defaultLimits
class Monad m => StoreReadBase m where
getNetwork :: m Network
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 => 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 =
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just BlockData
b | BlockData -> Bool
blockDataMainChain BlockData
b -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just BlockData
b)
Maybe BlockData
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
getActiveTxData :: StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData :: forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData TxHash
th =
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
th forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just TxData
td | Bool -> Bool
not (TxData -> Bool
txDataDeleted TxData
td) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just TxData
td)
Maybe TxData
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
getDefaultBalance :: StoreReadBase m => Address -> m Balance
getDefaultBalance :: forall (m :: * -> *). StoreReadBase m => Address -> m Balance
getDefaultBalance Address
a =
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Balance
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Address -> Balance
zeroBalance Address
a
Just Balance
b -> 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 = forall a b. (a -> b) -> [a] -> [b]
map (\Word32
i -> (Word32
i, DeriveAddr
derive XPubKey
xpub Word32
i)) [Word32
start ..]
deriveFunction :: DeriveType -> DeriveAddr
deriveFunction :: DeriveType -> DeriveAddr
deriveFunction DeriveType
DeriveNormal XPubKey
i = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> Word32 -> (Address, PubKey)
deriveAddr XPubKey
i
deriveFunction DeriveType
DeriveP2SH XPubKey
i = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> Word32 -> (Address, PubKey)
deriveCompatWitnessAddr XPubKey
i
deriveFunction DeriveType
DeriveP2WPKH XPubKey
i = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> Word32 -> (Address, PubKey)
deriveWitnessAddr XPubKey
i
xPubSummary :: XPubSpec -> [XPubBal] -> XPubSummary
xPubSummary :: XPubSpec -> [XPubBal] -> XPubSummary
xPubSummary XPubSpec
_xspec [XPubBal]
xbals =
XPubSummary
{ xPubSummaryConfirmed :: Word64
xPubSummaryConfirmed = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Word64
balanceAmount forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
bs),
xPubSummaryZero :: Word64
xPubSummaryZero = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Word64
balanceZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
bs),
xPubSummaryReceived :: Word64
xPubSummaryReceived = Word64
rx,
xPubUnspentCount :: Word64
xPubUnspentCount = Word64
uc,
xPubChangeIndex :: Word32
xPubChangeIndex = Word32
ch,
xPubExternalIndex :: Word32
xPubExternalIndex = Word32
ex
}
where
bs :: [XPubBal]
bs = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Bool
nullBalance forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
xbals
ex :: Word32
ex = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Ord a => a -> a -> a
max Word32
0 [Word32
i | XPubBal {xPubBalPath :: XPubBal -> [Word32]
xPubBalPath = [Word32
0, Word32
i]} <- [XPubBal]
bs]
ch :: Word32
ch = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Ord a => a -> a -> a
max Word32
0 [Word32
i | XPubBal {xPubBalPath :: XPubBal -> [Word32]
xPubBalPath = [Word32
1, Word32
i]} <- [XPubBal]
bs]
uc :: Word64
uc = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance -> Word64
balanceUnspentCount (XPubBal -> Balance
xPubBal XPubBal
b) | XPubBal
b <- [XPubBal]
bs]
xt :: [XPubBal]
xt = [XPubBal
b | b :: XPubBal
b@XPubBal {xPubBalPath :: XPubBal -> [Word32]
xPubBalPath = [Word32
0, Word32
_]} <- [XPubBal]
bs]
rx :: Word64
rx = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance -> Word64
balanceTotalReceived (XPubBal -> Balance
xPubBal XPubBal
b) | XPubBal
b <- [XPubBal]
xt]
getTransaction ::
(Monad m, StoreReadBase m) => TxHash -> m (Maybe Transaction)
getTransaction :: forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
h = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxData -> Transaction
toTransaction forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
h
getNumTransaction ::
(Monad m, StoreReadExtra m) => Word64 -> m [Transaction]
getNumTransaction :: forall (m :: * -> *).
(Monad m, StoreReadExtra m) =>
Word64 -> m [Transaction]
getNumTransaction Word64
i = forall a b. (a -> b) -> [a] -> [b]
map TxData -> Transaction
toTransaction forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
Network
net <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
BlockNode
x <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *).
BlockHeaders m =>
Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
firstGreaterOrEqual Network
net forall {m :: * -> *}. Monad m => BlockNode -> m Ordering
f) Chain
ch
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
x))
where
f :: BlockNode -> m Ordering
f BlockNode
x =
let t :: Word64
t = forall a b. (Integral a, Num b) => a -> b
fromIntegral (BlockHeader -> Word32
blockTimestamp (BlockNode -> BlockHeader
nodeHeader BlockNode
x))
in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word64
t 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 = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
Network
net <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
BlockNode
x <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *).
BlockHeaders m =>
Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
lastSmallerOrEqual Network
net forall {m :: * -> *}. Monad m => BlockNode -> m Ordering
f) Chain
ch
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
x))
where
f :: BlockNode -> m Ordering
f BlockNode
x =
let t :: Word64
t = forall a b. (Integral a, Num b) => a -> b
fromIntegral (BlockHeader -> Word32
blockTimestamp (BlockNode -> BlockHeader
nodeHeader BlockNode
x))
in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word64
t 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 = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
Network
net <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
BlockNode
x <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *).
BlockHeaders m =>
Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
firstGreaterOrEqual Network
net forall {m :: * -> *}. BlockHeaders m => BlockNode -> m Ordering
f) Chain
ch
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
x))
where
f :: BlockNode -> m Ordering
f BlockNode
x = do
Word64
t <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). BlockHeaders m => BlockNode -> m Word32
mtp BlockNode
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word64
t forall a. Ord a => a -> a -> Ordering
`compare` Word64
q
data StoreEvent
= StoreBestBlock !BlockHash
| StoreMempoolNew !TxHash
| StoreMempoolDelete !TxHash
| StorePeerConnected !Peer
| StorePeerDisconnected !Peer
| StorePeerPong !Peer !Word64
| StoreTxAnnounce !Peer ![TxHash]
| StoreTxReject !Peer !TxHash !RejectCode !ByteString
data PubExcept
= PubNoPeers
| PubReject RejectCode
| PubTimeout
| PubPeerDisconnected
deriving (PubExcept -> PubExcept -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubExcept -> PubExcept -> Bool
$c/= :: PubExcept -> PubExcept -> Bool
== :: PubExcept -> PubExcept -> Bool
$c== :: PubExcept -> PubExcept -> Bool
Eq, PubExcept -> ()
forall a. (a -> ()) -> NFData a
rnf :: PubExcept -> ()
$crnf :: PubExcept -> ()
NFData, forall x. Rep PubExcept x -> PubExcept
forall x. PubExcept -> Rep PubExcept x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PubExcept x -> PubExcept
$cfrom :: forall x. PubExcept -> Rep PubExcept x
Generic, Get PubExcept
Putter PubExcept
forall t. Putter t -> Get t -> Serialize t
get :: Get PubExcept
$cget :: Get PubExcept
put :: Putter PubExcept
$cput :: Putter PubExcept
Serialize)
instance Show PubExcept where
show :: PubExcept -> String
show PubExcept
PubNoPeers = String
"no peers"
show (PubReject RejectCode
c) =
String
"rejected: "
forall a. Semigroup a => a -> a -> a
<> case RejectCode
c of
RejectCode
RejectMalformed -> String
"malformed"
RejectCode
RejectInvalid -> String
"invalid"
RejectCode
RejectObsolete -> String
"obsolete"
RejectCode
RejectDuplicate -> String
"duplicate"
RejectCode
RejectNonStandard -> String
"not standard"
RejectCode
RejectDust -> String
"dust"
RejectCode
RejectInsufficientFee -> String
"insufficient fee"
RejectCode
RejectCheckpoint -> String
"checkpoint"
show PubExcept
PubTimeout = String
"peer timeout or silent rejection"
show PubExcept
PubPeerDisconnected = String
"peer disconnected"
instance Exception PubExcept
applyLimits :: Limits -> [a] -> [a]
applyLimits :: forall a. Limits -> [a] -> [a]
applyLimits Limits {Maybe Start
Word32
start :: Maybe Start
offset :: Word32
limit :: Word32
start :: Limits -> Maybe Start
offset :: Limits -> Word32
limit :: Limits -> Word32
..} = forall a. Word32 -> [a] -> [a]
applyLimit Word32
limit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Word32 -> [a] -> [a]
applyOffset Word32
offset
applyOffset :: Offset -> [a] -> [a]
applyOffset :: forall a. Word32 -> [a] -> [a]
applyOffset = forall a. Int -> [a] -> [a]
drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
applyLimit :: Limit -> [a] -> [a]
applyLimit :: forall a. Word32 -> [a] -> [a]
applyLimit Word32
0 = forall a. a -> a
id
applyLimit Word32
l = forall a. Int -> [a] -> [a]
take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l)
deOffset :: Limits -> Limits
deOffset :: Limits -> Limits
deOffset Limits
l = case Limits -> Word32
limit Limits
l of
Word32
0 -> Limits
l {offset :: Word32
offset = Word32
0}
Word32
_ -> Limits
l {limit :: Word32
limit = Limits -> Word32
limit Limits
l forall a. Num a => a -> a -> a
+ Limits -> Word32
offset Limits
l, offset :: Word32
offset = Word32
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
start :: Maybe Start
offset :: Word32
limit :: Word32
start :: Limits -> Maybe Start
offset :: Limits -> Word32
limit :: Limits -> Word32
..} = forall (m :: * -> *) i. Monad m => Word32 -> ConduitT i i m ()
applyOffsetC Word32
offset forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 = forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC forall a. a -> a
id
applyLimitC Word32
l = forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l)
sortTxs :: [Tx] -> [(Word32, Tx)]
sortTxs :: [Tx] -> [(Word32, Tx)]
sortTxs [Tx]
txs = forall {a}. [(a, Tx)] -> HashSet TxHash -> [(a, Tx)] -> [(a, Tx)]
go [] HashSet TxHash
thset forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] [Tx]
txs
where
thset :: HashSet TxHash
thset = forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList (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 = forall a b. (a -> b) -> [a] -> [b]
map (OutPoint -> TxHash
outPointHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> OutPoint
prevOutput) (Tx -> [TxIn]
txIn Tx
tx)
orp :: Bool
orp = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (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) forall a. a -> [a] -> [a]
: [(a, Tx)]
orphans) HashSet TxHash
ths [(a, Tx)]
xs
else (a
i, Tx
tx) forall a. a -> [a] -> [a]
: [(a, Tx)] -> HashSet TxHash -> [(a, Tx)] -> [(a, Tx)]
go [(a, Tx)]
orphans (Tx -> TxHash
txHash Tx
tx forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
`H.delete` HashSet TxHash
ths) [(a, Tx)]
xs
nub' :: (Eq a, Hashable a) => [a] -> [a]
nub' :: forall a. (Eq a, Hashable a) => [a] -> [a]
nub' = forall a. HashSet a -> [a]
H.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall a. Integral a => a -> Integer
toInteger (SystemTime -> Int64
systemSeconds SystemTime
t) forall a. Num a => a -> a -> a
* Integer
1000000
forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Integer
toInteger (SystemTime -> Word32
systemNanoseconds SystemTime
t) forall a. Integral a => a -> a -> a
`div` Integer
1000
in forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ SystemTime -> Integer
f 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 =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Limits -> m [a]
getit Limits
limits) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
[a]
ls -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [a]
ls forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {i}. Limits -> a -> ConduitT i a m ()
go Limits
limits (forall a. [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 -> forall a. a -> Maybe a
Just Limits
l {offset :: Word32
offset = Word32
1, start :: Maybe Start
start = forall a. a -> Maybe a
Just (TxHash -> Start
AtTx (a -> TxHash
g a
x))}
Maybe (a -> TxHash)
Nothing -> case Limits -> Word32
limit Limits
l of
Word32
0 -> forall a. Maybe a
Nothing
Word32
_ -> forall a. a -> Maybe a
Just Limits
l {offset :: Word32
offset = Limits -> Word32
offset Limits
l forall a. Num a => a -> a -> a
+ Limits -> Word32
limit Limits
l}
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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Limits
l' ->
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Limits -> m [a]
getit Limits
l') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
[a]
ls -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [a]
ls forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Limits -> a -> ConduitT i a m ()
go Limits
l' (forall a. [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 = forall a b. (a -> b) -> [a] -> [b]
map forall i o (m :: * -> *) r.
ConduitT i o m r -> SealedConduitT i o m r
sealConduitT [ConduitT () a m ()]
xs
forall {m :: * -> *} {a} {i}.
(Monad m, Ord a) =>
Maybe a -> Map a [SealedConduitT () a m ()] -> ConduitT i a m ()
go forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {t :: (* -> *) -> * -> *} {m :: * -> *} {k}.
(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]) 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {f :: * -> *} {a} {a}. Functor f => (a, f a) -> f (a, [a])
j forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a b.
Monad m =>
SealedConduitT () a m ()
-> ConduitT a Void m b -> m (SealedConduitT () a m (), b)
$$++ forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await) [SealedConduitT () k m ()]
ss)
in forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) 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 forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map a [SealedConduitT () a m ()]
mp of
Maybe (a, [SealedConduitT () a m ()])
Nothing -> 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 -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield a
x
Just a
x'
| a
x forall a. Eq a => a -> a -> Bool
== a
x' -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield a
x
Map a [SealedConduitT () a m ()]
mp1 <- forall {t :: (* -> *) -> * -> *} {m :: * -> *} {k}.
(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 = forall k a. Map k a -> Map k a
Map.deleteMax Map a [SealedConduitT () a m ()]
mp
mp' :: Map a [SealedConduitT () a m ()]
mp' = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith 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 (forall a. a -> Maybe a
Just a
x) Map a [SealedConduitT () a m ()]
mp'
data DataMetrics = DataMetrics
{ DataMetrics -> Counter
dataBestCount :: !Counter,
DataMetrics -> Counter
dataBlockCount :: !Counter,
DataMetrics -> Counter
dataTxCount :: !Counter,
DataMetrics -> Counter
dataMempoolCount :: !Counter,
DataMetrics -> Counter
dataBalanceCount :: !Counter,
DataMetrics -> Counter
dataUnspentCount :: !Counter,
DataMetrics -> Counter
dataAddrTxCount :: !Counter,
DataMetrics -> Counter
dataXPubBals :: !Counter,
DataMetrics -> Counter
dataXPubUnspents :: !Counter,
DataMetrics -> Counter
dataXPubTxs :: !Counter,
DataMetrics -> Counter
dataXPubTxCount :: !Counter
}
createDataMetrics :: MonadIO m => Metrics.Store -> m DataMetrics
createDataMetrics :: forall (m :: * -> *). MonadIO m => Store -> m DataMetrics
createDataMetrics Store
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Counter
dataBestCount <- Text -> Store -> IO Counter
Metrics.createCounter Text
"data.best_block" Store
s
Counter
dataBlockCount <- Text -> Store -> IO Counter
Metrics.createCounter Text
"data.blocks" Store
s
Counter
dataTxCount <- Text -> Store -> IO Counter
Metrics.createCounter Text
"data.txs" Store
s
Counter
dataMempoolCount <- Text -> Store -> IO Counter
Metrics.createCounter Text
"data.mempool" Store
s
Counter
dataBalanceCount <- Text -> Store -> IO Counter
Metrics.createCounter Text
"data.balances" Store
s
Counter
dataUnspentCount <- Text -> Store -> IO Counter
Metrics.createCounter Text
"data.unspents" Store
s
Counter
dataAddrTxCount <- Text -> Store -> IO Counter
Metrics.createCounter Text
"data.address_txs" Store
s
Counter
dataXPubBals <- Text -> Store -> IO Counter
Metrics.createCounter Text
"data.xpub_balances" Store
s
Counter
dataXPubUnspents <- Text -> Store -> IO Counter
Metrics.createCounter Text
"data.xpub_unspents" Store
s
Counter
dataXPubTxs <- Text -> Store -> IO Counter
Metrics.createCounter Text
"data.xpub_txs" Store
s
Counter
dataXPubTxCount <- Text -> Store -> IO Counter
Metrics.createCounter Text
"data.xpub_tx_count" Store
s
forall (m :: * -> *) a. Monad m => a -> m a
return DataMetrics {Counter
dataXPubTxCount :: Counter
dataXPubTxs :: Counter
dataXPubUnspents :: Counter
dataXPubBals :: Counter
dataAddrTxCount :: Counter
dataUnspentCount :: Counter
dataBalanceCount :: Counter
dataMempoolCount :: Counter
dataTxCount :: Counter
dataBlockCount :: Counter
dataBestCount :: Counter
dataXPubTxCount :: Counter
dataXPubTxs :: Counter
dataXPubUnspents :: Counter
dataXPubBals :: Counter
dataAddrTxCount :: Counter
dataUnspentCount :: Counter
dataBalanceCount :: Counter
dataMempoolCount :: Counter
dataTxCount :: Counter
dataBlockCount :: Counter
dataBestCount :: Counter
..}