{-# 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(..)
, getActiveBlock
, getActiveTxData
, getDefaultBalance
, getSpenders
, getTransaction
, getNumTransaction
, blockAtOrAfter
, blockAtOrBefore
, blockAtOrAfterMTP
, deOffset
, applyLimits
, applyLimitsC
, applyLimit
, applyLimitC
, sortTxs
, nub'
, microseconds
, streamThings
, joinDescStreams
) 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 UnliftIO (MonadIO, liftIO)
type DeriveAddr = XPubKey -> KeyIndex -> Address
type Offset = Word32
type Limit = Word32
data Start
= AtTx{Start -> TxHash
atTxHash :: !TxHash}
| AtBlock{Start -> BlockHeight
atBlockHeight :: !BlockHeight}
deriving (Start -> Start -> Bool
(Start -> Start -> Bool) -> (Start -> Start -> Bool) -> Eq Start
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
(Int -> Start -> ShowS)
-> (Start -> String) -> ([Start] -> ShowS) -> Show Start
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 -> BlockHeight
limit :: !Word32
, Limits -> BlockHeight
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
/= :: Limits -> Limits -> Bool
$c/= :: Limits -> Limits -> Bool
== :: Limits -> Limits -> Bool
$c== :: 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
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 :: BlockHeight -> BlockHeight -> Maybe Start -> Limits
Limits { limit :: BlockHeight
limit = BlockHeight
0, offset :: BlockHeight
offset = BlockHeight
0, start :: 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
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)]
countBlocks :: Int -> m ()
countBlocks Int
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
countTxs :: Int -> m ()
countTxs Int
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
countBalances :: Int -> m ()
countBalances Int
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
countUnspents :: Int -> m ()
countUnspents Int
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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]
getBalances [Address]
as =
(Address -> Maybe Balance -> Balance)
-> [Address] -> [Maybe Balance] -> [Balance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Address -> Maybe Balance -> Balance
f [Address]
as ([Maybe Balance] -> [Balance]) -> m [Maybe Balance] -> m [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address -> m (Maybe Balance)) -> [Address] -> m [Maybe Balance]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Address -> m (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance [Address]
as
where
f :: Address -> Maybe Balance -> Balance
f Address
a Maybe Balance
Nothing = Address -> Balance
zeroBalance Address
a
f Address
_ (Just Balance
b) = Balance
b
getAddressTxs :: Address -> Limits -> m [TxRef]
getAddressTxs Address
a = [Address] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address
a]
getAddressUnspents :: Address -> Limits -> m [Unspent]
getAddressUnspents Address
a = [Address] -> Limits -> m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [Unspent]
getAddressesUnspents [Address
a]
xPubBals :: XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub = do
BlockHeight
igap <- m BlockHeight
forall (m :: * -> *). StoreReadExtra m => m BlockHeight
getInitialGap
BlockHeight
gap <- m BlockHeight
forall (m :: * -> *). StoreReadExtra m => m BlockHeight
getMaxGap
[XPubBal]
ext1 <- BlockHeight
-> BlockHeight -> [(BlockHeight, Address)] -> m [XPubBal]
forall (m :: * -> *) a.
(StoreReadExtra m, Integral a) =>
a -> BlockHeight -> [(BlockHeight, Address)] -> m [XPubBal]
derive_until_gap BlockHeight
gap BlockHeight
0 (Int -> [(BlockHeight, Address)] -> [(BlockHeight, Address)]
forall a. Int -> [a] -> [a]
take (BlockHeight -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
igap) (BlockHeight -> BlockHeight -> [(BlockHeight, Address)]
aderiv BlockHeight
0 BlockHeight
0))
if (XPubBal -> Bool) -> [XPubBal] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Balance -> Bool
nullBalance (Balance -> Bool) -> (XPubBal -> Balance) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
ext1
then [XPubBal] -> m [XPubBal]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
[XPubBal]
ext2 <- BlockHeight
-> BlockHeight -> [(BlockHeight, Address)] -> m [XPubBal]
forall (m :: * -> *) a.
(StoreReadExtra m, Integral a) =>
a -> BlockHeight -> [(BlockHeight, Address)] -> m [XPubBal]
derive_until_gap BlockHeight
gap BlockHeight
0 (BlockHeight -> BlockHeight -> [(BlockHeight, Address)]
aderiv BlockHeight
0 BlockHeight
igap)
[XPubBal]
chg <- BlockHeight
-> BlockHeight -> [(BlockHeight, Address)] -> m [XPubBal]
forall (m :: * -> *) a.
(StoreReadExtra m, Integral a) =>
a -> BlockHeight -> [(BlockHeight, Address)] -> m [XPubBal]
derive_until_gap BlockHeight
gap BlockHeight
1 (BlockHeight -> BlockHeight -> [(BlockHeight, Address)]
aderiv BlockHeight
1 BlockHeight
0)
[XPubBal] -> m [XPubBal]
forall (m :: * -> *) a. Monad m => a -> m a
return ([XPubBal]
ext1 [XPubBal] -> [XPubBal] -> [XPubBal]
forall a. Semigroup a => a -> a -> a
<> [XPubBal]
ext2 [XPubBal] -> [XPubBal] -> [XPubBal]
forall a. Semigroup a => a -> a -> a
<> [XPubBal]
chg)
where
aderiv :: BlockHeight -> BlockHeight -> [(BlockHeight, Address)]
aderiv BlockHeight
m =
DeriveAddr -> XPubKey -> BlockHeight -> [(BlockHeight, Address)]
deriveAddresses
(DeriveType -> DeriveAddr
deriveFunction (XPubSpec -> DeriveType
xPubDeriveType XPubSpec
xpub))
(XPubKey -> BlockHeight -> XPubKey
pubSubKey (XPubSpec -> XPubKey
xPubSpecKey XPubSpec
xpub) BlockHeight
m)
xbalance :: BlockHeight -> Balance -> BlockHeight -> XPubBal
xbalance BlockHeight
m Balance
b BlockHeight
n = XPubBal :: [BlockHeight] -> Balance -> XPubBal
XPubBal {xPubBalPath :: [BlockHeight]
xPubBalPath = [BlockHeight
m, BlockHeight
n], xPubBal :: Balance
xPubBal = Balance
b}
derive_until_gap :: a -> BlockHeight -> [(BlockHeight, Address)] -> m [XPubBal]
derive_until_gap a
_ BlockHeight
_ [] = [XPubBal] -> m [XPubBal]
forall (m :: * -> *) a. Monad m => a -> m a
return []
derive_until_gap a
gap BlockHeight
m [(BlockHeight, Address)]
as = do
let ([(BlockHeight, Address)]
as1, [(BlockHeight, Address)]
as2) = Int
-> [(BlockHeight, Address)]
-> ([(BlockHeight, Address)], [(BlockHeight, Address)])
forall a. Int -> [a] -> ([a], [a])
splitAt (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
gap) [(BlockHeight, Address)]
as
Int -> m ()
forall (m :: * -> *). StoreReadExtra m => Int -> m ()
countXPubDerivations ([(BlockHeight, Address)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(BlockHeight, Address)]
as1)
[Balance]
bs <- [Address] -> m [Balance]
forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances (((BlockHeight, Address) -> Address)
-> [(BlockHeight, Address)] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (BlockHeight, Address) -> Address
forall a b. (a, b) -> b
snd [(BlockHeight, Address)]
as1)
let xbs :: [XPubBal]
xbs = (Balance -> BlockHeight -> XPubBal)
-> [Balance] -> [BlockHeight] -> [XPubBal]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (BlockHeight -> Balance -> BlockHeight -> XPubBal
xbalance BlockHeight
m) [Balance]
bs (((BlockHeight, Address) -> BlockHeight)
-> [(BlockHeight, Address)] -> [BlockHeight]
forall a b. (a -> b) -> [a] -> [b]
map (BlockHeight, Address) -> BlockHeight
forall a b. (a, b) -> a
fst [(BlockHeight, Address)]
as1)
if (Balance -> Bool) -> [Balance] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Balance -> Bool
nullBalance [Balance]
bs
then [XPubBal] -> m [XPubBal]
forall (m :: * -> *) a. Monad m => a -> m a
return [XPubBal]
xbs
else ([XPubBal]
xbs [XPubBal] -> [XPubBal] -> [XPubBal]
forall a. Semigroup a => a -> a -> a
<>) ([XPubBal] -> [XPubBal]) -> m [XPubBal] -> m [XPubBal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> BlockHeight -> [(BlockHeight, Address)] -> m [XPubBal]
derive_until_gap a
gap BlockHeight
m [(BlockHeight, Address)]
as2
xPubSummary :: XPubSpec -> [XPubBal] -> m XPubSummary
xPubSummary XPubSpec
_xspec [XPubBal]
xbals = XPubSummary -> m XPubSummary
forall (m :: * -> *) a. Monad m => a -> m a
return
XPubSummary :: Word64
-> Word64
-> Word64
-> Word64
-> BlockHeight
-> BlockHeight
-> XPubSummary
XPubSummary
{ xPubSummaryConfirmed :: Word64
xPubSummaryConfirmed = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Word64
balanceAmount (Balance -> Word64) -> (XPubBal -> Balance) -> XPubBal -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
bs)
, xPubSummaryZero :: Word64
xPubSummaryZero = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Word64
balanceZero (Balance -> Word64) -> (XPubBal -> Balance) -> XPubBal -> Word64
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 :: BlockHeight
xPubChangeIndex = BlockHeight
ch
, xPubExternalIndex :: BlockHeight
xPubExternalIndex = BlockHeight
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
. XPubBal -> Balance
xPubBal) [XPubBal]
xbals
ex :: BlockHeight
ex = (BlockHeight -> BlockHeight -> BlockHeight)
-> BlockHeight -> [BlockHeight] -> BlockHeight
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl BlockHeight -> BlockHeight -> BlockHeight
forall a. Ord a => a -> a -> a
max BlockHeight
0 [BlockHeight
i | XPubBal {xPubBalPath :: XPubBal -> [BlockHeight]
xPubBalPath = [BlockHeight
0, BlockHeight
i]} <- [XPubBal]
bs]
ch :: BlockHeight
ch = (BlockHeight -> BlockHeight -> BlockHeight)
-> BlockHeight -> [BlockHeight] -> BlockHeight
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl BlockHeight -> BlockHeight -> BlockHeight
forall a. Ord a => a -> a -> a
max BlockHeight
0 [BlockHeight
i | XPubBal {xPubBalPath :: XPubBal -> [BlockHeight]
xPubBalPath = [BlockHeight
1, BlockHeight
i]} <- [XPubBal]
bs]
uc :: Word64
uc = [Word64] -> Word64
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 -> [BlockHeight]
xPubBalPath = [BlockHeight
0, BlockHeight
_]} <- [XPubBal]
bs]
rx :: Word64
rx = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance -> Word64
balanceTotalReceived (XPubBal -> Balance
xPubBal XPubBal
b) | XPubBal
b <- [XPubBal]
xt]
xPubUnspents :: XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
_xspec [XPubBal]
xbals Limits
limits =
Limits -> [XPubUnspent] -> [XPubUnspent]
forall a. Limits -> [a] -> [a]
applyLimits Limits
limits ([XPubUnspent] -> [XPubUnspent])
-> ([[XPubUnspent]] -> [XPubUnspent])
-> [[XPubUnspent]]
-> [XPubUnspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPubUnspent -> Down XPubUnspent) -> [XPubUnspent] -> [XPubUnspent]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn XPubUnspent -> Down XPubUnspent
forall a. a -> Down a
Down ([XPubUnspent] -> [XPubUnspent])
-> ([[XPubUnspent]] -> [XPubUnspent])
-> [[XPubUnspent]]
-> [XPubUnspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[XPubUnspent]] -> [XPubUnspent]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[XPubUnspent]] -> [XPubUnspent])
-> m [[XPubUnspent]] -> m [XPubUnspent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XPubBal -> m [XPubUnspent]) -> [XPubBal] -> m [[XPubUnspent]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM XPubBal -> m [XPubUnspent]
forall (f :: * -> *).
StoreReadExtra f =>
XPubBal -> f [XPubUnspent]
h [XPubBal]
cs
where
l :: Limits
l = Limits -> Limits
deOffset Limits
limits
cs :: [XPubBal]
cs = (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0) (Word64 -> Bool) -> (XPubBal -> Word64) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Word64
balanceUnspentCount (Balance -> Word64) -> (XPubBal -> Balance) -> XPubBal -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
xbals
i :: XPubBal -> m [Unspent]
i XPubBal
b = do
[Unspent]
us <- Address -> Limits -> m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents (Balance -> Address
balanceAddress (XPubBal -> Balance
xPubBal XPubBal
b)) Limits
l
Int -> m ()
forall (m :: * -> *). StoreReadBase m => Int -> m ()
countUnspents ([Unspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Unspent]
us)
[Unspent] -> m [Unspent]
forall (m :: * -> *) a. Monad m => a -> m a
return [Unspent]
us
f :: XPubBal -> Unspent -> XPubUnspent
f XPubBal
b Unspent
t = XPubUnspent :: Unspent -> [BlockHeight] -> XPubUnspent
XPubUnspent {xPubUnspentPath :: [BlockHeight]
xPubUnspentPath = XPubBal -> [BlockHeight]
xPubBalPath XPubBal
b, xPubUnspent :: Unspent
xPubUnspent = Unspent
t}
h :: XPubBal -> f [XPubUnspent]
h XPubBal
b = (Unspent -> XPubUnspent) -> [Unspent] -> [XPubUnspent]
forall a b. (a -> b) -> [a] -> [b]
map (XPubBal -> Unspent -> XPubUnspent
f XPubBal
b) ([Unspent] -> [XPubUnspent]) -> f [Unspent] -> f [XPubUnspent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubBal -> f [Unspent]
forall (m :: * -> *). StoreReadExtra m => XPubBal -> m [Unspent]
i XPubBal
b
xPubTxs :: XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
_xspec [XPubBal]
xbals Limits
limits =
let as :: [Address]
as = (Balance -> Address) -> [Balance] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map Balance -> Address
balanceAddress ([Balance] -> [Address]) -> [Balance] -> [Address]
forall a b. (a -> b) -> a -> b
$
(Balance -> Bool) -> [Balance] -> [Balance]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Balance -> Bool) -> Balance -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Bool
nullBalance) ([Balance] -> [Balance]) -> [Balance] -> [Balance]
forall a b. (a -> b) -> a -> b
$
(XPubBal -> Balance) -> [XPubBal] -> [Balance]
forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> Balance
xPubBal [XPubBal]
xbals
in [Address] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
as Limits
limits
xPubTxCount :: XPubSpec -> [XPubBal] -> m Word32
xPubTxCount XPubSpec
xspec [XPubBal]
xbals =
Int -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockHeight) -> ([TxRef] -> Int) -> [TxRef] -> BlockHeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxRef] -> BlockHeight) -> m [TxRef] -> m BlockHeight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
xspec [XPubBal]
xbals Limits
forall a. Default a => a
def
countTxRefs :: Int -> m ()
countTxRefs Int
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
countXPubDerivations :: Int -> m ()
countXPubDerivations Int
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
class StoreWrite m where
setBest :: BlockHash -> m ()
insertBlock :: BlockData -> m ()
setBlocksAtHeight :: [BlockHash] -> BlockHeight -> m ()
insertTx :: TxData -> m ()
insertSpender :: OutPoint -> Spender -> m ()
deleteSpender :: OutPoint -> 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 ()
getSpenders :: StoreReadBase m => TxHash -> m (IntMap Spender)
getSpenders :: TxHash -> m (IntMap Spender)
getSpenders TxHash
th =
TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData TxHash
th m (Maybe TxData)
-> (Maybe TxData -> m (IntMap Spender)) -> m (IntMap Spender)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe TxData
Nothing -> IntMap Spender -> m (IntMap Spender)
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap Spender
forall a. IntMap a
I.empty
Just TxData
td -> [(Int, Spender)] -> IntMap Spender
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Spender)] -> IntMap Spender)
-> ([Maybe (Int, Spender)] -> [(Int, Spender)])
-> [Maybe (Int, Spender)]
-> IntMap Spender
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Int, Spender)] -> [(Int, Spender)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Int, Spender)] -> IntMap Spender)
-> m [Maybe (Int, Spender)] -> m (IntMap Spender)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Int -> m (Maybe (Int, Spender)))
-> [Int] -> m [Maybe (Int, Spender)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> m (Maybe (Int, Spender))
forall (f :: * -> *) a.
(StoreReadBase f, Integral a) =>
a -> f (Maybe (a, Spender))
get_spender [Int
0 .. [TxOut] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxOut]
txOut (TxData -> Tx
txData TxData
td)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
where
get_spender :: a -> f (Maybe (a, Spender))
get_spender a
i = (Spender -> (a, Spender)) -> Maybe Spender -> Maybe (a, Spender)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
i,) (Maybe Spender -> Maybe (a, Spender))
-> f (Maybe Spender) -> f (Maybe (a, Spender))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OutPoint -> f (Maybe Spender)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Spender)
getSpender (TxHash -> BlockHeight -> OutPoint
OutPoint TxHash
th (a -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i))
getActiveBlock :: StoreReadExtra m => BlockHash -> m (Maybe BlockData)
getActiveBlock :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just BlockData
b | BlockData -> Bool
blockDataMainChain BlockData
b -> Maybe BlockData -> m (Maybe BlockData)
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe BlockData
forall a. Maybe a
Nothing
getActiveTxData :: StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just TxData
td | Bool -> Bool
not (TxData -> Bool
txDataDeleted TxData
td) -> Maybe TxData -> m (Maybe TxData)
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe TxData
forall a. Maybe a
Nothing
getDefaultBalance :: StoreReadBase m => Address -> m Balance
getDefaultBalance :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Balance
Nothing -> Balance -> m Balance
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 (m :: * -> *) a. Monad m => a -> m a
return Balance
b
deriveAddresses :: DeriveAddr -> XPubKey -> Word32 -> [(Word32, Address)]
deriveAddresses :: DeriveAddr -> XPubKey -> BlockHeight -> [(BlockHeight, Address)]
deriveAddresses DeriveAddr
derive XPubKey
xpub BlockHeight
start = (BlockHeight -> (BlockHeight, Address))
-> [BlockHeight] -> [(BlockHeight, Address)]
forall a b. (a -> b) -> [a] -> [b]
map (\BlockHeight
i -> (BlockHeight
i, DeriveAddr
derive XPubKey
xpub BlockHeight
i)) [BlockHeight
start ..]
deriveFunction :: DeriveType -> DeriveAddr
deriveFunction :: DeriveType -> DeriveAddr
deriveFunction DeriveType
DeriveNormal XPubKey
i = (Address, PubKey) -> Address
forall a b. (a, b) -> a
fst ((Address, PubKey) -> Address)
-> (BlockHeight -> (Address, PubKey)) -> BlockHeight -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> BlockHeight -> (Address, PubKey)
deriveAddr XPubKey
i
deriveFunction DeriveType
DeriveP2SH XPubKey
i = (Address, PubKey) -> Address
forall a b. (a, b) -> a
fst ((Address, PubKey) -> Address)
-> (BlockHeight -> (Address, PubKey)) -> BlockHeight -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> BlockHeight -> (Address, PubKey)
deriveCompatWitnessAddr XPubKey
i
deriveFunction DeriveType
DeriveP2WPKH XPubKey
i = (Address, PubKey) -> Address
forall a b. (a, b) -> a
fst ((Address, PubKey) -> Address)
-> (BlockHeight -> (Address, PubKey)) -> BlockHeight -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> BlockHeight -> (Address, PubKey)
deriveWitnessAddr XPubKey
i
getTransaction ::
(Monad m, StoreReadBase m) => TxHash -> m (Maybe Transaction)
getTransaction :: TxHash -> m (Maybe Transaction)
getTransaction TxHash
h = MaybeT m Transaction -> m (Maybe Transaction)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m Transaction -> m (Maybe Transaction))
-> MaybeT m Transaction -> m (Maybe Transaction)
forall a b. (a -> b) -> a -> b
$ do
TxData
d <- m (Maybe TxData) -> MaybeT m TxData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe TxData) -> MaybeT m TxData)
-> m (Maybe TxData) -> MaybeT m TxData
forall a b. (a -> b) -> a -> b
$ TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
h
IntMap Spender
sm <- m (IntMap Spender) -> MaybeT m (IntMap Spender)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (IntMap Spender) -> MaybeT m (IntMap Spender))
-> m (IntMap Spender) -> MaybeT m (IntMap Spender)
forall a b. (a -> b) -> a -> b
$ TxHash -> m (IntMap Spender)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (IntMap Spender)
getSpenders TxHash
h
Transaction -> MaybeT m Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return (Transaction -> MaybeT m Transaction)
-> Transaction -> MaybeT m Transaction
forall a b. (a -> b) -> a -> b
$ TxData -> IntMap Spender -> Transaction
toTransaction TxData
d IntMap Spender
sm
getNumTransaction ::
(Monad m, StoreReadExtra m) => Word64 -> m [Transaction]
getNumTransaction :: Word64 -> m [Transaction]
getNumTransaction Word64
i = do
[TxData]
ds <- Word64 -> m [TxData]
forall (m :: * -> *). StoreReadExtra m => Word64 -> m [TxData]
getNumTxData Word64
i
[TxData] -> (TxData -> m Transaction) -> m [Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TxData]
ds ((TxData -> m Transaction) -> m [Transaction])
-> (TxData -> m Transaction) -> m [Transaction]
forall a b. (a -> b) -> a -> b
$ \TxData
d -> do
IntMap Spender
sm <- TxHash -> m (IntMap Spender)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (IntMap Spender)
getSpenders (Tx -> TxHash
txHash (TxData -> Tx
txData TxData
d))
Transaction -> m Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return (Transaction -> m Transaction) -> Transaction -> m Transaction
forall a b. (a -> b) -> a -> b
$ TxData -> IntMap Spender -> Transaction
toTransaction TxData
d IntMap Spender
sm
blockAtOrAfter :: (MonadIO m, StoreReadExtra m)
=> Chain
-> UnixTime
-> m (Maybe BlockData)
blockAtOrAfter :: 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 (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 (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 :: * -> *). Monad 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 (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
x))
where
f :: BlockNode -> m Ordering
f BlockNode
x = let t :: Word64
t = BlockHeight -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BlockHeader -> BlockHeight
blockTimestamp (BlockNode -> BlockHeader
nodeHeader BlockNode
x))
in Ordering -> m Ordering
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 :: 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 (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 (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 :: * -> *). Monad 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 (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
x))
where
f :: BlockNode -> m Ordering
f BlockNode
x = let t :: Word64
t = BlockHeight -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BlockHeader -> BlockHeight
blockTimestamp (BlockNode -> BlockHeader
nodeHeader BlockNode
x))
in Ordering -> m Ordering
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 :: 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 (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 (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 (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
x))
where
f :: BlockNode -> m Ordering
f BlockNode
x = do
Word64
t <- BlockHeight -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BlockHeight -> Word64) -> m BlockHeight -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockNode -> m BlockHeight
forall (m :: * -> *). BlockHeaders m => BlockNode -> m BlockHeight
mtp BlockNode
x
Ordering -> m Ordering
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
data StoreEvent
= StoreBestBlock !BlockHash
| StoreMempoolNew !TxHash
| StoreMempoolDelete !TxHash
| StorePeerConnected !Peer
| StorePeerDisconnected !Peer
| StorePeerPong !Peer !Word64
| StoreTxAvailable !Peer ![TxHash]
| StoreTxReject !Peer !TxHash !RejectCode !ByteString
data PubExcept = PubNoPeers
| PubReject RejectCode
| PubTimeout
| PubPeerDisconnected
deriving (PubExcept -> PubExcept -> Bool
(PubExcept -> PubExcept -> Bool)
-> (PubExcept -> PubExcept -> Bool) -> Eq PubExcept
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 -> ()
(PubExcept -> ()) -> NFData PubExcept
forall a. (a -> ()) -> NFData a
rnf :: PubExcept -> ()
$crnf :: PubExcept -> ()
NFData, (forall x. PubExcept -> Rep PubExcept x)
-> (forall x. Rep PubExcept x -> PubExcept) -> Generic PubExcept
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
Putter PubExcept -> Get PubExcept -> Serialize 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: " String -> ShowS
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 :: Limits -> [a] -> [a]
applyLimits Limits {Maybe Start
BlockHeight
start :: Maybe Start
offset :: BlockHeight
limit :: BlockHeight
start :: Limits -> Maybe Start
offset :: Limits -> BlockHeight
limit :: Limits -> BlockHeight
..} = BlockHeight -> [a] -> [a]
forall a. BlockHeight -> [a] -> [a]
applyLimit BlockHeight
limit ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeight -> [a] -> [a]
forall a. BlockHeight -> [a] -> [a]
applyOffset BlockHeight
offset
applyOffset :: Offset -> [a] -> [a]
applyOffset :: BlockHeight -> [a] -> [a]
applyOffset = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int -> [a] -> [a])
-> (BlockHeight -> Int) -> BlockHeight -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeight -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
applyLimit :: Limit -> [a] -> [a]
applyLimit :: BlockHeight -> [a] -> [a]
applyLimit BlockHeight
0 = [a] -> [a]
forall a. a -> a
id
applyLimit BlockHeight
l = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (BlockHeight -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
l)
deOffset :: Limits -> Limits
deOffset :: Limits -> Limits
deOffset Limits
l = case Limits -> BlockHeight
limit Limits
l of
BlockHeight
0 -> Limits
l{offset :: BlockHeight
offset = BlockHeight
0}
BlockHeight
_ -> Limits
l{limit :: BlockHeight
limit = Limits -> BlockHeight
limit Limits
l BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
+ Limits -> BlockHeight
offset Limits
l, offset :: BlockHeight
offset = BlockHeight
0}
applyLimitsC :: Monad m => Limits -> ConduitT i i m ()
applyLimitsC :: Limits -> ConduitT i i m ()
applyLimitsC Limits {Maybe Start
BlockHeight
start :: Maybe Start
offset :: BlockHeight
limit :: BlockHeight
start :: Limits -> Maybe Start
offset :: Limits -> BlockHeight
limit :: Limits -> BlockHeight
..} = BlockHeight -> ConduitT i i m ()
forall (m :: * -> *) i. Monad m => BlockHeight -> ConduitT i i m ()
applyOffsetC BlockHeight
offset ConduitT i i m () -> ConduitT i i m () -> ConduitT i i m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BlockHeight -> ConduitT i i m ()
forall (m :: * -> *) i. Monad m => BlockHeight -> ConduitT i i m ()
applyLimitC BlockHeight
limit
applyOffsetC :: Monad m => Offset -> ConduitT i i m ()
applyOffsetC :: BlockHeight -> 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 ())
-> (BlockHeight -> Int) -> BlockHeight -> ConduitT i i m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeight -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
applyLimitC :: Monad m => Limit -> ConduitT i i m ()
applyLimitC :: BlockHeight -> ConduitT i i m ()
applyLimitC BlockHeight
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 BlockHeight
l = Int -> ConduitT i i m ()
forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC (BlockHeight -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
l)
sortTxs :: [Tx] -> [(Word32, Tx)]
sortTxs :: [Tx] -> [(BlockHeight, Tx)]
sortTxs [Tx]
txs = [(BlockHeight, Tx)]
-> HashSet TxHash -> [(BlockHeight, Tx)] -> [(BlockHeight, Tx)]
forall a. [(a, Tx)] -> HashSet TxHash -> [(a, Tx)] -> [(a, Tx)]
go [] HashSet TxHash
thset ([(BlockHeight, Tx)] -> [(BlockHeight, Tx)])
-> [(BlockHeight, Tx)] -> [(BlockHeight, Tx)]
forall a b. (a -> b) -> a -> b
$ [BlockHeight] -> [Tx] -> [(BlockHeight, Tx)]
forall a b. [a] -> [b] -> [(a, b)]
zip [BlockHeight
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 -> TxHash
outPointHash (OutPoint -> TxHash) -> (TxIn -> OutPoint) -> TxIn -> TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> OutPoint
prevOutput) (Tx -> [TxIn]
txIn Tx
tx)
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' :: (Eq a, Hashable a) => [a] -> [a]
nub' :: [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 :: 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
+ BlockHeight -> Integer
forall a. Integral a => a -> Integer
toInteger (SystemTime -> BlockHeight
systemNanoseconds SystemTime
t) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000
in IO Integer -> m Integer
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 :: (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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> () -> ConduitT () a m ()
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 (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. [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 :: BlockHeight
offset = BlockHeight
1, start :: Maybe Start
start = Start -> Maybe Start
forall a. a -> Maybe a
Just (TxHash -> Start
AtTx (a -> TxHash
g a
x))}
Maybe (a -> TxHash)
Nothing -> case Limits -> BlockHeight
limit Limits
l of
BlockHeight
0 -> Maybe Limits
forall a. Maybe a
Nothing
BlockHeight
_ -> Limits -> Maybe Limits
forall a. a -> Maybe a
Just Limits
l{offset :: BlockHeight
offset = Limits -> BlockHeight
offset Limits
l BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
+ Limits -> BlockHeight
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 -> () -> ConduitT i a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Limits
l' -> 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> () -> ConduitT i a m ()
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Limits -> a -> ConduitT i a m ()
go Limits
l' ([a] -> a
forall a. [a] -> a
last [a]
ls)
joinDescStreams :: (Monad m, Ord a)
=> [ConduitT () a m ()]
-> ConduitT () a m ()
joinDescStreams :: [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 :: * -> *) k i.
(Monad m, Ord k) =>
Maybe k -> Map k [SealedConduitT () k m ()] -> ConduitT i k 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 (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 t) -> f (t, [a])
j (a
x, f t
y) = (, [a
x]) (t -> (t, [a])) -> f t -> f (t, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f t
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 t. Functor f => (a, f t) -> f (t, [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 (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)
traverse (SealedConduitT () k m ()
-> Sink k m (Maybe k) -> m (SealedConduitT () k m (), Maybe k)
forall (m :: * -> *) a b.
Monad m =>
SealedConduitT () a m ()
-> Sink a m b -> m (SealedConduitT () a m (), b)
$$++ Sink k m (Maybe k)
forall (m :: * -> *) i. Monad m => Consumer i 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 k -> Map k [SealedConduitT () k m ()] -> ConduitT i k m ()
go Maybe k
m Map k [SealedConduitT () k m ()]
mp = case Map k [SealedConduitT () k m ()]
-> Maybe (k, [SealedConduitT () k m ()])
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map k [SealedConduitT () k m ()]
mp of
Maybe (k, [SealedConduitT () k m ()])
Nothing -> () -> ConduitT i k m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (k
x, [SealedConduitT () k m ()]
ss) -> do
case Maybe k
m of
Maybe k
Nothing -> k -> ConduitT i k m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield k
x
Just k
x'
| k
x k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
x' -> () -> ConduitT i k m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> k -> ConduitT i k m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield k
x
Map k [SealedConduitT () k m ()]
mp1 <- [SealedConduitT () k m ()]
-> ConduitT i k m (Map k [SealedConduitT () k m ()])
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 () k m ()]
ss
let mp2 :: Map k [SealedConduitT () k m ()]
mp2 = Map k [SealedConduitT () k m ()]
-> Map k [SealedConduitT () k m ()]
forall k a. Map k a -> Map k a
Map.deleteMax Map k [SealedConduitT () k m ()]
mp
mp' :: Map k [SealedConduitT () k m ()]
mp' = ([SealedConduitT () k m ()]
-> [SealedConduitT () k m ()] -> [SealedConduitT () k m ()])
-> Map k [SealedConduitT () k m ()]
-> Map k [SealedConduitT () k m ()]
-> Map k [SealedConduitT () k m ()]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [SealedConduitT () k m ()]
-> [SealedConduitT () k m ()] -> [SealedConduitT () k m ()]
forall a. [a] -> [a] -> [a]
(++) Map k [SealedConduitT () k m ()]
mp1 Map k [SealedConduitT () k m ()]
mp2
Maybe k -> Map k [SealedConduitT () k m ()] -> ConduitT i k m ()
go (k -> Maybe k
forall a. a -> Maybe a
Just k
x) Map k [SealedConduitT () k m ()]
mp'