summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/PeerWire
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/PeerWire')
-rw-r--r--src/Network/BitTorrent/PeerWire/Bitfield.hs39
-rw-r--r--src/Network/BitTorrent/PeerWire/Message.hs10
2 files changed, 45 insertions, 4 deletions
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--
13module Network.BitTorrent.PeerWire.Bitfield
14 ( Bitfield(..)
15 , getBitfield, putBitfield, bitfieldByteCount
16 ) where
17
18import Control.Applicative
19import Data.ByteString (ByteString)
20import qualified Data.ByteString as B
21
22import Data.Serialize
23
24
25newtype Bitfield = MkBitfield {
26 bfBits :: ByteString
27 } deriving (Show, Eq, Ord)
28
29bitfieldByteCount :: Bitfield -> Int
30bitfieldByteCount = B.length . bfBits
31{-# INLINE bitfieldByteCount #-}
32
33getBitfield :: Int -> Get Bitfield
34getBitfield n = MkBitfield <$> getBytes n
35{-# INLINE getBitfield #-}
36
37putBitfield :: Bitfield -> Put
38putBitfield = 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 @@
1module Network.BitTorrent.PeerWire.Message 1module 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
10import Data.Serialize 11import Data.Serialize
11 12
12import Network.BitTorrent.PeerWire.Block 13import Network.BitTorrent.PeerWire.Block
14import 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