summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Exchange.hs')
-rw-r--r--src/Network/BitTorrent/Exchange.hs118
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 #-}
13module Network.BitTorrent.Exchange 47module 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
31import Control.Applicative 70import Control.Applicative
@@ -54,11 +93,6 @@ import Network.BitTorrent.Exchange.Protocol
54import Data.Bitfield as BF 93import Data.Bitfield as BF
55 94
56 95
57data 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--
282data 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--
251awaitEvent :: P2P Event 314awaitEvent :: P2P Event
252awaitEvent = awaitMessage >>= go 315awaitEvent = 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--
357yieldEvent :: Event -> P2P () 433yieldEvent :: Event -> P2P ()
358yieldEvent (Available _ ) = undefined 434yieldEvent (Available _ ) = undefined
359yieldEvent (Want bix) = do 435yieldEvent (Want bix) = do