haskoin-store 1.5.8 → 1.5.9

raw patch · 2 files changed

+30/−27 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• haskoin-store.cabal +1/−1
• src/Haskoin/Store/BlockStore.hs +29/−26

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           haskoin-store-version:        1.5.8+version:        1.5.9 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

@@ -223,7 +223,8 @@     peer :: !(TVar (Maybe Syncing)),     txs :: !(TVar (HashMap TxHash PendingTx)),     requested :: !(TVar (HashSet TxHash)),-    metrics :: !(Maybe StoreMetrics)+    metrics :: !(Maybe StoreMetrics),+    syncedMempool :: !(TVar (HashSet Text))   }  data StoreMetrics = StoreMetrics@@ -382,6 +383,7 @@   pb <- newTVarIO Nothing   ts <- newTVarIO HashMap.empty   rq <- newTVarIO HashSet.empty+  sy <- newTVarIO HashSet.empty   inbox <- newInbox   metrics <- newStoreMetrics cfg   let r =@@ -391,7 +393,8 @@             peer = pb,             txs = ts,             requested = rq,-            metrics = metrics+            metrics = metrics,+            syncedMempool = sy           }   withAsync (runReaderT (go inbox) r) $ \a -> do     link a@@ -456,22 +459,22 @@         then clearSyncingState >> return True         else return False -guardMempool :: (Monad m) => BlockT m () -> BlockT m ()-guardMempool f = do-  n <- asks (.config.noMempool)-  unless n f+guardSync :: (MonadLoggerIO m) => BlockT m () -> BlockT m ()+guardSync f = isInSync >>= \s -> when s f -syncMempool :: (Monad m) => BlockT m () -> BlockT m ()-syncMempool f = do-  s <- asks (.config.syncMempool)-  when s f+guardMempool :: (Monad m) => BlockT m () -> BlockT m ()+guardMempool f = asks (.config.noMempool) >>= \n -> unless n f -requestMempool :: (MonadUnliftIO m, MonadLoggerIO m) => Peer -> BlockT m ()-requestMempool p =-  guardMempool . syncMempool $-    isInSync >>= \s -> when s $ do+syncMempool :: (MonadUnliftIO m, MonadLoggerIO m) => Peer -> BlockT m ()+syncMempool p =+  guardMempool . guardSync $ do+    s <- asks (.config.syncMempool)+    m <- asks (.syncedMempool)+    y <- not . HashSet.member p.label <$> readTVarIO m+    when (s && y) $ do       $(logDebugS) "BlockStore" $         "Requesting mempool from peer: " <> p.label+      atomically . modifyTVar m $ HashSet.insert p.label       MMempool `sendMessage` p  processBlock ::@@ -525,7 +528,7 @@         False -> syncMe         True -> do           updateOrphans-          requestMempool peer+          syncMempool peer     failure e = do       $(logErrorS) "BlockStore" $         "Error importing block "@@ -811,16 +814,14 @@   Peer ->   [TxHash] ->   BlockT m ()-processTxs p hs = guardMempool $ do-  s <- isInSync-  when s $ do-    $(logDebugS) "BlockStore" $-      "Received inventory with "-        <> cs (show (length hs))-        <> " transactions from peer: "-        <> p.label-    xs <- catMaybes <$> zip_counter process_tx-    unless (null xs) $ go xs+processTxs p hs = guardMempool . guardSync $ do+  $(logDebugS) "BlockStore" $+    "Received inventory with "+      <> cs (show (length hs))+      <> " transactions from peer: "+      <> p.label+  xs <- catMaybes <$> zip_counter process_tx+  unless (null xs) $ go xs   where     len = length hs     zip_counter = forM (zip [(1 :: Int) ..] hs) . uncurry@@ -1039,6 +1040,8 @@   readTVarIO box >>= \case     Just Syncing {peer = p'} | p == p' -> reset_it box     _ -> return ()+  y <- asks (.syncedMempool)+  atomically $ modifyTVar y $ HashSet.delete p.label   where     reset_it box = do       atomically $ writeTVar box Nothing@@ -1090,7 +1093,7 @@ trySyncingPeer :: (MonadUnliftIO m, MonadLoggerIO m) => Peer -> BlockT m () trySyncingPeer p =   isInSync >>= \case-    True -> requestMempool p+    True -> syncMempool p     False ->       trySetPeer p >>= \case         False -> return ()