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-11 17:44:54 +03:00
parent ca995a8228
commit fe88522200
1 changed files with 16 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -609,15 +609,17 @@ downloadDispatcher brains env = flip runContT pure do
-- let color = if isJust s then green else red
-- debug $ color "GOT BLOCK SIZE" <+> pretty h <+> pretty s <+> pretty p
-- dtt <- randomRIO (-0.05, 0.05)
let dtt = 0
dtt <- randomRIO (-0.01, 0.01)
-- let dtt = 0
here <- hasBlock sto (coerce h) <&> isJust
unless here do
dt <- readTVarIO stat <&> (+dtt) . fromMaybe 1.0 . HM.lookup p
dt <- readTVarIO stat <&> (*(1+dtt)) . fromMaybe 1.0 . HM.lookup p
atomically do
-- blkNum <- stateTVar _blkNum (\x -> (x, succ x))
modifyTVar sizeCache (HM.insert (p,h) s)
choo <- readTVar choosen <&> HS.member h
maybe1 s none $ \size -> do
unless choo do
modifyTVar downWip (HPSQ.insert (p,h) dt size)
parseQ <- newTQueueIO
@ -628,7 +630,7 @@ downloadDispatcher brains env = flip runContT pure do
atomically do
modifyTVar wip (HM.delete h)
modifyTVar sizeRq (HPSQ.delete h)
modifyTVar choosen (HS.delete h)
-- modifyTVar choosen (HS.delete h)
srwq <- readTVar sizeRqWip <&> HM.toList
writeTVar sizeRqWip (HM.fromList $ [ x | x@((_,hi),_) <- srwq, hi /= h ])
dw <- readTVar downWip <&> HPSQ.toList
@ -645,9 +647,9 @@ downloadDispatcher brains env = flip runContT pure do
BlockFetched bs -> do
-- debug $ green "GOT BLOCK" <+> pretty h <+> pretty (LBS.length bs) <+> pretty p
void $ putBlock sto bs
atomically $ writeTQueue parseQ (h, bs)
-- atomically $ modifyTVar done (HS.insert h)
-- deleteBlockFromWip h
atomically do
writeTQueue parseQ (h, bs)
modifyTVar fuckup (HM.insertWith (<>) h (HS.singleton p))
BlockFetchError -> do
now <- getTimeCoarse
@ -656,7 +658,7 @@ downloadDispatcher brains env = flip runContT pure do
atomically $ modifyTVar choosen (HS.delete h)
ContT $ withAsync $ forever do
let blkz = readTVarIO choosen <&> fmap (,5) . HS.toList
let blkz = readTVarIO choosen <&> fmap (,30) . HS.toList
polling (Polling 1 1) blkz $ \h -> do
here <- hasBlock sto (coerce h) <&> isJust
if here then do
@ -735,7 +737,7 @@ downloadDispatcher brains env = flip runContT pure do
dw <- readTVar downWip
let total = [ x | x@((p,_),_,_) <- L.take 256 (HPSQ.toList dw), HM.member p peers ]
let total = [ x | x@((p,_),_,_) <- L.take 16 (HPSQ.toList dw), HM.member p peers ]
let queue = total
@ -762,11 +764,11 @@ downloadDispatcher brains env = flip runContT pure do
(_,size) <- ContT $ maybe1 (HPSQ.lookup (p0,h) dw) (warn $ red "FUCKED SIZE")
atomically do
modifyTVar fuckup (HM.insertWith (<>) h (HS.singleton p0))
choo <- readTVar choosen <&> HS.member h
unless choo do
writeTQueue who (FetchBlock h size (onBlock p0 h))
modifyTVar choosen (HS.insert h)
forever $ (>> pause @'Seconds 10) do
sw0 <- readTVarIO wip <&> HM.size
srqw <- readTVarIO sizeRqWip <&> HM.size