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

before-permutation

This commit is contained in:
voidlizard 2024-11-13 19:07:16 +03:00
parent 8df3485752
commit dbf6e4b44a
1 changed files with 22 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -510,6 +510,7 @@ downloadFromPeer t bu cache env h peer = liftIO $ withPeerM env do
blk <- readTVarIO _sBlockChunks2 blk <- readTVarIO _sBlockChunks2
let rs = LBS.concat $ IntMap.elems blk let rs = LBS.concat $ IntMap.elems blk
-- ha <- putBlock sto rs
ha <- putBlock sto rs ha <- putBlock sto rs
-- let ha = Just $ hashObject @HbSync rs -- let ha = Just $ hashObject @HbSync rs
@ -536,35 +537,12 @@ downloadFromPeer t bu cache env h peer = liftIO $ withPeerM env do
Right (Just s) -> pure s Right (Just s) -> pure s
data S1 =
S1Init
| S1QuerySize (Hash HbSync)
| S1CheckMissed (Hash HbSync)
data S2 =
S2Init (Hash HbSync)
| S2CheckBlock1 (Hash HbSync) ByteString
| S2CheckBlock2 (Hash HbSync)
| S2FetchBlock (Hash HbSync)
| S2Exit
newtype KnownSize = KnownSize Integer newtype KnownSize = KnownSize Integer
instance BlockSizeCache e KnownSize where instance BlockSizeCache e KnownSize where
cacheBlockSize _ y_ _ _ = pure () cacheBlockSize _ y_ _ _ = pure ()
findBlockSize (KnownSize s) _ _ = pure (Just s) findBlockSize (KnownSize s) _ _ = pure (Just s)
data BlockFetchResult =
BlockFetchError
| BlockFetched ByteString
| BlockAlreadyHere
data Work =
RequestSize HashRef (Maybe Integer -> IO ())
| FetchBlock HashRef Integer (BlockFetchResult -> IO ())
-- | Download control block -- | Download control block
data DCB = data DCB =
@ -730,34 +708,30 @@ downloadDispatcher brains env = flip runContT pure do
blocks <- readTVar wip <&> HPSQ.toList blocks <- readTVar wip <&> HPSQ.toList
let todo = blocks let todo = blocks
flip fix todo $ \loop w -> do flip fix todo $ \loop w -> do
erno <- readTVar _errors case w of
if erno > 10 then [] -> none
pure ()
else do
case w of
[] -> none
(h,_,dcb@DCB{..}):xs -> do (h,_,dcb@DCB{..}):xs -> do
wpsize <- readTVar wip <&> HPSQ.size wpsize <- readTVar wip <&> HPSQ.size
let trsh = if wpsize < 10 then 3 else 0 let trsh = if wpsize < 10 then 3 else 0
busy <- readTVar dcbBusy busy <- readTVar dcbBusy
down <- readTVar dcbDownloaded down <- readTVar dcbDownloaded
absent <- readTVar _sizeCache <&> (== Just Nothing) . HM.lookup h absent <- readTVar _sizeCache <&> (== Just Nothing) . HM.lookup h
if busy > trsh || down || absent then if busy > trsh || down || absent then
loop xs loop xs
else do else do
sizeCache <- readTVar _sizeCache sizeCache <- readTVar _sizeCache
let eps = case dcbParent of let eps = case dcbParent of
Nothing -> 1.0 Nothing -> 1.0
Just hp -> case HM.lookup hp sizeCache of Just hp -> case HM.lookup hp sizeCache of
Just (Just _) -> 0.5 Just (Just _) -> 0.5
Just Nothing -> 1.5 Just Nothing -> 1.5
Nothing -> 1.0 Nothing -> 1.0
modifyTVar r (HPSQ.insert h eps dcb) modifyTVar r (HPSQ.insert h eps dcb)
s <- readTVar r <&> HPSQ.size s <- readTVar r <&> HPSQ.size
if s >= 8 then pure () else loop xs if s >= 8 then pure () else loop xs
w <- readTVar r <&> HPSQ.findMin w <- readTVar r <&> HPSQ.findMin
case w of case w of