~ Move compact peer list decoding to Peer.

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
              | AllowedFast !PieceIx
                deriving (Show, Eq)
 
-instance Serialize PortNumber where
-  get = fromIntegral <$> S.getWord16be
-  {-# INLINE get #-}
-  put = S.putWord16be . fromIntegral
-  {-# INLINE put #-}
-
 instance Serialize Message where
   get = do
     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
 
          -- * Peer address
        , PeerAddr(..)
+       , getCompactPeerList
        , peerSockAddr
        , connectToPeer
        , ppPeer
@@ -496,8 +497,8 @@ nameMap =
 -- compact list encoding.
 data PeerAddr = PeerAddr {
       peerID   :: Maybe PeerId
-    , peerIP   :: HostAddress
-    , peerPort :: PortNumber
+    , peerIP   :: {-# UNPACK #-} !HostAddress
+    , peerPort :: {-# UNPACK #-} !PortNumber
     } deriving (Show, Eq, Ord)
 
 -- TODO check semantic of ord and eq instances
@@ -520,6 +521,20 @@ instance BEncodable PeerAddr where
 
   fromBEncode _ = decodingError "PeerAddr"
 
+instance Serialize PortNumber where
+  get = fromIntegral <$> getWord16be
+  {-# INLINE get #-}
+  put = putWord16be . fromIntegral
+  {-# INLINE put #-}
+
+instance Serialize PeerAddr where
+  put PeerAddr {..} = put peerID >> put peerPort
+  {-# INLINE put #-}
+  get = PeerAddr Nothing <$> get <*> get
+  {-# INLINE get #-}
+
+getCompactPeerList :: Get [PeerAddr]
+getCompactPeerList = many get
 
 -- TODO make platform independent, clarify htonl
 
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 @@
 --   For more information see:
 --   <https://wiki.theory.org/BitTorrentSpecification#Tracker_HTTP.2FHTTPS_Protocol>
 --
-{-# OPTIONS -fno-warn-orphans #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS -fno-warn-orphans           #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
 -- TODO: add "compact" field to TRequest
 module Network.BitTorrent.Tracker.Protocol
        ( Event(..), TRequest(..), TResponse(..)
@@ -34,11 +37,13 @@ import Control.Monad
 import Data.Char as Char
 import Data.Word (Word32)
 import Data.Map  as M
+import Data.Maybe
+import Data.Word
 import Data.Monoid
 import Data.BEncode
 import Data.ByteString as B
 import           Data.Text as T
-import Data.Serialize.Get hiding (Result)
+import Data.Serialize hiding (Result)
 import Data.URLEncoded as URL
 import Data.Torrent
 
@@ -48,7 +53,7 @@ import Network.HTTP
 import Network.URI
 
 import Network.BitTorrent.Peer
-
+import Network.BitTorrent.Exchange.Protocol hiding (Request)
 
 
 -- | Events used to specify which kind of tracker request is performed.
@@ -110,7 +115,7 @@ data TRequest = TRequest { -- TODO peer here -- TODO detach announce
 --
 data TResponse =
      Failure Text -- ^ Failure reason in human readable form.
-   | OK {
+   | OK { -- TODO rename to anounce
        respWarning     ::  Maybe Text
        -- ^ Human readable warning.
 
@@ -156,22 +161,11 @@ instance BEncodable TResponse where
       where
         getPeers :: Maybe BEncode -> Result [PeerAddr]
         getPeers (Just (BList l))     = fromBEncode (BList l)
-        getPeers (Just (BString s))
-            | B.length s `mod` 6 == 0 =
-              let cnt = B.length s `div` 6 in
-              runGet (replicateM cnt peerG) s
-            | otherwise = decodingError "peers length not a multiple of 6"
-          where
-            peerG = do
-              pip   <- getWord32be
-              pport <- getWord16be
-              return $ PeerAddr Nothing (fromIntegral pip)
-                                        (fromIntegral pport)
-        getPeers _ = decodingError "Peers"
+        getPeers (Just (BString s))   = runGet getCompactPeerList s
+        getPeers  _                   = decodingError "Peers"
 
   fromBEncode _ = decodingError "TResponse"
 
-
 instance URLShow PortNumber where
   urlShow = urlShow . fromEnum
 
@@ -205,7 +199,7 @@ encodeRequest req = URL.urlEncode req
 
 -- | Ports typically reserved for bittorrent P2P communication.
 defaultPorts :: [PortNumber]
-defaultPorts = [6881..6889]
+defaultPorts =  [6881..6889]
 
 -- | Above 25, new peers are highly unlikely to increase download
 --   speed.  Even 30 peers is /plenty/, the official client version 3