voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip

This commit is contained in:
Dmitry Zuikov 2023-02-26 15:47:29 +03:00
parent 5b9c1a301d
commit 96deffbf5c
2 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
hbs2-peer/app/BlockDownload.hs
View File

@ -493,12 +493,15 @@ blockDownloadLoop env0 = do
liftIO $ atomically $ writeTVar tinfo alive
po <- asks (view peerPostponed) >>= liftIO . readTVarIO
ba <- asks (view blockBanned ) >>= liftIO . Cache.size
wipNum <- liftIO $ Cache.size wip
notice $ "maintain blocks wip" <+> pretty wipNum
<+> "postponed"
<+> pretty (HashMap.size po)
<+> "banned"
<+> pretty ba
withDownload env0 do
@ -522,6 +525,12 @@ postponedLoop :: forall e m . ( MyPeer e
postponedLoop env0 = do
e <- ask
void $ liftIO $ async $ withPeerM e $ withDownload env0 do
pause @'Seconds 60
ban <- asks (view blockBanned)
void $ liftIO $ Cache.purgeExpired ban
void $ liftIO $ async $ withPeerM e $ withDownload env0 do
po <- asks (view peerPostponed)

10
hbs2-peer/app/PeerTypes.hs
View File

@ -279,10 +279,12 @@ addDownload h = do
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
notPostponed <- liftIO $ readTVarIO po <&> isNothing . HashMap.lookup h