diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/BitTorrent/Exchange.hs | 18 |
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 () | |||
121 | yieldMessage msg = P2P $ ReaderT $ const $ {-# SCC yieldMessage #-} C.yield msg | 121 | yieldMessage msg = P2P $ ReaderT $ const $ {-# SCC yieldMessage #-} C.yield msg |
122 | {-# INLINE yieldMessage #-} | 122 | {-# INLINE yieldMessage #-} |
123 | 123 | ||
124 | -- TODO send vectored | ||
124 | flushPending :: P2P () | 125 | flushPending :: P2P () |
125 | flushPending = {-# SCC flushPending #-} do | 126 | flushPending = {-# 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 | -- |
329 | awaitEvent :: P2P Event | 329 | awaitEvent :: P2P Event |
330 | awaitEvent = {-# SCC awaitEvent #-} awaitMessage >>= go | 330 | awaitEvent = {-# 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 | -- |
447 | yieldEvent :: Event -> P2P () | 449 | yieldEvent :: Event -> P2P () |
448 | yieldEvent e = {-# SCC yieldEvent #-} go e | 450 | yieldEvent 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. |
482 | exchange :: Storage -> P2P () | 486 | exchange :: Storage -> P2P () |
483 | exchange storage = {-# SCC exchange #-} (awaitEvent >>= handler) | 487 | exchange 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)) |