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

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

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