haskoin-store 0.23.14 → 0.23.15

raw patch · 3 files changed

+31/−19 lines, 3 files

Files

• CHANGELOG.md +5/−1
• haskoin-store.cabal +2/−2
• src/Haskoin/Store/Cache.hs +24/−16

@@ -4,7 +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.23.14+## 0.23.16+### Changed+- Better algorithm to avoid importing transaction multiple times in cache.++## 0.23.15 ### Changed - Do not storm the cache with mempool transactions. 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 7d374824fe2c26e617cd964c0bcb5bf89bbb6de74b233b3654bb2c72a3d5f347+-- hash: 0e7fcb134d97933c2fc5c053b4e405331be3381ea5e5af338be91c3b370240f0  name:           haskoin-store-version:        0.23.14+version:        0.23.15 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.

@@ -432,6 +432,9 @@ lockKey :: ByteString lockKey = "lock" +importLockKey :: ByteString+importLockKey = "import"+ addrPfx :: ByteString addrPfx = "a" @@ -463,8 +466,8 @@             x <- receive inbox             cacheWriterReact x -lockIt :: MonadLoggerIO m => CacheT m Bool-lockIt = do+lockIt :: MonadLoggerIO m => ByteString -> CacheT m Bool+lockIt k = do     go >>= \case         Right Redis.Ok -> return True         Right Redis.Pong -> do@@ -487,31 +490,35 @@                         , Redis.setMilliseconds = Nothing                         , Redis.setCondition = Just Redis.Nx                         }-            Redis.setOpts lockKey "l" opts+            Redis.setOpts k "l" opts  -unlockIt :: MonadLoggerIO m => CacheT m ()-unlockIt = runRedis (Redis.del [lockKey]) >> return ()+unlockIt :: MonadLoggerIO m => ByteString -> CacheT m ()+unlockIt k = runRedis (Redis.del [k]) >> return ()  withLock ::-       (MonadLoggerIO m, MonadUnliftIO m) => CacheT m a -> CacheT m (Maybe a)-withLock f =-    bracket lockIt (const unlockIt) $ \case+       (MonadLoggerIO m, MonadUnliftIO m) => ByteString -> CacheT m a -> CacheT m (Maybe a)+withLock k f =+    bracket (lockIt k) (const (unlockIt k)) $ \case         True -> Just <$> f         False -> return Nothing -withLockWait :: (MonadLoggerIO m, MonadUnliftIO m) => CacheT m a -> CacheT m a-withLockWait f =-    withLock f >>= \case+withLockWait ::+       (MonadLoggerIO m, MonadUnliftIO m)+    => ByteString+    -> CacheT m a+    -> CacheT m a+withLockWait k f =+    withLock k f >>= \case         Just x -> return x         Nothing -> do             r <- liftIO $ randomRIO (500, 10000)             threadDelay r-            withLockWait f+            withLockWait k f  pruneDB :: (MonadUnliftIO m, MonadLoggerIO m, StoreRead m) => CacheT m Integer pruneDB =-    withLockWait $+    withLockWait lockKey $     isAnythingCached >>= \case         True -> do             x <- asks cacheMax@@ -591,7 +598,7 @@             "Caching xpub with " <> cs (show (length xtxs)) <> " txs: " <>             xpubtxt         now <- systemSeconds <$> liftIO getSystemTime-        withLockWait . runRedis $ do+        withLockWait lockKey . runRedis $ do             b <- redisTouchKeys now [xpub]             c <- redisAddXPubBalances xpub bals             d <- redisAddXPubUnspents xpub (map op utxo)@@ -600,6 +607,7 @@  newBlockC :: (MonadUnliftIO m, MonadLoggerIO m, StoreRead m) => CacheT m () newBlockC =+    withLockWait importLockKey $     isAnythingCached >>= \case         False -> return ()         True ->@@ -713,7 +721,7 @@             ": " <>             xpubtxt     addrs' <--        withLockWait $+        withLockWait lockKey $         getxbals xpubs >>= \xmap -> do             let addrmap' = faddrmap (HashMap.keysSet xmap) addrmap             runRedis $ do@@ -927,7 +935,7 @@                     return Nothing                 Just newhead -> do                     mem <- lift getMempool-                    withLockWait . runRedis $ do+                    withLockWait lockKey . runRedis $ do                         a <- redisAddToMempool mem                         b <- redisSetHead newhead                         return $ a >> b >> return (Just newhead)