diff options
Diffstat (limited to 'src/Network/BitTorrent/PeerWire')
-rw-r--r-- | src/Network/BitTorrent/PeerWire/Bitfield.hs | 88 |
1 files changed, 82 insertions, 6 deletions
diff --git a/src/Network/BitTorrent/PeerWire/Bitfield.hs b/src/Network/BitTorrent/PeerWire/Bitfield.hs index c9357a25..5cbd4e86 100644 --- a/src/Network/BitTorrent/PeerWire/Bitfield.hs +++ b/src/Network/BitTorrent/PeerWire/Bitfield.hs | |||
@@ -12,23 +12,95 @@ | |||
12 | -- | 12 | -- |
13 | module Network.BitTorrent.PeerWire.Bitfield | 13 | module Network.BitTorrent.PeerWire.Bitfield |
14 | ( Bitfield(..) | 14 | ( Bitfield(..) |
15 | |||
16 | -- * Construction | ||
17 | , empty, full | ||
18 | , fromByteString, toByteString | ||
19 | |||
20 | -- * Query | ||
21 | , findMin, findMax, difference | ||
22 | |||
23 | -- * Serialization | ||
15 | , getBitfield, putBitfield, bitfieldByteCount | 24 | , getBitfield, putBitfield, bitfieldByteCount |
16 | ) where | 25 | ) where |
17 | 26 | ||
18 | import Control.Applicative | 27 | import Control.Applicative hiding (empty) |
28 | import Data.Array.Unboxed | ||
29 | import Data.Bits | ||
19 | import Data.ByteString (ByteString) | 30 | import Data.ByteString (ByteString) |
20 | import qualified Data.ByteString as B | 31 | import qualified Data.ByteString as B |
21 | 32 | import Data.List as L | |
33 | import Data.Maybe | ||
22 | import Data.Serialize | 34 | import Data.Serialize |
35 | import Data.Word | ||
23 | 36 | ||
37 | import Network.BitTorrent.PeerWire.Block | ||
38 | import Data.Torrent | ||
24 | 39 | ||
25 | newtype Bitfield = MkBitfield { | 40 | newtype Bitfield = MkBitfield { |
26 | bfBits :: ByteString | 41 | bfBits :: ByteString |
42 | -- , bfSize :: Int | ||
27 | } deriving (Show, Eq, Ord) | 43 | } deriving (Show, Eq, Ord) |
28 | 44 | ||
29 | bitfieldByteCount :: Bitfield -> Int | 45 | |
30 | bitfieldByteCount = B.length . bfBits | 46 | empty :: Int -> Bitfield |
31 | {-# INLINE bitfieldByteCount #-} | 47 | empty n = MkBitfield $ B.replicate (sizeInBase n 8) 0 |
48 | |||
49 | full :: Int -> Bitfield | ||
50 | full n = MkBitfield $ B.replicate (sizeInBase n 8) (complement 0) | ||
51 | |||
52 | fromByteString :: ByteString -> Bitfield | ||
53 | fromByteString = MkBitfield | ||
54 | {-# INLINE fromByteString #-} | ||
55 | |||
56 | toByteString :: Bitfield -> ByteString | ||
57 | toByteString = bfBits | ||
58 | {-# INLINE toByteString #-} | ||
59 | |||
60 | combine :: [ByteString] -> Maybe ByteString | ||
61 | combine [] = Nothing | ||
62 | combine as@(a : _) = return $ foldr andBS empty as | ||
63 | where | ||
64 | andBS x acc = B.pack (B.zipWith (.&.) x acc) | ||
65 | empty = B.replicate (B.length a) 0 | ||
66 | |||
67 | frequencies :: [Bitfield] -> UArray PieceIx Int | ||
68 | frequencies = undefined | ||
69 | |||
70 | diffWord8 :: Word8 -> Word8 -> Word8 | ||
71 | diffWord8 a b = a .&. (a `xor` b) | ||
72 | {-# INLINE diffWord8 #-} | ||
73 | |||
74 | difference :: Bitfield -> Bitfield -> Bitfield | ||
75 | difference a b = MkBitfield $ B.pack $ B.zipWith diffWord8 (bfBits a) (bfBits b) | ||
76 | {-# INLINE difference #-} | ||
77 | |||
78 | difference' :: ByteString -> ByteString -> ByteString | ||
79 | difference' a b = undefined | ||
80 | where | ||
81 | go i = undefined | ||
82 | |||
83 | |||
84 | -- TODO: bit tricks | ||
85 | findMinWord8 :: Word8 -> Maybe Int | ||
86 | findMinWord8 b = L.findIndex (testBit b) [0..bitSize (undefined :: Word8) - 1] | ||
87 | {-# INLINE findMinWord8 #-} | ||
88 | |||
89 | -- | Get min index of piece that the peer have. | ||
90 | findMin :: Bitfield -> Maybe PieceIx | ||
91 | findMin (MkBitfield b) = do | ||
92 | byteIx <- B.findIndex (0 /=) b | ||
93 | bitIx <- findMinWord8 (B.index b byteIx) | ||
94 | return $ byteIx * bitSize (undefined :: Word8) + bitIx | ||
95 | {-# INLINE findMin #-} | ||
96 | |||
97 | findMaxWord8 :: Word8 -> Maybe Int | ||
98 | findMaxWord8 = error "bitfield: findMaxWord8" | ||
99 | |||
100 | findMax :: Bitfield -> Maybe PieceIx | ||
101 | findMax = error "bitfield: findMax" | ||
102 | {-# INLINE findMax #-} | ||
103 | |||
32 | 104 | ||
33 | getBitfield :: Int -> Get Bitfield | 105 | getBitfield :: Int -> Get Bitfield |
34 | getBitfield n = MkBitfield <$> getBytes n | 106 | getBitfield n = MkBitfield <$> getBytes n |
@@ -36,4 +108,8 @@ getBitfield n = MkBitfield <$> getBytes n | |||
36 | 108 | ||
37 | putBitfield :: Bitfield -> Put | 109 | putBitfield :: Bitfield -> Put |
38 | putBitfield = putByteString . bfBits | 110 | putBitfield = putByteString . bfBits |
39 | {-# INLINE putBitfield #-} \ No newline at end of file | 111 | {-# INLINE putBitfield #-} |
112 | |||
113 | bitfieldByteCount :: Bitfield -> Int | ||
114 | bitfieldByteCount = B.length . bfBits | ||
115 | {-# INLINE bitfieldByteCount #-} | ||