From 1d2aa791d243be5a697e65e1c4c6536f1ae3ed0a Mon Sep 17 00:00:00 2001 From: voidlizard Date: Thu, 14 Nov 2024 15:59:39 +0300 Subject: [PATCH] wip --- hbs2-peer/app/BlockDownloadNew.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/hbs2-peer/app/BlockDownloadNew.hs b/hbs2-peer/app/BlockDownloadNew.hs index 8edefb53..711a4741 100644 --- a/hbs2-peer/app/BlockDownloadNew.hs +++ b/hbs2-peer/app/BlockDownloadNew.hs @@ -470,22 +470,20 @@ downloadFromPeer bu cache env h peer = liftIO $ withPeerM env do callCC $ \exit2 -> do - _wx <- newTVarIO waity + _wx <- newTVarIO 10000 -- waity for_ bursts $ \(i,chunkN) -> do + wx <- readTVarIO _wx + flip fix 0 \again n -> do let req = BlockChunks @e coo (BlockGetChunks h chunkSize (fromIntegral i) (fromIntegral chunkN)) lift $ request peer req - t0 <- getTimeCoarse - _num <- newTVarIO 0 - wx <- readTVarIO _wx - let w0 = 2.0 :: Timeout 'MilliSeconds 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 either (const none) next r + t0 <- getTimeCoarse + r <- liftIO $ pause w0 >> race watchdog do atomically do pieces <- readTVar _sBlockChunks2 @@ -507,13 +507,14 @@ downloadFromPeer bu cache env h peer = liftIO $ withPeerM env do atomically do when (isRight r) do 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 case r of Left{} -> 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) else do exit2 (Left $ DownloadStuckError (HashRef h) peer)