haskoin-store 0.22.1 → 0.22.2
raw patch · 4 files changed
+114/−69 lines, 4 files
Files
- CHANGELOG.md +5/−0
- haskoin-store.cabal +2/−2
- src/Haskoin/Store/Cache.hs +70/−67
- src/Haskoin/Store/Common.hs +37/−0
CHANGELOG.md view
@@ -4,6 +4,11 @@ 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.22.2+### Changed+- More efficient algorithms for caching and cache misses.+- Better debug logging of cache hits and misses.+ ## 0.22.1 ### Added - More debug logging for cache hits.
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f3c4b3255b61e04e753f990846948489835c294b9d7759ac68a62ef6543d69d9+-- hash: 7a0c5880e387abb80513ece5fc14ba5c2d3b10d5eec8fe814d1eba0c88e7ffeb name: haskoin-store-version: 0.22.1+version: 0.22.2 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Store and index Bitcoin or Bitcoin Cash blocks, transactions, balances and unspent outputs. All data is available via REST API in JSON or binary format.
src/Haskoin/Store/Cache.hs view
@@ -62,15 +62,29 @@ xPubWitnessAddr) import Haskoin.Node (Chain, chainGetAncestor, chainGetBlock, chainGetSplitBlock)-import Haskoin.Store.Common (Balance (..), BlockData (..),- BlockRef (..), BlockTx (..),- DeriveType (..), Limit, Offset,- Prev (..), StoreRead (..),- StoreRead (..), TxData (..),- Unspent (..), XPubBal (..),- XPubSpec (..), XPubUnspent (..),- nullBalance, sortTxs, xPubBals,- xPubTxs, xPubUnspents)+import Haskoin.Store.Common+ ( Balance(..)+ , BlockData(..)+ , BlockRef(..)+ , BlockTx(..)+ , DeriveType(..)+ , Limit+ , Offset+ , Prev(..)+ , StoreRead(..)+ , StoreRead(..)+ , TxData(..)+ , Unspent(..)+ , XPubBal(..)+ , XPubSpec(..)+ , XPubUnspent(..)+ , nullBalance+ , sortTxs+ , xPubBals+ , xPubBalsTxs+ , xPubBalsUnspents+ , xPubTxs+ ) import NQE (Inbox, Mailbox, receive) import UnliftIO (Exception, MonadIO, MonadUnliftIO, liftIO, throwIO)@@ -152,25 +166,18 @@ -> Maybe Limit -> CacheT m [BlockTx] getXPubTxs xpub start offset limit =- c >>= \case- [] ->- newXPubC xpub >>= \(bals, t) ->- if t- then c- else do- txs <- d- $(logDebugS) "Cache" $- "Not caching xpub with " <>- cs (show (lenNotNull bals)) <>- " balances"- return txs- txs -> do+ isXPubCached xpub >>= \case+ True -> do+ txs <- cacheGetXPubTxs xpub start offset limit $(logDebugS) "Cache" $ "Cache hit for " <> cs (show (length txs)) <> " xpub txs" return txs- where- c = cacheGetXPubTxs xpub start offset limit- d = lift $ xPubTxs xpub start offset limit+ False -> do+ $(logDebugS) "Cache" $ "Cache miss for xpub txs request"+ newXPubC xpub >>= \(bals, t) ->+ if t+ then cacheGetXPubTxs xpub start offset limit+ else xPubBalsTxs bals start offset limit getXPubUnspents :: (MonadLoggerIO m, StoreRead m)@@ -180,23 +187,20 @@ -> Maybe Limit -> CacheT m [XPubUnspent] getXPubUnspents xpub start offset limit =- cacheGetXPubBalances xpub >>= \case- [] ->+ isXPubCached xpub >>= \case+ True -> do+ bals <- cacheGetXPubBalances xpub+ $(logDebugS) "Cache" $+ "Cache hit for unspents on an xpub with " <>+ cs (show (length bals)) <>+ " balances"+ process bals+ False -> do+ $(logDebugS) "Cache" $ "Cache miss for xpub unspents request" newXPubC xpub >>= \(bals, t) -> if t then process bals- else do- uns <- lift $ xPubUnspents xpub start offset limit- $(logDebugS) "Cache" $- "Not caching xpub with " <>- cs (show (lenNotNull bals)) <>- " balances"- return uns- bals -> do- $(logDebugS) "Cache" $- "Cache hit for xpub with " <> cs (show (length bals)) <>- " xpub balances"- process bals+ else xPubBalsUnspents bals start offset limit where process bals = do ops <- map snd <$> cacheGetXPubUnspents xpub start offset limit@@ -223,24 +227,23 @@ (MonadLoggerIO m, StoreRead m) => XPubSpec -> CacheT m [XPubBal]-getXPubBalances xpub = do- cacheGetXPubBalances xpub >>= \case- [] ->- newXPubC xpub >>= \(bals, t) ->- if t- then return bals- else do- $(logDebugS) "Cache" $- "Not caching xpub with " <>- cs (show (lenNotNull bals)) <>- " balances"- return bals- bals -> do+getXPubBalances xpub =+ isXPubCached xpub >>= \case+ True -> do+ bals <- cacheGetXPubBalances xpub $(logDebugS) "Cache" $- "Cache hit for xpub with " <> cs (show (length bals)) <>- " xpub balances"+ "Cache hit for " <> cs (show (length bals)) <> " xpub balances" return bals+ False -> do+ $(logDebugS) "Cache" "Cache miss for xpub balances request"+ fst <$> newXPubC xpub +isXPubCached :: MonadIO m => XPubSpec -> CacheT m Bool+isXPubCached = runRedisReply . redisIsXPubCached++redisIsXPubCached :: XPubSpec -> RedisReply Bool+redisIsXPubCached xpub = Redis.exists (balancesPfx <> encode xpub)+ cacheGetXPubBalances :: MonadIO m => XPubSpec -> CacheT m [XPubBal] cacheGetXPubBalances xpub = do now <- systemSeconds <$> liftIO getSystemTime@@ -483,21 +486,21 @@ => XPubSpec -> CacheT m ([XPubBal], Bool) newXPubC xpub = do- bals <- cacheGetXPubBalances xpub+ bals <- lift $ xPubBals xpub x <- asks cacheMin- if null bals+ let n = lenNotNull bals+ if x <= n then do- bals' <- lift $ xPubBals xpub- case lenNotNull bals' of- 0 -> return (bals', False)- _- | x <= lenNotNull bals' -> go bals' >> return (bals', True)- | otherwise -> return (bals', False)- else return (bals, False)+ $(logDebugS) "Cache" $+ "Caching xpub with " <> cs (show n) <> " used addresses"+ go bals+ return (bals, True)+ else do+ $(logDebugS) "Cache" $+ "Not caching xpub with " <> cs (show n) <> " used addresses"+ return (bals, False) where go bals = do- $(logDebugS) "Cache" $- "Adding xpub with " <> cs (show (lenNotNull bals)) <> " balances" utxo <- lift $ xPubUnspents xpub Nothing 0 Nothing xtxs <- lift $ xPubTxs xpub Nothing 0 Nothing now <- systemSeconds <$> liftIO getSystemTime@@ -784,8 +787,8 @@ return $ HashMap.fromList xbs' newaddrs xpub bals = let paths = HashMap.lookupDefault [] xpub xpubmap- ext = maximum . (0 :) . map (head . tail) $ filter ((== 0) . head) (paths)- chg = maximum . (0 :) . map (head . tail) $ filter ((== 1) . head) (paths)+ ext = maximum . (0 :) . map (head . tail) $ filter ((== 0) . head) paths+ chg = maximum . (0 :) . map (head . tail) $ filter ((== 1) . head) paths extnew = addrsToAdd bals
src/Haskoin/Store/Common.hs view
@@ -37,7 +37,9 @@ , TxId(..) , PeerInformation(..) , XPubBal(..)+ , xPubBalsTxs , XPubUnspent(..)+ , xPubBalsUnspents , XPubSummary(..) , HealthCheck(..) , Event(..)@@ -318,6 +320,41 @@ deriveFunction DeriveNormal i = fst . deriveAddr i deriveFunction DeriveP2SH i = fst . deriveCompatWitnessAddr i deriveFunction DeriveP2WPKH i = fst . deriveWitnessAddr i++xPubBalsUnspents ::+ StoreRead m+ => [XPubBal]+ -> Maybe BlockRef+ -> Offset+ -> Maybe Limit+ -> m [XPubUnspent]+xPubBalsUnspents bals start offset limit = do+ let xs = filter positive bals+ applyOffsetLimit offset limit <$> go xs+ where+ positive XPubBal {xPubBal = Balance {balanceUnspentCount = c}} = c > 0+ go [] = return []+ go (XPubBal {xPubBalPath = p, xPubBal = Balance {balanceAddress = a}}:xs) = do+ uns <- getAddressUnspents a start limit+ let xuns =+ map+ (\t ->+ XPubUnspent {xPubUnspentPath = p, xPubUnspent = t})+ uns+ (xuns <>) <$> go xs++xPubBalsTxs ::+ StoreRead m+ => [XPubBal]+ -> Maybe BlockRef+ -> Offset+ -> Maybe Limit+ -> m [BlockTx]+xPubBalsTxs bals start offset limit = do+ let as = map balanceAddress . filter (not . nullBalance) $ map xPubBal bals+ ts <- concat <$> mapM (\a -> getAddressTxs a start limit) as+ let ts' = nub $ sortBy (flip compare `on` blockTxBlock) ts+ return $ applyOffsetLimit offset limit ts' getTransaction :: (Monad m, StoreRead m) => TxHash -> m (Maybe Transaction)