summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent.hs1
-rw-r--r--src/Network/BitTorrent/PeerWire/Handshake.hs27
-rw-r--r--tests/Main.hs1
3 files changed, 15 insertions, 14 deletions
diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs
index bd23b980..3d2406a8 100644
--- a/src/Network/BitTorrent.hs
+++ b/src/Network/BitTorrent.hs
@@ -7,6 +7,7 @@
7-- 7--
8module Network.BitTorrent (module BT) where 8module Network.BitTorrent (module BT) where
9 9
10import Network.BitTorrent.Extension as BT
10import Network.BitTorrent.Peer as BT 11import Network.BitTorrent.Peer as BT
11import Network.BitTorrent.PeerWire as BT 12import Network.BitTorrent.PeerWire as BT
12import Network.BitTorrent.Tracker as BT 13import Network.BitTorrent.Tracker as BT
diff --git a/src/Network/BitTorrent/PeerWire/Handshake.hs b/src/Network/BitTorrent/PeerWire/Handshake.hs
index 62d7d7f4..770ca3ce 100644
--- a/src/Network/BitTorrent/PeerWire/Handshake.hs
+++ b/src/Network/BitTorrent/PeerWire/Handshake.hs
@@ -20,6 +20,8 @@ module Network.BitTorrent.PeerWire.Handshake
20 ) where 20 ) where
21 21
22import Control.Applicative 22import Control.Applicative
23import Control.Monad
24import Control.Exception
23import Data.Word 25import Data.Word
24import Data.ByteString (ByteString) 26import Data.ByteString (ByteString)
25import qualified Data.ByteString as B 27import qualified Data.ByteString as B
@@ -74,7 +76,6 @@ instance Serialize Handshake where
74handshakeCaps :: Handshake -> Capabilities 76handshakeCaps :: Handshake -> Capabilities
75handshakeCaps = hsReserved 77handshakeCaps = hsReserved
76 78
77-- TODO add reserved bits info
78-- | Format handshake in human readable form. 79-- | Format handshake in human readable form.
79ppHandshake :: Handshake -> String 80ppHandshake :: Handshake -> String
80ppHandshake hs = BC.unpack (hsProtocol hs) ++ " " 81ppHandshake hs = BC.unpack (hsProtocol hs) ++ " "
@@ -100,23 +101,23 @@ defaultReserved = 0
100defaultHandshake :: InfoHash -> PeerID -> Handshake 101defaultHandshake :: InfoHash -> PeerID -> Handshake
101defaultHandshake = Handshake defaultBTProtocol defaultReserved 102defaultHandshake = Handshake defaultBTProtocol defaultReserved
102 103
103-- TODO exceptions instead of Either
104-- | Handshaking with a peer specified by the second argument. 104-- | Handshaking with a peer specified by the second argument.
105-- 105handshake :: Socket -> Handshake -> IO Handshake
106handshake :: Socket -> Handshake -> IO (Either String Handshake)
107handshake sock hs = do 106handshake sock hs = do
108 sendAll sock (S.encode hs) 107 sendAll sock (S.encode hs)
109 108
110 header <- recv sock 1 109 header <- recv sock 1
111 if B.length header == 0 then 110 when (B.length header == 0) $
112 return $ Left "" 111 throw $ userError "Unable to receive handshake."
113 else do 112
114 let protocolLen = B.head header 113 let protocolLen = B.head header
115 let restLen = handshakeSize protocolLen - 1 114 let restLen = handshakeSize protocolLen - 1
116 body <- recv sock restLen 115 body <- recv sock restLen
117 let resp = B.cons protocolLen body 116 let resp = B.cons protocolLen body
118 117
119 return (checkIH (S.decode resp)) 118 case checkIH (S.decode resp) of
119 Right hs' -> return hs'
120 Left msg -> throw $ userError msg
120 where 121 where
121 checkIH (Right hs') 122 checkIH (Right hs')
122 | hsInfoHash hs /= hsInfoHash hs' = Left "Handshake info hash do not match." 123 | hsInfoHash hs /= hsInfoHash hs' = Left "Handshake info hash do not match."
diff --git a/tests/Main.hs b/tests/Main.hs
index ff3d8260..9b0d58e4 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -1,7 +1,6 @@
1{-# LANGUAGE OverloadedStrings #-} 1{-# LANGUAGE OverloadedStrings #-}
2module Main (main) where 2module Main (main) where
3 3
4import Data.Bits
5import Data.Word 4import Data.Word
6import Test.Framework (defaultMain) 5import Test.Framework (defaultMain)
7import Test.Framework.Providers.QuickCheck2 (testProperty) 6import Test.Framework.Providers.QuickCheck2 (testProperty)