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:
voidlizard 2024-11-14 17:41:21 +03:00
parent 7322424f5e
commit 12aefbc66f
1 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -494,44 +494,44 @@ downloadFromPeer bu cache env h peer = liftIO $ withPeerM env do
atomically do atomically do
y <- readTVar _num y <- readTVar _num
if x == y then retry else pure y if x == y then retry else pure y
either (const none) next r either dontHandle next r
t0 <- getTimeCoarse t0 <- getTimeCoarse
r <- liftIO $ race watchdog do r <- liftIO $ race (pause w0 >> watchdog) do
atomically do atomically do
pieces <- readTVar _sBlockChunks2 pieces <- readTVar _sBlockChunks2
writeTVar _num ( IntMap.size pieces ) writeTVar _num ( IntMap.size pieces )
let done = and [ IntMap.member j pieces | j <- parts ] let done = and [ IntMap.member j pieces | j <- parts ]
unless done retry -- $ pause @'MilliSeconds ( 0.25 * rtt ) >> next unless done retry
t1 <- getTimeCoarse t1 <- getTimeCoarse
case r of
Right{} -> do
atomically do atomically do
when (isRight r) do when (isRight r) do
let nano = toNanoSeconds $ TimeoutTS (t1 - t0) let nano = toNanoSeconds $ TimeoutTS (t1 - t0)
let wx1 = 100 * realToFrac nano / 1e6 -- millis let wx1 = 100 * realToFrac nano / 1e6 -- millis
writeTVar _wx wx1 writeTVar _wx wx1
case r of
Left{} -> do Left{} -> do
if n < 2 then do if n < 2 then do
w <- readTVarIO _wx w <- readTVarIO _wx
pieces <- readTVarIO _sBlockChunks2 pieces <- readTVarIO _sBlockChunks2
let missed = IntMap.difference pieces (IntMap.fromList [ (j,()) | j <- parts ] ) let missed = IntMap.difference pieces (IntMap.fromList [ (j,()) | j <- parts ] )
debug $ red "Retry" <+> pretty w debug $ red "Retry" <+> pretty i
<+> pretty w
<+> pretty (length missed) <+> pretty (length missed)
<+> pretty h <+> pretty h
<+> pretty peer <+> pretty peer
again (succ n)
if L.null missed then none else again (succ n)
else do else do
exit2 (Left $ DownloadStuckError (HashRef h) peer) exit2 (Left $ DownloadStuckError (HashRef h) peer)
_ -> pure ()
blk <- readTVarIO _sBlockChunks2 blk <- readTVarIO _sBlockChunks2
let rs = LBS.concat $ IntMap.elems blk let rs = LBS.concat $ IntMap.elems blk