{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Haskoin.Store.Database.Reader (
    -- * RocksDB Database Access
    DatabaseReader (..),
    DatabaseReaderT,
    withDatabaseReader,
    addrTxCF,
    addrOutCF,
    txCF,
    spenderCF,
    unspentCF,
    blockCF,
    heightCF,
    balanceCF,
) where

import Conduit (
    ConduitT,
    dropWhileC,
    lift,
    mapC,
    runConduit,
    sinkList,
    (.|),
 )
import Control.Monad.Except (runExceptT, throwError)
import Control.Monad.Reader (ReaderT, ask, asks, runReaderT)
import Data.Bits ((.&.))
import qualified Data.ByteString as BS
import Data.Default (def)
import Data.Function (on)
import Data.List (sortOn)
import Data.Maybe (fromMaybe)
import Data.Ord (Down (..))
import Data.Serialize (encode)
import Data.Word (Word32, Word64)
import Database.RocksDB (
    ColumnFamily,
    Config (..),
    DB (..),
    Iterator,
    withDBCF,
    withIterCF,
 )
import Database.RocksDB.Query (
    insert,
    matching,
    matchingAsListCF,
    matchingSkip,
    retrieve,
    retrieveCF,
 )
import Haskoin (
    Address,
    BlockHash,
    BlockHeight,
    Network,
    OutPoint (..),
    TxHash,
    pubSubKey,
    txHash,
 )
import Haskoin.Store.Common
import Haskoin.Store.Data
import Haskoin.Store.Database.Types
import qualified System.Metrics as Metrics
import System.Metrics.Counter (Counter)
import qualified System.Metrics.Counter as Counter
import UnliftIO (MonadIO, MonadUnliftIO, liftIO)

type DatabaseReaderT = ReaderT DatabaseReader

data DatabaseReader = DatabaseReader
    { DatabaseReader -> DB
databaseHandle :: !DB
    , DatabaseReader -> Word32
databaseMaxGap :: !Word32
    , DatabaseReader -> Word32
databaseInitialGap :: !Word32
    , DatabaseReader -> Network
databaseNetwork :: !Network
    , DatabaseReader -> Maybe DataMetrics
databaseMetrics :: !(Maybe DataMetrics)
    }

incrementCounter ::
    MonadIO m =>
    (DataMetrics -> Counter) ->
    Int ->
    ReaderT DatabaseReader m ()
incrementCounter :: (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
f Int
i =
    (DatabaseReader -> Maybe DataMetrics)
-> ReaderT DatabaseReader m (Maybe DataMetrics)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> Maybe DataMetrics
databaseMetrics ReaderT DatabaseReader m (Maybe DataMetrics)
-> (Maybe DataMetrics -> ReaderT DatabaseReader m ())
-> ReaderT DatabaseReader m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just DataMetrics
s -> IO () -> ReaderT DatabaseReader m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT DatabaseReader m ())
-> IO () -> ReaderT DatabaseReader m ()
forall a b. (a -> b) -> a -> b
$ Counter -> Int64 -> IO ()
Counter.add (DataMetrics -> Counter
f DataMetrics
s) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
        Maybe DataMetrics
Nothing -> () -> ReaderT DatabaseReader m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

dataVersion :: Word32
dataVersion :: Word32
dataVersion = Word32
17

withDatabaseReader ::
    MonadUnliftIO m =>
    Network ->
    Word32 ->
    Word32 ->
    FilePath ->
    Maybe DataMetrics ->
    DatabaseReaderT m a ->
    m a
withDatabaseReader :: Network
-> Word32
-> Word32
-> FilePath
-> Maybe DataMetrics
-> DatabaseReaderT m a
-> m a
withDatabaseReader Network
net Word32
igap Word32
gap FilePath
dir Maybe DataMetrics
stats DatabaseReaderT m a
f =
    FilePath -> Config -> [(FilePath, Config)] -> (DB -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> Config -> [(FilePath, Config)] -> (DB -> m a) -> m a
withDBCF FilePath
dir Config
cfg [(FilePath, Config)]
columnFamilyConfig ((DB -> m a) -> m a) -> (DB -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \DB
db -> do
        let bdb :: DatabaseReader
bdb =
                DatabaseReader :: DB
-> Word32
-> Word32
-> Network
-> Maybe DataMetrics
-> DatabaseReader
DatabaseReader
                    { databaseHandle :: DB
databaseHandle = DB
db
                    , databaseMaxGap :: Word32
databaseMaxGap = Word32
gap
                    , databaseNetwork :: Network
databaseNetwork = Network
net
                    , databaseInitialGap :: Word32
databaseInitialGap = Word32
igap
                    , databaseMetrics :: Maybe DataMetrics
databaseMetrics = Maybe DataMetrics
stats
                    }
        DatabaseReader -> m ()
forall (m :: * -> *). MonadIO m => DatabaseReader -> m ()
initRocksDB DatabaseReader
bdb
        DatabaseReaderT m a -> DatabaseReader -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DatabaseReaderT m a
f DatabaseReader
bdb
  where
    cfg :: Config
cfg = Config
forall a. Default a => a
def{createIfMissing :: Bool
createIfMissing = Bool
True, maxFiles :: Maybe Int
maxFiles = Int -> Maybe Int
forall a. a -> Maybe a
Just (-Int
1)}

columnFamilyConfig :: [(String, Config)]
columnFamilyConfig :: [(FilePath, Config)]
columnFamilyConfig =
    [ (FilePath
"addr-tx", Config
forall a. Default a => a
def{prefixLength :: Maybe Int
prefixLength = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
22, bloomFilter :: Bool
bloomFilter = Bool
True})
    , (FilePath
"addr-out", Config
forall a. Default a => a
def{prefixLength :: Maybe Int
prefixLength = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
22, bloomFilter :: Bool
bloomFilter = Bool
True})
    , (FilePath
"tx", Config
forall a. Default a => a
def{prefixLength :: Maybe Int
prefixLength = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
33, bloomFilter :: Bool
bloomFilter = Bool
True})
    , (FilePath
"spender", Config
forall a. Default a => a
def{prefixLength :: Maybe Int
prefixLength = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
33, bloomFilter :: Bool
bloomFilter = Bool
True})
    , (FilePath
"unspent", Config
forall a. Default a => a
def{prefixLength :: Maybe Int
prefixLength = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
37, bloomFilter :: Bool
bloomFilter = Bool
True})
    , (FilePath
"block", Config
forall a. Default a => a
def{prefixLength :: Maybe Int
prefixLength = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
33, bloomFilter :: Bool
bloomFilter = Bool
True})
    , (FilePath
"height", Config
forall a. Default a => a
def{prefixLength :: Maybe Int
prefixLength = Maybe Int
forall a. Maybe a
Nothing, bloomFilter :: Bool
bloomFilter = Bool
True})
    , (FilePath
"balance", Config
forall a. Default a => a
def{prefixLength :: Maybe Int
prefixLength = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
22, bloomFilter :: Bool
bloomFilter = Bool
True})
    ]

addrTxCF :: DB -> ColumnFamily
addrTxCF :: DB -> ColumnFamily
addrTxCF = [ColumnFamily] -> ColumnFamily
forall a. [a] -> a
head ([ColumnFamily] -> ColumnFamily)
-> (DB -> [ColumnFamily]) -> DB -> ColumnFamily
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DB -> [ColumnFamily]
columnFamilies

addrOutCF :: DB -> ColumnFamily
addrOutCF :: DB -> ColumnFamily
addrOutCF DB
db = DB -> [ColumnFamily]
columnFamilies DB
db [ColumnFamily] -> Int -> ColumnFamily
forall a. [a] -> Int -> a
!! Int
1

txCF :: DB -> ColumnFamily
txCF :: DB -> ColumnFamily
txCF DB
db = DB -> [ColumnFamily]
columnFamilies DB
db [ColumnFamily] -> Int -> ColumnFamily
forall a. [a] -> Int -> a
!! Int
2

spenderCF :: DB -> ColumnFamily
spenderCF :: DB -> ColumnFamily
spenderCF DB
db = DB -> [ColumnFamily]
columnFamilies DB
db [ColumnFamily] -> Int -> ColumnFamily
forall a. [a] -> Int -> a
!! Int
3

unspentCF :: DB -> ColumnFamily
unspentCF :: DB -> ColumnFamily
unspentCF DB
db = DB -> [ColumnFamily]
columnFamilies DB
db [ColumnFamily] -> Int -> ColumnFamily
forall a. [a] -> Int -> a
!! Int
4

blockCF :: DB -> ColumnFamily
blockCF :: DB -> ColumnFamily
blockCF DB
db = DB -> [ColumnFamily]
columnFamilies DB
db [ColumnFamily] -> Int -> ColumnFamily
forall a. [a] -> Int -> a
!! Int
5

heightCF :: DB -> ColumnFamily
heightCF :: DB -> ColumnFamily
heightCF DB
db = DB -> [ColumnFamily]
columnFamilies DB
db [ColumnFamily] -> Int -> ColumnFamily
forall a. [a] -> Int -> a
!! Int
6

balanceCF :: DB -> ColumnFamily
balanceCF :: DB -> ColumnFamily
balanceCF DB
db = DB -> [ColumnFamily]
columnFamilies DB
db [ColumnFamily] -> Int -> ColumnFamily
forall a. [a] -> Int -> a
!! Int
7

initRocksDB :: MonadIO m => DatabaseReader -> m ()
initRocksDB :: DatabaseReader -> m ()
initRocksDB DatabaseReader{databaseHandle :: DatabaseReader -> DB
databaseHandle = DB
db} = do
    Either FilePath ()
e <-
        ExceptT FilePath m () -> m (Either FilePath ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FilePath m () -> m (Either FilePath ()))
-> ExceptT FilePath m () -> m (Either FilePath ())
forall a b. (a -> b) -> a -> b
$
            DB -> VersionKey -> ExceptT FilePath m (Maybe Word32)
forall (m :: * -> *) key value.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
DB -> key -> m (Maybe value)
retrieve DB
db VersionKey
VersionKey ExceptT FilePath m (Maybe Word32)
-> (Maybe Word32 -> ExceptT FilePath m ()) -> ExceptT FilePath m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just Word32
v
                    | Word32
v Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
dataVersion -> () -> ExceptT FilePath m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    | Bool
otherwise -> FilePath -> ExceptT FilePath m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FilePath
"Incorrect RocksDB database version"
                Maybe Word32
Nothing -> DB -> ExceptT FilePath m ()
forall (m :: * -> *). MonadIO m => DB -> m ()
setInitRocksDB DB
db
    case Either FilePath ()
e of
        Left FilePath
s -> FilePath -> m ()
forall a. HasCallStack => FilePath -> a
error FilePath
s
        Right () -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

setInitRocksDB :: MonadIO m => DB -> m ()
setInitRocksDB :: DB -> m ()
setInitRocksDB DB
db = DB -> VersionKey -> Word32 -> m ()
forall (m :: * -> *) key value.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
DB -> key -> value -> m ()
insert DB
db VersionKey
VersionKey Word32
dataVersion

addressConduit ::
    MonadUnliftIO m =>
    Address ->
    Maybe Start ->
    Iterator ->
    ConduitT i TxRef (DatabaseReaderT m) ()
addressConduit :: Address
-> Maybe Start
-> Iterator
-> ConduitT i TxRef (DatabaseReaderT m) ()
addressConduit Address
a Maybe Start
s Iterator
it =
    ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
forall i. ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
x ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
-> ConduitM (AddrTxKey, ()) TxRef (DatabaseReaderT m) ()
-> ConduitT i TxRef (DatabaseReaderT m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((AddrTxKey, ()) -> TxRef)
-> ConduitM (AddrTxKey, ()) TxRef (DatabaseReaderT m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC ((AddrTxKey -> () -> TxRef) -> (AddrTxKey, ()) -> TxRef
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AddrTxKey -> () -> TxRef
f)
  where
    f :: AddrTxKey -> () -> TxRef
f (AddrTxKey Address
_ TxRef
t) () = TxRef
t
    f AddrTxKey
_ ()
_ = TxRef
forall a. HasCallStack => a
undefined
    x :: ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
x = case Maybe Start
s of
        Maybe Start
Nothing ->
            Iterator
-> AddrTxKey -> ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> ConduitT i (key, value) m ()
matching Iterator
it (Address -> AddrTxKey
AddrTxKeyA Address
a)
        Just (AtBlock Word32
bh) ->
            Iterator
-> AddrTxKey
-> AddrTxKey
-> ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> key -> ConduitT i (key, value) m ()
matchingSkip
                Iterator
it
                (Address -> AddrTxKey
AddrTxKeyA Address
a)
                (Address -> BlockRef -> AddrTxKey
AddrTxKeyB Address
a (Word32 -> Word32 -> BlockRef
BlockRef Word32
bh Word32
forall a. Bounded a => a
maxBound))
        Just (AtTx TxHash
txh) ->
            DatabaseReaderT m (Maybe TxData)
-> ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TxHash -> DatabaseReaderT m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
txh) ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) (Maybe TxData)
-> (Maybe TxData
    -> ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ())
-> ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just TxData{txDataBlock :: TxData -> BlockRef
txDataBlock = b :: BlockRef
b@BlockRef{}} ->
                    Iterator
-> AddrTxKey
-> AddrTxKey
-> ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> key -> ConduitT i (key, value) m ()
matchingSkip Iterator
it (Address -> AddrTxKey
AddrTxKeyA Address
a) (Address -> BlockRef -> AddrTxKey
AddrTxKeyB Address
a BlockRef
b)
                Just TxData{txDataBlock :: TxData -> BlockRef
txDataBlock = MemRef{}} ->
                    let cond :: AddrTxKey -> Bool
cond (AddrTxKey Address
_a (TxRef MemRef{} TxHash
th)) =
                            TxHash
th TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
/= TxHash
txh
                        cond (AddrTxKey Address
_a (TxRef BlockRef{} TxHash
_th)) =
                            Bool
False
                     in Iterator
-> AddrTxKey -> ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> ConduitT i (key, value) m ()
matching Iterator
it (Address -> AddrTxKey
AddrTxKeyA Address
a)
                            ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
-> ConduitM (AddrTxKey, ()) (AddrTxKey, ()) (DatabaseReaderT m) ()
-> ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (((AddrTxKey, ()) -> Bool)
-> ConduitM (AddrTxKey, ()) (AddrTxKey, ()) (DatabaseReaderT m) ()
forall (m :: * -> *) a o.
Monad m =>
(a -> Bool) -> ConduitT a o m ()
dropWhileC (AddrTxKey -> Bool
cond (AddrTxKey -> Bool)
-> ((AddrTxKey, ()) -> AddrTxKey) -> (AddrTxKey, ()) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddrTxKey, ()) -> AddrTxKey
forall a b. (a, b) -> a
fst) ConduitM (AddrTxKey, ()) (AddrTxKey, ()) (DatabaseReaderT m) ()
-> ConduitM (AddrTxKey, ()) (AddrTxKey, ()) (DatabaseReaderT m) ()
-> ConduitM (AddrTxKey, ()) (AddrTxKey, ()) (DatabaseReaderT m) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((AddrTxKey, ()) -> (AddrTxKey, ()))
-> ConduitM (AddrTxKey, ()) (AddrTxKey, ()) (DatabaseReaderT m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (AddrTxKey, ()) -> (AddrTxKey, ())
forall a. a -> a
id)
                Maybe TxData
Nothing -> () -> ConduitT i (AddrTxKey, ()) (DatabaseReaderT m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

unspentConduit ::
    MonadUnliftIO m =>
    Address ->
    Maybe Start ->
    Iterator ->
    ConduitT i Unspent (DatabaseReaderT m) ()
unspentConduit :: Address
-> Maybe Start
-> Iterator
-> ConduitT i Unspent (DatabaseReaderT m) ()
unspentConduit Address
a Maybe Start
s Iterator
it =
    ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall i. ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
x ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
-> ConduitM (AddrOutKey, OutVal) Unspent (DatabaseReaderT m) ()
-> ConduitT i Unspent (DatabaseReaderT m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((AddrOutKey, OutVal) -> Unspent)
-> ConduitM (AddrOutKey, OutVal) Unspent (DatabaseReaderT m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC ((AddrOutKey -> OutVal -> Unspent)
-> (AddrOutKey, OutVal) -> Unspent
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AddrOutKey -> OutVal -> Unspent
toUnspent)
  where
    x :: ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
x = case Maybe Start
s of
        Maybe Start
Nothing ->
            Iterator
-> AddrOutKey
-> ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> ConduitT i (key, value) m ()
matching Iterator
it (Address -> AddrOutKey
AddrOutKeyA Address
a)
        Just (AtBlock Word32
h) ->
            Iterator
-> AddrOutKey
-> AddrOutKey
-> ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> key -> ConduitT i (key, value) m ()
matchingSkip
                Iterator
it
                (Address -> AddrOutKey
AddrOutKeyA Address
a)
                (Address -> BlockRef -> AddrOutKey
AddrOutKeyB Address
a (Word32 -> Word32 -> BlockRef
BlockRef Word32
h Word32
forall a. Bounded a => a
maxBound))
        Just (AtTx TxHash
txh) ->
            DatabaseReaderT m (Maybe TxData)
-> ConduitT
     i (AddrOutKey, OutVal) (DatabaseReaderT m) (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TxHash -> DatabaseReaderT m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
txh) ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) (Maybe TxData)
-> (Maybe TxData
    -> ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ())
-> ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just TxData{txDataBlock :: TxData -> BlockRef
txDataBlock = b :: BlockRef
b@BlockRef{}} ->
                    Iterator
-> AddrOutKey
-> AddrOutKey
-> ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> key -> ConduitT i (key, value) m ()
matchingSkip Iterator
it (Address -> AddrOutKey
AddrOutKeyA Address
a) (Address -> BlockRef -> AddrOutKey
AddrOutKeyB Address
a BlockRef
b)
                Just TxData{txDataBlock :: TxData -> BlockRef
txDataBlock = MemRef{}} ->
                    let cond :: AddrOutKey -> Bool
cond (AddrOutKey Address
_a MemRef{} OutPoint
p) =
                            OutPoint -> TxHash
outPointHash OutPoint
p TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
/= TxHash
txh
                        cond (AddrOutKey Address
_a BlockRef{} OutPoint
_p) =
                            Bool
False
                     in Iterator
-> AddrOutKey
-> ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> ConduitT i (key, value) m ()
matching Iterator
it (Address -> AddrOutKey
AddrOutKeyA Address
a)
                            ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
-> ConduitM
     (AddrOutKey, OutVal) (AddrOutKey, OutVal) (DatabaseReaderT m) ()
-> ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (((AddrOutKey, OutVal) -> Bool)
-> ConduitM
     (AddrOutKey, OutVal) (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) a o.
Monad m =>
(a -> Bool) -> ConduitT a o m ()
dropWhileC (AddrOutKey -> Bool
cond (AddrOutKey -> Bool)
-> ((AddrOutKey, OutVal) -> AddrOutKey)
-> (AddrOutKey, OutVal)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddrOutKey, OutVal) -> AddrOutKey
forall a b. (a, b) -> a
fst) ConduitM
  (AddrOutKey, OutVal) (AddrOutKey, OutVal) (DatabaseReaderT m) ()
-> ConduitM
     (AddrOutKey, OutVal) (AddrOutKey, OutVal) (DatabaseReaderT m) ()
-> ConduitM
     (AddrOutKey, OutVal) (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((AddrOutKey, OutVal) -> (AddrOutKey, OutVal))
-> ConduitM
     (AddrOutKey, OutVal) (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (AddrOutKey, OutVal) -> (AddrOutKey, OutVal)
forall a. a -> a
id)
                Maybe TxData
Nothing -> () -> ConduitT i (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance MonadIO m => StoreReadBase (DatabaseReaderT m) where
    getNetwork :: DatabaseReaderT m Network
getNetwork = (DatabaseReader -> Network) -> DatabaseReaderT m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> Network
databaseNetwork

    getTxData :: TxHash -> DatabaseReaderT m (Maybe TxData)
getTxData TxHash
th = do
        DB
db <- (DatabaseReader -> DB) -> ReaderT DatabaseReader m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
        DB -> ColumnFamily -> TxKey -> DatabaseReaderT m (Maybe TxData)
forall (m :: * -> *) key value.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
DB -> ColumnFamily -> key -> m (Maybe value)
retrieveCF DB
db (DB -> ColumnFamily
txCF DB
db) (TxHash -> TxKey
TxKey TxHash
th) DatabaseReaderT m (Maybe TxData)
-> (Maybe TxData -> DatabaseReaderT m (Maybe TxData))
-> DatabaseReaderT m (Maybe TxData)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe TxData
Nothing -> Maybe TxData -> DatabaseReaderT m (Maybe TxData)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TxData
forall a. Maybe a
Nothing
            Just TxData
t -> do
                (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataTxCount Int
1
                Maybe TxData -> DatabaseReaderT m (Maybe TxData)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxData -> Maybe TxData
forall a. a -> Maybe a
Just TxData
t)

    getSpender :: OutPoint -> DatabaseReaderT m (Maybe Spender)
getSpender OutPoint
op = do
        DB
db <- (DatabaseReader -> DB) -> ReaderT DatabaseReader m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
        DB
-> ColumnFamily -> SpenderKey -> DatabaseReaderT m (Maybe Spender)
forall (m :: * -> *) key value.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
DB -> ColumnFamily -> key -> m (Maybe value)
retrieveCF DB
db (DB -> ColumnFamily
spenderCF DB
db) (OutPoint -> SpenderKey
SpenderKey OutPoint
op) DatabaseReaderT m (Maybe Spender)
-> (Maybe Spender -> DatabaseReaderT m (Maybe Spender))
-> DatabaseReaderT m (Maybe Spender)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe Spender
Nothing -> Maybe Spender -> DatabaseReaderT m (Maybe Spender)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Spender
forall a. Maybe a
Nothing
            Just Spender
s -> do
                (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataSpenderCount Int
1
                Maybe Spender -> DatabaseReaderT m (Maybe Spender)
forall (m :: * -> *) a. Monad m => a -> m a
return (Spender -> Maybe Spender
forall a. a -> Maybe a
Just Spender
s)

    getUnspent :: OutPoint -> DatabaseReaderT m (Maybe Unspent)
getUnspent OutPoint
p = do
        DB
db <- (DatabaseReader -> DB) -> ReaderT DatabaseReader m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
        (UnspentVal -> Unspent) -> Maybe UnspentVal -> Maybe Unspent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OutPoint -> UnspentVal -> Unspent
valToUnspent OutPoint
p) (Maybe UnspentVal -> Maybe Unspent)
-> ReaderT DatabaseReader m (Maybe UnspentVal)
-> DatabaseReaderT m (Maybe Unspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB
-> ColumnFamily
-> UnspentKey
-> ReaderT DatabaseReader m (Maybe UnspentVal)
forall (m :: * -> *) key value.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
DB -> ColumnFamily -> key -> m (Maybe value)
retrieveCF DB
db (DB -> ColumnFamily
unspentCF DB
db) (OutPoint -> UnspentKey
UnspentKey OutPoint
p) DatabaseReaderT m (Maybe Unspent)
-> (Maybe Unspent -> DatabaseReaderT m (Maybe Unspent))
-> DatabaseReaderT m (Maybe Unspent)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe Unspent
Nothing -> Maybe Unspent -> DatabaseReaderT m (Maybe Unspent)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Unspent
forall a. Maybe a
Nothing
            Just Unspent
u -> do
                (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataUnspentCount Int
1
                Maybe Unspent -> DatabaseReaderT m (Maybe Unspent)
forall (m :: * -> *) a. Monad m => a -> m a
return (Unspent -> Maybe Unspent
forall a. a -> Maybe a
Just Unspent
u)

    getBalance :: Address -> DatabaseReaderT m (Maybe Balance)
getBalance Address
a = do
        DB
db <- (DatabaseReader -> DB) -> ReaderT DatabaseReader m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
        (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataBalanceCount Int
1
        (BalVal -> Balance) -> Maybe BalVal -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Address -> BalVal -> Balance
valToBalance Address
a) (Maybe BalVal -> Maybe Balance)
-> ReaderT DatabaseReader m (Maybe BalVal)
-> DatabaseReaderT m (Maybe Balance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB
-> ColumnFamily
-> BalKey
-> ReaderT DatabaseReader m (Maybe BalVal)
forall (m :: * -> *) key value.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
DB -> ColumnFamily -> key -> m (Maybe value)
retrieveCF DB
db (DB -> ColumnFamily
balanceCF DB
db) (Address -> BalKey
BalKey Address
a)

    getMempool :: DatabaseReaderT m [(UnixTime, TxHash)]
getMempool = do
        DB
db <- (DatabaseReader -> DB) -> ReaderT DatabaseReader m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
        (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataMempoolCount Int
1
        [(UnixTime, TxHash)]
-> Maybe [(UnixTime, TxHash)] -> [(UnixTime, TxHash)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(UnixTime, TxHash)] -> [(UnixTime, TxHash)])
-> ReaderT DatabaseReader m (Maybe [(UnixTime, TxHash)])
-> DatabaseReaderT m [(UnixTime, TxHash)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB
-> MemKey -> ReaderT DatabaseReader m (Maybe [(UnixTime, TxHash)])
forall (m :: * -> *) key value.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
DB -> key -> m (Maybe value)
retrieve DB
db MemKey
MemKey

    getBestBlock :: DatabaseReaderT m (Maybe BlockHash)
getBestBlock = do
        (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataBestCount Int
1
        (DatabaseReader -> DB) -> ReaderT DatabaseReader m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle ReaderT DatabaseReader m DB
-> (DB -> DatabaseReaderT m (Maybe BlockHash))
-> DatabaseReaderT m (Maybe BlockHash)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (DB -> BestKey -> DatabaseReaderT m (Maybe BlockHash)
forall (m :: * -> *) key value.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
DB -> key -> m (Maybe value)
`retrieve` BestKey
BestKey)

    getBlocksAtHeight :: Word32 -> DatabaseReaderT m [BlockHash]
getBlocksAtHeight Word32
h = do
        DB
db <- (DatabaseReader -> DB) -> ReaderT DatabaseReader m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
        DB
-> ColumnFamily
-> HeightKey
-> ReaderT DatabaseReader m (Maybe [BlockHash])
forall (m :: * -> *) key value.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
DB -> ColumnFamily -> key -> m (Maybe value)
retrieveCF DB
db (DB -> ColumnFamily
heightCF DB
db) (Word32 -> HeightKey
HeightKey Word32
h) ReaderT DatabaseReader m (Maybe [BlockHash])
-> (Maybe [BlockHash] -> DatabaseReaderT m [BlockHash])
-> DatabaseReaderT m [BlockHash]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe [BlockHash]
Nothing -> [BlockHash] -> DatabaseReaderT m [BlockHash]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            Just [BlockHash]
ls -> do
                (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataBlockCount ([BlockHash] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockHash]
ls)
                [BlockHash] -> DatabaseReaderT m [BlockHash]
forall (m :: * -> *) a. Monad m => a -> m a
return [BlockHash]
ls

    getBlock :: BlockHash -> DatabaseReaderT m (Maybe BlockData)
getBlock BlockHash
h = do
        DB
db <- (DatabaseReader -> DB) -> ReaderT DatabaseReader m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
        DB
-> ColumnFamily -> BlockKey -> DatabaseReaderT m (Maybe BlockData)
forall (m :: * -> *) key value.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
DB -> ColumnFamily -> key -> m (Maybe value)
retrieveCF DB
db (DB -> ColumnFamily
blockCF DB
db) (BlockHash -> BlockKey
BlockKey BlockHash
h) DatabaseReaderT m (Maybe BlockData)
-> (Maybe BlockData -> DatabaseReaderT m (Maybe BlockData))
-> DatabaseReaderT m (Maybe BlockData)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe BlockData
Nothing -> Maybe BlockData -> DatabaseReaderT m (Maybe BlockData)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BlockData
forall a. Maybe a
Nothing
            Just BlockData
b -> do
                (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataBlockCount Int
1
                Maybe BlockData -> DatabaseReaderT m (Maybe BlockData)
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockData -> Maybe BlockData
forall a. a -> Maybe a
Just BlockData
b)

instance MonadUnliftIO m => StoreReadExtra (DatabaseReaderT m) where
    getAddressesTxs :: [Address] -> Limits -> DatabaseReaderT m [TxRef]
getAddressesTxs [Address]
addrs Limits
limits = do
        [TxRef]
txs <- Limits -> [TxRef] -> [TxRef]
forall a. Limits -> [a] -> [a]
applyLimits Limits
limits ([TxRef] -> [TxRef])
-> ([[TxRef]] -> [TxRef]) -> [[TxRef]] -> [TxRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxRef -> Down TxRef) -> [TxRef] -> [TxRef]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn TxRef -> Down TxRef
forall a. a -> Down a
Down ([TxRef] -> [TxRef])
-> ([[TxRef]] -> [TxRef]) -> [[TxRef]] -> [TxRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[TxRef]] -> [TxRef]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TxRef]] -> [TxRef])
-> ReaderT DatabaseReader m [[TxRef]] -> DatabaseReaderT m [TxRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address -> DatabaseReaderT m [TxRef])
-> [Address] -> ReaderT DatabaseReader m [[TxRef]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Address -> DatabaseReaderT m [TxRef]
forall (m :: * -> *).
MonadUnliftIO m =>
Address -> DatabaseReaderT m [TxRef]
f [Address]
addrs
        (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataAddrTxCount ([TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
        [TxRef] -> DatabaseReaderT m [TxRef]
forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
txs
      where
        l :: Limits
l = Limits -> Limits
deOffset Limits
limits
        f :: Address -> DatabaseReaderT m [TxRef]
f Address
a = do
            DB
db <- (DatabaseReader -> DB) -> DatabaseReaderT m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
            DB
-> ColumnFamily
-> (Iterator -> DatabaseReaderT m [TxRef])
-> DatabaseReaderT m [TxRef]
forall (m :: * -> *) a.
MonadUnliftIO m =>
DB -> ColumnFamily -> (Iterator -> m a) -> m a
withIterCF DB
db (DB -> ColumnFamily
addrTxCF DB
db) ((Iterator -> DatabaseReaderT m [TxRef])
 -> DatabaseReaderT m [TxRef])
-> (Iterator -> DatabaseReaderT m [TxRef])
-> DatabaseReaderT m [TxRef]
forall a b. (a -> b) -> a -> b
$ \Iterator
it ->
                ConduitT () Void (DatabaseReaderT m) [TxRef]
-> DatabaseReaderT m [TxRef]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (DatabaseReaderT m) [TxRef]
 -> DatabaseReaderT m [TxRef])
-> ConduitT () Void (DatabaseReaderT m) [TxRef]
-> DatabaseReaderT m [TxRef]
forall a b. (a -> b) -> a -> b
$
                    Address
-> Maybe Start
-> Iterator
-> ConduitT () TxRef (DatabaseReaderT m) ()
forall (m :: * -> *) i.
MonadUnliftIO m =>
Address
-> Maybe Start
-> Iterator
-> ConduitT i TxRef (DatabaseReaderT m) ()
addressConduit Address
a (Limits -> Maybe Start
start Limits
l) Iterator
it
                        ConduitT () TxRef (DatabaseReaderT m) ()
-> ConduitM TxRef Void (DatabaseReaderT m) [TxRef]
-> ConduitT () Void (DatabaseReaderT m) [TxRef]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Word32 -> ConduitT TxRef TxRef (DatabaseReaderT m) ()
forall (m :: * -> *) i. Monad m => Word32 -> ConduitT i i m ()
applyLimitC (Limits -> Word32
limit Limits
l)
                        ConduitT TxRef TxRef (DatabaseReaderT m) ()
-> ConduitM TxRef Void (DatabaseReaderT m) [TxRef]
-> ConduitM TxRef Void (DatabaseReaderT m) [TxRef]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM TxRef Void (DatabaseReaderT m) [TxRef]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList

    getAddressesUnspents :: [Address] -> Limits -> DatabaseReaderT m [Unspent]
getAddressesUnspents [Address]
addrs Limits
limits = do
        [Unspent]
us <- Limits -> [Unspent] -> [Unspent]
forall a. Limits -> [a] -> [a]
applyLimits Limits
limits ([Unspent] -> [Unspent])
-> ([[Unspent]] -> [Unspent]) -> [[Unspent]] -> [Unspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unspent -> Down Unspent) -> [Unspent] -> [Unspent]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Unspent -> Down Unspent
forall a. a -> Down a
Down ([Unspent] -> [Unspent])
-> ([[Unspent]] -> [Unspent]) -> [[Unspent]] -> [Unspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Unspent]] -> [Unspent]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Unspent]] -> [Unspent])
-> ReaderT DatabaseReader m [[Unspent]]
-> DatabaseReaderT m [Unspent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address -> DatabaseReaderT m [Unspent])
-> [Address] -> ReaderT DatabaseReader m [[Unspent]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Address -> DatabaseReaderT m [Unspent]
forall (m :: * -> *).
MonadUnliftIO m =>
Address -> DatabaseReaderT m [Unspent]
f [Address]
addrs
        (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataUnspentCount ([Unspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Unspent]
us)
        [Unspent] -> DatabaseReaderT m [Unspent]
forall (m :: * -> *) a. Monad m => a -> m a
return [Unspent]
us
      where
        l :: Limits
l = Limits -> Limits
deOffset Limits
limits
        f :: Address -> DatabaseReaderT m [Unspent]
f Address
a = do
            DB
db <- (DatabaseReader -> DB) -> DatabaseReaderT m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
            DB
-> ColumnFamily
-> (Iterator -> DatabaseReaderT m [Unspent])
-> DatabaseReaderT m [Unspent]
forall (m :: * -> *) a.
MonadUnliftIO m =>
DB -> ColumnFamily -> (Iterator -> m a) -> m a
withIterCF DB
db (DB -> ColumnFamily
addrOutCF DB
db) ((Iterator -> DatabaseReaderT m [Unspent])
 -> DatabaseReaderT m [Unspent])
-> (Iterator -> DatabaseReaderT m [Unspent])
-> DatabaseReaderT m [Unspent]
forall a b. (a -> b) -> a -> b
$ \Iterator
it ->
                ConduitT () Void (DatabaseReaderT m) [Unspent]
-> DatabaseReaderT m [Unspent]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (DatabaseReaderT m) [Unspent]
 -> DatabaseReaderT m [Unspent])
-> ConduitT () Void (DatabaseReaderT m) [Unspent]
-> DatabaseReaderT m [Unspent]
forall a b. (a -> b) -> a -> b
$
                    Address
-> Maybe Start
-> Iterator
-> ConduitT () Unspent (DatabaseReaderT m) ()
forall (m :: * -> *) i.
MonadUnliftIO m =>
Address
-> Maybe Start
-> Iterator
-> ConduitT i Unspent (DatabaseReaderT m) ()
unspentConduit Address
a (Limits -> Maybe Start
start Limits
l) Iterator
it
                        ConduitT () Unspent (DatabaseReaderT m) ()
-> ConduitM Unspent Void (DatabaseReaderT m) [Unspent]
-> ConduitT () Void (DatabaseReaderT m) [Unspent]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Word32 -> ConduitT Unspent Unspent (DatabaseReaderT m) ()
forall (m :: * -> *) i. Monad m => Word32 -> ConduitT i i m ()
applyLimitC (Limits -> Word32
limit Limits
l)
                        ConduitT Unspent Unspent (DatabaseReaderT m) ()
-> ConduitM Unspent Void (DatabaseReaderT m) [Unspent]
-> ConduitM Unspent Void (DatabaseReaderT m) [Unspent]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Unspent Void (DatabaseReaderT m) [Unspent]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList

    getAddressUnspents :: Address -> Limits -> DatabaseReaderT m [Unspent]
getAddressUnspents Address
a Limits
limits = do
        DB
db <- (DatabaseReader -> DB) -> ReaderT DatabaseReader m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
        [Unspent]
us <- DB
-> ColumnFamily
-> (Iterator -> DatabaseReaderT m [Unspent])
-> DatabaseReaderT m [Unspent]
forall (m :: * -> *) a.
MonadUnliftIO m =>
DB -> ColumnFamily -> (Iterator -> m a) -> m a
withIterCF DB
db (DB -> ColumnFamily
addrOutCF DB
db) ((Iterator -> DatabaseReaderT m [Unspent])
 -> DatabaseReaderT m [Unspent])
-> (Iterator -> DatabaseReaderT m [Unspent])
-> DatabaseReaderT m [Unspent]
forall a b. (a -> b) -> a -> b
$ \Iterator
it ->
            ConduitT () Void (DatabaseReaderT m) [Unspent]
-> DatabaseReaderT m [Unspent]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (DatabaseReaderT m) [Unspent]
 -> DatabaseReaderT m [Unspent])
-> ConduitT () Void (DatabaseReaderT m) [Unspent]
-> DatabaseReaderT m [Unspent]
forall a b. (a -> b) -> a -> b
$
                Iterator -> ConduitT () (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) value i.
(MonadIO m, KeyValue AddrOutKey value, Serialize value,
 StoreReadBase m) =>
Iterator -> ConduitT i (AddrOutKey, value) m ()
x Iterator
it ConduitT () (AddrOutKey, OutVal) (DatabaseReaderT m) ()
-> ConduitM (AddrOutKey, OutVal) Void (DatabaseReaderT m) [Unspent]
-> ConduitT () Void (DatabaseReaderT m) [Unspent]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Limits
-> ConduitT
     (AddrOutKey, OutVal) (AddrOutKey, OutVal) (DatabaseReaderT m) ()
forall (m :: * -> *) i. Monad m => Limits -> ConduitT i i m ()
applyLimitsC Limits
limits ConduitT
  (AddrOutKey, OutVal) (AddrOutKey, OutVal) (DatabaseReaderT m) ()
-> ConduitM (AddrOutKey, OutVal) Void (DatabaseReaderT m) [Unspent]
-> ConduitM (AddrOutKey, OutVal) Void (DatabaseReaderT m) [Unspent]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((AddrOutKey, OutVal) -> Unspent)
-> ConduitT (AddrOutKey, OutVal) Unspent (DatabaseReaderT m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC ((AddrOutKey -> OutVal -> Unspent)
-> (AddrOutKey, OutVal) -> Unspent
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AddrOutKey -> OutVal -> Unspent
toUnspent) ConduitT (AddrOutKey, OutVal) Unspent (DatabaseReaderT m) ()
-> ConduitM Unspent Void (DatabaseReaderT m) [Unspent]
-> ConduitM (AddrOutKey, OutVal) Void (DatabaseReaderT m) [Unspent]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Unspent Void (DatabaseReaderT m) [Unspent]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList
        (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataUnspentCount ([Unspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Unspent]
us)
        [Unspent] -> DatabaseReaderT m [Unspent]
forall (m :: * -> *) a. Monad m => a -> m a
return [Unspent]
us
      where
        x :: Iterator -> ConduitT i (AddrOutKey, value) m ()
x Iterator
it = case Limits -> Maybe Start
start Limits
limits of
            Maybe Start
Nothing ->
                Iterator -> AddrOutKey -> ConduitT i (AddrOutKey, value) m ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> ConduitT i (key, value) m ()
matching Iterator
it (Address -> AddrOutKey
AddrOutKeyA Address
a)
            Just (AtBlock Word32
h) ->
                Iterator
-> AddrOutKey -> AddrOutKey -> ConduitT i (AddrOutKey, value) m ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> key -> ConduitT i (key, value) m ()
matchingSkip
                    Iterator
it
                    (Address -> AddrOutKey
AddrOutKeyA Address
a)
                    (Address -> BlockRef -> AddrOutKey
AddrOutKeyB Address
a (Word32 -> Word32 -> BlockRef
BlockRef Word32
h Word32
forall a. Bounded a => a
maxBound))
            Just (AtTx TxHash
txh) ->
                m (Maybe TxData) -> ConduitT i (AddrOutKey, value) m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
txh) ConduitT i (AddrOutKey, value) m (Maybe TxData)
-> (Maybe TxData -> ConduitT i (AddrOutKey, value) m ())
-> ConduitT i (AddrOutKey, value) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Just TxData{txDataBlock :: TxData -> BlockRef
txDataBlock = b :: BlockRef
b@BlockRef{}} ->
                        Iterator
-> AddrOutKey -> AddrOutKey -> ConduitT i (AddrOutKey, value) m ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> key -> ConduitT i (key, value) m ()
matchingSkip Iterator
it (Address -> AddrOutKey
AddrOutKeyA Address
a) (Address -> BlockRef -> AddrOutKey
AddrOutKeyB Address
a BlockRef
b)
                    Just TxData{txDataBlock :: TxData -> BlockRef
txDataBlock = MemRef{}} ->
                        let cond :: AddrOutKey -> Bool
cond (AddrOutKey Address
_a MemRef{} OutPoint
p) =
                                OutPoint -> TxHash
outPointHash OutPoint
p TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
/= TxHash
txh
                            cond (AddrOutKey Address
_a BlockRef{} OutPoint
_p) =
                                Bool
False
                         in Iterator -> AddrOutKey -> ConduitT i (AddrOutKey, value) m ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> ConduitT i (key, value) m ()
matching Iterator
it (Address -> AddrOutKey
AddrOutKeyA Address
a)
                                ConduitT i (AddrOutKey, value) m ()
-> ConduitM (AddrOutKey, value) (AddrOutKey, value) m ()
-> ConduitT i (AddrOutKey, value) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (((AddrOutKey, value) -> Bool)
-> ConduitM (AddrOutKey, value) (AddrOutKey, value) m ()
forall (m :: * -> *) a o.
Monad m =>
(a -> Bool) -> ConduitT a o m ()
dropWhileC (AddrOutKey -> Bool
cond (AddrOutKey -> Bool)
-> ((AddrOutKey, value) -> AddrOutKey)
-> (AddrOutKey, value)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddrOutKey, value) -> AddrOutKey
forall a b. (a, b) -> a
fst) ConduitM (AddrOutKey, value) (AddrOutKey, value) m ()
-> ConduitM (AddrOutKey, value) (AddrOutKey, value) m ()
-> ConduitM (AddrOutKey, value) (AddrOutKey, value) m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((AddrOutKey, value) -> (AddrOutKey, value))
-> ConduitM (AddrOutKey, value) (AddrOutKey, value) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (AddrOutKey, value) -> (AddrOutKey, value)
forall a. a -> a
id)
                    Maybe TxData
_ -> Iterator -> AddrOutKey -> ConduitT i (AddrOutKey, value) m ()
forall (m :: * -> *) key value i.
(MonadIO m, KeyValue key value, Serialize key, Serialize value) =>
Iterator -> key -> ConduitT i (key, value) m ()
matching Iterator
it (Address -> AddrOutKey
AddrOutKeyA Address
a)

    getAddressTxs :: Address -> Limits -> DatabaseReaderT m [TxRef]
getAddressTxs Address
a Limits
limits = do
        DB
db <- (DatabaseReader -> DB) -> ReaderT DatabaseReader m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
        [TxRef]
txs <- DB
-> ColumnFamily
-> (Iterator -> DatabaseReaderT m [TxRef])
-> DatabaseReaderT m [TxRef]
forall (m :: * -> *) a.
MonadUnliftIO m =>
DB -> ColumnFamily -> (Iterator -> m a) -> m a
withIterCF DB
db (DB -> ColumnFamily
addrTxCF DB
db) ((Iterator -> DatabaseReaderT m [TxRef])
 -> DatabaseReaderT m [TxRef])
-> (Iterator -> DatabaseReaderT m [TxRef])
-> DatabaseReaderT m [TxRef]
forall a b. (a -> b) -> a -> b
$ \Iterator
it ->
            ConduitT () Void (DatabaseReaderT m) [TxRef]
-> DatabaseReaderT m [TxRef]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (DatabaseReaderT m) [TxRef]
 -> DatabaseReaderT m [TxRef])
-> ConduitT () Void (DatabaseReaderT m) [TxRef]
-> DatabaseReaderT m [TxRef]
forall a b. (a -> b) -> a -> b
$
                Address
-> Maybe Start
-> Iterator
-> ConduitT () TxRef (DatabaseReaderT m) ()
forall (m :: * -> *) i.
MonadUnliftIO m =>
Address
-> Maybe Start
-> Iterator
-> ConduitT i TxRef (DatabaseReaderT m) ()
addressConduit Address
a (Limits -> Maybe Start
start Limits
limits) Iterator
it
                    ConduitT () TxRef (DatabaseReaderT m) ()
-> ConduitM TxRef Void (DatabaseReaderT m) [TxRef]
-> ConduitT () Void (DatabaseReaderT m) [TxRef]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Limits -> ConduitT TxRef TxRef (DatabaseReaderT m) ()
forall (m :: * -> *) i. Monad m => Limits -> ConduitT i i m ()
applyLimitsC Limits
limits
                    ConduitT TxRef TxRef (DatabaseReaderT m) ()
-> ConduitM TxRef Void (DatabaseReaderT m) [TxRef]
-> ConduitM TxRef Void (DatabaseReaderT m) [TxRef]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM TxRef Void (DatabaseReaderT m) [TxRef]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList
        (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataAddrTxCount ([TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
        [TxRef] -> DatabaseReaderT m [TxRef]
forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
txs

    getMaxGap :: DatabaseReaderT m Word32
getMaxGap = (DatabaseReader -> Word32) -> DatabaseReaderT m Word32
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> Word32
databaseMaxGap

    getInitialGap :: DatabaseReaderT m Word32
getInitialGap = (DatabaseReader -> Word32) -> DatabaseReaderT m Word32
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> Word32
databaseInitialGap

    getNumTxData :: UnixTime -> DatabaseReaderT m [TxData]
getNumTxData UnixTime
i = do
        DB
db <- (DatabaseReader -> DB) -> ReaderT DatabaseReader m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DatabaseReader -> DB
databaseHandle
        let ((Word32, Word16)
sk, Word8
w) = UnixTime -> ((Word32, Word16), Word8)
decodeTxKey UnixTime
i
        [(TxKey, TxData)]
ls <- IO [(TxKey, TxData)] -> ReaderT DatabaseReader m [(TxKey, TxData)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(TxKey, TxData)]
 -> ReaderT DatabaseReader m [(TxKey, TxData)])
-> IO [(TxKey, TxData)]
-> ReaderT DatabaseReader m [(TxKey, TxData)]
forall a b. (a -> b) -> a -> b
$ DB -> ColumnFamily -> TxKey -> IO [(TxKey, TxData)]
forall (m :: * -> *) key value.
(MonadUnliftIO m, KeyValue key value, Serialize key,
 Serialize value) =>
DB -> ColumnFamily -> key -> m [(key, value)]
matchingAsListCF DB
db (DB -> ColumnFamily
txCF DB
db) ((Word32, Word16) -> TxKey
TxKeyS (Word32, Word16)
sk)
        let f :: TxData -> Bool
f TxData
t =
                let bs :: ByteString
bs = TxHash -> ByteString
forall a. Serialize a => a -> ByteString
encode (TxHash -> ByteString) -> TxHash -> ByteString
forall a b. (a -> b) -> a -> b
$ Tx -> TxHash
txHash (TxData -> Tx
txData TxData
t)
                    b :: Word8
b = ByteString -> Word8
BS.head (Int -> ByteString -> ByteString
BS.drop Int
6 ByteString
bs)
                    w' :: Word8
w' = Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf8
                 in Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w'
            txs :: [TxData]
txs = (TxData -> Bool) -> [TxData] -> [TxData]
forall a. (a -> Bool) -> [a] -> [a]
filter TxData -> Bool
f ([TxData] -> [TxData]) -> [TxData] -> [TxData]
forall a b. (a -> b) -> a -> b
$ ((TxKey, TxData) -> TxData) -> [(TxKey, TxData)] -> [TxData]
forall a b. (a -> b) -> [a] -> [b]
map (TxKey, TxData) -> TxData
forall a b. (a, b) -> b
snd [(TxKey, TxData)]
ls
        (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataTxCount ([TxData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxData]
txs)
        [TxData] -> DatabaseReaderT m [TxData]
forall (m :: * -> *) a. Monad m => a -> m a
return [TxData]
txs

    getBalances :: [Address] -> DatabaseReaderT m [Balance]
getBalances [Address]
as = do
        (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])
-> ReaderT DatabaseReader m [Maybe Balance]
-> DatabaseReaderT m [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address -> ReaderT DatabaseReader m (Maybe Balance))
-> [Address] -> ReaderT DatabaseReader m [Maybe Balance]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Address -> ReaderT DatabaseReader 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

    xPubBals :: XPubSpec -> DatabaseReaderT m [XPubBal]
xPubBals XPubSpec
xpub = do
        Word32
igap <- DatabaseReaderT m Word32
forall (m :: * -> *). StoreReadExtra m => m Word32
getInitialGap
        Word32
gap <- DatabaseReaderT m Word32
forall (m :: * -> *). StoreReadExtra m => m Word32
getMaxGap
        [XPubBal]
ext1 <- Word32
-> Word32 -> [(Word32, Address)] -> DatabaseReaderT m [XPubBal]
forall (m :: * -> *) a.
(StoreReadExtra m, Integral a) =>
a -> Word32 -> [(Word32, Address)] -> m [XPubBal]
derive_until_gap Word32
gap Word32
0 (Int -> [(Word32, Address)] -> [(Word32, Address)]
forall a. Int -> [a] -> [a]
take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
igap) (Word32 -> Word32 -> [(Word32, Address)]
aderiv Word32
0 Word32
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 do
                (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataXPubBals ([XPubBal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
ext1)
                [XPubBal] -> DatabaseReaderT m [XPubBal]
forall (m :: * -> *) a. Monad m => a -> m a
return [XPubBal]
ext1
            else do
                [XPubBal]
ext2 <- Word32
-> Word32 -> [(Word32, Address)] -> DatabaseReaderT m [XPubBal]
forall (m :: * -> *) a.
(StoreReadExtra m, Integral a) =>
a -> Word32 -> [(Word32, Address)] -> m [XPubBal]
derive_until_gap Word32
gap Word32
0 (Word32 -> Word32 -> [(Word32, Address)]
aderiv Word32
0 Word32
igap)
                [XPubBal]
chg <- Word32
-> Word32 -> [(Word32, Address)] -> DatabaseReaderT m [XPubBal]
forall (m :: * -> *) a.
(StoreReadExtra m, Integral a) =>
a -> Word32 -> [(Word32, Address)] -> m [XPubBal]
derive_until_gap Word32
gap Word32
1 (Word32 -> Word32 -> [(Word32, Address)]
aderiv Word32
1 Word32
0)
                let bals :: [XPubBal]
bals = [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
                (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataXPubBals ([XPubBal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
bals)
                [XPubBal] -> DatabaseReaderT m [XPubBal]
forall (m :: * -> *) a. Monad m => a -> m a
return [XPubBal]
bals
      where
        aderiv :: Word32 -> Word32 -> [(Word32, Address)]
aderiv Word32
m =
            DeriveAddr -> XPubKey -> Word32 -> [(Word32, Address)]
deriveAddresses
                (DeriveType -> DeriveAddr
deriveFunction (XPubSpec -> DeriveType
xPubDeriveType XPubSpec
xpub))
                (XPubKey -> Word32 -> XPubKey
pubSubKey (XPubSpec -> XPubKey
xPubSpecKey XPubSpec
xpub) Word32
m)
        xbalance :: Word32 -> Balance -> Word32 -> XPubBal
xbalance Word32
m Balance
b Word32
n = XPubBal :: [Word32] -> Balance -> XPubBal
XPubBal{xPubBalPath :: [Word32]
xPubBalPath = [Word32
m, Word32
n], xPubBal :: Balance
xPubBal = Balance
b}
        derive_until_gap :: a -> Word32 -> [(Word32, Address)] -> m [XPubBal]
derive_until_gap a
_ Word32
_ [] = [XPubBal] -> m [XPubBal]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        derive_until_gap a
gap Word32
m [(Word32, Address)]
as = do
            let ([(Word32, Address)]
as1, [(Word32, Address)]
as2) = Int
-> [(Word32, Address)]
-> ([(Word32, Address)], [(Word32, Address)])
forall a. Int -> [a] -> ([a], [a])
splitAt (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
gap) [(Word32, Address)]
as
            [Balance]
bs <- [Address] -> m [Balance]
forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances (((Word32, Address) -> Address) -> [(Word32, Address)] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (Word32, Address) -> Address
forall a b. (a, b) -> b
snd [(Word32, Address)]
as1)
            let xbs :: [XPubBal]
xbs = (Balance -> Word32 -> XPubBal)
-> [Balance] -> [Word32] -> [XPubBal]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Word32 -> Balance -> Word32 -> XPubBal
xbalance Word32
m) [Balance]
bs (((Word32, Address) -> Word32) -> [(Word32, Address)] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map (Word32, Address) -> Word32
forall a b. (a, b) -> a
fst [(Word32, 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 -> Word32 -> [(Word32, Address)] -> m [XPubBal]
derive_until_gap a
gap Word32
m [(Word32, Address)]
as2

    xPubUnspents :: XPubSpec -> [XPubBal] -> Limits -> DatabaseReaderT m [XPubUnspent]
xPubUnspents XPubSpec
_xspec [XPubBal]
xbals Limits
limits = do
        [XPubUnspent]
us <- [[XPubUnspent]] -> [XPubUnspent]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[XPubUnspent]] -> [XPubUnspent])
-> ReaderT DatabaseReader m [[XPubUnspent]]
-> DatabaseReaderT m [XPubUnspent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XPubBal -> DatabaseReaderT m [XPubUnspent])
-> [XPubBal] -> ReaderT DatabaseReader m [[XPubUnspent]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM XPubBal -> DatabaseReaderT m [XPubUnspent]
forall (f :: * -> *).
StoreReadExtra f =>
XPubBal -> f [XPubUnspent]
h [XPubBal]
cs
        (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataXPubUnspents ([XPubUnspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubUnspent]
us)
        [XPubUnspent] -> DatabaseReaderT m [XPubUnspent]
forall (m :: * -> *) a. Monad m => a -> m a
return ([XPubUnspent] -> DatabaseReaderT m [XPubUnspent])
-> ([XPubUnspent] -> [XPubUnspent])
-> [XPubUnspent]
-> DatabaseReaderT m [XPubUnspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Limits -> [XPubUnspent] -> [XPubUnspent]
forall a. Limits -> [a] -> [a]
applyLimits Limits
limits ([XPubUnspent] -> DatabaseReaderT m [XPubUnspent])
-> [XPubUnspent] -> DatabaseReaderT m [XPubUnspent]
forall a b. (a -> b) -> a -> b
$ (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]
us
      where
        l :: Limits
l = Limits -> Limits
deOffset Limits
limits
        cs :: [XPubBal]
cs = (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UnixTime -> UnixTime -> Bool
forall a. Ord a => a -> a -> Bool
> UnixTime
0) (UnixTime -> Bool) -> (XPubBal -> UnixTime) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> UnixTime
balanceUnspentCount (Balance -> UnixTime)
-> (XPubBal -> Balance) -> XPubBal -> UnixTime
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
            [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 -> [Word32] -> XPubUnspent
XPubUnspent{xPubUnspentPath :: [Word32]
xPubUnspentPath = XPubBal -> [Word32]
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 -> DatabaseReaderT m [TxRef]
xPubTxs XPubSpec
_xspec [XPubBal]
xbals 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] -> [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
        [TxRef]
txs <- [Address] -> Limits -> DatabaseReaderT m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
as Limits
limits
        (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataXPubTxs ([TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
        [TxRef] -> DatabaseReaderT m [TxRef]
forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
txs

    xPubTxCount :: XPubSpec -> [XPubBal] -> DatabaseReaderT m Word32
xPubTxCount XPubSpec
xspec [XPubBal]
xbals = do
        (DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
forall (m :: * -> *).
MonadIO m =>
(DataMetrics -> Counter) -> Int -> ReaderT DatabaseReader m ()
incrementCounter DataMetrics -> Counter
dataXPubTxCount Int
1
        Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> ([TxRef] -> Int) -> [TxRef] -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxRef] -> Word32)
-> DatabaseReaderT m [TxRef] -> DatabaseReaderT m Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> [XPubBal] -> Limits -> DatabaseReaderT m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
xspec [XPubBal]
xbals Limits
forall a. Default a => a
def