diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/PeerWire.hs | 1 | ||||
-rw-r--r-- | src/Network/BitTorrent/PeerWire/Bitfield.hs | 39 | ||||
-rw-r--r-- | src/Network/BitTorrent/PeerWire/Message.hs | 10 |
3 files changed, 46 insertions, 4 deletions
diff --git a/src/Network/BitTorrent/PeerWire.hs b/src/Network/BitTorrent/PeerWire.hs index fde98695..9f1e02ca 100644 --- a/src/Network/BitTorrent/PeerWire.hs +++ b/src/Network/BitTorrent/PeerWire.hs | |||
@@ -8,6 +8,7 @@ | |||
8 | {-# LANGUAGE DoAndIfThenElse #-} | 8 | {-# LANGUAGE DoAndIfThenElse #-} |
9 | module Network.BitTorrent.PeerWire (module PW) where | 9 | module Network.BitTorrent.PeerWire (module PW) where |
10 | 10 | ||
11 | import Network.BitTorrent.PeerWire.Bitfield as PW | ||
11 | import Network.BitTorrent.PeerWire.Block as PW | 12 | import Network.BitTorrent.PeerWire.Block as PW |
12 | import Network.BitTorrent.PeerWire.Message as PW | 13 | import Network.BitTorrent.PeerWire.Message as PW |
13 | import Network.BitTorrent.PeerWire.Handshake as PW | 14 | import Network.BitTorrent.PeerWire.Handshake as PW |
diff --git a/src/Network/BitTorrent/PeerWire/Bitfield.hs b/src/Network/BitTorrent/PeerWire/Bitfield.hs new file mode 100644 index 00000000..c9357a25 --- /dev/null +++ b/src/Network/BitTorrent/PeerWire/Bitfield.hs | |||
@@ -0,0 +1,39 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam T. 2013 | ||
3 | -- License : MIT | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- | ||
9 | -- This module provides Bitfield datatype used to represent sets of | ||
10 | -- piece indexes any peer have. All associated operations should be | ||
11 | -- defined here as well. | ||
12 | -- | ||
13 | module Network.BitTorrent.PeerWire.Bitfield | ||
14 | ( Bitfield(..) | ||
15 | , getBitfield, putBitfield, bitfieldByteCount | ||
16 | ) where | ||
17 | |||
18 | import Control.Applicative | ||
19 | import Data.ByteString (ByteString) | ||
20 | import qualified Data.ByteString as B | ||
21 | |||
22 | import Data.Serialize | ||
23 | |||
24 | |||
25 | newtype Bitfield = MkBitfield { | ||
26 | bfBits :: ByteString | ||
27 | } deriving (Show, Eq, Ord) | ||
28 | |||
29 | bitfieldByteCount :: Bitfield -> Int | ||
30 | bitfieldByteCount = B.length . bfBits | ||
31 | {-# INLINE bitfieldByteCount #-} | ||
32 | |||
33 | getBitfield :: Int -> Get Bitfield | ||
34 | getBitfield n = MkBitfield <$> getBytes n | ||
35 | {-# INLINE getBitfield #-} | ||
36 | |||
37 | putBitfield :: Bitfield -> Put | ||
38 | putBitfield = putByteString . bfBits | ||
39 | {-# INLINE putBitfield #-} \ No newline at end of file | ||
diff --git a/src/Network/BitTorrent/PeerWire/Message.hs b/src/Network/BitTorrent/PeerWire/Message.hs index 3f6647dd..9cbc2e38 100644 --- a/src/Network/BitTorrent/PeerWire/Message.hs +++ b/src/Network/BitTorrent/PeerWire/Message.hs | |||
@@ -1,5 +1,6 @@ | |||
1 | module Network.BitTorrent.PeerWire.Message | 1 | module Network.BitTorrent.PeerWire.Message |
2 | ( Message(..) | 2 | ( Message(..) |
3 | , Bitfield | ||
3 | , ppMessage | 4 | , ppMessage |
4 | ) where | 5 | ) where |
5 | 6 | ||
@@ -10,6 +11,7 @@ import qualified Data.ByteString as B | |||
10 | import Data.Serialize | 11 | import Data.Serialize |
11 | 12 | ||
12 | import Network.BitTorrent.PeerWire.Block | 13 | import Network.BitTorrent.PeerWire.Block |
14 | import Network.BitTorrent.PeerWire.Bitfield | ||
13 | 15 | ||
14 | 16 | ||
15 | -- | Messages used in communication between peers. | 17 | -- | Messages used in communication between peers. |
@@ -32,7 +34,7 @@ data Message = KeepAlive | |||
32 | -- after the handshaking sequence is complete, and | 34 | -- after the handshaking sequence is complete, and |
33 | -- before any other message are sent. If client have no | 35 | -- before any other message are sent. If client have no |
34 | -- pieces then bitfield need not to be sent. | 36 | -- pieces then bitfield need not to be sent. |
35 | | Bitfield ByteString | 37 | | Bitfield Bitfield |
36 | 38 | ||
37 | -- | Request for a particular block. If a client is | 39 | -- | Request for a particular block. If a client is |
38 | -- requested a block that another peer do not have the | 40 | -- requested a block that another peer do not have the |
@@ -87,7 +89,7 @@ instance Serialize Message where | |||
87 | 0x02 -> return Interested | 89 | 0x02 -> return Interested |
88 | 0x03 -> return NotInterested | 90 | 0x03 -> return NotInterested |
89 | 0x04 -> Have <$> getInt | 91 | 0x04 -> Have <$> getInt |
90 | 0x05 -> Bitfield <$> getBytes (pred len) | 92 | 0x05 -> Bitfield <$> getBitfield (pred len) |
91 | 0x06 -> Request <$> get | 93 | 0x06 -> Request <$> get |
92 | 0x07 -> Piece <$> getBlock (len - 9) | 94 | 0x07 -> Piece <$> getBlock (len - 9) |
93 | 0x08 -> Cancel <$> get | 95 | 0x08 -> Cancel <$> get |
@@ -111,8 +113,8 @@ instance Serialize Message where | |||
111 | put Interested = putInt 1 >> putWord8 0x02 | 113 | put Interested = putInt 1 >> putWord8 0x02 |
112 | put NotInterested = putInt 1 >> putWord8 0x03 | 114 | put NotInterested = putInt 1 >> putWord8 0x03 |
113 | put (Have i) = putInt 5 >> putWord8 0x04 >> putInt i | 115 | put (Have i) = putInt 5 >> putWord8 0x04 >> putInt i |
114 | put (Bitfield b) = putInt l >> putWord8 0x05 >> putByteString b | 116 | put (Bitfield b) = putInt l >> putWord8 0x05 >> putBitfield b |
115 | where l = succ (B.length b) | 117 | where l = succ (bitfieldByteCount b) |
116 | {-# INLINE l #-} | 118 | {-# INLINE l #-} |
117 | put (Request blk) = putInt 13 >> putWord8 0x06 >> put blk | 119 | put (Request blk) = putInt 13 >> putWord8 0x06 >> put blk |
118 | put (Piece blk) = putInt l >> putWord8 0x07 >> putBlock | 120 | put (Piece blk) = putInt l >> putWord8 0x07 >> putBlock |