summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bittorrent.cabal1
-rw-r--r--src/Network/BitTorrent/Exchange/Bitfield.hs74
-rw-r--r--src/Network/BitTorrent/Exchange/Selection.hs85
3 files changed, 74 insertions, 86 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal
index cac6531f..292680dd 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -70,7 +70,6 @@ library
70 Network.BitTorrent.Exchange.Connection 70 Network.BitTorrent.Exchange.Connection
71 Network.BitTorrent.Exchange.Manager 71 Network.BitTorrent.Exchange.Manager
72 Network.BitTorrent.Exchange.Message 72 Network.BitTorrent.Exchange.Message
73 Network.BitTorrent.Exchange.Selection
74 Network.BitTorrent.Exchange.Session 73 Network.BitTorrent.Exchange.Session
75 Network.BitTorrent.Exchange.Session.Metadata 74 Network.BitTorrent.Exchange.Session.Metadata
76 Network.BitTorrent.Exchange.Session.Status 75 Network.BitTorrent.Exchange.Session.Status
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
80import Control.Monad 91import 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
341type 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
347selector :: 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.
353selector 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
359data StartegyClass
360 = SCBeginning
361 | SCReady
362 | SCEnd
363 deriving (Show, Eq, Ord, Enum, Bounded)
364
365
366strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass
367strategyClass 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.
377strictFirst :: Selector
378strictFirst h a _ = Just $ findMin (difference a h)
379
380-- | Select the last available piece.
381strictLast :: Selector
382strictLast h a _ = Just $ findMax (difference a h)
383
384-- |
385rarestFirst :: Selector
386rarestFirst 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.
392randomFirst :: Selector
393randomFirst = do
394-- randomIO
395 error "randomFirst"
396
397endGame :: Selector
398endGame = 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--
10module 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
23import Data.Ratio
24
25import Network.BitTorrent.Exchange.Bitfield
26
27
28type 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
34selector :: 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.
40selector 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
46data StartegyClass
47 = SCBeginning
48 | SCReady
49 | SCEnd
50 deriving (Show, Eq, Ord, Enum, Bounded)
51
52
53strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass
54strategyClass 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.
64strictFirst :: Selector
65strictFirst h a _ = Just $ findMin (difference a h)
66
67-- | Select the last available piece.
68strictLast :: Selector
69strictLast h a _ = Just $ findMax (difference a h)
70
71-- |
72rarestFirst :: Selector
73rarestFirst 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.
79randomFirst :: Selector
80randomFirst = do
81-- randomIO
82 error "randomFirst"
83
84endGame :: Selector
85endGame = strictLast