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

...

This commit is contained in:
voidlizard 2024-11-14 20:51:17 +03:00
parent 2afb24323f
commit e5950b9ca9
1 changed files with 4 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -169,6 +169,7 @@ data BurstMachine =
, _buStepUp :: Double , _buStepUp :: Double
, _buStepDown :: Double , _buStepDown :: Double
, _buCurrent :: TVar Double , _buCurrent :: TVar Double
, _buMaxReal :: TVar Double
, _buErrors :: TVar Int , _buErrors :: TVar Int
} }
@ -193,6 +194,7 @@ newBurstMachine :: MonadUnliftIO m
newBurstMachine t0 buMax buStart up' down' = do newBurstMachine t0 buMax buStart up' down' = do
BurstMachine t0 bu0 buMax up down BurstMachine t0 bu0 buMax up down
<$> newTVarIO bu0 <$> newTVarIO bu0
<*> newTVarIO bu0
<*> newTVarIO 0 <*> newTVarIO 0
where where
@ -208,7 +210,8 @@ instance MonadUnliftIO m => IsBurstMachine BurstMachine m where
burstMachineReset BurstMachine{..} = do burstMachineReset BurstMachine{..} = do
atomically do atomically do
writeTVar _buCurrent _buStart bmr <- readTVar _buMaxReal
writeTVar _buCurrent (min bmr _buStart)
writeTVar _buErrors 0 writeTVar _buErrors 0
runBurstMachine BurstMachine{..} = do runBurstMachine BurstMachine{..} = do
@ -223,8 +226,6 @@ instance MonadUnliftIO m => IsBurstMachine BurstMachine m where
_rates <- newTVarIO (mempty :: Map Double Double) _rates <- newTVarIO (mempty :: Map Double Double)
_buMaxReal <- newTVarIO buMax
pause @'Seconds (realToFrac _buTimeout) pause @'Seconds (realToFrac _buTimeout)
flip runContT pure do flip runContT pure do