{-# 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
    , xPubBalsTxs
    , xPubBalsUnspents
    , getTransaction
    , blockAtOrBefore
    , blockAtOrAfterMTP
    , deOffset
    , applyLimits
    , applyLimitsC
    , sortTxs
    , nub'
    , microseconds
    ) where

import           Conduit                    (ConduitT, dropC, mapC, takeC)
import           Control.DeepSeq            (NFData)
import           Control.Exception          (Exception)
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.Function              (on)
import           Data.Hashable              (Hashable)
import qualified Data.HashSet               as H
import           Data.IntMap.Strict         (IntMap)
import qualified Data.IntMap.Strict         as I
import           Data.List                  (sortBy)
import           Data.Maybe                 (catMaybes)
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 = $WLimits :: BlockHeight -> BlockHeight -> Maybe Start -> Limits
Limits { limit :: BlockHeight
limit = 0, offset :: BlockHeight
offset = 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)]

class StoreReadBase m => StoreReadExtra m where
    getBalances :: [Address] -> m [Balance]
    getBalances as :: [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 a :: Address
a Nothing  = Address -> Balance
zeroBalance Address
a
        f _ (Just b :: Balance
b) = Balance
b
    getAddressesTxs :: [Address] -> Limits -> m [TxRef]
    getAddressTxs :: Address -> Limits -> m [TxRef]
    getAddressTxs a :: Address
a = [Address] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address
a]
    getAddressUnspents :: Address -> Limits -> m [Unspent]
    getAddressUnspents a :: Address
a = [Address] -> Limits -> m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [Unspent]
getAddressesUnspents [Address
a]
    getAddressesUnspents :: [Address] -> Limits -> m [Unspent]
    xPubBals :: XPubSpec -> m [XPubBal]
    xPubBals xpub :: 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 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 0 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 0 (BlockHeight -> BlockHeight -> [(BlockHeight, Address)]
aderiv 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 1 (BlockHeight -> BlockHeight -> [(BlockHeight, Address)]
aderiv 1 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 m :: 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 m :: BlockHeight
m b :: Balance
b n :: BlockHeight
n = $WXPubBal :: [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 _ _ [] = [XPubBal] -> m [XPubBal]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        derive_until_gap gap :: a
gap m :: BlockHeight
m as :: [(BlockHeight, Address)]
as = do
            let (as1 :: [(BlockHeight, Address)]
as1, as2 :: [(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
            [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 -> m XPubSummary
    xPubSummary xpub :: XPubSpec
xpub = do
        [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] -> [XPubBal]) -> m [XPubBal] -> m [XPubBal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
        let 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 0 [BlockHeight
i | XPubBal {xPubBalPath :: XPubBal -> [BlockHeight]
xPubBalPath = [0, i :: 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 0 [BlockHeight
i | XPubBal {xPubBalPath :: XPubBal -> [BlockHeight]
xPubBalPath = [1, i :: BlockHeight
i]} <- [XPubBal]
bs]
            uc :: Word64
uc =
                [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
                    [ Word64
c
                    | XPubBal {xPubBal :: XPubBal -> Balance
xPubBal = Balance {balanceUnspentCount :: Balance -> Word64
balanceUnspentCount = Word64
c}} <-
                          [XPubBal]
bs
                    ]
            xt :: [XPubBal]
xt = [XPubBal
b | b :: XPubBal
b@XPubBal {xPubBalPath :: XPubBal -> [BlockHeight]
xPubBalPath = [0, _]} <- [XPubBal]
bs]
            rx :: Word64
rx =
                [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
                    [ Word64
r
                    | XPubBal {xPubBal :: XPubBal -> Balance
xPubBal = Balance {balanceTotalReceived :: Balance -> Word64
balanceTotalReceived = Word64
r}} <-
                          [XPubBal]
xt
                    ]
        XPubSummary -> m XPubSummary
forall (m :: * -> *) a. Monad m => a -> m a
return
            $WXPubSummary :: 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
                }
    xPubUnspents :: XPubSpec -> Limits -> m [XPubUnspent]
    xPubUnspents xpub :: XPubSpec
xpub limits :: Limits
limits = do
        [XPubBal]
xs <- (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter XPubBal -> Bool
positive ([XPubBal] -> [XPubBal]) -> m [XPubBal] -> m [XPubBal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
        (XPubUnspent -> XPubUnspent -> Ordering)
-> [XPubUnspent] -> [XPubUnspent]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (BlockRef -> BlockRef -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (BlockRef -> BlockRef -> Ordering)
-> (XPubUnspent -> BlockRef)
-> XPubUnspent
-> XPubUnspent
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` XPubUnspent -> BlockRef
unsblock) ([XPubUnspent] -> [XPubUnspent])
-> ([XPubUnspent] -> [XPubUnspent])
-> [XPubUnspent]
-> [XPubUnspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Limits -> [XPubUnspent] -> [XPubUnspent]
forall a. Limits -> [a] -> [a]
applyLimits Limits
limits ([XPubUnspent] -> [XPubUnspent])
-> m [XPubUnspent] -> m [XPubUnspent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Limits -> [XPubBal] -> m [XPubUnspent]
forall (f :: * -> *).
StoreReadExtra f =>
Limits -> [XPubBal] -> f [XPubUnspent]
xUns Limits
limits [XPubBal]
xs
      where
        unsblock :: XPubUnspent -> BlockRef
unsblock = Unspent -> BlockRef
unspentBlock (Unspent -> BlockRef)
-> (XPubUnspent -> Unspent) -> XPubUnspent -> BlockRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubUnspent -> Unspent
xPubUnspent
        positive :: XPubBal -> Bool
positive XPubBal {xPubBal :: XPubBal -> Balance
xPubBal = Balance {balanceUnspentCount :: Balance -> Word64
balanceUnspentCount = Word64
c}} = Word64
c Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0
    xPubTxs :: XPubSpec -> Limits -> m [TxRef]
    xPubTxs xpub :: XPubSpec
xpub limits :: Limits
limits = do
        [XPubBal]
bs <- XPubSpec -> m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
        let as :: [Address]
as = (XPubBal -> Address) -> [XPubBal] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Address
balanceAddress (Balance -> Address) -> (XPubBal -> Balance) -> XPubBal -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
bs
        [Address] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
as Limits
limits
    getMaxGap :: m Word32
    getInitialGap :: m Word32

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 th :: 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
        Nothing -> IntMap Spender -> m (IntMap Spender)
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap Spender
forall a. IntMap a
I.empty
        Just td :: 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 [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
- 1]
  where
    get_spender :: a -> f (Maybe (a, Spender))
get_spender i :: 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 bh :: 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 b :: 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 -> 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 th :: 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 td :: 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 -> 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 a :: 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
    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  b :: Balance
b -> Balance -> m Balance
forall (m :: * -> *) a. Monad m => a -> m a
return Balance
b

xUns :: StoreReadExtra f => Limits -> [XPubBal] -> f [XPubUnspent]
xUns :: Limits -> [XPubBal] -> f [XPubUnspent]
xUns limits :: Limits
limits bs :: [XPubBal]
bs = [[XPubUnspent]] -> [XPubUnspent]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[XPubUnspent]] -> [XPubUnspent])
-> f [[XPubUnspent]] -> f [XPubUnspent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XPubBal -> f [XPubUnspent]) -> [XPubBal] -> f [[XPubUnspent]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM XPubBal -> f [XPubUnspent]
forall (f :: * -> *).
StoreReadExtra f =>
XPubBal -> f [XPubUnspent]
g [XPubBal]
bs
  where
    f :: [BlockHeight] -> Unspent -> XPubUnspent
f p :: [BlockHeight]
p t :: Unspent
t = $WXPubUnspent :: [BlockHeight] -> Unspent -> XPubUnspent
XPubUnspent {xPubUnspentPath :: [BlockHeight]
xPubUnspentPath = [BlockHeight]
p, xPubUnspent :: Unspent
xPubUnspent = Unspent
t}
    g :: XPubBal -> f [XPubUnspent]
g b :: XPubBal
b =
        (Unspent -> XPubUnspent) -> [Unspent] -> [XPubUnspent]
forall a b. (a -> b) -> [a] -> [b]
map ([BlockHeight] -> Unspent -> XPubUnspent
f (XPubBal -> [BlockHeight]
xPubBalPath XPubBal
b)) ([Unspent] -> [XPubUnspent]) -> f [Unspent] -> f [XPubUnspent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Address -> Limits -> f [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents (Balance -> Address
balanceAddress (XPubBal -> Balance
xPubBal XPubBal
b)) (Limits -> Limits
deOffset Limits
limits)

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

deriveFunction :: DeriveType -> DeriveAddr
deriveFunction :: DeriveType -> DeriveAddr
deriveFunction DeriveNormal i :: 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 DeriveP2SH i :: 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 DeriveP2WPKH i :: 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

xPubBalsUnspents ::
       StoreReadExtra m
    => [XPubBal]
    -> Limits
    -> m [XPubUnspent]
xPubBalsUnspents :: [XPubBal] -> Limits -> m [XPubUnspent]
xPubBalsUnspents bals :: [XPubBal]
bals limits :: Limits
limits = do
    let xs :: [XPubBal]
xs = (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter XPubBal -> Bool
positive [XPubBal]
bals
    Limits -> [XPubUnspent] -> [XPubUnspent]
forall a. Limits -> [a] -> [a]
applyLimits Limits
limits ([XPubUnspent] -> [XPubUnspent])
-> m [XPubUnspent] -> m [XPubUnspent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Limits -> [XPubBal] -> m [XPubUnspent]
forall (f :: * -> *).
StoreReadExtra f =>
Limits -> [XPubBal] -> f [XPubUnspent]
xUns Limits
limits [XPubBal]
xs
  where
    positive :: XPubBal -> Bool
positive XPubBal {xPubBal :: XPubBal -> Balance
xPubBal = Balance {balanceUnspentCount :: Balance -> Word64
balanceUnspentCount = Word64
c}} = Word64
c Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0

xPubBalsTxs ::
       StoreReadExtra m
    => [XPubBal]
    -> Limits
    -> m [TxRef]
xPubBalsTxs :: [XPubBal] -> Limits -> m [TxRef]
xPubBalsTxs bals :: [XPubBal]
bals limits :: Limits
limits = do
    let as :: [Address]
as = (Balance -> Address) -> [Balance] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map Balance -> Address
balanceAddress ([Balance] -> [Address])
-> ([Balance] -> [Balance]) -> [Balance] -> [Address]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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] -> [Address]) -> [Balance] -> [Address]
forall a b. (a -> b) -> a -> b
$ (XPubBal -> Balance) -> [XPubBal] -> [Balance]
forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> Balance
xPubBal [XPubBal]
bals
    [TxRef]
ts <- [[TxRef]] -> [TxRef]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TxRef]] -> [TxRef]) -> m [[TxRef]] -> m [TxRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address -> m [TxRef]) -> [Address] -> m [[TxRef]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\a :: Address
a -> Address -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a (Limits -> Limits
deOffset Limits
limits)) [Address]
as
    let ts' :: [TxRef]
ts' = (TxRef -> TxRef -> Ordering) -> [TxRef] -> [TxRef]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((BlockRef -> BlockRef -> Ordering)
-> BlockRef -> BlockRef -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip BlockRef -> BlockRef -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (BlockRef -> BlockRef -> Ordering)
-> (TxRef -> BlockRef) -> TxRef -> TxRef -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TxRef -> BlockRef
txRefBlock) ([TxRef] -> [TxRef]
forall a. (Eq a, Hashable a) => [a] -> [a]
nub' [TxRef]
ts)
    [TxRef] -> m [TxRef]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TxRef] -> m [TxRef]) -> [TxRef] -> m [TxRef]
forall a b. (a -> b) -> a -> b
$ Limits -> [TxRef] -> [TxRef]
forall a. Limits -> [a] -> [a]
applyLimits Limits
limits [TxRef]
ts'

getTransaction ::
       (Monad m, StoreReadBase m) => TxHash -> m (Maybe Transaction)
getTransaction :: TxHash -> m (Maybe Transaction)
getTransaction h :: 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

blockAtOrBefore :: (MonadIO m, StoreReadExtra m)
                => Chain
                -> UnixTime
                -> m (Maybe BlockData)
blockAtOrBefore :: Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore ch :: Chain
ch q :: 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 x :: 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 ch :: Chain
ch q :: 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 x :: 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


-- | Events that the store can generate.
data StoreEvent
    = StoreBestBlock !BlockHash
    | StoreMempoolNew !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 PubNoPeers = "no peers"
    show (PubReject c :: RejectCode
c) =
        "rejected: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        case RejectCode
c of
            RejectMalformed       -> "malformed"
            RejectInvalid         -> "invalid"
            RejectObsolete        -> "obsolete"
            RejectDuplicate       -> "duplicate"
            RejectNonStandard     -> "not standard"
            RejectDust            -> "dust"
            RejectInsufficientFee -> "insufficient fee"
            RejectCheckpoint      -> "checkpoint"
    show PubTimeout = "peer timeout or silent rejection"
    show PubPeerDisconnected = "peer disconnected"

instance Exception PubExcept

applyLimits :: Limits -> [a] -> [a]
applyLimits :: Limits -> [a] -> [a]
applyLimits Limits {..} = 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 0 = [a] -> [a]
forall a. a -> a
id
applyLimit l :: 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 l :: Limits
l = 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 = 0}

applyLimitsC :: Monad m => Limits -> ConduitT i i m ()
applyLimitsC :: Limits -> ConduitT i i m ()
applyLimitsC Limits {..} = 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 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 l :: 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 txs :: [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 [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 [] _ [] = []
    go orphans :: [(a, Tx)]
orphans ths :: HashSet TxHash
ths [] = [(a, Tx)] -> HashSet TxHash -> [(a, Tx)] -> [(a, Tx)]
go [] HashSet TxHash
ths [(a, Tx)]
orphans
    go orphans :: [(a, Tx)]
orphans ths :: HashSet TxHash
ths ((i :: a
i, tx :: Tx
tx):xs :: [(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 t :: 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
* 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` 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