summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bench/serialization.hs3
-rw-r--r--network-bittorrent.cabal3
-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
-rw-r--r--tests/encoding.hs4
6 files changed, 55 insertions, 5 deletions
diff --git a/bench/serialization.hs b/bench/serialization.hs
index 8ed90958..c6d14328 100644
--- a/bench/serialization.hs
+++ b/bench/serialization.hs
@@ -15,6 +15,9 @@ instance NFData BlockIx where
15instance NFData Block where 15instance NFData Block where
16 rnf (Block a b c) = a `deepseq` b `deepseq` rnf c 16 rnf (Block a b c) = a `deepseq` b `deepseq` rnf c
17 17
18instance NFData Bitfield where
19 rnf = rnf . bfBits
20
18instance NFData Message where 21instance NFData Message where
19 rnf (Have i) = rnf i 22 rnf (Have i) = rnf i
20 rnf (Bitfield b) = rnf b 23 rnf (Bitfield b) = rnf b
diff --git a/network-bittorrent.cabal b/network-bittorrent.cabal
index a26068f6..00ed2162 100644
--- a/network-bittorrent.cabal
+++ b/network-bittorrent.cabal
@@ -32,8 +32,9 @@ library
32 , Network.BitTorrent.Tracker.Scrape 32 , Network.BitTorrent.Tracker.Scrape
33 33
34 , Network.BitTorrent.PeerWire 34 , Network.BitTorrent.PeerWire
35 , Network.BitTorrent.PeerWire.ClientInfo 35 , Network.BitTorrent.PeerWire.Bitfield
36 , Network.BitTorrent.PeerWire.Block 36 , Network.BitTorrent.PeerWire.Block
37 , Network.BitTorrent.PeerWire.ClientInfo
37 , Network.BitTorrent.PeerWire.Message 38 , Network.BitTorrent.PeerWire.Message
38 , Network.BitTorrent.PeerWire.Handshake 39 , Network.BitTorrent.PeerWire.Handshake
39 40
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
diff --git a/tests/encoding.hs b/tests/encoding.hs
index a8490551..405d2eb1 100644
--- a/tests/encoding.hs
+++ b/tests/encoding.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE StandaloneDeriving #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1{-# OPTIONS -fno-warn-orphans #-} 3{-# OPTIONS -fno-warn-orphans #-}
2module Main (main) where 4module Main (main) where
3 5
@@ -29,6 +31,8 @@ instance Arbitrary BlockIx where
29instance Arbitrary Block where 31instance Arbitrary Block where
30 arbitrary = Block <$> positive <*> positive <*> arbitrary 32 arbitrary = Block <$> positive <*> positive <*> arbitrary
31 33
34deriving instance Arbitrary Bitfield
35
32instance Arbitrary Message where 36instance Arbitrary Message where
33 arbitrary = oneof 37 arbitrary = oneof
34 [ pure KeepAlive 38 [ pure KeepAlive