diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-06-11 05:31:38 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-06-11 05:31:38 +0400 |
commit | d092d9111baa9aa474fba21878c3ffd82ef39451 (patch) | |
tree | 27572fddd0cf126d1b51107f99ebb5b1c8cda662 | |
parent | eba89394fa87256fd2ec71b67e667032e9e765dd (diff) |
~ Merge selection module to bitfield.
-rw-r--r-- | bittorrent.cabal | 1 | ||||
-rw-r--r-- | src/Data/Bitfield.hs | 87 | ||||
-rw-r--r-- | src/Network/BitTorrent/Exchange.hs | 3 | ||||
-rw-r--r-- | src/Network/BitTorrent/Exchange/Selection.hs | 94 |
4 files changed, 87 insertions, 98 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal index b4da98a4..fdcfc6d9 100644 --- a/bittorrent.cabal +++ b/bittorrent.cabal | |||
@@ -44,7 +44,6 @@ library | |||
44 | , Network.BitTorrent.Tracker.Scrape | 44 | , Network.BitTorrent.Tracker.Scrape |
45 | 45 | ||
46 | , Network.BitTorrent.Exchange | 46 | , Network.BitTorrent.Exchange |
47 | , Network.BitTorrent.Exchange.Selection | ||
48 | 47 | ||
49 | other-modules: Network.BitTorrent.Internal | 48 | other-modules: Network.BitTorrent.Internal |
50 | 49 | ||
diff --git a/src/Data/Bitfield.hs b/src/Data/Bitfield.hs index 1ceaf78b..3c278691 100644 --- a/src/Data/Bitfield.hs +++ b/src/Data/Bitfield.hs | |||
@@ -9,6 +9,21 @@ | |||
9 | -- bitfields. Bitfields are used to keep track indices of complete | 9 | -- bitfields. Bitfields are used to keep track indices of complete |
10 | -- pieces either peer have or client have. | 10 | -- pieces either peer have or client have. |
11 | -- | 11 | -- |
12 | -- There are also commonly used piece seletion algorithms | ||
13 | -- which used to find out which one next piece to download. | ||
14 | -- Selectors considered to be used in the following order: | ||
15 | -- | ||
16 | -- * Random first - at the start. | ||
17 | -- | ||
18 | -- * Rarest first selection - performed to avoid situation when | ||
19 | -- rarest piece is unaccessible. | ||
20 | -- | ||
21 | -- * _End game_ seletion - performed after a peer has requested all | ||
22 | -- the subpieces of the content. | ||
23 | -- | ||
24 | -- Note that BitTorrent applies the strict priority policy for | ||
25 | -- /subpiece/ or /blocks/ selection. | ||
26 | -- | ||
12 | {-# LANGUAGE CPP #-} | 27 | {-# LANGUAGE CPP #-} |
13 | {-# LANGUAGE BangPatterns #-} | 28 | {-# LANGUAGE BangPatterns #-} |
14 | {-# LANGUAGE RecordWildCards #-} | 29 | {-# LANGUAGE RecordWildCards #-} |
@@ -34,6 +49,13 @@ module Data.Bitfield | |||
34 | -- * Serialization | 49 | -- * Serialization |
35 | , fromBitmap, toBitmap | 50 | , fromBitmap, toBitmap |
36 | 51 | ||
52 | -- * Selection | ||
53 | , Selector | ||
54 | , selector, strategyClass | ||
55 | |||
56 | , strictFirst, strictLast | ||
57 | , rarestFirst, randomFirst, endGame | ||
58 | |||
37 | #if defined (TESTING) | 59 | #if defined (TESTING) |
38 | -- * Debug | 60 | -- * Debug |
39 | , mkBitfield | 61 | , mkBitfield |
@@ -239,4 +261,67 @@ mkBitfield :: PieceCount -> [PieceIx] -> Bitfield | |||
239 | mkBitfield s ixs = Bitfield { | 261 | mkBitfield s ixs = Bitfield { |
240 | bfSize = s | 262 | bfSize = s |
241 | , bfSet = S.splitGT (-1) $ S.splitLT s $ S.fromList ixs | 263 | , bfSet = S.splitGT (-1) $ S.splitLT s $ S.fromList ixs |
242 | } \ No newline at end of file | 264 | } |
265 | |||
266 | {----------------------------------------------------------------------- | ||
267 | Selection | ||
268 | -----------------------------------------------------------------------} | ||
269 | |||
270 | type Selector = Bitfield -- ^ Indices of client /have/ pieces. | ||
271 | -> Bitfield -- ^ Indices of peer /have/ pieces. | ||
272 | -> [Bitfield] -- ^ Indices of other peers /have/ pieces. | ||
273 | -> Maybe PieceIx -- ^ Zero-based index of piece to request | ||
274 | -- to, if any. | ||
275 | |||
276 | selector :: Selector -- ^ Selector to use at the start. | ||
277 | -> Ratio PieceCount | ||
278 | -> Selector -- ^ Selector to use after the client have | ||
279 | -- the C pieces. | ||
280 | -> Selector -- ^ Selector that changes behaviour based | ||
281 | -- on completeness. | ||
282 | selector start pt ready h a xs = | ||
283 | case strategyClass pt h of | ||
284 | SCBeginning -> start h a xs | ||
285 | SCReady -> ready h a xs | ||
286 | SCEnd -> endGame h a xs | ||
287 | |||
288 | data StartegyClass | ||
289 | = SCBeginning | ||
290 | | SCReady | ||
291 | | SCEnd | ||
292 | deriving (Show, Eq, Ord, Enum, Bounded) | ||
293 | |||
294 | |||
295 | strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass | ||
296 | strategyClass threshold = classify . completeness | ||
297 | where | ||
298 | classify have | ||
299 | | have < threshold = SCBeginning | ||
300 | | have + 1 % numerator have < 1 = SCReady | ||
301 | -- FIXME numerator have is not total count | ||
302 | | otherwise = SCEnd | ||
303 | |||
304 | |||
305 | -- | Select the first available piece. | ||
306 | strictFirst :: Selector | ||
307 | strictFirst h a _ = findMin (difference a h) | ||
308 | |||
309 | -- | Select the last available piece. | ||
310 | strictLast :: Selector | ||
311 | strictLast h a _ = findMax (difference a h) | ||
312 | |||
313 | -- | | ||
314 | rarestFirst :: Selector | ||
315 | rarestFirst h a xs = rarest (map (intersection want) xs) | ||
316 | where | ||
317 | want = difference h a | ||
318 | |||
319 | -- | In average random first is faster than rarest first strategy but | ||
320 | -- only if all pieces are available. | ||
321 | randomFirst :: Selector | ||
322 | randomFirst = do | ||
323 | -- randomIO | ||
324 | error "randomFirst" | ||
325 | |||
326 | endGame :: Selector | ||
327 | endGame = strictLast | ||
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs index b23ca667..dd1f9d0b 100644 --- a/src/Network/BitTorrent/Exchange.hs +++ b/src/Network/BitTorrent/Exchange.hs | |||
@@ -33,12 +33,11 @@ import Data.Serialize as S | |||
33 | 33 | ||
34 | import Network | 34 | import Network |
35 | 35 | ||
36 | import Network.BitTorrent.Exchange.Selection | ||
37 | import Network.BitTorrent.Exchange.Protocol | ||
38 | 36 | ||
39 | import Network.BitTorrent.Internal | 37 | import Network.BitTorrent.Internal |
40 | import Network.BitTorrent.Extension | 38 | import Network.BitTorrent.Extension |
41 | import Network.BitTorrent.Peer | 39 | import Network.BitTorrent.Peer |
40 | import Network.BitTorrent.Exchange.Protocol | ||
42 | import Data.Bitfield as BF | 41 | import Data.Bitfield as BF |
43 | import Data.Torrent | 42 | import Data.Torrent |
44 | 43 | ||
diff --git a/src/Network/BitTorrent/Exchange/Selection.hs b/src/Network/BitTorrent/Exchange/Selection.hs deleted file mode 100644 index ef47876a..00000000 --- a/src/Network/BitTorrent/Exchange/Selection.hs +++ /dev/null | |||
@@ -1,94 +0,0 @@ | |||
1 | -- TODO tests | ||
2 | -- | | ||
3 | -- Copyright : (c) Sam T. 2013 | ||
4 | -- License : MIT | ||
5 | -- Maintainer : pxqr.sta@gmail.com | ||
6 | -- Stability : experimental | ||
7 | -- Portability : portable | ||
8 | -- | ||
9 | -- This module provides commonly used piece seletion algorithms | ||
10 | -- which used to find out which one next piece to download. | ||
11 | -- Selectors considered to be used in the following order: | ||
12 | -- | ||
13 | -- * Random first - at the start. | ||
14 | -- | ||
15 | -- * Rarest first selection - performed to avoid situation when | ||
16 | -- rarest piece is unaccessible. | ||
17 | -- | ||
18 | -- * _End game_ seletion - performed after a peer has requested all | ||
19 | -- the subpieces of the content. | ||
20 | -- | ||
21 | -- Note that BitTorrent applies the strict priority policy for | ||
22 | -- /subpiece/ or /blocks/ selection. | ||
23 | -- | ||
24 | module Network.BitTorrent.Exchange.Selection | ||
25 | ( Selector | ||
26 | |||
27 | -- * Construction | ||
28 | , selector, strategyClass | ||
29 | |||
30 | -- * Strategies | ||
31 | , strictFirst, strictLast | ||
32 | , rarestFirst, randomFirst, endGame | ||
33 | ) where | ||
34 | |||
35 | import Data.Bitfield | ||
36 | import Data.Ratio | ||
37 | import Network.BitTorrent.Exchange.Protocol | ||
38 | |||
39 | |||
40 | type Selector = Bitfield -- ^ Indices of client /have/ pieces. | ||
41 | -> Bitfield -- ^ Indices of peer /have/ pieces. | ||
42 | -> [Bitfield] -- ^ Indices of other peers /have/ pieces. | ||
43 | -> Maybe PieceIx -- ^ Zero-based index of piece to request | ||
44 | -- to, if any. | ||
45 | |||
46 | selector :: Selector -- ^ Selector to use at the start. | ||
47 | -> Ratio PieceCount | ||
48 | -> Selector -- ^ Selector to use after the client have the C pieces. | ||
49 | -> Selector -- ^ Selector that changes behaviour based on completeness. | ||
50 | selector start pt ready h a xs = | ||
51 | case strategyClass pt h of | ||
52 | SCBeginning -> start h a xs | ||
53 | SCReady -> ready h a xs | ||
54 | SCEnd -> endGame h a xs | ||
55 | |||
56 | data StartegyClass | ||
57 | = SCBeginning | ||
58 | | SCReady | ||
59 | | SCEnd | ||
60 | deriving (Show, Eq, Ord, Enum, Bounded) | ||
61 | |||
62 | |||
63 | strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass | ||
64 | strategyClass threshold = classify . completeness | ||
65 | where | ||
66 | classify have | ||
67 | | have < threshold = SCBeginning | ||
68 | | have + 1 % numerator have < 1 = SCReady -- FIXME numerator have is not total count | ||
69 | | otherwise = SCEnd | ||
70 | |||
71 | |||
72 | -- | Select the first available piece. | ||
73 | strictFirst :: Selector | ||
74 | strictFirst h a _ = findMin (difference a h) | ||
75 | |||
76 | -- | Select the last available piece. | ||
77 | strictLast :: Selector | ||
78 | strictLast h a _ = findMax (difference a h) | ||
79 | |||
80 | -- | | ||
81 | rarestFirst :: Selector | ||
82 | rarestFirst h a xs = rarest (map (intersection want) xs) | ||
83 | where | ||
84 | want = difference h a | ||
85 | |||
86 | -- | In average random first is faster than rarest first strategy but | ||
87 | -- only if all pieces are available. | ||
88 | randomFirst :: Selector | ||
89 | randomFirst = do | ||
90 | -- randomIO | ||
91 | error "randomFirst" | ||
92 | |||
93 | endGame :: Selector | ||
94 | endGame = strictLast | ||