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: 3ef4d7acbc42cf65fef64eae75b754c1bab3b375f5a47010f12170c6c06e8f4e +-- hash: b10fa47ab2013300357e9e4aacde948306c4a536982708da3c2cb7b552c21207 name: haskoin-store -version: 0.40.22 +version: 0.41.0 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -56,7 +56,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 - , haskoin-store-data ==0.40.2 + , haskoin-store-data ==0.41.0 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1 @@ -106,7 +106,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store - , haskoin-store-data ==0.40.2 + , haskoin-store-data ==0.41.0 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1 @@ -161,7 +161,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store - , haskoin-store-data ==0.40.2 + , haskoin-store-data ==0.41.0 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3 diff --git a/src/Haskoin/Store.hs b/src/Haskoin/Store.hs --- a/src/Haskoin/Store.hs +++ b/src/Haskoin/Store.hs @@ -15,7 +15,6 @@ , withCache , connectRedis , isInCache - , evictFromCache -- * Store Reader , StoreReadBase(..) , StoreReadExtra(..) 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 @@ -24,7 +24,6 @@ , cacheNewBlock , cacheWriter , isInCache - , evictFromCache ) where import Control.DeepSeq (NFData) @@ -47,7 +46,8 @@ import qualified Data.IntMap.Strict as I import Data.List (sort) import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, isNothing, mapMaybe) +import Data.Maybe (catMaybes, fromMaybe, isNothing, + mapMaybe) import Data.Serialize (Serialize, decode, encode) import Data.String.Conversions (cs) import Data.Text (Text) @@ -619,7 +619,7 @@ flush n = case n `div` 64 of 0 -> return 0 - x -> withLockForever $ do + x -> fmap (fromMaybe 0) $ withLock $ do ks <- fmap (map fst) . runRedis $ getFromSortedSet maxKey Nothing 0 (fromIntegral x) $(logDebugS) "Cache" $ @@ -639,15 +639,16 @@ cacheWriterReact :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) => CacheWriterMessage -> CacheX m () -cacheWriterReact CacheNewBlock = - inSync >>= \s -> when s newBlockC -cacheWriterReact (CachePing respond) = do - s <- inSync - when s $ do - syncMempoolC - void pruneDB - atomically (respond ()) +cacheWriterReact CacheNewBlock = doSync +cacheWriterReact (CachePing respond) = doSync >> atomically (respond ()) +doSync :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) + => CacheX m () +doSync = inSync >>= \s -> when s $ do + newBlockC + syncMempoolC + void pruneDB + lenNotNull :: [XPubBal] -> Int lenNotNull bals = length $ filter (not . nullBalance . xPubBal) bals @@ -713,7 +714,7 @@ cacheGetHead >>= \case Nothing -> do $(logInfoS) "Cache" "Initializing best cache block" - importBlockC bb + void $ importBlockC bb Just hb -> if hb == headerHash (nodeHeader cn) then $(logDebugS) "Cache" "Cache in sync" @@ -743,11 +744,10 @@ $(logDebugS) "Cache" $ "Reverting cache head not in main chain: " <> blockHashToHex hb - removeHeadC hb - newBlockC + removeHeadC hb >>= \s -> when s newBlockC next ch bn hn = if | prevBlock (nodeHeader bn) == headerHash (nodeHeader hn) -> - importBlockC (headerHash (nodeHeader bn)) + void $ importBlockC (headerHash (nodeHeader bn)) | nodeHeight bn > nodeHeight hn -> chainGetAncestor (nodeHeight hn + 1) bn ch >>= \case Nothing -> @@ -756,16 +756,16 @@ <> cs (show (nodeHeight hn + 1)) <> " for block: " <> blockHashToHex (headerHash (nodeHeader bn)) - Just hn' -> do - importBlockC (headerHash (nodeHeader hn')) - newBlockC + Just hn' -> + importBlockC (headerHash (nodeHeader hn')) >>= \s -> + when s newBlockC | otherwise -> $(logInfoS) "Cache" "Cache best block higher than this node's" importBlockC :: (MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) - => BlockHash -> CacheX m () + => BlockHash -> CacheX m Bool importBlockC bh = - withLockForever $ + fmap (maybe False (const True)) $ withLock $ withMetrics cacheBlockSyncTime $ cacheGetHead >>= \case Nothing -> go @@ -801,9 +801,9 @@ <> blockHashToHex bh removeHeadC :: (StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m) - => BlockHash -> CacheX m () + => BlockHash -> CacheX m Bool removeHeadC cb = - withLockForever $ + fmap (maybe False (const True)) $ withLock $ void . runMaybeT $ do bh <- MaybeT cacheGetHead guard (cb == bh) @@ -1052,7 +1052,7 @@ => CacheX m () syncMempoolC = toInteger <$> asks cacheRefresh >>= \refresh -> - void . withLockForever . withCool "cool" (refresh * 9 `div` 10) $ + void . withLock . withCool "cool" (refresh * 9 `div` 10) $ withMetrics cacheMempoolSyncTime $ do nodepool <- HashSet.fromList . map snd <$> lift getMempool cachepool <- HashSet.fromList . map snd <$> cacheGetMempool @@ -1099,14 +1099,6 @@ redisSetAddrInfo :: (Functor f, RedisCtx m f) => Address -> AddressXPub -> m (f ()) redisSetAddrInfo a i = void <$> Redis.set (addrPfx <> encode a) (encode i) - -evictFromCache :: - (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) - => [XPubSpec] - -> CacheT m () -evictFromCache xpubs = ask >>= \case - Nothing -> return () - Just cfg -> void (runReaderT (withLockRetry 100 (delXPubKeys xpubs)) cfg) delXPubKeys :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) diff --git a/src/Haskoin/Store/Web.hs b/src/Haskoin/Store/Web.hs --- a/src/Haskoin/Store/Web.hs +++ b/src/Haskoin/Store/Web.hs @@ -188,7 +188,6 @@ , xPubTxResponseTime :: !StatDist , xPubTxFullResponseTime :: !StatDist , xPubUnspentResponseTime :: !StatDist - , xPubEvictResponseTime :: !StatDist , multiaddrResponseTime :: !StatDist , multiaddrErrors :: !ErrorCounter , rawtxResponseTime :: !StatDist @@ -221,7 +220,6 @@ xPubTxResponseTime <- d "xpub_tx.response_time_ms" xPubTxFullResponseTime <- d "xpub_tx_full.response_time_ms" xPubUnspentResponseTime <- d "xpub_unspent.response_time_ms" - xPubEvictResponseTime <- d "xpub_evict.response_time_ms" multiaddrResponseTime <- d "multiaddr.response_time_ms" multiaddrErrors <- e "multiaddr.errors" rawtxResponseTime <- d "rawtx.response_time_ms" @@ -607,11 +605,6 @@ scottyXPubUnspent (list . xPubUnspentToEncoding) (json_list xPubUnspentToJSON) - pathCompact - (GetXPubEvict <$> paramLazy <*> paramDef) - scottyXPubEvict - (const toEncoding) - (const toJSON) -- Network pathPretty (GetPeers & return) @@ -1150,16 +1143,6 @@ withMetrics xPubUnspentResponseTime 1 $ do limits <- paramToLimits False pLimits lift . runNoCache noCache $ xPubUnspents (XPubSpec xpub deriv) limits - -scottyXPubEvict :: - (MonadUnliftIO m, MonadLoggerIO m) - => GetXPubEvict - -> WebT m (GenericResult Bool) -scottyXPubEvict (GetXPubEvict xpub deriv) = - withMetrics xPubEvictResponseTime 1 $ do - cache <- lift $ asks (storeCache . webStore . webConfig) - lift . withCache cache $ evictFromCache [XPubSpec xpub deriv] - return $ GenericResult True --------------------------------------- -- Blockchain.info API Compatibility --