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 10:46:49 +03:00
parent 9004dfaa5e
commit fa31750a80
5 changed files with 4 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -562,13 +562,10 @@ downloadDispatcher :: forall e m . ( e ~ L4Proto
downloadDispatcher brains env = flip runContT pure do downloadDispatcher brains env = flip runContT pure do
pts <- newTVarIO ( mempty :: HashMap (Peer e) (Async (), PeerNonce) ) pts <- newTVarIO ( mempty :: HashMap (Peer e) (Async (), PeerNonce) )
-- tasks <- newTVarIO ( HPSQ.empty :: HashPSQ (Work e) Double (TVar Int) )
_blkNum <- newTVarIO 0
wip <- newTVarIO ( mempty :: HashMap HashRef DCB ) wip <- newTVarIO ( mempty :: HashMap HashRef DCB )
parseQ <- newTQueueIO parseQ <- newTQueueIO
let let
onBlockSTM :: HashRef -> STM () onBlockSTM :: HashRef -> STM ()
onBlockSTM = writeTQueue parseQ onBlockSTM = writeTQueue parseQ
@ -745,7 +742,7 @@ downloadDispatcher brains env = flip runContT pure do
down <- readTVar _blknum down <- readTVar _blknum
writeTVar _peerErrorsLast erno writeTVar _peerErrorsLast erno
writeTVar _peerBurst bu writeTVar _peerBurst bu
writeTVar _peerDownloadedLast down writeTVar _peerDownloaded down
rndGen <- liftIO newStdGen >>= newTVarIO rndGen <- liftIO newStdGen >>= newTVarIO

2
hbs2-peer/app/PeerInfo.hs
View File

@ -194,7 +194,7 @@ peerPingLoop (PeerConfig syn) penv = do
burst <- liftIO $ readTVarIO (view peerBurst pinfo) burst <- liftIO $ readTVarIO (view peerBurst pinfo)
errors <- liftIO $ readTVarIO (view peerErrorsPerSec pinfo) errors <- liftIO $ readTVarIO (view peerErrorsPerSec pinfo)
downMiss <- liftIO $ readTVarIO (view peerDownloadMiss pinfo) downMiss <- liftIO $ readTVarIO (view peerDownloadMiss pinfo)
down <- liftIO $ readTVarIO (view peerDownloadedBlk pinfo) down <- liftIO $ readTVarIO (view peerDownloaded pinfo)
rtt <- liftIO $ medianPeerRTT pinfo <&> fmap realToFrac rtt <- liftIO $ medianPeerRTT pinfo <&> fmap realToFrac
httpDownloaded <- liftIO $ readTVarIO (_peerHttpDownloaded pinfo) httpDownloaded <- liftIO $ readTVarIO (_peerHttpDownloaded pinfo)
seen <- liftIO $ readTVarIO (view peerLastWatched pinfo) seen <- liftIO $ readTVarIO (view peerLastWatched pinfo)

2
hbs2-peer/app/PeerMain.hs
View File

@ -143,7 +143,7 @@ instance Exception GoAgainException
-- TODO: write-workers-to-config -- TODO: write-workers-to-config
defStorageThreads :: Integral a => a defStorageThreads :: Integral a => a
defStorageThreads = 4 defStorageThreads = 8
defLocalMulticast :: String defLocalMulticast :: String
defLocalMulticast = "239.192.152.145:10153" defLocalMulticast = "239.192.152.145:10153"

4
hbs2-peer/app/PeerTypes.hs
View File

@ -74,9 +74,7 @@ data PeerInfo e =
, _peerErrorsPerSec :: TVar Int , _peerErrorsPerSec :: TVar Int
, _peerLastWatched :: TVar TimeSpec , _peerLastWatched :: TVar TimeSpec
, _peerDownloaded :: TVar Int , _peerDownloaded :: TVar Int
, _peerDownloadedLast :: TVar Int
, _peerPingFailed :: TVar Int , _peerPingFailed :: TVar Int
, _peerDownloadedBlk :: TVar Int
, _peerDownloadFail :: TVar Int , _peerDownloadFail :: TVar Int
, _peerDownloadMiss :: TVar Int , _peerDownloadMiss :: TVar Int
, _peerRTTBuffer :: TVar [Integer] -- ^ Contains a list of the last few round-trip time (RTT) values, measured in nanoseconds. , _peerRTTBuffer :: TVar [Integer] -- ^ Contains a list of the last few round-trip time (RTT) values, measured in nanoseconds.
@ -99,9 +97,7 @@ newPeerInfo = liftIO do
_peerErrorsPerSec <- newTVarIO 0 _peerErrorsPerSec <- newTVarIO 0
_peerLastWatched <- newTVarIO 0 _peerLastWatched <- newTVarIO 0
_peerDownloaded <- newTVarIO 0 _peerDownloaded <- newTVarIO 0
_peerDownloadedLast <- newTVarIO 0
_peerPingFailed <- newTVarIO 0 _peerPingFailed <- newTVarIO 0
_peerDownloadedBlk <- newTVarIO 0
_peerDownloadFail <- newTVarIO 0 _peerDownloadFail <- newTVarIO 0
_peerDownloadMiss <- newTVarIO 0 _peerDownloadMiss <- newTVarIO 0
_peerRTTBuffer <- newTVarIO [] _peerRTTBuffer <- newTVarIO []

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

@ -231,7 +231,7 @@ instance (e ~ L4Proto, MonadUnliftIO m, HasRpcContext PeerAPI RPC2Context m) =>
errors <- readTVarIO _peerErrorsPerSec errors <- readTVarIO _peerErrorsPerSec
downFails <- readTVarIO _peerDownloadFail downFails <- readTVarIO _peerDownloadFail
downMiss <- readTVarIO _peerDownloadMiss downMiss <- readTVarIO _peerDownloadMiss
down <- readTVarIO _peerDownloadedBlk down <- readTVarIO _peerDownloaded
rtt <- medianPeerRTT pinfo <&> fmap realToFrac rtt <- medianPeerRTT pinfo <&> fmap realToFrac
seen <- readTVarIO _peerLastWatched seen <- readTVarIO _peerLastWatched
let l = realToFrac (toNanoSecs $ now - seen) / 1e9 let l = realToFrac (toNanoSecs $ now - seen) / 1e9