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

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

import Conduit
  ( ConduitT,
    dropC,
    dropWhileC,
    lift,
    mapC,
    runConduit,
    sinkList,
    takeC,
    (.|),
  )
import Control.Monad.Except (runExceptT, throwError)
import Control.Monad.Reader (ReaderT, ask, asks, runReaderT)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Data.Bits ((.&.))
import qualified Data.ByteString as BS
import Data.Default (def)
import Data.Function (on)
import qualified Data.IntMap.Strict as IntMap
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
18

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}), -- unused
    (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

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 ()

withManyIters ::
  MonadUnliftIO m =>
  DB ->
  ColumnFamily ->
  Int ->
  ([Iterator] -> m a) ->
  m a
withManyIters :: DB -> ColumnFamily -> Int -> ([Iterator] -> m a) -> m a
withManyIters DB
db ColumnFamily
cf Int
i [Iterator] -> m a
f = [Iterator] -> Int -> m a
forall t. (Eq t, Num t) => [Iterator] -> t -> m a
go [] Int
i
  where
    go :: [Iterator] -> t -> m a
go [Iterator]
acc t
0 = [Iterator] -> m a
f [Iterator]
acc
    go [Iterator]
acc t
n = DB -> ColumnFamily -> (Iterator -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
DB -> ColumnFamily -> (Iterator -> m a) -> m a
withIterCF DB
db ColumnFamily
cf ((Iterator -> m a) -> m a) -> (Iterator -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Iterator
it -> [Iterator] -> t -> m a
go (Iterator
it Iterator -> [Iterator] -> [Iterator]
forall a. a -> [a] -> [a]
: [Iterator]
acc) (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)

joinConduits ::
  (Monad m, Ord o) =>
  [ConduitT () o m ()] ->
  Limits ->
  m [o]
joinConduits :: [ConduitT () o m ()] -> Limits -> m [o]
joinConduits [ConduitT () o m ()]
cs Limits
l =
  ConduitT () Void m [o] -> m [o]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m [o] -> m [o])
-> ConduitT () Void m [o] -> m [o]
forall a b. (a -> b) -> a -> b
$ [ConduitT () o m ()] -> ConduitT () o m ()
forall (m :: * -> *) a.
(Monad m, Ord a) =>
[ConduitT () a m ()] -> ConduitT () a m ()
joinDescStreams [ConduitT () o m ()]
cs ConduitT () o m ()
-> ConduitM o Void m [o] -> ConduitT () Void m [o]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Limits -> ConduitT o o m ()
forall (m :: * -> *) i. Monad m => Limits -> ConduitT i i m ()
applyLimitsC Limits
l ConduitT o o m () -> ConduitM o Void m [o] -> ConduitM o Void m [o]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM o Void m [o]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList

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 = MaybeT (DatabaseReaderT m) Spender
-> DatabaseReaderT m (Maybe Spender)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (DatabaseReaderT m) Spender
 -> DatabaseReaderT m (Maybe Spender))
-> MaybeT (DatabaseReaderT m) Spender
-> DatabaseReaderT m (Maybe Spender)
forall a b. (a -> b) -> a -> b
$ do
    TxData
td <- DatabaseReaderT m (Maybe TxData)
-> MaybeT (DatabaseReaderT m) TxData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (DatabaseReaderT m (Maybe TxData)
 -> MaybeT (DatabaseReaderT m) TxData)
-> DatabaseReaderT m (Maybe TxData)
-> MaybeT (DatabaseReaderT m) TxData
forall a b. (a -> b) -> a -> b
$ TxHash -> DatabaseReaderT m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData (OutPoint -> TxHash
outPointHash OutPoint
op)
    let i :: Int
i = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (OutPoint -> Word32
outPointIndex OutPoint
op)
    DatabaseReaderT m (Maybe Spender)
-> MaybeT (DatabaseReaderT m) Spender
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (DatabaseReaderT m (Maybe Spender)
 -> MaybeT (DatabaseReaderT m) Spender)
-> (Maybe Spender -> DatabaseReaderT m (Maybe Spender))
-> Maybe Spender
-> MaybeT (DatabaseReaderT m) Spender
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Spender -> DatabaseReaderT m (Maybe Spender)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Spender -> MaybeT (DatabaseReaderT m) Spender)
-> Maybe Spender -> MaybeT (DatabaseReaderT m) Spender
forall a b. (a -> b) -> a -> b
$ Int
i Int -> IntMap Spender -> Maybe Spender
forall a. Int -> IntMap a -> Maybe a
`IntMap.lookup` TxData -> IntMap Spender
txDataSpenders TxData
td

  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
    Maybe UnspentVal
val <- 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)
    case (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
val of
      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
    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
-> Int
-> ([Iterator] -> DatabaseReaderT m [TxRef])
-> DatabaseReaderT m [TxRef]
forall (m :: * -> *) a.
MonadUnliftIO m =>
DB -> ColumnFamily -> Int -> ([Iterator] -> m a) -> m a
withManyIters DB
db (DB -> ColumnFamily
addrTxCF DB
db) ([Address] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Address]
addrs) (([Iterator] -> DatabaseReaderT m [TxRef])
 -> DatabaseReaderT m [TxRef])
-> ([Iterator] -> DatabaseReaderT m [TxRef])
-> DatabaseReaderT m [TxRef]
forall a b. (a -> b) -> a -> b
$ \[Iterator]
its -> do
      [TxRef]
txs <- [ConduitT () TxRef (DatabaseReaderT m) ()]
-> Limits -> DatabaseReaderT m [TxRef]
forall (m :: * -> *) o.
(Monad m, Ord o) =>
[ConduitT () o m ()] -> Limits -> m [o]
joinConduits ([Iterator] -> [ConduitT () TxRef (DatabaseReaderT m) ()]
forall i. [Iterator] -> [ConduitT i TxRef (DatabaseReaderT m) ()]
cs [Iterator]
its) Limits
limits
      (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
      cs :: [Iterator] -> [ConduitT i TxRef (DatabaseReaderT m) ()]
cs = ((Address, Iterator) -> ConduitT i TxRef (DatabaseReaderT m) ())
-> [(Address, Iterator)]
-> [ConduitT i TxRef (DatabaseReaderT m) ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Address -> Iterator -> ConduitT i TxRef (DatabaseReaderT m) ())
-> (Address, Iterator) -> ConduitT i TxRef (DatabaseReaderT m) ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address -> Iterator -> ConduitT i TxRef (DatabaseReaderT m) ()
forall (m :: * -> *) i.
MonadUnliftIO m =>
Address -> Iterator -> ConduitT i TxRef (DatabaseReaderT m) ()
c) ([(Address, Iterator)]
 -> [ConduitT i TxRef (DatabaseReaderT m) ()])
-> ([Iterator] -> [(Address, Iterator)])
-> [Iterator]
-> [ConduitT i TxRef (DatabaseReaderT m) ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> [Iterator] -> [(Address, Iterator)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Address]
addrs
      c :: Address -> Iterator -> ConduitT i TxRef (DatabaseReaderT m) ()
c Address
a = Address
-> Maybe Start
-> Iterator
-> ConduitT i 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)

  getAddressesUnspents :: [Address] -> Limits -> DatabaseReaderT m [Unspent]
getAddressesUnspents [Address]
addrs 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
    DB
-> ColumnFamily
-> Int
-> ([Iterator] -> DatabaseReaderT m [Unspent])
-> DatabaseReaderT m [Unspent]
forall (m :: * -> *) a.
MonadUnliftIO m =>
DB -> ColumnFamily -> Int -> ([Iterator] -> m a) -> m a
withManyIters DB
db (DB -> ColumnFamily
addrOutCF DB
db) ([Address] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Address]
addrs) (([Iterator] -> DatabaseReaderT m [Unspent])
 -> DatabaseReaderT m [Unspent])
-> ([Iterator] -> DatabaseReaderT m [Unspent])
-> DatabaseReaderT m [Unspent]
forall a b. (a -> b) -> a -> b
$ \[Iterator]
its -> do
      [Unspent]
uns <- [ConduitT () Unspent (DatabaseReaderT m) ()]
-> Limits -> DatabaseReaderT m [Unspent]
forall (m :: * -> *) o.
(Monad m, Ord o) =>
[ConduitT () o m ()] -> Limits -> m [o]
joinConduits ([Iterator] -> [ConduitT () Unspent (DatabaseReaderT m) ()]
forall i. [Iterator] -> [ConduitT i Unspent (DatabaseReaderT m) ()]
cs [Iterator]
its) Limits
limits
      (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]
uns)
      [Unspent] -> DatabaseReaderT m [Unspent]
forall (m :: * -> *) a. Monad m => a -> m a
return [Unspent]
uns
    where
      cs :: [Iterator] -> [ConduitT i Unspent (DatabaseReaderT m) ()]
cs = ((Address, Iterator) -> ConduitT i Unspent (DatabaseReaderT m) ())
-> [(Address, Iterator)]
-> [ConduitT i Unspent (DatabaseReaderT m) ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Address -> Iterator -> ConduitT i Unspent (DatabaseReaderT m) ())
-> (Address, Iterator) -> ConduitT i Unspent (DatabaseReaderT m) ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address -> Iterator -> ConduitT i Unspent (DatabaseReaderT m) ()
forall (m :: * -> *) i.
MonadUnliftIO m =>
Address -> Iterator -> ConduitT i Unspent (DatabaseReaderT m) ()
c) ([(Address, Iterator)]
 -> [ConduitT i Unspent (DatabaseReaderT m) ()])
-> ([Iterator] -> [(Address, Iterator)])
-> [Iterator]
-> [ConduitT i Unspent (DatabaseReaderT m) ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> [Iterator] -> [(Address, Iterator)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Address]
addrs
      c :: Address -> Iterator -> ConduitT i Unspent (DatabaseReaderT m) ()
c Address
a = Address
-> Maybe Start
-> Iterator
-> ConduitT i 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
limits)

  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
$
        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
limits) 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
.| Limits -> ConduitT Unspent Unspent (DatabaseReaderT m) ()
forall (m :: * -> *) i. Monad m => Limits -> ConduitT i i m ()
applyLimitsC Limits
limits
          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
    (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

  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