diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/haskoin-store.cabal b/haskoin-store.cabal --- a/haskoin-store.cabal +++ b/haskoin-store.cabal @@ -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. diff --git a/src/Haskoin/Store/Cache.hs b/src/Haskoin/Store/Cache.hs --- a/src/Haskoin/Store/Cache.hs +++ b/src/Haskoin/Store/Cache.hs @@ -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 diff --git a/src/Haskoin/Store/Common.hs b/src/Haskoin/Store/Common.hs --- a/src/Haskoin/Store/Common.hs +++ b/src/Haskoin/Store/Common.hs @@ -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)