summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bittorrent.cabal2
-rw-r--r--src/Data/Bitfield.hs5
-rw-r--r--src/Network/BitTorrent/PeerWire.hs2
-rw-r--r--src/Network/BitTorrent/PeerWire/Block.hs113
-rw-r--r--src/Network/BitTorrent/PeerWire/Handshake.hs127
-rw-r--r--src/Network/BitTorrent/PeerWire/Protocol.hs242
-rw-r--r--src/Network/BitTorrent/PeerWire/Selection.hs2
7 files changed, 241 insertions, 252 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal
index 526f703a..4e3251d4 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -45,9 +45,7 @@ library
45 , Network.BitTorrent.Tracker.Scrape 45 , Network.BitTorrent.Tracker.Scrape
46 46
47 , Network.BitTorrent.PeerWire 47 , Network.BitTorrent.PeerWire
48 , Network.BitTorrent.PeerWire.Block
49 , Network.BitTorrent.PeerWire.Selection 48 , Network.BitTorrent.PeerWire.Selection
50 , Network.BitTorrent.PeerWire.Handshake
51 , Network.BitTorrent.PeerWire.Protocol 49 , Network.BitTorrent.PeerWire.Protocol
52 50
53 other-modules: 51 other-modules:
diff --git a/src/Data/Bitfield.hs b/src/Data/Bitfield.hs
index 56365bf7..7cd07123 100644
--- a/src/Data/Bitfield.hs
+++ b/src/Data/Bitfield.hs
@@ -13,7 +13,7 @@
13{-# LANGUAGE BangPatterns #-} 13{-# LANGUAGE BangPatterns #-}
14{-# LANGUAGE RecordWildCards #-} 14{-# LANGUAGE RecordWildCards #-}
15module Data.Bitfield 15module Data.Bitfield
16 ( Bitfield, PieceCount 16 ( PieceIx, PieceCount, Bitfield
17 17
18 -- * Construction 18 -- * Construction
19 , haveAll, haveNone, have 19 , haveAll, haveNone, have
@@ -54,9 +54,10 @@ import qualified Data.IntervalSet.ByteString as S
54import Data.List (foldl') 54import Data.List (foldl')
55import Data.Monoid 55import Data.Monoid
56import Data.Ratio 56import Data.Ratio
57import Network.BitTorrent.PeerWire.Block
58 57
59 58
59type PieceIx = Int
60
60-- | Used to represent max set bound. Min set bound is always set to 61-- | Used to represent max set bound. Min set bound is always set to
61-- zero. 62-- zero.
62type PieceCount = Int 63type PieceCount = Int
diff --git a/src/Network/BitTorrent/PeerWire.hs b/src/Network/BitTorrent/PeerWire.hs
index 5ac4c7f3..b048fe1f 100644
--- a/src/Network/BitTorrent/PeerWire.hs
+++ b/src/Network/BitTorrent/PeerWire.hs
@@ -8,7 +8,5 @@
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.Block as PW
12import Network.BitTorrent.PeerWire.Selection as PW 11import Network.BitTorrent.PeerWire.Selection as PW
13import Network.BitTorrent.PeerWire.Protocol as PW 12import Network.BitTorrent.PeerWire.Protocol as PW
14import Network.BitTorrent.PeerWire.Handshake as PW
diff --git a/src/Network/BitTorrent/PeerWire/Block.hs b/src/Network/BitTorrent/PeerWire/Block.hs
deleted file mode 100644
index dea37321..00000000
--- a/src/Network/BitTorrent/PeerWire/Block.hs
+++ /dev/null
@@ -1,113 +0,0 @@
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Network.BitTorrent.PeerWire.Block
4 ( BlockIx(..)
5 , Block(..), blockSize
6 , PieceIx
7 , BlockLIx, PieceLIx
8 , defaultBlockSize
9 , pieceIx, blockIx
10 , blockRange, ixRange, isPiece
11 , ppBlockIx, ppBlock
12
13 , putInt, getInt
14 ) where
15
16import Control.Applicative
17import Data.ByteString (ByteString)
18import qualified Data.ByteString as B
19import Data.Int
20import Data.Serialize
21import Text.PrettyPrint
22
23
24type BlockLIx = Int
25type PieceLIx = Int
26type PieceIx = Int
27
28data BlockIx = BlockIx {
29 -- | Zero-based piece index.
30 ixPiece :: {-# UNPACK #-} !PieceLIx
31
32 -- | Zero-based byte offset within the piece.
33 , ixOffset :: {-# UNPACK #-} !Int
34
35 -- | Block size starting from offset.
36 , ixLength :: {-# UNPACK #-} !Int
37 } deriving (Show, Eq)
38
39getInt :: Get Int
40getInt = fromIntegral <$> getWord32be
41{-# INLINE getInt #-}
42
43putInt :: Putter Int
44putInt = putWord32be . fromIntegral
45{-# INLINE putInt #-}
46
47instance Serialize BlockIx where
48 {-# SPECIALIZE instance Serialize BlockIx #-}
49 get = BlockIx <$> getInt <*> getInt <*> getInt
50 {-# INLINE get #-}
51
52 put ix = do putInt (ixPiece ix)
53 putInt (ixOffset ix)
54 putInt (ixLength ix)
55 {-# INLINE put #-}
56
57ppBlockIx :: BlockIx -> Doc
58ppBlockIx BlockIx {..} =
59 "piece = " <> int ixPiece <> "," <+>
60 "offset = " <> int ixOffset <> "," <+>
61 "length = " <> int ixLength
62
63data Block = Block {
64 -- | Zero-based piece index.
65 blkPiece :: PieceLIx
66
67 -- | Zero-based byte offset within the piece.
68 , blkOffset :: Int
69
70 -- | Payload.
71 , blkData :: ByteString
72 } deriving (Show, Eq)
73
74ppBlock :: Block -> Doc
75ppBlock = ppBlockIx . blockIx
76
77blockSize :: Block -> Int
78blockSize blk = B.length (blkData blk)
79
80-- | Widely used semi-official block size.
81defaultBlockSize :: Int
82defaultBlockSize = 16 * 1024
83
84
85isPiece :: Int -> Block -> Bool
86isPiece pieceSize (Block i offset bs) =
87 offset == 0 && B.length bs == pieceSize && i >= 0
88{-# INLINE isPiece #-}
89
90pieceIx :: Int -> Int -> BlockIx
91pieceIx i = BlockIx i 0
92{-# INLINE pieceIx #-}
93
94blockIx :: Block -> BlockIx
95blockIx = BlockIx <$> blkPiece <*> blkOffset <*> B.length . blkData
96
97blockRange :: (Num a, Integral a) => Int -> Block -> (a, a)
98blockRange pieceSize blk = (offset, offset + len)
99 where
100 offset = fromIntegral pieceSize * fromIntegral (blkPiece blk)
101 + fromIntegral (blkOffset blk)
102 len = fromIntegral (B.length (blkData blk))
103{-# INLINE blockRange #-}
104{-# SPECIALIZE blockRange :: Int -> Block -> (Int64, Int64) #-}
105
106ixRange :: (Num a, Integral a) => Int -> BlockIx -> (a, a)
107ixRange pieceSize ix = (offset, offset + len)
108 where
109 offset = fromIntegral pieceSize * fromIntegral (ixPiece ix)
110 + fromIntegral (ixOffset ix)
111 len = fromIntegral (ixLength ix)
112{-# INLINE ixRange #-}
113{-# SPECIALIZE ixRange :: Int -> BlockIx -> (Int64, Int64) #-}
diff --git a/src/Network/BitTorrent/PeerWire/Handshake.hs b/src/Network/BitTorrent/PeerWire/Handshake.hs
deleted file mode 100644
index d5ee0b5b..00000000
--- a/src/Network/BitTorrent/PeerWire/Handshake.hs
+++ /dev/null
@@ -1,127 +0,0 @@
1-- |
2-- Copyright : (c) Sam T. 2013
3-- License : MIT
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- In order to establish the connection between peers we should send
9-- 'Handshake' message. The 'Handshake' is a required message and
10-- must be the first message transmitted by the peer to the another
11-- peer.
12--
13{-# LANGUAGE OverloadedStrings #-}
14{-# LANGUAGE RecordWildCards #-}
15module Network.BitTorrent.PeerWire.Handshake
16 ( Handshake(..), handshakeCaps
17 , handshake
18 , ppHandshake
19 , defaultHandshake, defaultBTProtocol, defaultReserved
20 , handshakeMaxSize
21 ) where
22
23import Control.Applicative
24import Control.Monad
25import Control.Exception
26import Data.Word
27import Data.ByteString (ByteString)
28import qualified Data.ByteString as B
29import qualified Data.ByteString.Char8 as BC
30import Data.Serialize as S
31import Text.PrettyPrint
32
33import Network
34import Network.Socket.ByteString
35
36import Data.Torrent
37import Network.BitTorrent.Extension
38import Network.BitTorrent.Peer
39
40
41
42data Handshake = Handshake {
43 -- | Identifier of the protocol.
44 hsProtocol :: ByteString
45
46 -- | Reserved bytes used to specify supported BEP's.
47 , hsReserved :: Capabilities
48
49 -- | Info hash of the info part of the metainfo file. that is
50 -- transmitted in tracker requests. Info hash of the initiator
51 -- handshake and response handshake should match, otherwise
52 -- initiator should break the connection.
53 --
54 , hsInfoHash :: InfoHash
55
56 -- | Peer id of the initiator. This is usually the same peer id
57 -- that is transmitted in tracker requests.
58 --
59 , hsPeerID :: PeerID
60
61 } deriving (Show, Eq)
62
63instance Serialize Handshake where
64 put hs = do
65 putWord8 (fromIntegral (B.length (hsProtocol hs)))
66 putByteString (hsProtocol hs)
67 putWord64be (hsReserved hs)
68 put (hsInfoHash hs)
69 put (hsPeerID hs)
70
71 get = do
72 len <- getWord8
73 Handshake <$> getBytes (fromIntegral len)
74 <*> getWord64be
75 <*> get
76 <*> get
77
78
79handshakeCaps :: Handshake -> Capabilities
80handshakeCaps = hsReserved
81
82-- | Format handshake in human readable form.
83ppHandshake :: Handshake -> Doc
84ppHandshake Handshake {..} =
85 text (BC.unpack hsProtocol) <+> ppClientInfo (clientInfo hsPeerID)
86
87-- | Get handshake message size in bytes from the length of protocol string.
88handshakeSize :: Word8 -> Int
89handshakeSize n = 1 + fromIntegral n + 8 + 20 + 20
90
91-- | Maximum size of handshake message in bytes.
92handshakeMaxSize :: Int
93handshakeMaxSize = handshakeSize 255
94
95-- | Default protocol string "BitTorrent protocol" as is.
96defaultBTProtocol :: ByteString
97defaultBTProtocol = "BitTorrent protocol"
98
99-- | Default reserved word is 0.
100defaultReserved :: Word64
101defaultReserved = 0
102
103-- | Length of info hash and peer id is unchecked, so it /should/ be equal 20.
104defaultHandshake :: InfoHash -> PeerID -> Handshake
105defaultHandshake = Handshake defaultBTProtocol defaultReserved
106
107-- | Handshaking with a peer specified by the second argument.
108handshake :: Socket -> Handshake -> IO Handshake
109handshake sock hs = do
110 sendAll sock (S.encode hs)
111
112 header <- recv sock 1
113 when (B.length header == 0) $
114 throw $ userError "Unable to receive handshake."
115
116 let protocolLen = B.head header
117 let restLen = handshakeSize protocolLen - 1
118 body <- recv sock restLen
119 let resp = B.cons protocolLen body
120
121 case checkIH (S.decode resp) of
122 Right hs' -> return hs'
123 Left msg -> throw $ userError msg
124 where
125 checkIH (Right hs')
126 | hsInfoHash hs /= hsInfoHash hs' = Left "Handshake info hash do not match."
127 checkIH x = x
diff --git a/src/Network/BitTorrent/PeerWire/Protocol.hs b/src/Network/BitTorrent/PeerWire/Protocol.hs
index a4d987e6..b40676ca 100644
--- a/src/Network/BitTorrent/PeerWire/Protocol.hs
+++ b/src/Network/BitTorrent/PeerWire/Protocol.hs
@@ -1,22 +1,254 @@
1-- |
2-- Copyright : (c) Sam T. 2013
3-- License : MIT
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- In order to establish the connection between peers we should send
9-- 'Handshake' message. The 'Handshake' is a required message and
10-- must be the first message transmitted by the peer to the another
11-- peer.
12--
1{-# LANGUAGE OverloadedStrings #-} 13{-# LANGUAGE OverloadedStrings #-}
14{-# LANGUAGE RecordWildCards #-}
2module Network.BitTorrent.PeerWire.Protocol 15module Network.BitTorrent.PeerWire.Protocol
3 ( 16 ( -- * Inital handshake
4 -- * Messages 17 Handshake(..), ppHandshake
5 Message(..) 18 , handshake , handshakeCaps
19
20 -- ** Defaults
21 , defaultHandshake, defaultBTProtocol, defaultReserved
22 , handshakeMaxSize
23
24 -- * Block
25 , BlockLIx, PieceLIx
26 , BlockIx(..), ppBlockIx
27 , Block(..), ppBlock ,blockSize
28 , pieceIx, blockIx
29 , blockRange, ixRange, isPiece
30
31 -- ** Defaults
32 , defaultBlockSize
33
34 -- * Regular messages
35 , Message(..)
6 , ppMessage 36 , ppMessage
7 ) where 37 ) where
8 38
9import Control.Applicative 39import Control.Applicative
40import Control.Monad
41import Control.Exception
42import Data.ByteString (ByteString)
10import qualified Data.ByteString as B 43import qualified Data.ByteString as B
44import qualified Data.ByteString.Char8 as BC
11import qualified Data.ByteString.Lazy as Lazy 45import qualified Data.ByteString.Lazy as Lazy
12import Data.Serialize 46import Data.Serialize as S
47import Data.Int
48import Data.Word
13import Text.PrettyPrint 49import Text.PrettyPrint
50
14import Network 51import Network
52import Network.Socket.ByteString
15 53
16import Network.BitTorrent.PeerWire.Block
17import Data.Bitfield 54import Data.Bitfield
55import Data.Torrent
56import Network.BitTorrent.Extension
57import Network.BitTorrent.Peer
58
59
60
61{-----------------------------------------------------------------------
62 Handshake
63-----------------------------------------------------------------------}
64
65data Handshake = Handshake {
66 -- | Identifier of the protocol.
67 hsProtocol :: ByteString
68
69 -- | Reserved bytes used to specify supported BEP's.
70 , hsReserved :: Capabilities
71
72 -- | Info hash of the info part of the metainfo file. that is
73 -- transmitted in tracker requests. Info hash of the initiator
74 -- handshake and response handshake should match, otherwise
75 -- initiator should break the connection.
76 --
77 , hsInfoHash :: InfoHash
78
79 -- | Peer id of the initiator. This is usually the same peer id
80 -- that is transmitted in tracker requests.
81 --
82 , hsPeerID :: PeerID
83
84 } deriving (Show, Eq)
85
86instance Serialize Handshake where
87 put hs = do
88 putWord8 (fromIntegral (B.length (hsProtocol hs)))
89 putByteString (hsProtocol hs)
90 putWord64be (hsReserved hs)
91 put (hsInfoHash hs)
92 put (hsPeerID hs)
93
94 get = do
95 len <- getWord8
96 Handshake <$> getBytes (fromIntegral len)
97 <*> getWord64be
98 <*> get
99 <*> get
100
101
102handshakeCaps :: Handshake -> Capabilities
103handshakeCaps = hsReserved
104
105-- | Format handshake in human readable form.
106ppHandshake :: Handshake -> Doc
107ppHandshake Handshake {..} =
108 text (BC.unpack hsProtocol) <+> ppClientInfo (clientInfo hsPeerID)
109
110-- | Get handshake message size in bytes from the length of protocol string.
111handshakeSize :: Word8 -> Int
112handshakeSize n = 1 + fromIntegral n + 8 + 20 + 20
113
114-- | Maximum size of handshake message in bytes.
115handshakeMaxSize :: Int
116handshakeMaxSize = handshakeSize 255
117
118-- | Default protocol string "BitTorrent protocol" as is.
119defaultBTProtocol :: ByteString
120defaultBTProtocol = "BitTorrent protocol"
121
122-- | Default reserved word is 0.
123defaultReserved :: Word64
124defaultReserved = 0
125
126-- | Length of info hash and peer id is unchecked, so it /should/ be equal 20.
127defaultHandshake :: InfoHash -> PeerID -> Handshake
128defaultHandshake = Handshake defaultBTProtocol defaultReserved
129
130-- | Handshaking with a peer specified by the second argument.
131handshake :: Socket -> Handshake -> IO Handshake
132handshake sock hs = do
133 sendAll sock (S.encode hs)
134
135 header <- recv sock 1
136 when (B.length header == 0) $
137 throw $ userError "Unable to receive handshake."
138
139 let protocolLen = B.head header
140 let restLen = handshakeSize protocolLen - 1
141 body <- recv sock restLen
142 let resp = B.cons protocolLen body
143
144 case checkIH (S.decode resp) of
145 Right hs' -> return hs'
146 Left msg -> throw $ userError msg
147 where
148 checkIH (Right hs')
149 | hsInfoHash hs /= hsInfoHash hs'
150 = Left "Handshake info hash do not match."
151 checkIH x = x
152
153{-----------------------------------------------------------------------
154 Blocks
155-----------------------------------------------------------------------}
156
157type BlockLIx = Int
158type PieceLIx = Int
159
160
161data BlockIx = BlockIx {
162 -- | Zero-based piece index.
163 ixPiece :: {-# UNPACK #-} !PieceLIx
164
165 -- | Zero-based byte offset within the piece.
166 , ixOffset :: {-# UNPACK #-} !Int
167
168 -- | Block size starting from offset.
169 , ixLength :: {-# UNPACK #-} !Int
170 } deriving (Show, Eq)
171
172getInt :: Get Int
173getInt = fromIntegral <$> getWord32be
174{-# INLINE getInt #-}
175
176putInt :: Putter Int
177putInt = putWord32be . fromIntegral
178{-# INLINE putInt #-}
179
180instance Serialize BlockIx where
181 {-# SPECIALIZE instance Serialize BlockIx #-}
182 get = BlockIx <$> getInt <*> getInt <*> getInt
183 {-# INLINE get #-}
184
185 put ix = do putInt (ixPiece ix)
186 putInt (ixOffset ix)
187 putInt (ixLength ix)
188 {-# INLINE put #-}
189
190ppBlockIx :: BlockIx -> Doc
191ppBlockIx BlockIx {..} =
192 "piece = " <> int ixPiece <> "," <+>
193 "offset = " <> int ixOffset <> "," <+>
194 "length = " <> int ixLength
195
196data Block = Block {
197 -- | Zero-based piece index.
198 blkPiece :: !PieceLIx
199
200 -- | Zero-based byte offset within the piece.
201 , blkOffset :: !Int
202
203 -- | Payload.
204 , blkData :: !ByteString
205 } deriving (Show, Eq)
206
207ppBlock :: Block -> Doc
208ppBlock = ppBlockIx . blockIx
209
210blockSize :: Block -> Int
211blockSize blk = B.length (blkData blk)
212
213-- | Widely used semi-official block size.
214defaultBlockSize :: Int
215defaultBlockSize = 16 * 1024
216
217
218isPiece :: Int -> Block -> Bool
219isPiece pieceSize (Block i offset bs) =
220 offset == 0 && B.length bs == pieceSize && i >= 0
221{-# INLINE isPiece #-}
222
223pieceIx :: Int -> Int -> BlockIx
224pieceIx i = BlockIx i 0
225{-# INLINE pieceIx #-}
226
227blockIx :: Block -> BlockIx
228blockIx = BlockIx <$> blkPiece <*> blkOffset <*> B.length . blkData
229
230blockRange :: (Num a, Integral a) => Int -> Block -> (a, a)
231blockRange pieceSize blk = (offset, offset + len)
232 where
233 offset = fromIntegral pieceSize * fromIntegral (blkPiece blk)
234 + fromIntegral (blkOffset blk)
235 len = fromIntegral (B.length (blkData blk))
236{-# INLINE blockRange #-}
237{-# SPECIALIZE blockRange :: Int -> Block -> (Int64, Int64) #-}
238
239ixRange :: (Num a, Integral a) => Int -> BlockIx -> (a, a)
240ixRange pieceSize ix = (offset, offset + len)
241 where
242 offset = fromIntegral pieceSize * fromIntegral (ixPiece ix)
243 + fromIntegral (ixOffset ix)
244 len = fromIntegral (ixLength ix)
245{-# INLINE ixRange #-}
246{-# SPECIALIZE ixRange :: Int -> BlockIx -> (Int64, Int64) #-}
18 247
19 248
249{-----------------------------------------------------------------------
250 Handshake
251-----------------------------------------------------------------------}
20 252
21-- | Messages used in communication between peers. 253-- | Messages used in communication between peers.
22-- 254--
diff --git a/src/Network/BitTorrent/PeerWire/Selection.hs b/src/Network/BitTorrent/PeerWire/Selection.hs
index 63cca15d..db9e04f4 100644
--- a/src/Network/BitTorrent/PeerWire/Selection.hs
+++ b/src/Network/BitTorrent/PeerWire/Selection.hs
@@ -34,7 +34,7 @@ module Network.BitTorrent.PeerWire.Selection
34 34
35import Data.Bitfield 35import Data.Bitfield
36import Data.Ratio 36import Data.Ratio
37import Network.BitTorrent.PeerWire.Block 37import Network.BitTorrent.PeerWire.Protocol
38 38
39 39
40type Selector = Bitfield -- ^ Indices of client /have/ pieces. 40type Selector = Bitfield -- ^ Indices of client /have/ pieces.
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 20:26:05 +0000