haskoin-store 0.23.22 → 0.23.23
raw patch · 5 files changed
+46/−31 lines, 5 files
Files
- CHANGELOG.md +4/−0
- haskoin-store.cabal +2/−2
- src/Haskoin/Store/BlockStore.hs +13/−9
- src/Haskoin/Store/Cache.hs +21/−16
- src/Haskoin/Store/Manager.hs +6/−4
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.23.23+### Changed+- Do not read full mempool so often from cache code.+ ## 0.23.22 ### Changed - Depend on latest Haskoin Node that fixes debugging regression.
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 805c70561a3a193b9ca315be92495d62f2993e0ac1fba8ef414394e75342e7b3+-- hash: e389f53da7c91a8ac730b39e0edc1bd54dc05d5c0da6b6202ba42e40c332d09d name: haskoin-store-version: 0.23.22+version: 0.23.23 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/BlockStore.hs view
@@ -412,15 +412,19 @@ t = pendingTxTime p th = txHash tx h x TxOrphan {} = return (Left (Just x))- h _ _ = return (Left Nothing)- $(logInfoS) "BlockStore" $- "New mempool tx " <> cs (show i) <> "/" <>- cs (show (length ps)) <>- ": " <>- txHashToHex th- catchError- (maybe (Left Nothing) (Right . (th, )) <$> newMempoolTx tx t)- (h p)+ h _ _ = return (Left Nothing)+ let f = do+ x <- newMempoolTx tx t+ $(logInfoS) "BlockStore" $+ "New mempool tx " <> cs (show i) <> "/" <>+ cs (show (length ps)) <>+ ": " <>+ txHashToHex th+ return $+ case x of+ Just ls -> Right (th, ls)+ Nothing -> Left Nothing+ catchError f (h p) case output of Left e -> do $(logErrorS) "BlockStore" $
src/Haskoin/Store/Cache.hs view
@@ -18,6 +18,7 @@ , CacheWriter , CacheWriterInbox , cacheNewBlock+ , cacheNewTx , cacheWriter , isXPubCached , delXPubKeys@@ -77,13 +78,10 @@ nullBalance, sortTxs, xPubBals, xPubBalsTxs, xPubBalsUnspents, xPubTxs)-import NQE (Inbox, Listen, Mailbox,- inboxToMailbox, query, receive,- send)+import NQE (Inbox, Mailbox, receive, send) import System.Random (randomRIO) import UnliftIO (Exception, MonadIO, MonadUnliftIO,- atomically, bracket, liftIO,- throwIO, withAsync)+ bracket, liftIO, throwIO) import UnliftIO.Concurrent (threadDelay) runRedis :: MonadLoggerIO m => Redis (Either Reply a) -> CacheT m a@@ -415,7 +413,7 @@ data CacheWriterMessage = CacheNewBlock- | CachePing (Listen ())+ | CacheNewTx !TxHash type CacheWriterInbox = Inbox CacheWriterMessage type CacheWriter = Mailbox CacheWriterMessage@@ -461,7 +459,7 @@ where go = do newBlockC- withAsync (pingMe (inboxToMailbox inbox)) . const . forever $ do+ forever $ do pruneDB x <- receive inbox cacheWriterReact x@@ -554,7 +552,20 @@ => CacheWriterMessage -> CacheT m () cacheWriterReact CacheNewBlock = newBlockC-cacheWriterReact (CachePing r) = newBlockC >> atomically (r ())+cacheWriterReact (CacheNewTx th) =+ withLockWait importLockKey $ do+ runRedis (Redis.zscore mempoolSetKey (encode th)) >>= \case+ Nothing ->+ lift (getTxData th) >>= \case+ Just td -> do+ $(logDebugS) "Cache" $+ "Updating cache with tx: " <> txHashToHex th+ importMultiTxC [td]+ Nothing ->+ $(logErrorS) "Cache" $+ "Tx not found in db: " <> txHashToHex th+ Just _ ->+ $(logDebugS) "Cache" $ "Tx already in cache: " <> txHashToHex th lenNotNull :: [XPubBal] -> Int lenNotNull bals = length $ filter (not . nullBalance . xPubBal) bals@@ -1120,14 +1131,8 @@ net <- getNetwork return . cs $ xPubExport net (xPubSpecKey xpub) -pingMe :: MonadLoggerIO m => CacheWriter -> m ()-pingMe mbox =- forever $ do- threadDelay =<< liftIO (randomRIO (100 * 1000, 1000 * 1000))- cachePing mbox- cacheNewBlock :: MonadIO m => CacheWriter -> m () cacheNewBlock = send CacheNewBlock -cachePing :: MonadIO m => CacheWriter -> m ()-cachePing = query CachePing+cacheNewTx :: MonadIO m => TxHash -> CacheWriter -> m ()+cacheNewTx th = send (CacheNewTx th)
src/Haskoin/Store/Manager.hs view
@@ -24,8 +24,8 @@ import Haskoin.Store.BlockStore (BlockStoreConfig (..), blockStore) import Haskoin.Store.Cache (CacheConfig (..), CacheWriter,- cacheNewBlock, cacheWriter,- connectRedis)+ cacheNewBlock, cacheNewTx,+ cacheWriter, connectRedis) import Haskoin.Store.Common (BlockStore, BlockStoreMessage (..), StoreEvent (..))@@ -181,8 +181,10 @@ cacheWriterEvents evts cwm = forever $ receive evts >>= (`cacheWriterDispatch` cwm) cacheWriterDispatch :: MonadIO m => StoreEvent -> CacheWriter -> m ()-cacheWriterDispatch (StoreBestBlock _) = cacheNewBlock-cacheWriterDispatch _ = const (return ())+cacheWriterDispatch (StoreBestBlock _) = cacheNewBlock+cacheWriterDispatch (StoreMempoolNew th) = cacheNewTx th+cacheWriterDispatch (StoreTxDeleted th) = cacheNewTx th+cacheWriterDispatch _ = const (return ()) -- | Dispatcher of node events. storeDispatch :: BlockStore -> Listen StoreEvent -> Listen NodeEvent