summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Network/BitTorrent/Exchange/Protocol.hs6
-rw-r--r--src/Network/BitTorrent/Peer.hs19
-rw-r--r--src/Network/BitTorrent/Tracker/Protocol.hs32
3 files changed, 30 insertions, 27 deletions
diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs
index 6dce2b4a..573a6e5c 100644
--- a/src/Network/BitTorrent/Exchange/Protocol.hs
+++ b/src/Network/BitTorrent/Exchange/Protocol.hs
@@ -383,12 +383,6 @@ data Message = KeepAlive
383 | AllowedFast !PieceIx 383 | AllowedFast !PieceIx
384 deriving (Show, Eq) 384 deriving (Show, Eq)
385 385
386instance Serialize PortNumber where
387 get = fromIntegral <$> S.getWord16be
388 {-# INLINE get #-}
389 put = S.putWord16be . fromIntegral
390 {-# INLINE put #-}
391
392instance Serialize Message where 386instance Serialize Message where
393 get = do 387 get = do
394 len <- getInt 388 len <- getInt
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs
index 7bac336b..7e4a1b5d 100644
--- a/src/Network/BitTorrent/Peer.hs
+++ b/src/Network/BitTorrent/Peer.hs
@@ -51,6 +51,7 @@ module Network.BitTorrent.Peer
51 51
52 -- * Peer address 52 -- * Peer address
53 , PeerAddr(..) 53 , PeerAddr(..)
54 , getCompactPeerList
54 , peerSockAddr 55 , peerSockAddr
55 , connectToPeer 56 , connectToPeer
56 , ppPeer 57 , ppPeer
@@ -496,8 +497,8 @@ nameMap =
496-- compact list encoding. 497-- compact list encoding.
497data PeerAddr = PeerAddr { 498data PeerAddr = PeerAddr {
498 peerID :: Maybe PeerId 499 peerID :: Maybe PeerId
499 , peerIP :: HostAddress 500 , peerIP :: {-# UNPACK #-} !HostAddress
500 , peerPort :: PortNumber 501 , peerPort :: {-# UNPACK #-} !PortNumber
501 } deriving (Show, Eq, Ord) 502 } deriving (Show, Eq, Ord)
502 503
503-- TODO check semantic of ord and eq instances 504-- TODO check semantic of ord and eq instances
@@ -520,6 +521,20 @@ instance BEncodable PeerAddr where
520 521
521 fromBEncode _ = decodingError "PeerAddr" 522 fromBEncode _ = decodingError "PeerAddr"
522 523
524instance Serialize PortNumber where
525 get = fromIntegral <$> getWord16be
526 {-# INLINE get #-}
527 put = putWord16be . fromIntegral
528 {-# INLINE put #-}
529
530instance Serialize PeerAddr where
531 put PeerAddr {..} = put peerID >> put peerPort
532 {-# INLINE put #-}
533 get = PeerAddr Nothing <$> get <*> get
534 {-# INLINE get #-}
535
536getCompactPeerList :: Get [PeerAddr]
537getCompactPeerList = many get
523 538
524-- TODO make platform independent, clarify htonl 539-- TODO make platform independent, clarify htonl
525 540
diff --git a/src/Network/BitTorrent/Tracker/Protocol.hs b/src/Network/BitTorrent/Tracker/Protocol.hs
index 52eb6c92..51d713dd 100644
--- a/src/Network/BitTorrent/Tracker/Protocol.hs
+++ b/src/Network/BitTorrent/Tracker/Protocol.hs
@@ -17,8 +17,11 @@
17-- For more information see: 17-- For more information see:
18-- <https://wiki.theory.org/BitTorrentSpecification#Tracker_HTTP.2FHTTPS_Protocol> 18-- <https://wiki.theory.org/BitTorrentSpecification#Tracker_HTTP.2FHTTPS_Protocol>
19-- 19--
20{-# OPTIONS -fno-warn-orphans #-} 20{-# OPTIONS -fno-warn-orphans #-}
21{-# LANGUAGE OverloadedStrings #-} 21{-# LANGUAGE OverloadedStrings #-}
22{-# LANGUAGE RecordWildCards #-}
23{-# LANGUAGE GeneralizedNewtypeDeriving #-}
24{-# LANGUAGE FlexibleInstances #-}
22-- TODO: add "compact" field to TRequest 25-- TODO: add "compact" field to TRequest
23module Network.BitTorrent.Tracker.Protocol 26module Network.BitTorrent.Tracker.Protocol
24 ( Event(..), TRequest(..), TResponse(..) 27 ( Event(..), TRequest(..), TResponse(..)
@@ -34,11 +37,13 @@ import Control.Monad
34import Data.Char as Char 37import Data.Char as Char
35import Data.Word (Word32) 38import Data.Word (Word32)
36import Data.Map as M 39import Data.Map as M
40import Data.Maybe
41import Data.Word
37import Data.Monoid 42import Data.Monoid
38import Data.BEncode 43import Data.BEncode
39import Data.ByteString as B 44import Data.ByteString as B
40import Data.Text as T 45import Data.Text as T
41import Data.Serialize.Get hiding (Result) 46import Data.Serialize hiding (Result)
42import Data.URLEncoded as URL 47import Data.URLEncoded as URL
43import Data.Torrent 48import Data.Torrent
44 49
@@ -48,7 +53,7 @@ import Network.HTTP
48import Network.URI 53import Network.URI
49 54
50import Network.BitTorrent.Peer 55import Network.BitTorrent.Peer
51 56import Network.BitTorrent.Exchange.Protocol hiding (Request)
52 57
53 58
54-- | Events used to specify which kind of tracker request is performed. 59-- | Events used to specify which kind of tracker request is performed.
@@ -110,7 +115,7 @@ data TRequest = TRequest { -- TODO peer here -- TODO detach announce
110-- 115--
111data TResponse = 116data TResponse =
112 Failure Text -- ^ Failure reason in human readable form. 117 Failure Text -- ^ Failure reason in human readable form.
113 | OK { 118 | OK { -- TODO rename to anounce
114 respWarning :: Maybe Text 119 respWarning :: Maybe Text
115 -- ^ Human readable warning. 120 -- ^ Human readable warning.
116 121
@@ -156,22 +161,11 @@ instance BEncodable TResponse where
156 where 161 where
157 getPeers :: Maybe BEncode -> Result [PeerAddr] 162 getPeers :: Maybe BEncode -> Result [PeerAddr]
158 getPeers (Just (BList l)) = fromBEncode (BList l) 163 getPeers (Just (BList l)) = fromBEncode (BList l)
159 getPeers (Just (BString s)) 164 getPeers (Just (BString s)) = runGet getCompactPeerList s
160 | B.length s `mod` 6 == 0 = 165 getPeers _ = decodingError "Peers"
161 let cnt = B.length s `div` 6 in
162 runGet (replicateM cnt peerG) s
163 | otherwise = decodingError "peers length not a multiple of 6"
164 where
165 peerG = do
166 pip <- getWord32be
167 pport <- getWord16be
168 return $ PeerAddr Nothing (fromIntegral pip)
169 (fromIntegral pport)
170 getPeers _ = decodingError "Peers"
171 166
172 fromBEncode _ = decodingError "TResponse" 167 fromBEncode _ = decodingError "TResponse"
173 168
174
175instance URLShow PortNumber where 169instance URLShow PortNumber where
176 urlShow = urlShow . fromEnum 170 urlShow = urlShow . fromEnum
177 171
@@ -205,7 +199,7 @@ encodeRequest req = URL.urlEncode req
205 199
206-- | Ports typically reserved for bittorrent P2P communication. 200-- | Ports typically reserved for bittorrent P2P communication.
207defaultPorts :: [PortNumber] 201defaultPorts :: [PortNumber]
208defaultPorts = [6881..6889] 202defaultPorts = [6881..6889]
209 203
210-- | Above 25, new peers are highly unlikely to increase download 204-- | Above 25, new peers are highly unlikely to increase download
211-- speed. Even 30 peers is /plenty/, the official client version 3 205-- speed. Even 30 peers is /plenty/, the official client version 3