summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSam T <pxqr.sta@gmail.com>2013-06-11 05:31:38 +0400
committerSam T <pxqr.sta@gmail.com>2013-06-11 05:31:38 +0400
commitd092d9111baa9aa474fba21878c3ffd82ef39451 (patch)
tree27572fddd0cf126d1b51107f99ebb5b1c8cda662
parenteba89394fa87256fd2ec71b67e667032e9e765dd (diff)
~ Merge selection module to bitfield.
-rw-r--r--bittorrent.cabal1
-rw-r--r--src/Data/Bitfield.hs87
-rw-r--r--src/Network/BitTorrent/Exchange.hs3
-rw-r--r--src/Network/BitTorrent/Exchange/Selection.hs94
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
239mkBitfield s ixs = Bitfield { 261mkBitfield 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
270type 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
276selector :: 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.
282selector 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
288data StartegyClass
289 = SCBeginning
290 | SCReady
291 | SCEnd
292 deriving (Show, Eq, Ord, Enum, Bounded)
293
294
295strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass
296strategyClass 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.
306strictFirst :: Selector
307strictFirst h a _ = findMin (difference a h)
308
309-- | Select the last available piece.
310strictLast :: Selector
311strictLast h a _ = findMax (difference a h)
312
313-- |
314rarestFirst :: Selector
315rarestFirst 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.
321randomFirst :: Selector
322randomFirst = do
323-- randomIO
324 error "randomFirst"
325
326endGame :: Selector
327endGame = 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
34import Network 34import Network
35 35
36import Network.BitTorrent.Exchange.Selection
37import Network.BitTorrent.Exchange.Protocol
38 36
39import Network.BitTorrent.Internal 37import Network.BitTorrent.Internal
40import Network.BitTorrent.Extension 38import Network.BitTorrent.Extension
41import Network.BitTorrent.Peer 39import Network.BitTorrent.Peer
40import Network.BitTorrent.Exchange.Protocol
42import Data.Bitfield as BF 41import Data.Bitfield as BF
43import Data.Torrent 42import 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--
24module 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
35import Data.Bitfield
36import Data.Ratio
37import Network.BitTorrent.Exchange.Protocol
38
39
40type 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
46selector :: 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.
50selector 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
56data StartegyClass
57 = SCBeginning
58 | SCReady
59 | SCEnd
60 deriving (Show, Eq, Ord, Enum, Bounded)
61
62
63strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass
64strategyClass 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.
73strictFirst :: Selector
74strictFirst h a _ = findMin (difference a h)
75
76-- | Select the last available piece.
77strictLast :: Selector
78strictLast h a _ = findMax (difference a h)
79
80-- |
81rarestFirst :: Selector
82rarestFirst 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.
88randomFirst :: Selector
89randomFirst = do
90-- randomIO
91 error "randomFirst"
92
93endGame :: Selector
94endGame = strictLast