summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Exchange')
-rw-r--r--src/Network/BitTorrent/Exchange/Wire.hs40
1 files changed, 20 insertions, 20 deletions
diff --git a/src/Network/BitTorrent/Exchange/Wire.hs b/src/Network/BitTorrent/Exchange/Wire.hs
index 109f6551..c0658961 100644
--- a/src/Network/BitTorrent/Exchange/Wire.hs
+++ b/src/Network/BitTorrent/Exchange/Wire.hs
@@ -432,8 +432,9 @@ data Connection = Connection
432 -- future. 432 -- future.
433 connProtocol :: !ProtocolName 433 connProtocol :: !ProtocolName
434 434
435 -- | A set of enabled extensions. This value used to check if a 435 -- | Set of enabled core extensions, i.e. the pre BEP10 extension
436 -- message is allowed to be sent or received. 436 -- mecahnism. This value is used to check if a message is allowed to be sent
437 -- or received.
437 , connCaps :: !Caps 438 , connCaps :: !Caps
438 439
439 -- | /Both/ peers handshaked with this infohash. A connection can 440 -- | /Both/ peers handshaked with this infohash. A connection can
@@ -450,9 +451,9 @@ data Connection = Connection
450 -- | 451 -- |
451 , connOptions :: !Options 452 , connOptions :: !Options
452 453
453 -- | If @not (allowed ExtExtended connCaps)@ then this set is 454 -- | If @not (allowed ExtExtended connCaps)@ then this set is always
454 -- always empty. Otherwise it has extension protocol 'MessageId' 455 -- empty. Otherwise it has the BEP10 extension protocol mandated mapping of
455 -- map. 456 -- 'MessageId' to the message type for the remote peer.
456 , connExtCaps :: !(IORef ExtendedCaps) 457 , connExtCaps :: !(IORef ExtendedCaps)
457 458
458 -- | Current extended handshake information from the remote peer 459 -- | Current extended handshake information from the remote peer
@@ -632,9 +633,9 @@ rehandshake caps = undefined
632reconnect :: Wire () 633reconnect :: Wire ()
633reconnect = undefined 634reconnect = undefined
634 635
635-- | Initiate 'Wire' connection and handshake with a peer. This 636-- | Initiate 'Wire' connection and handshake with a peer. This function will
636-- function will also do extension protocol handshake if 'ExtExtended' 637-- also do the BEP10 extension protocol handshake if 'ExtExtended' is enabled on
637-- is enabled on both sides. 638-- both sides.
638-- 639--
639-- This function can throw 'WireFailure' exception. 640-- This function can throw 'WireFailure' exception.
640-- 641--
@@ -643,20 +644,19 @@ connectWire hs addr extCaps wire =
643 bracket (connectToPeer addr) close $ \ sock -> do 644 bracket (connectToPeer addr) close $ \ sock -> do
644 hs' <- initiateHandshake sock hs 645 hs' <- initiateHandshake sock hs
645 646
646 unless (def == hsProtocol hs') $ do 647 Prelude.mapM_ (\(t,e) -> unless t $ throwIO $ ProtocolError e) [
647 throwIO $ ProtocolError $ InvalidProtocol (hsProtocol hs') 648 (def == hsProtocol hs'
648 649 , InvalidProtocol $ hsProtocol hs'),
649 unless (hsProtocol hs == hsProtocol hs') $ do 650 (hsProtocol hs == hsProtocol hs'
650 throwIO $ ProtocolError $ UnexpectedProtocol (hsProtocol hs') 651 , UnexpectedProtocol $ hsProtocol hs'),
651 652 (hsInfoHash hs == hsInfoHash hs'
652 unless (hsInfoHash hs == hsInfoHash hs') $ do 653 , UnexpectedTopic $ hsInfoHash hs'),
653 throwIO $ ProtocolError $ UnexpectedTopic (hsInfoHash hs') 654 (hsPeerId hs' == fromMaybe (hsPeerId hs') (peerId addr)
654 655 , UnexpectedPeerId $ hsPeerId hs')
655 unless (hsPeerId hs' == fromMaybe (hsPeerId hs') (peerId addr)) $ do 656 ]
656 throwIO $ ProtocolError $ UnexpectedPeerId (hsPeerId hs')
657 657
658 let caps = hsReserved hs <> hsReserved hs' 658 let caps = hsReserved hs <> hsReserved hs'
659 let wire' = if ExtExtended `allowed` caps 659 wire' = if ExtExtended `allowed` caps
660 then extendedHandshake extCaps >> wire 660 then extendedHandshake extCaps >> wire
661 else wire 661 else wire
662 662