diff options
Diffstat (limited to 'src/Network/BitTorrent/PeerWire/Handshake.hs')
-rw-r--r-- | src/Network/BitTorrent/PeerWire/Handshake.hs | 27 |
1 files changed, 14 insertions, 13 deletions
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 | ||
22 | import Control.Applicative | 22 | import Control.Applicative |
23 | import Control.Monad | ||
24 | import Control.Exception | ||
23 | import Data.Word | 25 | import Data.Word |
24 | import Data.ByteString (ByteString) | 26 | import Data.ByteString (ByteString) |
25 | import qualified Data.ByteString as B | 27 | import qualified Data.ByteString as B |
@@ -74,7 +76,6 @@ instance Serialize Handshake where | |||
74 | handshakeCaps :: Handshake -> Capabilities | 76 | handshakeCaps :: Handshake -> Capabilities |
75 | handshakeCaps = hsReserved | 77 | handshakeCaps = hsReserved |
76 | 78 | ||
77 | -- TODO add reserved bits info | ||
78 | -- | Format handshake in human readable form. | 79 | -- | Format handshake in human readable form. |
79 | ppHandshake :: Handshake -> String | 80 | ppHandshake :: Handshake -> String |
80 | ppHandshake hs = BC.unpack (hsProtocol hs) ++ " " | 81 | ppHandshake hs = BC.unpack (hsProtocol hs) ++ " " |
@@ -100,23 +101,23 @@ defaultReserved = 0 | |||
100 | defaultHandshake :: InfoHash -> PeerID -> Handshake | 101 | defaultHandshake :: InfoHash -> PeerID -> Handshake |
101 | defaultHandshake = Handshake defaultBTProtocol defaultReserved | 102 | defaultHandshake = 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 | -- | 105 | handshake :: Socket -> Handshake -> IO Handshake |
106 | handshake :: Socket -> Handshake -> IO (Either String Handshake) | ||
107 | handshake sock hs = do | 106 | handshake 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." |