voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

okay

This commit is contained in:
voidlizard 2024-11-06 12:36:04 +03:00
parent 73d9f7ec2c
commit 5cb86b714d
1 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
hbs2-peer/app/RPC2.hs
View File

@ -268,7 +268,7 @@ runBurstMachine BurstMachine{..} = do
new <- if e2 > e1 then do new <- if e2 > e1 then do
let d = max 2.0 (current * (1.0 - down)) let d = max 2.0 (current * (1.0 - down))
nrates <- readTVar _rates <&> drop 2 . Map.toList nrates <- readTVar _rates <&> drop 10 . Map.toList
let newFucked = maybe d snd (headMay nrates) let newFucked = maybe d snd (headMay nrates)
writeTVar _rates (Map.fromList nrates) writeTVar _rates (Map.fromList nrates)
pure newFucked pure newFucked
@ -336,7 +336,7 @@ downloadFromPeerRec t bu0 cache env h0 peer = do
txs <- readTVarIO toq <&> L.take 1000 txs <- readTVarIO toq <&> L.take 1000
let m1 = fromMaybe m0 $ median txs let m1 = fromMaybe m0 $ median txs
when ( m1 > m0 ) $ burstMachineAddErrors bm 1 when ( m1 > m0 ) $ burstMachineAddErrors bm 1
pause @'Seconds 5 pause @'Seconds 3
next m1 next m1
ContT $ withAsync $ runBurstMachine bm ContT $ withAsync $ runBurstMachine bm
@ -466,6 +466,8 @@ downloadFromPeer t bu cache env h peer = liftIO $ withPeerM env do
callCC $ \exit2 -> do callCC $ \exit2 -> do
_wx <- newTVarIO waity
for_ bursts $ \(i,chunkN) -> do for_ bursts $ \(i,chunkN) -> do
-- atomically $ flushTQueue chuQ -- atomically $ flushTQueue chuQ
@ -474,15 +476,14 @@ downloadFromPeer t bu cache env h peer = liftIO $ withPeerM env do
lift $ request peer req lift $ request peer req
t0 <- getTimeCoarse
let watchdog = fix \next -> do let watchdog = fix \next -> do
wx <- readTVarIO _wx <&> realToFrac
-- debug $ "WATCHDOG" <+> pretty wx <+> pretty waity
r <- race (pause @'MilliSeconds waity) do r <- race (pause @'MilliSeconds waity) do
void $ atomically $ readTQueue chuQ void $ atomically $ readTQueue chuQ
either (const none) (const next) r either (const none) (const next) r
-- next
-- s1 <- readTVarIO _sBlockChunks2 <&> IntMap.size
-- pause @'MilliSeconds 1000
-- s2 <- readTVarIO _sBlockChunks2 <&> IntMap.size
-- when (s1 /= s2) next
r <- liftIO $ race watchdog do r <- liftIO $ race watchdog do
@ -493,10 +494,18 @@ downloadFromPeer t bu cache env h peer = liftIO $ withPeerM env do
atomically $ flushTQueue chuQ atomically $ flushTQueue chuQ
t1 <- getTimeCoarse
atomically do
wx0 <- readTVar _wx
let wx1 = realToFrac (t1 - t0) * 100 / 1e6 -- millis
writeTVar _wx wx1
case r of case r of
Left{} -> exit2 (Left $ DownloadStuckError (HashRef h) peer) Left{} -> exit2 (Left $ DownloadStuckError (HashRef h) peer)
_ -> pure () _ -> pure ()
blk <- readTVarIO _sBlockChunks2 blk <- readTVarIO _sBlockChunks2
let rs = LBS.concat $ IntMap.elems blk let rs = LBS.concat $ IntMap.elems blk