diff options
-rw-r--r-- | src/Network/BitTorrent/Exchange.hs | 118 |
1 files changed, 97 insertions, 21 deletions
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs index 75bd4bfd..2eedc6bd 100644 --- a/src/Network/BitTorrent/Exchange.hs +++ b/src/Network/BitTorrent/Exchange.hs | |||
@@ -1,3 +1,16 @@ | |||
1 | {- TODO turn awaitEvent and yieldEvent to sourcePeer and sinkPeer | ||
2 | |||
3 | sourceSocket sock $= | ||
4 | conduitGet S.get $= | ||
5 | sourcePeer $= | ||
6 | p2p $= | ||
7 | sinkPeer $= | ||
8 | conduitPut S.put $$ | ||
9 | sinkSocket sock | ||
10 | |||
11 | measure performance | ||
12 | -} | ||
13 | |||
1 | -- | | 14 | -- | |
2 | -- Copyright : (c) Sam T. 2013 | 15 | -- Copyright : (c) Sam T. 2013 |
3 | -- License : MIT | 16 | -- License : MIT |
@@ -5,27 +18,53 @@ | |||
5 | -- Stability : experimental | 18 | -- Stability : experimental |
6 | -- Portability : portable | 19 | -- Portability : portable |
7 | -- | 20 | -- |
21 | -- This module provides P2P communication and aims to hide the | ||
22 | -- following stuff under the hood: | ||
23 | -- | ||
24 | -- * TODO; | ||
25 | -- | ||
26 | -- * /keep alives/ -- ; | ||
27 | -- | ||
28 | -- * /choking mechanism/ -- is used ; | ||
29 | -- | ||
30 | -- * /message broadcasting/ -- ; | ||
31 | -- | ||
32 | -- * /message filtering/ -- due to network latency and concurrency | ||
33 | -- some arriving messages might not make sense in the current | ||
34 | -- session context; | ||
35 | -- | ||
36 | -- * /scatter\/gather pieces/ -- ; | ||
37 | -- | ||
38 | -- * /various P2P protocol extensions/ -- . | ||
39 | -- | ||
40 | -- Finally we get a simple event-based communication model. | ||
41 | -- | ||
8 | {-# LANGUAGE OverloadedStrings #-} | 42 | {-# LANGUAGE OverloadedStrings #-} |
9 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 43 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
10 | {-# LANGUAGE MultiParamTypeClasses #-} | 44 | {-# LANGUAGE MultiParamTypeClasses #-} |
11 | {-# LANGUAGE RecordWildCards #-} | 45 | {-# LANGUAGE RecordWildCards #-} |
12 | {-# LANGUAGE BangPatterns #-} | 46 | {-# LANGUAGE BangPatterns #-} |
13 | module Network.BitTorrent.Exchange | 47 | module Network.BitTorrent.Exchange |
14 | ( -- * Block | 48 | ( P2P |
15 | Block(..), BlockIx(..) | 49 | , runP2P |
16 | 50 | , spawnP2P | |
17 | -- * Event | ||
18 | , Event(..) | ||
19 | |||
20 | , P2P | ||
21 | , runP2P, spawnP2P | ||
22 | , awaitEvent, yieldEvent | ||
23 | |||
24 | , disconnect, protocolError | ||
25 | 51 | ||
52 | -- * Query | ||
26 | , getHaveCount | 53 | , getHaveCount |
27 | , getWantCount | 54 | , getWantCount |
28 | , getPieceCount | 55 | , getPieceCount |
56 | |||
57 | -- * Events | ||
58 | , Event(..) | ||
59 | , awaitEvent | ||
60 | , yieldEvent | ||
61 | |||
62 | -- * Exceptions | ||
63 | , disconnect | ||
64 | , protocolError | ||
65 | |||
66 | -- * Block | ||
67 | , Block(..), BlockIx(..) | ||
29 | ) where | 68 | ) where |
30 | 69 | ||
31 | import Control.Applicative | 70 | import Control.Applicative |
@@ -54,11 +93,6 @@ import Network.BitTorrent.Exchange.Protocol | |||
54 | import Data.Bitfield as BF | 93 | import Data.Bitfield as BF |
55 | 94 | ||
56 | 95 | ||
57 | data Event = Available Bitfield | ||
58 | | Want BlockIx | ||
59 | | Fragment Block | ||
60 | deriving Show | ||
61 | |||
62 | {----------------------------------------------------------------------- | 96 | {----------------------------------------------------------------------- |
63 | Peer wire | 97 | Peer wire |
64 | -----------------------------------------------------------------------} | 98 | -----------------------------------------------------------------------} |
@@ -234,7 +268,34 @@ requireExtension required = do | |||
234 | Exchange | 268 | Exchange |
235 | -----------------------------------------------------------------------} | 269 | -----------------------------------------------------------------------} |
236 | 270 | ||
237 | -- | | 271 | |
272 | -- | The 'Event' occur when either client or a peer change their | ||
273 | -- state. 'Event' are similar to 'Message' but differ in. We could | ||
274 | -- both wait for an event or raise an event using the 'awaitEvent' and | ||
275 | -- 'yieldEvent' functions respectively. | ||
276 | -- | ||
277 | -- | ||
278 | -- 'awaitEvent'\/'yieldEvent' properties: | ||
279 | -- | ||
280 | -- * between any await or yield state of the (another)peer could not change. | ||
281 | -- | ||
282 | data Event | ||
283 | -- | Generalize 'Bitfield', 'Have', 'HaveAll', 'HaveNone', | ||
284 | -- 'SuggestPiece', 'AllowedFast' messages. | ||
285 | = Available Bitfield | ||
286 | |||
287 | -- | Generalize 'Request' and 'Interested' messages. | ||
288 | | Want BlockIx | ||
289 | |||
290 | -- | Generalize 'Piece' and 'Unchoke' messages. | ||
291 | | Fragment Block | ||
292 | deriving Show | ||
293 | |||
294 | |||
295 | -- | You could think of 'awaitEvent' as wait until something interesting occur. | ||
296 | -- | ||
297 | -- The following table shows which events may occur: | ||
298 | -- | ||
238 | -- > +----------+---------+ | 299 | -- > +----------+---------+ |
239 | -- > | Leacher | Seeder | | 300 | -- > | Leacher | Seeder | |
240 | -- > |----------+---------+ | 301 | -- > |----------+---------+ |
@@ -243,10 +304,12 @@ requireExtension required = do | |||
243 | -- > | Fragment | | | 304 | -- > | Fragment | | |
244 | -- > +----------+---------+ | 305 | -- > +----------+---------+ |
245 | -- | 306 | -- |
307 | -- The reason is that seeder is not interested in any piece, and | ||
308 | -- both available or fragment events doesn't make sense in this context. | ||
246 | -- | 309 | -- |
247 | -- properties: | 310 | -- Some properties: |
248 | -- | 311 | -- |
249 | -- forall (Fragment block). isPiece block == True | 312 | -- forall (Fragment block). isPiece block == True |
250 | -- | 313 | -- |
251 | awaitEvent :: P2P Event | 314 | awaitEvent :: P2P Event |
252 | awaitEvent = awaitMessage >>= go | 315 | awaitEvent = awaitMessage >>= go |
@@ -341,9 +404,12 @@ awaitEvent = awaitMessage >>= go | |||
341 | requireExtension ExtFast | 404 | requireExtension ExtFast |
342 | awaitEvent | 405 | awaitEvent |
343 | 406 | ||
344 | -- TODO minimized number of peerOffer calls | 407 | -- TODO minimize number of peerOffer calls |
345 | 408 | ||
346 | -- | | 409 | -- | Raise an events which may occur |
410 | -- | ||
411 | -- This table shows when a some specific events /makes sense/ to yield: | ||
412 | -- | ||
347 | -- @ | 413 | -- @ |
348 | -- +----------+---------+ | 414 | -- +----------+---------+ |
349 | -- | Leacher | Seeder | | 415 | -- | Leacher | Seeder | |
@@ -354,6 +420,16 @@ awaitEvent = awaitMessage >>= go | |||
354 | -- +----------+---------+ | 420 | -- +----------+---------+ |
355 | -- @ | 421 | -- @ |
356 | -- | 422 | -- |
423 | -- Seeder should not yield: | ||
424 | -- | ||
425 | -- * Available -- seeder could not store anything new. | ||
426 | -- | ||
427 | -- * Want -- seeder alread have everything, no reason to want. | ||
428 | -- | ||
429 | -- Hovewer, it's okay to not obey the rules -- if we are yield some | ||
430 | -- event which doesn't /makes sense/ in the current context then it | ||
431 | -- most likely will be ignored without any network IO. | ||
432 | -- | ||
357 | yieldEvent :: Event -> P2P () | 433 | yieldEvent :: Event -> P2P () |
358 | yieldEvent (Available _ ) = undefined | 434 | yieldEvent (Available _ ) = undefined |
359 | yieldEvent (Want bix) = do | 435 | yieldEvent (Want bix) = do |