diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Assembler.hs | 95 |
1 files changed, 39 insertions, 56 deletions
diff --git a/src/Network/BitTorrent/Exchange/Assembler.hs b/src/Network/BitTorrent/Exchange/Assembler.hs index a490d2dc..b1a80c9b 100644 --- a/src/Network/BitTorrent/Exchange/Assembler.hs +++ b/src/Network/BitTorrent/Exchange/Assembler.hs | |||
@@ -1,82 +1,65 @@ | |||
1 | module Network.BitTorrent.Exchange.Assembler | 1 | module Network.BitTorrent.Exchange.Assembler |
2 | ( Assembler | 2 | ( Assembler |
3 | , insert | ||
4 | |||
5 | -- * Query | ||
6 | , pendingPieces | ||
7 | , completeBlocks | ||
8 | , incompleteBlocks | ||
9 | ) where | 3 | ) where |
10 | 4 | ||
5 | import Control.Applicative | ||
11 | import Data.IntMap.Strict as IM | 6 | import Data.IntMap.Strict as IM |
7 | import Data.List as L | ||
12 | import Data.Maybe | 8 | import Data.Maybe |
9 | |||
13 | import Data.Torrent.Piece | 10 | import Data.Torrent.Piece |
14 | import Data.Torrent.Block | 11 | import Network.BitTorrent.Exchange.Block |
12 | |||
15 | 13 | ||
16 | type PieceMap = IntMap | 14 | type PieceMap = IntMap |
17 | 15 | ||
18 | -- TODO move to Data.Torrent.Piece ? | ||
19 | -- assembler is also a block selector? | ||
20 | data Assembler a = Assembler | 16 | data Assembler a = Assembler |
21 | { piecePending :: PieceMap [Block a] | 17 | { inflightSet :: PieceMap [BlockIx] |
18 | , piecePending :: PieceMap [Block a] | ||
22 | , pieceInfo :: PieceInfo | 19 | , pieceInfo :: PieceInfo |
23 | } | 20 | } |
24 | 21 | ||
25 | |||
26 | data Result a | 22 | data Result a |
27 | = Assembled (Piece a) | 23 | = Assembled (Piece a) |
28 | | Failed PieceIx | 24 | | Corrupted PieceIx |
25 | | NotRequested PieceIx | ||
26 | | Overlapped BlockIx | ||
29 | 27 | ||
30 | -- | You should check if a returned by peer block is actually have | 28 | empty :: PieceInfo -> Assembler a |
31 | -- been requested and in-flight. This is needed to avoid "I send | 29 | empty = Assembler IM.empty IM.empty |
32 | -- random corrupted block" attacks. | ||
33 | insert :: Block a -> Assembler a -> (Assembler a, Maybe (Result a)) | ||
34 | insert Block {..} Assembler {..} = undefined | ||
35 | -- updateWithKey bixPiece | ||
36 | 30 | ||
37 | pendingPieces :: Assembler a -> [PieceIx] | 31 | inflightPieces :: Assembler a -> [PieceIx] |
38 | pendingPieces Assembler {..} = keys piecePending | 32 | inflightPieces Assembler {..} = keys piecePending |
39 | 33 | ||
40 | completeBlocks :: Assembler a -> PieceIx -> [Block a] | 34 | completeBlocks :: PieceIx -> Assembler a -> [Block a] |
41 | completeBlocks Assembler {..} pix = fromMaybe [] $ IM.lookup pix piecePending | 35 | completeBlocks pix Assembler {..} = fromMaybe [] $ IM.lookup pix piecePending |
42 | 36 | ||
43 | incompleteBlocks :: Assembler a -> PieceIx -> [BlockIx] | 37 | incompleteBlocks :: PieceIx -> Assembler a -> [BlockIx] |
44 | incompleteBlocks = undefined | 38 | incompleteBlocks = undefined |
45 | 39 | ||
46 | -- TODO merge BlockSelector with Assembler? | 40 | nextBlock :: Assembler a -> Maybe (Assembler a, BlockIx) |
47 | data BlockSelector a = BlockSelector | 41 | nextBlock Assembler {..} = undefined |
48 | { assembler :: Assembler a -- we do not select already transfered blocks | ||
49 | , inflightSet :: Set BlockIx -- we do not select blocks in flight | ||
50 | } | ||
51 | |||
52 | insert :: BlockSelector -> (BlockSelector a, Maybe (Result a)) | ||
53 | insert = undefined | ||
54 | |||
55 | 42 | ||
56 | data StorageAdapter = StorageAdapter | 43 | allowPiece :: PieceIx -> Assembler a -> Assembler a |
57 | { bitfield :: Bitfield | 44 | allowPiece = undefined |
58 | , requestQ :: Queue PieceIx | ||
59 | } | ||
60 | -- we do select 'incompleteBlocks' that is not in flight | ||
61 | 45 | ||
62 | --assembler :: Assembler -> Conduit (Block a) (Result a) | 46 | insert' :: Block a -> [Block a] -> [Block a] |
63 | --assembler = undefined | 47 | insert' a (x : xs) = undefined |
64 | 48 | ||
65 | -- by priority | 49 | insertBlock :: Block a -> [Block a] -> Either [Block a] (Piece a) |
66 | -- foreign request queue (max queue size) | 50 | insertBlock = undefined |
67 | -- assembler block information (max queue size) | ||
68 | -- selection strategies (bitfields) | ||
69 | 51 | ||
70 | -- when in flight queue is full we do not use selector | 52 | inserta :: Block a -> PieceMap [Block a] -> (PieceMap [Block a], Maybe (Piece a)) |
71 | -- in flight queue information (max queue size) | 53 | inserta = undefined |
72 | |||
73 | -- piece select is used when | ||
74 | data PieceSelector = Selector | ||
75 | { forceQueue :: TVar (Queue PieceIx) | ||
76 | , forcePendingQueue :: TVar (Queue PieceIx) | ||
77 | , assembler :: TVar Assembler | ||
78 | , strategy :: Bool | ||
79 | } | ||
80 | 54 | ||
81 | select :: Selector -> (Selector, PieceIx) | 55 | -- | You should check if a returned by peer block is actually have |
82 | select = undefined \ No newline at end of file | 56 | -- been requested and in-flight. This is needed to avoid "I send |
57 | -- random corrupted block" attacks. | ||
58 | insert :: Block a -> Assembler a -> (Assembler a, Maybe (Result a)) | ||
59 | insert blk @ Block {..} a @ Assembler {..} | ||
60 | = let (pending, mpiece) = inserta blk piecePending | ||
61 | in (Assembler inflightSet pending pieceInfo, f <$> mpiece) | ||
62 | where | ||
63 | f p = undefined | ||
64 | -- | checkPieceLazy pieceInfo p = Assembled p | ||
65 | -- | otherwise = Corrupted ixPiece | ||