summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/PeerWire
diff options
context:
space:
mode:
authorSam T <pxqr.sta@gmail.com>2013-05-08 10:02:48 +0400
committerSam T <pxqr.sta@gmail.com>2013-05-08 10:02:48 +0400
commitd0282172da33bbc58cc40f14d7368726dfde8b37 (patch)
tree6c7bb5511f8cd67b8af3a196a5566d4f4fda947f /src/Network/BitTorrent/PeerWire
parentfe546e6c3926019efd614787f6c2e8cf12469aed (diff)
+ Add capabilities.
Diffstat (limited to 'src/Network/BitTorrent/PeerWire')
-rw-r--r--src/Network/BitTorrent/PeerWire/Block.hs7
-rw-r--r--src/Network/BitTorrent/PeerWire/Handshake.hs24
2 files changed, 22 insertions, 9 deletions
diff --git a/src/Network/BitTorrent/PeerWire/Block.hs b/src/Network/BitTorrent/PeerWire/Block.hs
index 582accdb..fbc65338 100644
--- a/src/Network/BitTorrent/PeerWire/Block.hs
+++ b/src/Network/BitTorrent/PeerWire/Block.hs
@@ -1,5 +1,7 @@
1module Network.BitTorrent.PeerWire.Block 1module Network.BitTorrent.PeerWire.Block
2 ( BlockIx(..), Block(..), PieceIx 2 ( BlockIx(..)
3 , Block(..), blockSize
4 , PieceIx
3 , BlockLIx, PieceLIx 5 , BlockLIx, PieceLIx
4 , defaultBlockSize 6 , defaultBlockSize
5 , pieceIx, blockIx 7 , pieceIx, blockIx
@@ -68,6 +70,9 @@ data Block = Block {
68ppBlock :: Block -> String 70ppBlock :: Block -> String
69ppBlock = ppBlockIx . blockIx 71ppBlock = ppBlockIx . blockIx
70 72
73blockSize :: Block -> Int
74blockSize blk = B.length (blkData blk)
75
71-- | Widely used semi-official block size. 76-- | Widely used semi-official block size.
72defaultBlockSize :: Int 77defaultBlockSize :: Int
73defaultBlockSize = 16 * 1024 78defaultBlockSize = 16 * 1024
diff --git a/src/Network/BitTorrent/PeerWire/Handshake.hs b/src/Network/BitTorrent/PeerWire/Handshake.hs
index e0d1672b..62d7d7f4 100644
--- a/src/Network/BitTorrent/PeerWire/Handshake.hs
+++ b/src/Network/BitTorrent/PeerWire/Handshake.hs
@@ -12,7 +12,7 @@
12-- 12--
13{-# LANGUAGE OverloadedStrings #-} 13{-# LANGUAGE OverloadedStrings #-}
14module Network.BitTorrent.PeerWire.Handshake 14module Network.BitTorrent.PeerWire.Handshake
15 ( Handshake 15 ( Handshake, handshakeCaps
16 , handshake 16 , handshake
17 , ppHandshake 17 , ppHandshake
18 , defaultHandshake, defaultBTProtocol, defaultReserved 18 , defaultHandshake, defaultBTProtocol, defaultReserved
@@ -29,6 +29,7 @@ import Data.Torrent.InfoHash
29import Network 29import Network
30import Network.Socket.ByteString 30import Network.Socket.ByteString
31 31
32import Network.BitTorrent.Extension
32import Network.BitTorrent.Peer.ID 33import Network.BitTorrent.Peer.ID
33import Network.BitTorrent.Peer.ClientInfo 34import Network.BitTorrent.Peer.ClientInfo
34 35
@@ -69,6 +70,10 @@ instance Serialize Handshake where
69 <*> get 70 <*> get
70 <*> get 71 <*> get
71 72
73
74handshakeCaps :: Handshake -> Capabilities
75handshakeCaps = hsReserved
76
72-- TODO add reserved bits info 77-- TODO add reserved bits info
73-- | Format handshake in human readable form. 78-- | Format handshake in human readable form.
74ppHandshake :: Handshake -> String 79ppHandshake :: Handshake -> String
@@ -95,7 +100,7 @@ defaultReserved = 0
95defaultHandshake :: InfoHash -> PeerID -> Handshake 100defaultHandshake :: InfoHash -> PeerID -> Handshake
96defaultHandshake = Handshake defaultBTProtocol defaultReserved 101defaultHandshake = Handshake defaultBTProtocol defaultReserved
97 102
98 103-- TODO exceptions instead of Either
99-- | Handshaking with a peer specified by the second argument. 104-- | Handshaking with a peer specified by the second argument.
100-- 105--
101handshake :: Socket -> Handshake -> IO (Either String Handshake) 106handshake :: Socket -> Handshake -> IO (Either String Handshake)
@@ -103,12 +108,15 @@ handshake sock hs = do
103 sendAll sock (S.encode hs) 108 sendAll sock (S.encode hs)
104 109
105 header <- recv sock 1 110 header <- recv sock 1
106 let protocolLen = B.head header 111 if B.length header == 0 then
107 let restLen = handshakeSize protocolLen - 1 112 return $ Left ""
108 body <- recv sock restLen 113 else do
109 let resp = B.cons protocolLen body 114 let protocolLen = B.head header
110 115 let restLen = handshakeSize protocolLen - 1
111 return (checkIH (S.decode resp)) 116 body <- recv sock restLen
117 let resp = B.cons protocolLen body
118
119 return (checkIH (S.decode resp))
112 where 120 where
113 checkIH (Right hs') 121 checkIH (Right hs')
114 | hsInfoHash hs /= hsInfoHash hs' = Left "Handshake info hash do not match." 122 | hsInfoHash hs /= hsInfoHash hs' = Left "Handshake info hash do not match."