haskoin-store 0.21.5 → 0.21.6
raw patch · 6 files changed
+51/−67 lines, 6 files
Files
- CHANGELOG.md +4/−0
- app/Main.hs +1/−1
- haskoin-store.cabal +2/−2
- src/Network/Haskoin/Store/CacheWriter.hs +37/−59
- src/Network/Haskoin/Store/Data/CacheReader.hs +5/−3
- src/Network/Haskoin/Store/Web.hs +2/−2
CHANGELOG.md view
@@ -4,6 +4,10 @@ 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.21.6+### Fixed+- Fix missing xpub unspent outputs when using cache.+ ## 0.21.5 ### Added - Only store xpubs in cache if they have more than a threshold addresses used.
app/Main.hs view
@@ -155,7 +155,7 @@ configRedisMin <- option auto $ metavar "MINADDRS" <> long "cachemin" <>- help "Minmum xpub address count to cache" <>+ help "Minimum xpub address count to cache" <> showDefault <> value defRedisMin pure
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 9bff1adfaf74aaf3153599679243ab87120bbe1bbd3480d7ce1545f66a3c50f8+-- hash: 6c63490ebe39ea225abdcdb632f87f7913ab38a1bba8e637149e5873b85d8803 name: haskoin-store-version: 0.21.5+version: 0.21.6 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Store blocks, transactions, and balances for Bitcoin or Bitcoin Cash, and make that information via REST API. category: Bitcoin, Finance, Network
src/Network/Haskoin/Store/CacheWriter.hs view
@@ -53,7 +53,7 @@ XPubBal (..), XPubSpec (..), XPubUnspent (..),- nullBalance, sortTxs,+ sortTxs, xPubAddrFunction, xPubBals, xPubTxs, xPubUnspents)@@ -136,7 +136,7 @@ cacheWriterReact CacheNewBlock = newBlockC cacheWriterReact (CacheXPub xpub) = newXPubC xpub cacheWriterReact (CacheNewTx txh) = newTxC txh-cacheWriterReact (CacheDelTx txh) = removeTxC txh+cacheWriterReact (CacheDelTx txh) = newTxC txh newXPubC :: (MonadLoggerIO m, MonadUnliftIO m, StoreRead m)@@ -147,8 +147,7 @@ x <- asks cacheWriterMin when empty $ do bals <- lift $ xPubBals xpub- let l = length (filter (not . nullBalance . xPubBal) bals)- when (x <= l) (go bals)+ when (x <= length bals) (go bals) where go bals = do utxo <- lift $ xPubUnspents xpub Nothing 0 Nothing@@ -222,13 +221,6 @@ Nothing -> $(logErrorS) "Cache" $ "Transaction not found: " <> txHashToHex th -removeTxC :: (MonadLoggerIO m, StoreRead m) => TxHash -> CacheWriterT m ()-removeTxC th =- lift (getTxData th) >>= \case- Just txd -> deleteTxC txd- Nothing ->- $(logWarnS) "Cache" $ "Transaction not found: " <> txHashToHex th- --------------- -- Importing -- ---------------@@ -260,7 +252,7 @@ sortTxData . catMaybes <$> mapM (lift . getTxData) (blockDataTxs bd) $(logWarnS) "Cache" $ "Reverting head: " <> blockHashToHex bh- forM_ (reverse (map (txHash . txData) tds)) removeTxC+ forM_ (reverse (map (txHash . txData) tds)) newTxC cacheSetHead (prevBlock (blockDataHeader bd)) syncMempoolC @@ -271,50 +263,36 @@ let aim = Map.fromList (catMaybes (zipWith (\a i -> (a, ) <$> i) addrs is)) dus = mapMaybe (\(a, p) -> (, p) <$> Map.lookup a aim) spnts ius = mapMaybe (\(a, p) -> (, p) <$> Map.lookup a aim) utxos- forM_ aim $ \i -> do- cacheAddXPubTxs- (addressXPubSpec i)- [ BlockTx- { blockTxHash = txHash (txData txd)- , blockTxBlock = txDataBlock txd- }- ]- forM_ dus $ \(i, p) -> do cacheRemXPubUnspents (addressXPubSpec i) [p]- forM_ ius $ \(i, p) ->- cacheAddXPubUnspents (addressXPubSpec i) [(p, txDataBlock txd)]- case txDataBlock txd of- b@MemRef {} ->- cacheAddToMempool- BlockTx {blockTxHash = txHash (txData txd), blockTxBlock = b}- _ -> cacheRemFromMempool (txHash (txData txd))- where- spnts = txSpent txd- utxos = txUnspent txd- addrs = nub (map fst spnts <> map fst utxos)--deleteTxC :: (StoreRead m, MonadLoggerIO m) => TxData -> CacheWriterT m ()-deleteTxC txd = do- $(logWarnS) "Cache" $- "Deleting transaction: " <> txHashToHex (txHash (txData txd))- updateAddressesC addrs- is <- mapM cacheGetAddrInfo addrs- let aim = Map.fromList (catMaybes (zipWith (\a i -> (a, ) <$> i) addrs is))- dus = mapMaybe (\(a, p) -> (, p) <$> Map.lookup a aim) spnts- ius = mapMaybe (\(a, p) -> (, p) <$> Map.lookup a aim) utxos- forM_ aim $ \i -> do- cacheRemXPubTxs (addressXPubSpec i) [txHash (txData txd)]- forM_ dus $ \(i, p) ->+ if txDataDeleted txd+ then do+ forM_ aim $ \i ->+ cacheRemXPubTxs (addressXPubSpec i) [txHash (txData txd)]+ case txDataBlock txd of+ b@MemRef {} ->+ cacheAddToMempool+ BlockTx+ { blockTxHash = txHash (txData txd)+ , blockTxBlock = b+ }+ _ -> cacheRemFromMempool (txHash (txData txd))+ else do+ forM_ aim $ \i ->+ cacheAddXPubTxs+ (addressXPubSpec i)+ [ BlockTx+ { blockTxHash = txHash (txData txd)+ , blockTxBlock = txDataBlock txd+ }+ ]+ cacheRemFromMempool (txHash (txData txd))+ forM_ (dus <> ius) $ \(i, p) -> do lift (getUnspent p) >>= \case- Just u -> do+ Nothing -> cacheRemXPubUnspents (addressXPubSpec i) [p]+ Just u -> cacheAddXPubUnspents (addressXPubSpec i) [(p, unspentBlock u)]- Nothing -> return ()- forM_ ius $ \(i, p) -> cacheRemXPubUnspents (addressXPubSpec i) [p]- case txDataBlock txd of- MemRef {} -> cacheRemFromMempool (txHash (txData txd))- _ -> return () where- spnts = txSpent txd- utxos = txUnspent txd+ spnts = txInputs txd+ utxos = txOutputs txd addrs = nub (map fst spnts <> map fst utxos) updateAddressesC ::@@ -355,7 +333,7 @@ cachepool <- map blockTxHash <$> cacheGetMempool let deltxs = cachepool \\ nodepool deltds <- reverse . sortTxData . catMaybes <$> mapM (lift . getTxData) deltxs- forM_ deltds deleteTxC+ forM_ deltds importTxC let addtxs = nodepool \\ cachepool addtds <- sortTxData . catMaybes <$> mapM (lift . getTxData) addtxs forM_ addtds importTxC@@ -489,7 +467,7 @@ redisRemXPubUnspents :: (Monad f, RedisCtx m f) => XPubSpec -> [OutPoint] -> m (f ()) redisRemXPubUnspents xpub ops = do- f <- zrem (txSetPfx <> encode xpub) (map encode ops)+ f <- zrem (utxoPfx <> encode xpub) (map encode ops) return $ f >> return () redisAddXPubBalances ::@@ -550,8 +528,8 @@ ths = map (txHash . snd) (sortTxs (map txData tds)) in mapMaybe (\h -> Map.lookup h txm) ths -txSpent :: TxData -> [(Address, OutPoint)]-txSpent td =+txInputs :: TxData -> [(Address, OutPoint)]+txInputs td = let is = txIn (txData td) ps = IntMap.toAscList (txDataPrevs td) as = map (scriptToAddressBS . prevScript . snd) ps@@ -559,8 +537,8 @@ f (Left _) _ = Nothing in catMaybes (zipWith f as is) -txUnspent :: TxData -> [(Address, OutPoint)]-txUnspent td =+txOutputs :: TxData -> [(Address, OutPoint)]+txOutputs td = let ps = zipWith (\i _ ->
src/Network/Haskoin/Store/Data/CacheReader.hs view
@@ -3,11 +3,13 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeSynonymInstances #-} module Network.Haskoin.Store.Data.CacheReader where import Control.DeepSeq (NFData)+import Control.Monad.Logger (MonadLoggerIO) import Control.Monad.Reader (ReaderT (..), asks) import Control.Monad.Trans (lift) import Data.Bits (shift, (.&.), (.|.))@@ -57,7 +59,7 @@ | LogicError String deriving (Show, Eq, Generic, NFData, Exception) -instance (MonadIO m, StoreRead m) => StoreRead (CacheReaderT m) where+instance (MonadLoggerIO m, StoreRead m) => StoreRead (CacheReaderT m) where getBestBlock = lift getBestBlock getBlocksAtHeight = lift . getBlocksAtHeight getBlock = lift . getBlock@@ -114,14 +116,14 @@ txs -> return txs getXPubUnspents ::- (MonadIO m, StoreRead m)+ (MonadLoggerIO m, StoreRead m) => XPubSpec -> Maybe BlockRef -> Offset -> Maybe Limit -> CacheReaderT m [XPubUnspent] getXPubUnspents xpub start offset limit =- getXPubBalances xpub >>= \case+ cacheGetXPubBalances xpub >>= \case [] -> do cache <- asks cacheReaderWriter cacheXPub cache xpub
src/Network/Haskoin/Store/Web.hs view
@@ -262,7 +262,7 @@ Nothing -> bf Just c -> withCacheReader c cf -instance MonadIO m => StoreRead (ReaderT WebConfig m) where+instance MonadLoggerIO m => StoreRead (ReaderT WebConfig m) where getBestBlock = runInWebReader getBestBlock getBestBlock getBlocksAtHeight height = runInWebReader (getBlocksAtHeight height) (getBlocksAtHeight height)@@ -296,7 +296,7 @@ (xPubTxs xpub start offset limit) (xPubTxs xpub start offset limit) -instance MonadIO m => StoreRead (WebT m) where+instance MonadLoggerIO m => StoreRead (WebT m) where getBestBlock = lift getBestBlock getBlocksAtHeight = lift . getBlocksAtHeight getBlock = lift . getBlock