diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-06-29 23:22:25 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-06-29 23:22:25 +0400 |
commit | f556bf196bf07308f024cc43c1a51dfd4c21188c (patch) | |
tree | 228de5a632e8b758d507df7ddabf7fd85d113694 /src/Network/BitTorrent/Exchange.hs | |
parent | d4ada1b8a392d67f2835935084c5f0f3ecef2ab5 (diff) |
+ Scetch basic broadcasting.
Diffstat (limited to 'src/Network/BitTorrent/Exchange.hs')
-rw-r--r-- | src/Network/BitTorrent/Exchange.hs | 18 |
1 files changed, 9 insertions, 9 deletions
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs index 3d05f7fc..505360a4 100644 --- a/src/Network/BitTorrent/Exchange.hs +++ b/src/Network/BitTorrent/Exchange.hs | |||
@@ -109,15 +109,18 @@ runPeerWire sock p2p = | |||
109 | sinkSocket sock | 109 | sinkSocket sock |
110 | 110 | ||
111 | awaitMessage :: P2P Message | 111 | awaitMessage :: P2P Message |
112 | awaitMessage = P2P (ReaderT (const go)) | 112 | awaitMessage = P2P $ ReaderT $ const go |
113 | where | 113 | where |
114 | go = await >>= maybe (monadThrow PeerDisconnected) return | 114 | go = await >>= maybe (monadThrow PeerDisconnected) return |
115 | {-# INLINE awaitMessage #-} | 115 | {-# INLINE awaitMessage #-} |
116 | 116 | ||
117 | yieldMessage :: Message -> P2P () | 117 | yieldMessage :: Message -> P2P () |
118 | yieldMessage msg = P2P $ ReaderT $ \se -> C.yield msg | 118 | yieldMessage msg = P2P $ ReaderT $ const (C.yield msg) |
119 | {-# INLINE yieldMessage #-} | 119 | {-# INLINE yieldMessage #-} |
120 | 120 | ||
121 | flushPending :: P2P () | ||
122 | flushPending = ask >>= liftIO . getPending >>= mapM_ yieldMessage | ||
123 | |||
121 | {----------------------------------------------------------------------- | 124 | {----------------------------------------------------------------------- |
122 | P2P monad | 125 | P2P monad |
123 | -----------------------------------------------------------------------} | 126 | -----------------------------------------------------------------------} |
@@ -313,7 +316,9 @@ data Event | |||
313 | -- forall (Fragment block). isPiece block == True | 316 | -- forall (Fragment block). isPiece block == True |
314 | -- | 317 | -- |
315 | awaitEvent :: P2P Event | 318 | awaitEvent :: P2P Event |
316 | awaitEvent = awaitMessage >>= go | 319 | awaitEvent = do |
320 | |||
321 | awaitMessage >>= go | ||
317 | where | 322 | where |
318 | go KeepAlive = awaitEvent | 323 | go KeepAlive = awaitEvent |
319 | go Choke = do | 324 | go Choke = do |
@@ -432,7 +437,7 @@ awaitEvent = awaitMessage >>= go | |||
432 | -- most likely will be ignored without any network IO. | 437 | -- most likely will be ignored without any network IO. |
433 | -- | 438 | -- |
434 | yieldEvent :: Event -> P2P () | 439 | yieldEvent :: Event -> P2P () |
435 | yieldEvent (Available _ ) = undefined | 440 | yieldEvent (Available ixs) = asks swarmSession >>= liftIO . available ixs |
436 | yieldEvent (Want bix) = do | 441 | yieldEvent (Want bix) = do |
437 | offer <- peerOffer | 442 | offer <- peerOffer |
438 | if ixPiece bix `BF.member` offer | 443 | if ixPiece bix `BF.member` offer |
@@ -449,10 +454,5 @@ yieldEvent (Fragment blk) = do | |||
449 | handleEvent :: (Event -> P2P Event) -> P2P () | 454 | handleEvent :: (Event -> P2P Event) -> P2P () |
450 | handleEvent action = awaitEvent >>= action >>= yieldEvent | 455 | handleEvent action = awaitEvent >>= action >>= yieldEvent |
451 | 456 | ||
452 | --flushBroadcast :: P2P () | ||
453 | --flushBroadcast = nextBroadcast >>= maybe (return ()) go | ||
454 | -- where | ||
455 | -- go = undefined | ||
456 | |||
457 | checkPiece :: PieceLIx -> {-ByteString -> -} P2P Bool | 457 | checkPiece :: PieceLIx -> {-ByteString -> -} P2P Bool |
458 | checkPiece = undefined | 458 | checkPiece = undefined |