haskoin-store 0.40.22 → 0.41.0
raw patch · 4 files changed
+28/−54 lines, 4 filesdep ~haskoin-store-dataPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: haskoin-store-data
API changes (from Hackage documentation)
- Haskoin.Store: evictFromCache :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) => [XPubSpec] -> CacheT m ()
- Haskoin.Store.Cache: evictFromCache :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) => [XPubSpec] -> CacheT m ()
Files
- haskoin-store.cabal +5/−5
- src/Haskoin/Store.hs +0/−1
- src/Haskoin/Store/Cache.hs +23/−31
- src/Haskoin/Store/Web.hs +0/−17
haskoin-store.cabal view
@@ -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 <https://github.com/haskoin/haskoin-store#readme> 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
src/Haskoin/Store.hs view
@@ -15,7 +15,6 @@ , withCache , connectRedis , isInCache- , evictFromCache -- * Store Reader , StoreReadBase(..) , StoreReadExtra(..)
src/Haskoin/Store/Cache.hs view
@@ -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)
src/Haskoin/Store/Web.hs view
@@ -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 --