haskoin-store 0.16.4 → 0.16.5

raw patch · 3 files changed

+23/−53 lines, 3 files

Files

• CHANGELOG.md +4/−0
• haskoin-store.cabal +2/−2
• src/Network/Haskoin/Store/Web.hs +17/−51

@@ -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.16.5+### Removed+- Remove concurrency from xpub balance requests to prevent RocksDB segfaults.+ ## 0.16.4 ### Removed - Remove concurrency from requests using iterators to prevent RocksDB from segfaulting.

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 8ab386452576005ff6acda2b569d7e1219303832c0c0271c8a43b4c32e960acc+-- hash: 545948e0c4f4a34a7d6185ca86f13515e6f723853f2722c630202699fa2bf266  name:           haskoin-store-version:        0.16.4+version:        0.16.5 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

@@ -820,59 +820,25 @@  xpubBals ::        (MonadResource m, MonadUnliftIO m, StoreRead m) => XPubKey -> m [XPubBal]-xpubBals xpub = do-    (rk, ss) <- allocate (newTVarIO []) (readTVarIO >=> mapM_ cancel)-    stp0 <- newTVarIO False-    stp1 <- newTVarIO False-    q0 <- newTBQueueIO 20-    q1 <- newTBQueueIO 20-    xs <--        withAsync (go stp0 ss q0 0) $ \_ ->-            withAsync (go stp1 ss q1 1) $ \_ ->-                withAsync (red ss stp0 q0) $ \r0 ->-                    withAsync (red ss stp1 q1) $ \r1 -> do-                        xs0 <- wait r0-                        xs1 <- wait r1-                        return $ xs0 <> xs1-    release rk-    return xs+xpubBals xpub = (<>) <$> go 0 <*> go 1   where-    stp e =-        readTVarIO e >>= \s ->-            if s-                then return ()-                else await >>= \case-                         Nothing -> return ()-                         Just x -> yield x >> stp e-    go e ss q m =+    go m =         runConduit $-        yieldMany (as m) .| stp e .| mapMC (uncurry (b ss)) .| conduitToQueue q-    red ss e q = runConduit $ queueToConduit q .| f ss e 0 .| sinkList-    b ss a p = mask_ $ do-        s <--            async $-            getBalance a >>= \case-                Nothing -> return Nothing-                Just b' -> return $ Just XPubBal {xPubBalPath = p, xPubBal = b'}-        atomically $ modifyTVar ss (s :)-        return s-    as m = map (\(a, _, n') -> (a, [m, n'])) (deriveAddrs (pubSubKey xpub m) 0)-    f ss e n-        | n < 20 =-            await >>= \case-                Just a ->-                    wait a >>= \case-                        Nothing -> f ss e (n + 1)-                        Just b -> yield b >> f ss e 0-                Nothing -> return ()-        | otherwise = do-            atomically $ writeTVar e True-            await >>= \case-                Just a -> do-                    cancel a-                    atomically $ modifyTVar ss (Data.List.delete a)-                    f ss e n-                Nothing -> return ()+        yieldMany (addrs m) .| mapMC (uncurry bal) .| gap 20 .| sinkList+    bal a p =+        getBalance a >>= \case+            Nothing -> return Nothing+            Just b' -> return $ Just XPubBal {xPubBalPath = p, xPubBal = b'}+    addrs m =+        map (\(a, _, n') -> (a, [m, n'])) (deriveAddrs (pubSubKey xpub m) 0)+    gap n =+        let r 0 = return ()+            r i =+                await >>= \case+                    Just (Just b) -> yield b >> r n+                    Just Nothing -> r (i - 1)+                    Nothing -> return ()+         in r n  xpubUnspent ::        ( MonadResource m