diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2014-04-08 04:33:25 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2014-04-08 04:33:25 +0400 |
commit | 8f5fe074ebd3d3ba415dcd107210ae02808fcf11 (patch) | |
tree | 6787f5b7b2f177d61a1a9064c98c444d4aea9f02 /src/Network/BitTorrent | |
parent | a8f849f77dbe8327ec0a035f93ae4921065acbb6 (diff) |
Move selection strategies to bitfield module
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Bitfield.hs | 74 | ||||
-rw-r--r-- | src/Network/BitTorrent/Exchange/Selection.hs | 85 |
2 files changed, 74 insertions, 85 deletions
diff --git a/src/Network/BitTorrent/Exchange/Bitfield.hs b/src/Network/BitTorrent/Exchange/Bitfield.hs index 3f4931f3..eca11d83 100644 --- a/src/Network/BitTorrent/Exchange/Bitfield.hs +++ b/src/Network/BitTorrent/Exchange/Bitfield.hs | |||
@@ -75,6 +75,17 @@ module Network.BitTorrent.Exchange.Bitfield | |||
75 | -- * Serialization | 75 | -- * Serialization |
76 | , fromBitmap | 76 | , fromBitmap |
77 | , toBitmap | 77 | , toBitmap |
78 | |||
79 | -- * Piece selection | ||
80 | , Selector | ||
81 | , selector | ||
82 | , strategyClass | ||
83 | |||
84 | , strictFirst | ||
85 | , strictLast | ||
86 | , rarestFirst | ||
87 | , randomFirst | ||
88 | , endGame | ||
78 | ) where | 89 | ) where |
79 | 90 | ||
80 | import Control.Monad | 91 | import Control.Monad |
@@ -322,3 +333,66 @@ toBitmap Bitfield {..} = {-# SCC toBitmap #-} Lazy.fromChunks [intsetBM, alignme | |||
322 | byteSize = bfSize `div` 8 + if bfSize `mod` 8 == 0 then 0 else 1 | 333 | byteSize = bfSize `div` 8 + if bfSize `mod` 8 == 0 then 0 else 1 |
323 | alignment = B.replicate (byteSize - B.length intsetBM) 0 | 334 | alignment = B.replicate (byteSize - B.length intsetBM) 0 |
324 | intsetBM = S.toByteString bfSet | 335 | intsetBM = S.toByteString bfSet |
336 | |||
337 | {----------------------------------------------------------------------- | ||
338 | -- Piece selection | ||
339 | -----------------------------------------------------------------------} | ||
340 | |||
341 | type Selector = Bitfield -- ^ Indices of client /have/ pieces. | ||
342 | -> Bitfield -- ^ Indices of peer /have/ pieces. | ||
343 | -> [Bitfield] -- ^ Indices of other peers /have/ pieces. | ||
344 | -> Maybe PieceIx -- ^ Zero-based index of piece to request | ||
345 | -- to, if any. | ||
346 | |||
347 | selector :: Selector -- ^ Selector to use at the start. | ||
348 | -> Ratio PieceCount | ||
349 | -> Selector -- ^ Selector to use after the client have | ||
350 | -- the C pieces. | ||
351 | -> Selector -- ^ Selector that changes behaviour based | ||
352 | -- on completeness. | ||
353 | selector start pt ready h a xs = | ||
354 | case strategyClass pt h of | ||
355 | SCBeginning -> start h a xs | ||
356 | SCReady -> ready h a xs | ||
357 | SCEnd -> endGame h a xs | ||
358 | |||
359 | data StartegyClass | ||
360 | = SCBeginning | ||
361 | | SCReady | ||
362 | | SCEnd | ||
363 | deriving (Show, Eq, Ord, Enum, Bounded) | ||
364 | |||
365 | |||
366 | strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass | ||
367 | strategyClass threshold = classify . completeness | ||
368 | where | ||
369 | classify c | ||
370 | | c < threshold = SCBeginning | ||
371 | | c + 1 % numerator c < 1 = SCReady | ||
372 | -- FIXME numerator have is not total count | ||
373 | | otherwise = SCEnd | ||
374 | |||
375 | |||
376 | -- | Select the first available piece. | ||
377 | strictFirst :: Selector | ||
378 | strictFirst h a _ = Just $ findMin (difference a h) | ||
379 | |||
380 | -- | Select the last available piece. | ||
381 | strictLast :: Selector | ||
382 | strictLast h a _ = Just $ findMax (difference a h) | ||
383 | |||
384 | -- | | ||
385 | rarestFirst :: Selector | ||
386 | rarestFirst h a xs = rarest (map (intersection want) xs) | ||
387 | where | ||
388 | want = difference h a | ||
389 | |||
390 | -- | In average random first is faster than rarest first strategy but | ||
391 | -- only if all pieces are available. | ||
392 | randomFirst :: Selector | ||
393 | randomFirst = do | ||
394 | -- randomIO | ||
395 | error "randomFirst" | ||
396 | |||
397 | endGame :: Selector | ||
398 | endGame = strictLast | ||
diff --git a/src/Network/BitTorrent/Exchange/Selection.hs b/src/Network/BitTorrent/Exchange/Selection.hs deleted file mode 100644 index 3701450b..00000000 --- a/src/Network/BitTorrent/Exchange/Selection.hs +++ /dev/null | |||
@@ -1,85 +0,0 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- Piece selection algorithms. | ||
9 | -- | ||
10 | module Network.BitTorrent.Exchange.Selection | ||
11 | ( -- * Selection | ||
12 | Selector | ||
13 | , selector | ||
14 | , strategyClass | ||
15 | |||
16 | , strictFirst | ||
17 | , strictLast | ||
18 | , rarestFirst | ||
19 | , randomFirst | ||
20 | , endGame | ||
21 | ) where | ||
22 | |||
23 | import Data.Ratio | ||
24 | |||
25 | import Network.BitTorrent.Exchange.Bitfield | ||
26 | |||
27 | |||
28 | type Selector = Bitfield -- ^ Indices of client /have/ pieces. | ||
29 | -> Bitfield -- ^ Indices of peer /have/ pieces. | ||
30 | -> [Bitfield] -- ^ Indices of other peers /have/ pieces. | ||
31 | -> Maybe PieceIx -- ^ Zero-based index of piece to request | ||
32 | -- to, if any. | ||
33 | |||
34 | selector :: Selector -- ^ Selector to use at the start. | ||
35 | -> Ratio PieceCount | ||
36 | -> Selector -- ^ Selector to use after the client have | ||
37 | -- the C pieces. | ||
38 | -> Selector -- ^ Selector that changes behaviour based | ||
39 | -- on completeness. | ||
40 | selector start pt ready h a xs = | ||
41 | case strategyClass pt h of | ||
42 | SCBeginning -> start h a xs | ||
43 | SCReady -> ready h a xs | ||
44 | SCEnd -> endGame h a xs | ||
45 | |||
46 | data StartegyClass | ||
47 | = SCBeginning | ||
48 | | SCReady | ||
49 | | SCEnd | ||
50 | deriving (Show, Eq, Ord, Enum, Bounded) | ||
51 | |||
52 | |||
53 | strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass | ||
54 | strategyClass threshold = classify . completeness | ||
55 | where | ||
56 | classify c | ||
57 | | c < threshold = SCBeginning | ||
58 | | c + 1 % numerator c < 1 = SCReady | ||
59 | -- FIXME numerator have is not total count | ||
60 | | otherwise = SCEnd | ||
61 | |||
62 | |||
63 | -- | Select the first available piece. | ||
64 | strictFirst :: Selector | ||
65 | strictFirst h a _ = Just $ findMin (difference a h) | ||
66 | |||
67 | -- | Select the last available piece. | ||
68 | strictLast :: Selector | ||
69 | strictLast h a _ = Just $ findMax (difference a h) | ||
70 | |||
71 | -- | | ||
72 | rarestFirst :: Selector | ||
73 | rarestFirst h a xs = rarest (map (intersection want) xs) | ||
74 | where | ||
75 | want = difference h a | ||
76 | |||
77 | -- | In average random first is faster than rarest first strategy but | ||
78 | -- only if all pieces are available. | ||
79 | randomFirst :: Selector | ||
80 | randomFirst = do | ||
81 | -- randomIO | ||
82 | error "randomFirst" | ||
83 | |||
84 | endGame :: Selector | ||
85 | endGame = strictLast | ||