haskoin-store 0.37.3 → 0.37.4
raw patch · 2 files changed
+24/−32 lines, 2 filesdep ~haskoin-storedep ~haskoin-store-data
Dependency ranges changed: haskoin-store, haskoin-store-data
Files
- haskoin-store.cabal +6/−6
- src/Haskoin/Store/BlockStore.hs +18/−26
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: fe2151b6cf88eb8b5b1710e232de31add84c191400a70d900dd7e6ce15affa22+-- hash: a9cd74aee3b5a5b336b40bb4d2e3a0f823359573cc439ade5a2b32175bfb665b name: haskoin-store-version: 0.37.3+version: 0.37.4 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@@ -53,7 +53,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.13.6 , haskoin-node >=0.14.1- , haskoin-store-data ==0.37.3+ , haskoin-store-data ==0.37.4 , hedis >=0.12.13 , http-types >=0.12.3 , monad-logger >=0.3.32@@ -96,7 +96,7 @@ , haskoin-core >=0.13.6 , haskoin-node >=0.14.1 , haskoin-store- , haskoin-store-data ==0.37.3+ , haskoin-store-data ==0.37.4 , monad-logger >=0.3.32 , mtl >=2.2.2 , nqe >=0.6.1@@ -135,8 +135,8 @@ , hashable >=1.3.0.0 , haskoin-core >=0.13.6 , haskoin-node >=0.14.1- , haskoin-store ==0.37.3- , haskoin-store-data ==0.37.3+ , haskoin-store ==0.37.4+ , haskoin-store-data ==0.37.4 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store/BlockStore.hs view
@@ -136,7 +136,6 @@ , myPeer :: !(TVar (Maybe Syncing)) , myTxs :: !(TVar (HashMap TxHash PendingTx)) , requested :: !(TVar (HashSet TxHash))- , mempooled :: !(TVar Bool) } -- | Configuration for a block store.@@ -217,13 +216,11 @@ ts <- newTVarIO HashMap.empty rq <- newTVarIO HashSet.empty inbox <- newInbox- mem <- newTVarIO False let r = BlockStore { myMailbox = inboxToMailbox inbox , myConfig = cfg , myPeer = pb , myTxs = ts , requested = rq- , mempooled = mem } withAsync (runReaderT (go inbox) r) $ \a -> do link a@@ -280,19 +277,16 @@ n <- asks (blockConfNoMempool . myConfig) unless n f -guardNotMempooled :: MonadIO m => BlockT m () -> BlockT m ()-guardNotMempooled f = do- m <- readTVarIO =<< asks mempooled- unless m f--mempool :: MonadLoggerIO m => Peer -> BlockT m ()-mempool p = guardMempool $ guardNotMempooled $ do- $(logDebugS) "BlockStore" $- "Requesting mempool from peer: " <> peerText p- MMempool `sendMessage` p- atomically . (`writeTVar` True) =<< asks mempooled+mempool :: (MonadUnliftIO m, MonadLoggerIO m) => Peer -> BlockT m ()+mempool p = guardMempool $ void $ async $ do+ threadDelay 23849118+ isInSync >>= \s -> when s $ do+ $(logDebugS) "BlockStore" $+ "Requesting mempool from peer: " <> peerText p+ MMempool `sendMessage` p -processBlock :: MonadLoggerIO m => Peer -> Block -> BlockT m ()+processBlock :: (MonadUnliftIO m, MonadLoggerIO m)+ => Peer -> Block -> BlockT m () processBlock peer block = void . runMaybeT $ do checkPeer peer >>= \case True -> return ()@@ -734,13 +728,11 @@ shouldSync = isInSync >>= \case True -> return Nothing- False -> cont- where- cont = getSyncingState >>= \case- Nothing -> return Nothing- Just Syncing { syncingPeer = p, syncingBlocks = bs }- | 100 > length bs -> return (Just p)- | otherwise -> return Nothing+ False -> getSyncingState >>= \case+ Nothing -> return Nothing+ Just Syncing { syncingPeer = p, syncingBlocks = bs }+ | 100 > length bs -> return (Just p)+ | otherwise -> return Nothing syncMe :: MonadLoggerIO m => BlockT m () syncMe = do@@ -849,10 +841,10 @@ let ps = map onlinePeerMailbox ops recurse ps -trySyncingPeer :: MonadLoggerIO m => Peer -> BlockT m ()+trySyncingPeer :: (MonadUnliftIO m, MonadLoggerIO m) => Peer -> BlockT m () trySyncingPeer p = isInSync >>= \case- True -> return ()+ True -> mempool p False -> trySetPeer p >>= \case False -> return () True -> syncMe@@ -869,8 +861,8 @@ Nothing -> return () Just Syncing { syncingPeer = p } -> finishPeer p -processBlockStoreMessage- :: MonadLoggerIO m => BlockStoreMessage -> BlockT m ()+processBlockStoreMessage :: (MonadUnliftIO m, MonadLoggerIO m)+ => BlockStoreMessage -> BlockT m () processBlockStoreMessage (BlockNewBest _) = trySyncing