summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange/Wire.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Wire.hs')
-rw-r--r--src/Network/BitTorrent/Exchange/Wire.hs54
1 files changed, 1 insertions, 53 deletions
diff --git a/src/Network/BitTorrent/Exchange/Wire.hs b/src/Network/BitTorrent/Exchange/Wire.hs
index 4aebdd24..4224a25d 100644
--- a/src/Network/BitTorrent/Exchange/Wire.hs
+++ b/src/Network/BitTorrent/Exchange/Wire.hs
@@ -17,6 +17,7 @@ module Network.BitTorrent.Exchange.Wire
17 ( -- * Wire 17 ( -- * Wire
18 Connected 18 Connected
19 , Wire 19 , Wire
20 , ChannelSide (..)
20 21
21 -- * Connection 22 -- * Connection
22 , Connection 23 , Connection
@@ -54,11 +55,7 @@ module Network.BitTorrent.Exchange.Wire
54 , filterQueue 55 , filterQueue
55 , getMaxQueueLength 56 , getMaxQueueLength
56 57
57 -- * Query
58 , getMetadata
59
60 -- * Exceptions 58 -- * Exceptions
61 , ChannelSide (..)
62 , ProtocolError (..) 59 , ProtocolError (..)
63 , WireFailure (..) 60 , WireFailure (..)
64 , peerPenalty 61 , peerPenalty
@@ -448,11 +445,6 @@ instance Default Options where
448-- Connection 445-- Connection
449-----------------------------------------------------------------------} 446-----------------------------------------------------------------------}
450 447
451data Cached a = Cached { unCache :: a, cached :: BS.ByteString }
452
453cache :: (BEncode a) => a -> Cached a
454cache s = Cached s (BSL.toStrict $ BE.encode s)
455
456data ConnectionState = ConnectionState { 448data ConnectionState = ConnectionState {
457 -- | If @not (allowed ExtExtended connCaps)@ then this set is always 449 -- | If @not (allowed ExtExtended connCaps)@ then this set is always
458 -- empty. Otherwise it has the BEP10 extension protocol mandated mapping of 450 -- empty. Otherwise it has the BEP10 extension protocol mandated mapping of
@@ -477,9 +469,6 @@ data ConnectionState = ConnectionState {
477 469
478 -- | Bitfield of remote endpoint. 470 -- | Bitfield of remote endpoint.
479 , _connBitfield :: !Bitfield 471 , _connBitfield :: !Bitfield
480
481 -- | Infodict associated with this Connection's connTopic.
482 , _connMetadata :: Maybe (Cached InfoDict)
483 } 472 }
484 473
485makeLenses ''ConnectionState 474makeLenses ''ConnectionState
@@ -722,7 +711,6 @@ connectWire session hs addr extCaps chan wire = do
722 } 711 }
723 , _connStatus = def 712 , _connStatus = def
724 , _connBitfield = BF.haveNone 0 713 , _connBitfield = BF.haveNone 0
725 , _connMetadata = Nothing
726 } 714 }
727 715
728 -- TODO make KA interval configurable 716 -- TODO make KA interval configurable
@@ -757,43 +745,3 @@ acceptWire sock peerAddr wire = do
757-- | Used when size of bitfield becomes known. 745-- | Used when size of bitfield becomes known.
758resizeBitfield :: Int -> Connected s () 746resizeBitfield :: Int -> Connected s ()
759resizeBitfield n = connBitfield %= adjustSize n 747resizeBitfield n = connBitfield %= adjustSize n
760
761{-----------------------------------------------------------------------
762-- Metadata exchange
763-----------------------------------------------------------------------}
764-- TODO introduce new metadata exchange specific exceptions
765
766fetchMetadata :: Wire s [BS.ByteString]
767fetchMetadata = loop 0
768 where
769 recvData = recvMessage >>= inspect
770 where
771 inspect (Extended (EMetadata _ meta)) =
772 case meta of
773 MetadataRequest pix -> do
774 sendMessage (MetadataReject pix)
775 recvData
776 MetadataData {..} -> return (piece, totalSize)
777 MetadataReject _ -> disconnectPeer
778 MetadataUnknown _ -> recvData
779 inspect _ = recvData
780
781 loop i = do
782 sendMessage (MetadataRequest i)
783 (piece, totalSize) <- recvData
784 unless (pieceIndex piece == i) $ do
785 disconnectPeer
786
787 if piece `isLastPiece` totalSize
788 then pure [pieceData piece]
789 else (pieceData piece :) <$> loop (succ i)
790
791getMetadata :: Wire s InfoDict
792getMetadata = do
793 chunks <- fetchMetadata
794 Connection {..} <- ask
795 case BE.decode (BS.concat chunks) of
796 Right (infodict @ InfoDict {..})
797 | connTopic == idInfoHash -> return infodict
798 | otherwise -> error "broken infodict"
799 Left err -> error $ "unable to parse infodict" ++ err