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

crazy shit heads blown

This commit is contained in:
Dmitry Zuikov 2023-01-20 20:06:23 +03:00
parent 5d3d60778d
commit f25693a826
1 changed files with 17 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
hbs2-tests/test/PeerMain.hs
View File

@ -154,11 +154,11 @@ addBlockSizeEventNotify :: forall e m . (MonadIO m)
addBlockSizeEventNotify pe h e = do addBlockSizeEventNotify pe h e = do
void $ liftIO $ atomically $ modifyTVar' (onBlockSize pe) (Map.insertWith (<>) h [e]) void $ liftIO $ atomically $ modifyTVar' (onBlockSize pe) (Map.insertWith (<>) h [e])
emitBlockSizeEvent :: MonadIO m emitBlockSizeEvent :: forall e m . MonadIO m
=> PeerEvents e m => PeerEvents e m
-> Hash HbSync -> Hash HbSync
-> (Peer e, Hash HbSync, Maybe Integer) -> (Peer e, Hash HbSync, Maybe Integer)
-> m () -> m ()
emitBlockSizeEvent pe h event = do emitBlockSizeEvent pe h event = do
ev <- liftIO $ atomically $ stateTVar (onBlockSize pe) alter ev <- liftIO $ atomically $ stateTVar (onBlockSize pe) alter
@ -171,16 +171,18 @@ emitBlockSizeEvent pe h event = do
runFakePeer :: forall e b m . ( e ~ Fake runFakePeer :: forall e b m . ( e ~ Fake
, MonadIO m -- , MonadIO m
, Messaging b e ByteString , Messaging b e ByteString
-- , Sessions Fake (BlockSize Fake)
-- , m ~ ResponseM Fake IO
-- , MonadIO m -- , MonadIO m
-- , Response e p m -- , Response e p m
-- , EngineM e m -- , EngineM e m
) )
=> PeerEvents e m => PeerEvents e (EngineM e IO)
-> Peer e -> Peer e
-> b -> b
-> EngineM e m () -> EngineM e IO ()
-> IO () -> IO ()
runFakePeer ev p0 bus work = do runFakePeer ev p0 bus work = do
@ -221,7 +223,7 @@ runFakePeer ev p0 bus work = do
let bsz = fromIntegral sz let bsz = fromIntegral sz
update @e def (BlockSizeKey h) (over bsBlockSizes (Map.insert p bsz)) update @e def (BlockSizeKey h) (over bsBlockSizes (Map.insert p bsz))
emitBlockSizeEvent ev h (p, h, Just sz) lift $ runEngineM env $ emitBlockSizeEvent ev h (p, h, Just sz) -- TODO: fix this crazy shit
let adapter = let adapter =
BlockChunksI BlockChunksI
@ -317,10 +319,10 @@ test1 = do
let p0 = 0 :: Peer Fake let p0 = 0 :: Peer Fake
let p1 = 1 :: Peer Fake let p1 = 1 :: Peer Fake
ev1 <- liftIO newPeerEventsIO ev1 <- newPeerEventsIO @_ @(EngineM Fake IO)
ev0 <- liftIO newPeerEventsIO ev0 <- newPeerEventsIO @_ @(EngineM Fake IO)
p1Thread <- async $ runFakePeer ev1 p1 fake (liftIO $ forever yield) p1Thread <- async $ runFakePeer ev1 p1 fake $ forever $ liftIO yield
let ini = [ "5KP4vM6RuEX6RA1ywthBMqZV5UJDLANC17UrF6zuWdRt" let ini = [ "5KP4vM6RuEX6RA1ywthBMqZV5UJDLANC17UrF6zuWdRt"
, "81JeD7LNR6Q7RYfyWBxfjJn1RsWzvegkUXae6FUNgrMZ" , "81JeD7LNR6Q7RYfyWBxfjJn1RsWzvegkUXae6FUNgrMZ"
@ -331,6 +333,7 @@ test1 = do
traverse_ (atomically . TBQ.writeTBQueue b) ini traverse_ (atomically . TBQ.writeTBQueue b) ini
pure b pure b
p0Thread <- async $ runFakePeer ev0 p0 fake $ do p0Thread <- async $ runFakePeer ev0 p0 fake $ do
let knownPeers = [p1] let knownPeers = [p1]
@ -348,16 +351,12 @@ test1 = do
addBlockSizeEventNotify ev0 blkHash $ \case addBlockSizeEventNotify ev0 blkHash $ \case
(p, h, Just _) -> do (p, h, Just _) -> do
-- coo <- genCookie (p,blkHash) coo <- genCookie (p,blkHash)
-- let key = DownloadSessionKey (p, coo) let key = DownloadSessionKey (p, coo)
-- let new = newBlockDownload blkHash let new = newBlockDownload blkHash
-- update @Fake new key id update @Fake new key id
-- (over bsBlockSizes (Map.insert p bsz))
request p (GetBlockSize @Fake blkHash) request p (GetBlockSize @Fake blkHash)
-- liftIO $ print $ "DAVAI BLOCK!" <+> pretty h liftIO $ print $ "DAVAI BLOCK!" <+> pretty h
-- update
-- let q = pure ()
pure ()
_ -> pure () _ -> pure ()