summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/Exchange/Protocol.hs29
1 files changed, 15 insertions, 14 deletions
diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs
index aa0f4eaa..d4d9b239 100644
--- a/src/Network/BitTorrent/Exchange/Protocol.hs
+++ b/src/Network/BitTorrent/Exchange/Protocol.hs
@@ -170,29 +170,30 @@ defaultReserved = 0
170defaultHandshake :: InfoHash -> PeerId -> Handshake 170defaultHandshake :: InfoHash -> PeerId -> Handshake
171defaultHandshake = Handshake defaultBTProtocol defaultReserved 171defaultHandshake = Handshake defaultBTProtocol defaultReserved
172 172
173-- | Handshaking with a peer specified by the second argument. 173sendHandshake :: Socket -> Handshake -> IO ()
174handshake :: Socket -> Handshake -> IO Handshake 174sendHandshake sock hs = sendAll sock (S.encode hs)
175handshake sock hs = do
176 sendAll sock (S.encode hs)
177 175
176recvHandshake :: Socket -> IO Handshake
177recvHandshake sock = do
178 header <- recv sock 1 178 header <- recv sock 1
179 when (B.length header == 0) $ 179 unless (B.length header == 1) $
180 throw $ userError "Unable to receive handshake." 180 throw $ userError "Unable to receive handshake header."
181 181
182 let protocolLen = B.head header 182 let protocolLen = B.head header
183 let restLen = handshakeSize protocolLen - 1 183 let restLen = handshakeSize protocolLen - 1
184 184
185 body <- recv sock restLen 185 body <- recv sock restLen
186 let resp = B.cons protocolLen body 186 let resp = B.cons protocolLen body
187 either (throwIO . userError) return $ S.decode resp
187 188
188 case checkIH (S.decode resp) of 189-- | Handshaking with a peer specified by the second argument.
189 Right hs' -> return hs' 190handshake :: Socket -> Handshake -> IO Handshake
190 Left msg -> throwIO $ userError $ msg ++ " in handshake body." 191handshake sock hs = do
191 where 192 sendHandshake sock hs
192 checkIH (Right hs') 193 hs' <- recvHandshake sock
193 | hsInfoHash hs /= hsInfoHash hs' 194 when (hsInfoHash hs /= hsInfoHash hs') $ do
194 = Left "Handshake info hash do not match." 195 throwIO $ userError "Handshake info hash do not match."
195 checkIH x = x 196 return hs'
196 197
197{----------------------------------------------------------------------- 198{-----------------------------------------------------------------------
198 Block Index 199 Block Index