haskoin-store 0.46.3 → 0.46.4
raw patch · 4 files changed
+153/−88 lines, 4 filesdep ~haskoin-store-dataPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: haskoin-store-data
API changes (from Hackage documentation)
+ Haskoin.Store.Logic: joinStreams :: Monad m => (a -> a -> Ordering) -> [ConduitT () a m ()] -> ConduitT () a m ()
+ Haskoin.Store.Logic: streamThings :: Monad m => (Limits -> m [a]) -> (a -> TxHash) -> Limits -> ConduitT () a m ()
Files
- CHANGELOG.md +9/−0
- haskoin-store.cabal +5/−5
- src/Haskoin/Store/Logic.hs +57/−5
- src/Haskoin/Store/Web.hs +82/−78
CHANGELOG.md view
@@ -4,6 +4,15 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html) +## 0.46.4+### Fixed+- Do not compute balances separately for loose addresses when part of an xpub.++### Changed+- Do not fetch entire transaction list for loose addresses.+- Transaction count in wallet object is just a synonym for filtered tx count.+- Use conduits to prevent over-fetching transactions from database.+ ## 0.46.3 ### Fixed - Make hex value encoding compatible with Java BigInteger decoder.
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 1d506c7bd9f5afbe5f0b1da5bd8e173e9ff4ca6f5e64429f1153af50c15ce70b+-- hash: a1382f198453b7795ad226a8857b0e6ad8e5c31f07b52ca38ccd7ecc6eba6035 name: haskoin-store-version: 0.46.3+version: 0.46.4 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Please see the README on GitHub at <https://github.com/haskoin/haskoin-store#readme> category: Bitcoin, Finance, Network@@ -59,7 +59,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.19.0 , haskoin-node >=0.17.0- , haskoin-store-data ==0.46.3+ , haskoin-store-data ==0.46.4 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -109,7 +109,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.46.3+ , haskoin-store-data ==0.46.4 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -164,7 +164,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.46.3+ , haskoin-store-data ==0.46.4 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store/Logic.hs view
@@ -13,8 +13,12 @@ , importBlock , newMempoolTx , deleteUnconfirmedTx+ , streamThings+ , joinStreams ) where +import Conduit (ConduitT, await, lift, sealConduitT,+ yield, ($$++)) import Control.Monad (forM, forM_, guard, unless, void, when, zipWithM_) import Control.Monad.Except (MonadError, throwError)@@ -23,9 +27,11 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Short as B.Short import Data.Either (rights)+import Data.Function (on) import qualified Data.IntMap.Strict as I-import Data.List (nub)-import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)+import Data.List (nub, sortBy)+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing,+ mapMaybe) import Data.Serialize (encode) import Data.Word (Word32, Word64) import Haskoin (Address, Block (..), BlockHash,@@ -162,7 +168,7 @@ action i tx = testPresent tx >>= \case False -> import_it i tx- True -> confirm_it i tx+ True -> confirm_it i tx confirm_it i tx = getActiveTxData (txHash tx) >>= \case Just t -> do@@ -577,7 +583,7 @@ spendOutput :: MonadImport m => TxHash -> Word32 -> OutPoint -> m () spendOutput th ix op = do u <- getUnspent op >>= \case- Just u -> return u+ Just u -> return u Nothing -> error $ "Could not find UTXO to spend: " <> show op deleteUnspent op insertSpender op (Spender th ix)@@ -596,7 +602,7 @@ unspendOutput op = do t <- getActiveTxData (outPointHash op) >>= \case Nothing -> error $ "Could not find tx data: " <> show (outPointHash op)- Just t -> return t+ Just t -> return t let o = fromMaybe (error ("Could not find output: " <> show op)) (getTxOut (outPointIndex op) (txData t))@@ -669,3 +675,49 @@ testPresent :: StoreReadBase m => Tx -> m Bool testPresent tx = isJust <$> getActiveTxData (txHash tx)++streamThings :: Monad m+ => (Limits -> m [a])+ -> (a -> TxHash)+ -> Limits+ -> ConduitT () a m ()+streamThings f g l =+ lift (f l{limit = 50}) >>= \case+ [] -> return ()+ ls -> do+ mapM yield ls+ go (last ls)+ where+ go x =+ lift (f (Limits 50 0 (Just (AtTx (g x))))) >>= \case+ [] -> return ()+ ls -> do+ case dropWhile ((== g x) . g) ls of+ [] -> return ()+ ls' -> do+ mapM yield ls'+ go (last ls')++joinStreams :: Monad m+ => (a -> a -> Ordering)+ -> [ConduitT () a m ()]+ -> ConduitT () a m ()+joinStreams c xs = do+ let ss = map sealConduitT xs+ ys <- mapMaybe j <$>+ lift (traverse ($$++ await) ss)+ go Nothing ys+ where+ j (x, y) = (,) x <$> y+ go m ys =+ case sortBy (c `on` snd) ys of+ [] -> return ()+ (i,x):ys' -> do+ case m of+ Nothing -> yield x+ Just x'+ | c x x' == EQ -> return ()+ | otherwise -> yield x+ j <$> lift (i $$++ await) >>= \case+ Nothing -> go (Just x) ys'+ Just y -> go (Just x) (y:ys')
src/Haskoin/Store/Web.hs view
@@ -17,8 +17,9 @@ , runWeb ) where -import Conduit (await, runConduit, takeC, yield,- (.|))+import Conduit (ConduitT, await, dropC,+ runConduit, sinkList, takeC,+ yield, (.|)) import Control.Applicative ((<|>)) import Control.Arrow (second) import Control.Lens@@ -80,6 +81,7 @@ import Haskoin.Store.Common import Haskoin.Store.Data import Haskoin.Store.Database.Reader+import Haskoin.Store.Logic import Haskoin.Store.Manager import Haskoin.Store.Stats import Haskoin.Store.WebCommon@@ -1304,9 +1306,68 @@ get_xpub_unspents = mapM (`xPubUnspents` def) get_addr_unspents = (`getAddressesUnspents` def) . HashSet.toList +getBinfoTxs :: (StoreReadExtra m, MonadIO m)+ => HashMap Address (Maybe BinfoXPubPath) -- address book+ -> HashSet XPubSpec -- show xpubs+ -> HashSet Address -- show addrs+ -> HashSet Address -- balance addresses+ -> BinfoFilter+ -> Bool -- numtxid+ -> Bool -- prune outputs+ -> Int64 -- starting balance+ -> ConduitT () BinfoTx m ()+getBinfoTxs abook sxspecs saddrs baddrs bfilter numtxid prune bal =+ joinStreams (flip compare) conduits .| go bal+ where+ sxspecs_ls = HashSet.toList sxspecs+ saddrs_ls = HashSet.toList saddrs+ conduits = map xpub_c sxspecs_ls <> map addr_c saddrs_ls+ xpub_c x = streamThings (xPubTxs x) txRefHash def+ addr_c a = streamThings (getAddressTxs a) txRefHash def+ binfo_tx b = toBinfoTx numtxid abook prune b+ compute_bal_change BinfoTx{..} =+ let ins = mapMaybe getBinfoTxInputPrevOut getBinfoTxInputs+ out = getBinfoTxOutputs+ f b BinfoTxOutput{..} =+ let val = fromIntegral getBinfoTxOutputValue+ in case getBinfoTxOutputAddress of+ Nothing -> 0+ Just a | a `HashSet.member` baddrs ->+ if b then val else negate val+ | otherwise -> 0+ in sum $ map (f False) ins <> map (f True) out+ go b = await >>= \case+ Nothing -> return ()+ Just (TxRef _ t) -> lift (getTransaction t) >>= \case+ Nothing -> go b+ Just x -> do+ let a = binfo_tx b x+ b' = b - compute_bal_change a+ c = isJust (getBinfoTxBlockHeight a)+ Just (d, _) = getBinfoTxResultBal a+ r = d + fromIntegral (getBinfoTxFee a)+ case bfilter of+ BinfoFilterAll ->+ yield a >> go b'+ BinfoFilterSent+ | 0 > r -> yield a >> go b'+ | otherwise -> go b'+ BinfoFilterReceived+ | r > 0 -> yield a >> go b'+ | otherwise -> go b'+ BinfoFilterMoved+ | r == 0 -> yield a >> go b'+ | otherwise -> go b'+ BinfoFilterConfirmed+ | c -> yield a >> go b'+ | otherwise -> go b'+ BinfoFilterMempool+ | c -> return ()+ | otherwise -> yield a >> go b'+ scottyMultiAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () scottyMultiAddr =- get_addrs >>= \(addrs, xpubs, saddrs, sxpubs, xspecs) ->+ get_addrs >>= \(addrs', xpubs, saddrs, sxpubs, xspecs) -> getNumTxId >>= \numtxid -> lift (asks webTicker) >>= \ticker -> get_price ticker >>= \local ->@@ -1315,19 +1376,15 @@ get_count >>= \n -> get_prune >>= \prune -> get_filter >>= \fltr ->- let len = HashSet.size addrs + HashSet.size xpubs+ let len = HashSet.size addrs' + HashSet.size xpubs in withMetrics multiaddrResponseTime len $ do xbals <- get_xbals xspecs+ xtxns <- mapM count_txs xspecs let sxbals = subset sxpubs xbals- xtrs <- get_xtrs xspecs- let sxtrs = subset sxpubs xtrs- abals <- get_abals addrs- satrs <- get_atrs saddrs- nosatrs <- get_atrs (addrs `HashSet.difference` saddrs)- let xtns = HashMap.map length xtrs- xtrset = Set.fromList (concat (HashMap.elems xtrs))- sxtrset = Set.fromList (concat (HashMap.elems sxtrs)) xabals = compute_xabals xbals+ addrs = addrs' `HashSet.difference` HashMap.keysSet xabals+ abals <- get_abals addrs+ let sxspecs = compute_sxspecs sxpubs xspecs sxabals = compute_xabals sxbals sabals = subset saddrs abals sallbals = sabals <> sxabals@@ -1335,27 +1392,26 @@ allbals = abals <> xabals abook = compute_abook addrs xbals sxaddrs = compute_xaddrs sxbals- salladdrs = sxaddrs <> saddrs+ salladdrs = saddrs <> sxaddrs bal = compute_bal allbals- alltrs = xtrset <> nosatrs <> satrs- salltrs = sxtrset <> satrs- stxids = compute_txids salltrs let ibal = fromIntegral sbal- btxs <- binfo_txs (n + offset) fltr numtxid salladdrs abook prune ibal stxids+ ftxs <-+ lift . runConduit $+ getBinfoTxs abook sxspecs saddrs salladdrs fltr numtxid prune ibal .|+ (dropC offset >> takeC n .| sinkList) best <- get_best_block peers <- get_peers net <- lift $ asks (storeNetwork . webStore . webConfig)- let ftxs = drop offset btxs- baddrs = toBinfoAddrs sabals sxbals xtns- abaddrs = toBinfoAddrs abals xbals xtns+ let baddrs = toBinfoAddrs sabals sxbals xtxns+ abaddrs = toBinfoAddrs abals xbals xtxns recv = sum $ map getBinfoAddrReceived abaddrs sent = sum $ map getBinfoAddrSent abaddrs- txn = fromIntegral $ Set.size alltrs+ txn = fromIntegral $ length ftxs wallet = BinfoWallet { getBinfoWalletBalance = bal , getBinfoWalletTxCount = txn- , getBinfoWalletFilteredCount = fromIntegral (length ftxs)+ , getBinfoWalletFilteredCount = txn , getBinfoWalletTotalReceived = recv , getBinfoWalletTotalSent = sent }@@ -1386,6 +1442,7 @@ , getBinfoMultiAddrCashAddr = cashaddr } where+ count_txs xspec = length <$> xPubTxs xspec def get_filter = S.param "filter" `S.rescue` const (return BinfoFilterAll) get_best_block = getBestBlock >>= \case@@ -1414,57 +1471,19 @@ return (fromIntegral o :: Int) subset ks = HashMap.filterWithKey (\k _ -> k `HashSet.member` ks)+ compute_sxspecs sxpubs =+ HashSet.fromList . HashMap.elems . subset sxpubs addr (BinfoAddr a) = Just a addr (BinfoXpub x) = Nothing xpub (BinfoXpub x) = Just x xpub (BinfoAddr _) = Nothing- compute_bal_change addrs BinfoTx{..} =- let ins = mapMaybe getBinfoTxInputPrevOut getBinfoTxInputs- out = getBinfoTxOutputs- f b BinfoTxOutput{..} =- let val = fromIntegral getBinfoTxOutputValue- in case getBinfoTxOutputAddress of- Nothing -> 0- Just a | a `HashSet.member` addrs ->- if b- then val- else negate val- | otherwise -> 0- in sum $ map (f False) ins <> map (f True) out- binfo_txs _ _ _ _ _ _ _ [] = return []- binfo_txs 0 _ _ _ _ _ _ _ = return []- binfo_txs i f n s o p b (t:ts) =- getTransaction t >>= \case- Nothing -> binfo_txs i f n s o p b ts- Just x -> do- let a = toBinfoTx n o p b x- b' = b - compute_bal_change s a- c = isJust (getBinfoTxBlockHeight a)- Just (d, _) = getBinfoTxResultBal a- r = d + fromIntegral (getBinfoTxFee a)- y = (a:) <$> binfo_txs (i-1) f n s o p b' ts- z = binfo_txs i f n s o p b' ts- case f of- BinfoFilterAll -> y- BinfoFilterSent ->- if r < 0 then y else z- BinfoFilterReceived ->- if r > 0 then y else z- BinfoFilterMoved ->- if r == 0 then y else z- BinfoFilterConfirmed ->- if c then y else z- BinfoFilterMempool ->- if not c then y else return [] get_addrs = do (xspecs, addrs) <- getBinfoActive multiaddrErrors sh <- getBinfoAddrsParam multiaddrErrors "onlyShow" let xpubs = HashMap.keysSet xspecs actives = HashSet.map BinfoAddr addrs <> HashSet.map BinfoXpub xpubs- sh' = if HashSet.null sh- then actives- else sh `HashSet.intersection` actives+ sh' = if HashSet.null sh then actives else sh saddrs = HashSet.fromList . mapMaybe addr $ HashSet.toList sh' sxpubs = HashSet.fromList . mapMaybe xpub $ HashSet.toList sh' return (addrs, xpubs, saddrs, sxpubs, xspecs)@@ -1477,21 +1496,6 @@ let f b = (balanceAddress b, b) g = HashMap.fromList . map f in fmap g . getBalances . HashSet.toList- get_xtrs =- let f (k, s) = (,) k <$> xPubTxs s def- in fmap HashMap.fromList . mapM f . HashMap.toList- get_atrs =- let f x = getAddressesTxs x def- in fmap Set.fromList . f . HashSet.toList- get_txs _ _ [] = return []- get_txs _ 0 _ = return []- get_txs s n (i:is) =- getTransaction i >>= \case- Nothing -> get_txs s n is- Just t ->- if addr_in_set s t- then ((t, True):) <$> get_txs s (n - 1) is- else ((t, False):) <$> get_txs s n is addr_in_set s t = let f StoreCoinbase{} = False f StoreInput{inputAddress = Nothing} = False