diff --git a/hbs2-peer/app/BlockDownload.hs b/hbs2-peer/app/BlockDownload.hs index b4783be6..3a46fd75 100644 --- a/hbs2-peer/app/BlockDownload.hs +++ b/hbs2-peer/app/BlockDownload.hs @@ -46,9 +46,9 @@ getBlockForDownload = do q <- asks (view downloadQ) inq <- asks (view blockInQ) liftIO $ atomically $ do - readTQueue q - -- modifyTVar inq (HashMap.delete h) - -- pure h + h <- readTQueue q + modifyTVar' inq (HashMap.delete h) + pure h withBlockForDownload :: (MonadIO m, MyPeer e, HasStorage m, HasPeerLocator e m) => Peer e @@ -554,7 +554,7 @@ postponedLoop env0 = do for_ blk2pip $ \(h, banned) -> do let notBanned = HashSet.difference pipsAll banned when (null notBanned) do - liftIO $ atomically $ modifyTVar po $ HashMap.insert h () + liftIO $ atomically $ modifyTVar' po $ HashMap.insert h () void $ liftIO $ async $ withPeerM e $ withDownload env0 do diff --git a/hbs2-peer/app/PeerTypes.hs b/hbs2-peer/app/PeerTypes.hs index 4471a6c4..6650fc4a 100644 --- a/hbs2-peer/app/PeerTypes.hs +++ b/hbs2-peer/app/PeerTypes.hs @@ -150,7 +150,6 @@ data DownloadEnv e = , _peerPostponed :: TVar (HashMap (Hash HbSync) ()) , _blockStored :: Cache (Hash HbSync) () , _blockBanned :: Cache (Hash HbSync, Peer e) () - , _blocksWipCnt :: TVar Int } makeLenses 'DownloadEnv @@ -168,7 +167,6 @@ newDownloadEnv = liftIO do <*> newTVarIO mempty <*> Cache.newCache (Just defBlockWipTimeout) <*> Cache.newCache (Just defBlockBanTime) - <*> newTVarIO 0 newtype BlockDownloadM e m a = BlockDownloadM { fromBlockDownloadM :: ReaderT (DownloadEnv e) m a } @@ -222,7 +220,7 @@ isBanned p h = do delBlockState :: MonadIO m => Hash HbSync -> BlockDownloadM e m () delBlockState h = do sh <- asks (view blockState) - liftIO $ atomically $ modifyTVar sh (HashMap.delete h) + liftIO $ atomically $ modifyTVar' sh (HashMap.delete h) incBlockSizeReqCount :: MonadIO m => Hash HbSync -> BlockDownloadM e m () incBlockSizeReqCount h = do @@ -277,18 +275,17 @@ addDownload h = do po <- asks (view peerPostponed) tinq <- asks (view blockInQ) - wipCnt <- asks (view blocksWipCnt) - -- doAdd <- do liftIO $ atomically $ stateTVar tinq - -- \hm -> case HashMap.lookup h hm of - -- Nothing -> (True, HashMap.insert h () hm) - -- Just{} -> (False, HashMap.insert h () hm) + doAdd <- do liftIO $ atomically $ stateTVar tinq + \hm -> case HashMap.lookup h hm of + Nothing -> (True, HashMap.insert h () hm) + Just{} -> (False, HashMap.insert h () hm) - doAdd <- isBlockHereCached h <&> not + notHere <- isBlockHereCached h <&> not notPostponed <- liftIO $ readTVarIO po <&> isNothing . HashMap.lookup h - when (doAdd && notPostponed) do + when (doAdd && notPostponed && notHere) do q <- asks (view downloadQ) wip <- asks (view blockWip) @@ -341,7 +338,6 @@ removeFromWip h = do sz <- asks (view blockPeers) tinq <- asks (view blockInQ) po <- asks (view peerPostponed) - wi <- asks (view blocksWipCnt) ba <- asks (view blockBanned) liftIO $ Cache.delete wip h @@ -352,7 +348,6 @@ removeFromWip h = do modifyTVar' sz (HashMap.delete h) modifyTVar' tinq (HashMap.delete h) modifyTVar' po (HashMap.delete h) - modifyTVar' wi (max 0 . pred) hasPeerThread :: (MyPeer e, MonadIO m) => Peer e -> BlockDownloadM e m Bool hasPeerThread p = do