summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/Exchange.hs18
1 files changed, 11 insertions, 7 deletions
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs
index 3f3346d2..ca82181c 100644
--- a/src/Network/BitTorrent/Exchange.hs
+++ b/src/Network/BitTorrent/Exchange.hs
@@ -121,12 +121,12 @@ yieldMessage :: Message -> P2P ()
121yieldMessage msg = P2P $ ReaderT $ const $ {-# SCC yieldMessage #-} C.yield msg 121yieldMessage msg = P2P $ ReaderT $ const $ {-# SCC yieldMessage #-} C.yield msg
122{-# INLINE yieldMessage #-} 122{-# INLINE yieldMessage #-}
123 123
124-- TODO send vectored
124flushPending :: P2P () 125flushPending :: P2P ()
125flushPending = {-# SCC flushPending #-} do 126flushPending = {-# SCC flushPending #-} do
126 se <- ask 127 session <- ask
127 q <- liftIO (getPending se) 128 queue <- liftIO (getPending session)
128 -- TODO send vectored 129 mapM_ yieldMessage queue
129 mapM_ yieldMessage q
130 130
131{----------------------------------------------------------------------- 131{-----------------------------------------------------------------------
132 P2P monad 132 P2P monad
@@ -327,7 +327,9 @@ data Event
327-- forall (Fragment block). isPiece block == True 327-- forall (Fragment block). isPiece block == True
328-- 328--
329awaitEvent :: P2P Event 329awaitEvent :: P2P Event
330awaitEvent = {-# SCC awaitEvent #-} awaitMessage >>= go 330awaitEvent = {-# SCC awaitEvent #-} do
331 flushPending
332 awaitMessage >>= go
331 where 333 where
332 go KeepAlive = awaitEvent 334 go KeepAlive = awaitEvent
333 go Choke = do 335 go Choke = do
@@ -445,7 +447,9 @@ awaitEvent = {-# SCC awaitEvent #-} awaitMessage >>= go
445-- most likely will be ignored without any network IO. 447-- most likely will be ignored without any network IO.
446-- 448--
447yieldEvent :: Event -> P2P () 449yieldEvent :: Event -> P2P ()
448yieldEvent e = {-# SCC yieldEvent #-} go e 450yieldEvent e = {-# SCC yieldEvent #-} do
451 go e
452 flushPending
449 where 453 where
450 go (Available ixs) = asks swarmSession >>= liftIO . available ixs 454 go (Available ixs) = asks swarmSession >>= liftIO . available ixs
451 go (Want bix) = do 455 go (Want bix) = do
@@ -480,7 +484,7 @@ handleEvent action = awaitEvent >>= action >>= yieldEvent
480 484
481-- | Default P2P action. 485-- | Default P2P action.
482exchange :: Storage -> P2P () 486exchange :: Storage -> P2P ()
483exchange storage = {-# SCC exchange #-} (awaitEvent >>= handler) 487exchange storage = {-# SCC exchange #-} awaitEvent >>= handler
484 where 488 where
485 handler (Available bf) = do 489 handler (Available bf) = do
486 liftIO (print (completeness bf)) 490 liftIO (print (completeness bf))