mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
Dmitry Zuikov
parent
234dd8bde0
commit
7cd6afd165
|
|
@ -17,6 +17,7 @@ import HBS2.Net.Messaging.Fake
|
||||||
import HBS2.Actors.Peer
|
import HBS2.Actors.Peer
|
||||||
import HBS2.Defaults
|
import HBS2.Defaults
|
||||||
|
|
||||||
|
import HBS2.Data.Types.Refs
|
||||||
import HBS2.Storage
|
import HBS2.Storage
|
||||||
import HBS2.Storage.Simple
|
import HBS2.Storage.Simple
|
||||||
import HBS2.Storage.Simple.Extra
|
import HBS2.Storage.Simple.Extra
|
||||||
|
|
@ -332,6 +333,124 @@ runFakePeer ev p0 bus work = do
|
||||||
mapM_ cancel [w,cw,peer]
|
mapM_ cancel [w,cw,peer]
|
||||||
|
|
||||||
|
|
||||||
|
-- TODO: замутить мап/кэш со статистикой по блоку:
|
||||||
|
-- сколько блок там маринуется и т.п.
|
||||||
|
-- Если блок в этом кэше и еще не скачан, то
|
||||||
|
-- ... пробуем качать повторно?
|
||||||
|
-- ... увеличиваем время
|
||||||
|
-- ... если не появилось новых пиров
|
||||||
|
-- ... запоминать, у какого пира уже спрашивали и стараться
|
||||||
|
-- ... спрашивать у других?
|
||||||
|
-- ... для каждого блока - вести список, у кого лучше спрашивать?
|
||||||
|
-- ... и там whilelist, blacklist
|
||||||
|
-- ... не дохрена ли это будет занимать?
|
||||||
|
--
|
||||||
|
-- ... и тут, короче, еще кэш WiP
|
||||||
|
-- ... и еще один поток, который это всё хэндлит, например:
|
||||||
|
-- ... берём статистику блоков, берём wip
|
||||||
|
-- ... если блок не wip и до сих пор в мапе --- то то добавляем
|
||||||
|
-- ... в очередь.
|
||||||
|
--
|
||||||
|
-- ... блоку пишем, у каких пиров уже спрашивали (Set)
|
||||||
|
-- ... блоку пишем, когда стартовал процесс
|
||||||
|
--
|
||||||
|
--
|
||||||
|
|
||||||
|
|
||||||
|
blockDownloadLoop ev0 p1 = do
|
||||||
|
|
||||||
|
|
||||||
|
let ini = [ "5KP4vM6RuEX6RA1ywthBMqZV5UJDLANC17UrF6zuWdRt"
|
||||||
|
, "81JeD7LNR6Q7RYfyWBxfjJn1RsWzvegkUXae6FUNgrMZ"
|
||||||
|
]
|
||||||
|
|
||||||
|
blkQ <- liftIO $ do
|
||||||
|
b <- newTBQueueIO defBlockDownloadQ
|
||||||
|
traverse_ (atomically . TBQ.writeTBQueue b) ini
|
||||||
|
pure b
|
||||||
|
|
||||||
|
|
||||||
|
-- TODO: random shuffle and take X
|
||||||
|
-- подтягиваем новых пиров откуда можем
|
||||||
|
-- для каждого блока решаем, откуда брать:
|
||||||
|
-- shuffle (white-list) <> shuffle (black-list)
|
||||||
|
--
|
||||||
|
--
|
||||||
|
let knownPeers = [p1]
|
||||||
|
|
||||||
|
fix \next -> do
|
||||||
|
|
||||||
|
-- Вечно ждём. Это и правильно и неправильно
|
||||||
|
|
||||||
|
blkHash <- liftIO $ atomically $ TBQ.readTBQueue blkQ
|
||||||
|
|
||||||
|
-- TODO: check is this block is already here
|
||||||
|
-- maybe emit event to continue -> parse/seek for content
|
||||||
|
|
||||||
|
-- TODO: убивать нотификации, если блок скачан или что-то с ним еще
|
||||||
|
-- приключилось
|
||||||
|
--
|
||||||
|
-- добавляем сюда экшоны на почистить:
|
||||||
|
-- добавили нотификацию --- экшон на
|
||||||
|
-- почистить нотификацию
|
||||||
|
--
|
||||||
|
-- добавили еще какую парашу -- экшон на
|
||||||
|
-- её очистку
|
||||||
|
--
|
||||||
|
-- у каждого экшона - дедлайн
|
||||||
|
-- и там процесс, который берёт тех, у кого дедлайн
|
||||||
|
-- истёк и вызывает их
|
||||||
|
-- ?
|
||||||
|
|
||||||
|
addBlockReadyEventNotify ev0 blkHash $ \hash -> do
|
||||||
|
debug $ "DOWNLOADED BLOCK" <+> pretty hash <+> "NOW WHAT?"
|
||||||
|
|
||||||
|
-- ВЫКОВЫРЯТЬ СТОРЕЙДЖ (как?)
|
||||||
|
-- ЗАСУНУТЫЙ В READER?
|
||||||
|
|
||||||
|
obj <- undefined -- getBlock ss hash
|
||||||
|
|
||||||
|
let mbLink = deserialiseOrFail @AnnotatedHashRef obj
|
||||||
|
|
||||||
|
pure ()
|
||||||
|
|
||||||
|
|
||||||
|
-- -- TODO: смотрим, что за блок
|
||||||
|
-- -- если Merkle - то качаем рекурсивно
|
||||||
|
-- -- если ссылка - то смотрим, что за ссылка
|
||||||
|
-- -- проверяем пруфы
|
||||||
|
-- -- качаем рекурсивно
|
||||||
|
|
||||||
|
-- TODO: надо трекать, может блок-то и найден
|
||||||
|
-- либо по всем пирам спросить
|
||||||
|
|
||||||
|
addBlockSizeEventNotify ev0 blkHash $ \case
|
||||||
|
(p, h, Just size) -> do
|
||||||
|
coo <- genCookie (p,blkHash)
|
||||||
|
let key = DownloadSessionKey (p, coo)
|
||||||
|
let chusz = defChunkSize
|
||||||
|
|
||||||
|
let new = set sBlockChunkSize chusz
|
||||||
|
. set sBlockSize (fromIntegral size)
|
||||||
|
$ newBlockDownload blkHash
|
||||||
|
|
||||||
|
update @Fake new key id
|
||||||
|
request p (BlockChunks coo (BlockGetAllChunks @Fake blkHash chusz)) -- FIXME: nice construction
|
||||||
|
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
|
-- TODO: смотрим, может у нас уже есть block-size
|
||||||
|
-- тогда ловим случайного пира, у которого оно есть
|
||||||
|
-- и ставим на закачку
|
||||||
|
|
||||||
|
-- КТО ПЕРВЫЙ ВСТАЛ ТОГО И ТАПКИ
|
||||||
|
for_ knownPeers $ \who ->
|
||||||
|
request who (GetBlockSize @Fake blkHash)
|
||||||
|
|
||||||
|
next
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
test1 :: IO ()
|
test1 :: IO ()
|
||||||
test1 = do
|
test1 = do
|
||||||
|
|
||||||
|
|
@ -339,7 +458,7 @@ test1 = do
|
||||||
|
|
||||||
fake <- newFakeP2P True
|
fake <- newFakeP2P True
|
||||||
|
|
||||||
void $ race (pause (2 :: Timeout 'Seconds)) $ do
|
void $ race (pause (10 :: Timeout 'Seconds)) $ do
|
||||||
|
|
||||||
let p0 = 0 :: Peer Fake
|
let p0 = 0 :: Peer Fake
|
||||||
let p1 = 1 :: Peer Fake
|
let p1 = 1 :: Peer Fake
|
||||||
|
|
@ -349,122 +468,14 @@ test1 = do
|
||||||
|
|
||||||
p1Thread <- async $ runFakePeer ev1 p1 fake $ forever $ liftIO yield
|
p1Thread <- async $ runFakePeer ev1 p1 fake $ forever $ liftIO yield
|
||||||
|
|
||||||
-- TODO: замутить мап/кэш со статистикой по блоку:
|
|
||||||
-- сколько блок там маринуется и т.п.
|
|
||||||
-- Если блок в этом кэше и еще не скачан, то
|
|
||||||
-- ... пробуем качать повторно?
|
|
||||||
-- ... увеличиваем время
|
|
||||||
-- ... если не появилось новых пиров
|
|
||||||
-- ... запоминать, у какого пира уже спрашивали и стараться
|
|
||||||
-- ... спрашивать у других?
|
|
||||||
-- ... для каждого блока - вести список, у кого лучше спрашивать?
|
|
||||||
-- ... и там whilelist, blacklist
|
|
||||||
-- ... не дохрена ли это будет занимать?
|
|
||||||
--
|
|
||||||
-- ... и тут, короче, еще кэш WiP
|
|
||||||
-- ... и еще один поток, который это всё хэндлит, например:
|
|
||||||
-- ... берём статистику блоков, берём wip
|
|
||||||
-- ... если блок не wip и до сих пор в мапе --- то то добавляем
|
|
||||||
-- ... в очередь.
|
|
||||||
--
|
|
||||||
-- ... блоку пишем, у каких пиров уже спрашивали (Set)
|
|
||||||
-- ... блоку пишем, когда стартовал процесс
|
|
||||||
--
|
|
||||||
--
|
|
||||||
|
|
||||||
let ini = [ "5KP4vM6RuEX6RA1ywthBMqZV5UJDLANC17UrF6zuWdRt"
|
|
||||||
, "81JeD7LNR6Q7RYfyWBxfjJn1RsWzvegkUXae6FUNgrMZ"
|
|
||||||
]
|
|
||||||
|
|
||||||
blkQ <- liftIO $ do
|
|
||||||
b <- newTBQueueIO defBlockDownloadQ
|
|
||||||
traverse_ (atomically . TBQ.writeTBQueue b) ini
|
|
||||||
pure b
|
|
||||||
|
|
||||||
p0Thread <- async $ runFakePeer ev0 p0 fake $ do
|
p0Thread <- async $ runFakePeer ev0 p0 fake $ do
|
||||||
|
|
||||||
-- TODO: random shuffle and take X
|
blockDownloadLoop ev0 p1
|
||||||
-- подтягиваем новых пиров откуда можем
|
|
||||||
-- для каждого блока решаем, откуда брать:
|
|
||||||
-- shuffle (white-list) <> shuffle (black-list)
|
|
||||||
--
|
|
||||||
--
|
|
||||||
let knownPeers = [p1]
|
|
||||||
|
|
||||||
fix \next -> do
|
|
||||||
|
|
||||||
blkHash <- liftIO $ atomically $ TBQ.readTBQueue blkQ
|
|
||||||
|
|
||||||
-- TODO: check is this block is already here
|
|
||||||
-- maybe emit event to continue -> parse/seek for content
|
|
||||||
|
|
||||||
-- TODO: убивать нотификации, если блок скачан или что-то с ним еще
|
|
||||||
-- приключилось
|
|
||||||
--
|
|
||||||
-- добавляем сюда экшоны на почистить:
|
|
||||||
-- добавили нотификацию --- экшон на
|
|
||||||
-- почистить нотификацию
|
|
||||||
--
|
|
||||||
-- добавили еще какую парашу -- экшон на
|
|
||||||
-- её очистку
|
|
||||||
--
|
|
||||||
-- у каждого экшона - дедлайн
|
|
||||||
-- и там процесс, который берёт тех, у кого дедлайн
|
|
||||||
-- истёк и вызывает их
|
|
||||||
-- ?
|
|
||||||
|
|
||||||
addBlockReadyEventNotify ev0 blkHash $ \h -> do
|
|
||||||
debug $ "DOWNLOADED BLOCK" <+> pretty h <+> "NOW WHAT?"
|
|
||||||
|
|
||||||
-- -- TODO: смотрим, что за блок
|
|
||||||
-- -- если Merkle - то качаем рекурсивно
|
|
||||||
-- -- если ссылка - то смотрим, что за ссылка
|
|
||||||
-- -- проверяем пруфы
|
|
||||||
-- -- качаем рекурсивно
|
|
||||||
|
|
||||||
-- TODO: надо трекать, может блок-то и найден
|
|
||||||
-- либо по всем пирам спросить
|
|
||||||
|
|
||||||
addBlockSizeEventNotify ev0 blkHash $ \case
|
|
||||||
(p, h, Just size) -> do
|
|
||||||
coo <- genCookie (p,blkHash)
|
|
||||||
let key = DownloadSessionKey (p, coo)
|
|
||||||
let chusz = defChunkSize
|
|
||||||
|
|
||||||
let new = set sBlockChunkSize chusz
|
|
||||||
. set sBlockSize (fromIntegral size)
|
|
||||||
$ newBlockDownload blkHash
|
|
||||||
|
|
||||||
update @Fake new key id
|
|
||||||
request p (BlockChunks coo (BlockGetAllChunks @Fake blkHash chusz)) -- FIXME: nice construction
|
|
||||||
liftIO $ print $ "DAVAI BLOCK!" <+> pretty h
|
|
||||||
|
|
||||||
_ -> pure ()
|
|
||||||
|
|
||||||
-- TODO: смотрим, может у нас уже есть block-size
|
|
||||||
-- тогда ловим случайного пира, у которого оно есть
|
|
||||||
-- и ставим на закачку
|
|
||||||
|
|
||||||
-- КТО ПЕРВЫЙ ВСТАЛ ТОГО И ТАПКИ
|
|
||||||
for_ knownPeers $ \who ->
|
|
||||||
request who (GetBlockSize @Fake blkHash)
|
|
||||||
|
|
||||||
next
|
|
||||||
|
|
||||||
let peerz = p0Thread : [p1Thread]
|
let peerz = p0Thread : [p1Thread]
|
||||||
|
|
||||||
|
|
||||||
-- -- TODO: смотрим, что за блок
|
pause ( 5 :: Timeout 'Seconds)
|
||||||
-- -- если Merkle - то качаем рекурсивно
|
|
||||||
-- -- если ссылка - то смотрим, что за ссылка
|
|
||||||
-- -- проверяем пруфы
|
|
||||||
-- -- качаем рекурсивно
|
|
||||||
|
|
||||||
-- -- let mbLink = deserialiseOrFail @Merkle obj
|
|
||||||
|
|
||||||
-- pure ()
|
|
||||||
|
|
||||||
pause ( 1 :: Timeout 'Seconds)
|
|
||||||
|
|
||||||
mapM_ cancel peerz
|
mapM_ cancel peerz
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue