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

better

This commit is contained in:
voidlizard 2024-11-13 19:10:52 +03:00
parent 8eef38fa7d
commit ecda59fb55
1 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
hbs2-peer/app/BlockDownloadNew.hs
View File

@ -575,7 +575,7 @@ downloadDispatcher brains env = flip runContT pure do
-- tasks <- newTVarIO ( HPSQ.empty :: HashPSQ (Work e) Double (TVar Int) ) -- tasks <- newTVarIO ( HPSQ.empty :: HashPSQ (Work e) Double (TVar Int) )
_blkNum <- newTVarIO 0 _blkNum <- newTVarIO 0
wip <- newTVarIO ( HPSQ.empty @HashRef @Double @DCB ) wip <- newTVarIO ( mempty :: HashMap HashRef DCB )
parseQ <- newTQueueIO parseQ <- newTQueueIO
@ -594,25 +594,25 @@ downloadDispatcher brains env = flip runContT pure do
now <- getTimeCoarse now <- getTimeCoarse
debug $ green "New download request" <+> pretty h debug $ green "New download request" <+> pretty h
atomically do atomically do
already <- readTVar wip <&> HPSQ.member (HashRef h) already <- readTVar wip <&> HM.member (HashRef h)
dcb <- newDcbSTM now mzero dcb <- newDcbSTM now mzero
let w = 1.0 -- realToFrac now let w = 1.0 -- realToFrac now
unless already do unless already do
modifyTVar wip (HPSQ.insert (HashRef h) w dcb) modifyTVar wip (HM.insert (HashRef h) dcb)
ContT $ withAsync $ forever $ (>> pause @'Seconds 30) do ContT $ withAsync $ forever $ (>> pause @'Seconds 30) do
debug "Sweep blocks" debug "Sweep blocks"
atomically do atomically do
total <- readTVar wip <&> HPSQ.toList total <- readTVar wip <&> HM.toList
alive <- for total $ \e@(h,_,DCB{..}) -> do alive <- for total $ \e@(h,DCB{..}) -> do
down <- readTVar dcbDownloaded down <- readTVar dcbDownloaded
if down then if down then
pure Nothing pure Nothing
else else
pure (Just e) pure (Just e)
writeTVar wip (HPSQ.fromList (catMaybes alive)) writeTVar wip (HM.fromList (catMaybes alive))
ContT $ withAsync $ forever do ContT $ withAsync $ forever do
@ -623,12 +623,12 @@ downloadDispatcher brains env = flip runContT pure do
atomically do atomically do
dcb <- newDcbSTM now (Just what) dcb <- newDcbSTM now (Just what)
let w = realToFrac now let w = realToFrac now
already <- readTVar wip <&> HPSQ.member hi already <- readTVar wip <&> HM.member hi
unless already do unless already do
modifyTVar wip (HPSQ.insert hi 1.0 dcb) modifyTVar wip (HM.insert hi dcb)
forever $ (>> pause @'Seconds 10) do forever $ (>> pause @'Seconds 10) do
sw0 <- readTVarIO wip <&> HPSQ.size sw0 <- readTVarIO wip <&> HM.size
debug $ yellow $ "wip0" <+> pretty sw0 debug $ yellow $ "wip0" <+> pretty sw0
where where
@ -684,7 +684,7 @@ downloadDispatcher brains env = flip runContT pure do
let hashes = readTVarIO _sizeCache <&> fmap (,60) . HM.keys let hashes = readTVarIO _sizeCache <&> fmap (,60) . HM.keys
polling (Polling 1 10) hashes $ \h -> do polling (Polling 1 10) hashes $ \h -> do
atomically do atomically do
here <- readTVar wip <&> HPSQ.member h here <- readTVar wip <&> HM.member h
unless here do unless here do
modifyTVar _sizeCache (HM.delete h) modifyTVar _sizeCache (HM.delete h)
@ -705,14 +705,14 @@ downloadDispatcher brains env = flip runContT pure do
what <- atomically do what <- atomically do
r <- newTVar ( HPSQ.empty @HashRef @Double @DCB ) r <- newTVar ( HPSQ.empty @HashRef @Double @DCB )
blocks <- readTVar wip <&> HPSQ.toList blocks <- readTVar wip <&> HM.toList
let todo = blocks let todo = blocks
flip fix todo $ \loop w -> do flip fix todo $ \loop w -> do
case w of case w of
[] -> none [] -> none
(h,_,dcb@DCB{..}):xs -> do (h,dcb@DCB{..}):xs -> do
wpsize <- readTVar wip <&> HPSQ.size wpsize <- readTVar wip <&> HM.size
let trsh = if wpsize < 10 then 3 else 0 let trsh = if wpsize < 10 then 3 else 0
busy <- readTVar dcbBusy busy <- readTVar dcbBusy
down <- readTVar dcbDownloaded down <- readTVar dcbDownloaded
@ -823,7 +823,7 @@ downloadDispatcher brains env = flip runContT pure do
modifyTVar (dcbBusy dcb) pred modifyTVar (dcbBusy dcb) pred
else do else do
-- modifyTVar (dcbBusy dcb) pred -- modifyTVar (dcbBusy dcb) pred
modifyTVar wip (HPSQ.delete hx) modifyTVar wip (HM.delete hx)
bs <- ContT $ withAsync $ forever do bs <- ContT $ withAsync $ forever do
pause @'Seconds 10 pause @'Seconds 10