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 15:59:39 +03:00
parent 6d1fcf419d
commit 386d499a0a
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -470,22 +470,20 @@ downloadFromPeer bu cache env h peer = liftIO $ withPeerM env do
callCC $ \exit2 -> do callCC $ \exit2 -> do
_wx <- newTVarIO waity _wx <- newTVarIO 10000 -- waity
for_ bursts $ \(i,chunkN) -> do for_ bursts $ \(i,chunkN) -> do
wx <- readTVarIO _wx
flip fix 0 \again n -> do flip fix 0 \again n -> do
let req = BlockChunks @e coo (BlockGetChunks h chunkSize (fromIntegral i) (fromIntegral chunkN)) let req = BlockChunks @e coo (BlockGetChunks h chunkSize (fromIntegral i) (fromIntegral chunkN))
lift $ request peer req lift $ request peer req
t0 <- getTimeCoarse
_num <- newTVarIO 0 _num <- newTVarIO 0
wx <- readTVarIO _wx
let w0 = 2.0 :: Timeout 'MilliSeconds let w0 = 2.0 :: Timeout 'MilliSeconds
let watchdog = flip fix 0 \next x -> do let watchdog = flip fix 0 \next x -> do
@ -495,6 +493,8 @@ downloadFromPeer bu cache env h peer = liftIO $ withPeerM env do
if x == y then retry else pure y if x == y then retry else pure y
either (const none) next r either (const none) next r
t0 <- getTimeCoarse
r <- liftIO $ pause w0 >> race watchdog do r <- liftIO $ pause w0 >> race watchdog do
atomically do atomically do
pieces <- readTVar _sBlockChunks2 pieces <- readTVar _sBlockChunks2
@ -507,13 +507,14 @@ downloadFromPeer bu cache env h peer = liftIO $ withPeerM env 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 = max 1000 (100 * realToFrac nano / 1e6) -- millis
writeTVar _wx wx1 writeTVar _wx wx1
case r of case r of
Left{} -> do Left{} -> do
if n < 2 then do if n < 2 then do
debug $ red "Retry" <+> pretty i <+> pretty chunkN <+> pretty h <+> pretty peer w <- readTVarIO _wx
debug $ red "Retry" <+> pretty w <+> pretty i <+> pretty chunkN <+> pretty h <+> pretty peer
again (succ n) again (succ n)
else do else do
exit2 (Left $ DownloadStuckError (HashRef h) peer) exit2 (Left $ DownloadStuckError (HashRef h) peer)