summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/PeerWire.hs1
-rw-r--r--src/Network/BitTorrent/PeerWire/Bitfield.hs39
-rw-r--r--src/Network/BitTorrent/PeerWire/Message.hs10
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 #-}
9module Network.BitTorrent.PeerWire (module PW) where 9module Network.BitTorrent.PeerWire (module PW) where
10 10
11import Network.BitTorrent.PeerWire.Bitfield as PW
11import Network.BitTorrent.PeerWire.Block as PW 12import Network.BitTorrent.PeerWire.Block as PW
12import Network.BitTorrent.PeerWire.Message as PW 13import Network.BitTorrent.PeerWire.Message as PW
13import Network.BitTorrent.PeerWire.Handshake as PW 14import 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--
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