Add compact peer list constructor

2 files changed, 32 insertions, 16 deletions

diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index 73aa69fd..a4f45e74 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -16,7 +16,6 @@
 module Network.BitTorrent.Core.PeerAddr
        ( -- * Peer address
          PeerAddr(..)
-       , getCompactPeerList
        , peerSockAddr
        , connectToPeer
        , ppPeer
@@ -80,16 +79,14 @@ instance BEncode PeerAddr where
 
 -- | The tracker "compact peer list" compatible encoding. The
 -- 'peerId' is always 'Nothing'.
+--
+--   For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
 instance Serialize PeerAddr where
   put PeerAddr {..} = put peerID >> put peerPort
   {-# INLINE put #-}
   get = PeerAddr Nothing <$> get <*> get
   {-# INLINE get #-}
 
--- | For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
-getCompactPeerList :: S.Get [PeerAddr]
-getCompactPeerList = many get
-
 -- TODO make platform independent, clarify htonl
 
 -- | Convert peer info from tracker response to socket address.  Used
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs
index 469ca0ec..c46d5d58 100644
--- a/src/Network/BitTorrent/Tracker/Message.hs
+++ b/src/Network/BitTorrent/Tracker/Message.hs
@@ -27,6 +27,7 @@ module Network.BitTorrent.Tracker.Message
        ( -- * Announce
          Event(..)
        , AnnounceQuery(..)
+       , PeerList (..)
        , AnnounceInfo(..)
 
          -- ** Defaults
@@ -47,7 +48,7 @@ module Network.BitTorrent.Tracker.Message
 import Control.Applicative
 import Control.Exception
 import Control.Monad
-import Data.Aeson (ToJSON, FromJSON)
+import Data.Aeson (ToJSON(..), FromJSON(..))
 import Data.Aeson.TH
 import Data.BEncode as BE
 import Data.BEncode.BDict as BE
@@ -215,13 +216,29 @@ instance Serialize AnnounceQuery where
 --  Announce response
 -----------------------------------------------------------------------}
 
-newtype PeerList = PeerList { getPeerList :: [PeerAddr] }
-                   deriving (Show, Eq, ToJSON, FromJSON, Typeable)
+data PeerList
+  =        PeerList { getPeerList :: [PeerAddr] }
+  | CompactPeerList { getPeerList :: [PeerAddr] }
+    deriving (Show, Eq, Typeable)
+
+instance ToJSON PeerList where
+  toJSON      = toJSON . getPeerList
+
+instance FromJSON PeerList where
+  parseJSON v = PeerList <$> parseJSON v
+
+putCompactPeerList :: S.Putter [PeerAddr]
+putCompactPeerList = mapM_ put
+
+getCompactPeerList :: S.Get [PeerAddr]
+getCompactPeerList = many get
 
 instance BEncode PeerList where
-  toBEncode   (PeerList xs) = toBEncode xs
-  fromBEncode (BList    l ) = PeerList <$> fromBEncode (BList l)
-  fromBEncode (BString  s ) = PeerList <$> runGet getCompactPeerList s
+  toBEncode (PeerList        xs) = toBEncode xs
+  toBEncode (CompactPeerList xs) = toBEncode $ runPut (putCompactPeerList xs)
+
+  fromBEncode (BList    l ) = PeerList        <$> fromBEncode (BList l)
+  fromBEncode (BString  s ) = CompactPeerList <$> runGet getCompactPeerList s
   fromBEncode  _            = decodingError "Peer list"
 
 -- | The tracker response includes a peer list that helps the client
@@ -237,13 +254,13 @@ data AnnounceInfo =
        -- | Number of peers downloading the torrent. (leechers)
      , respIncomplete  :: !(Maybe Int)
 
-       -- | Recommended interval to wait between requests.
+       -- | Recommended interval to wait between requests, in seconds.
      , respInterval    :: !Int
 
-       -- | Minimal amount of time between requests. A peer /should/
-       -- make timeout with at least 'respMinInterval' value,
-       -- otherwise tracker might not respond. If not specified the
-       -- same applies to 'respInterval'.
+       -- | Minimal amount of time between requests, in seconds. A
+       -- peer /should/ make timeout with at least 'respMinInterval'
+       -- value, otherwise tracker might not respond. If not specified
+       -- the same applies to 'respInterval'.
      , respMinInterval :: !(Maybe Int)
 
        -- | Peers that must be contacted.
@@ -322,6 +339,8 @@ defaultPorts =  [6881..6889]
 defaultNumWant :: Int
 defaultNumWant = 50
 
+-- default value here: <https://wiki.theory.org/BitTorrent_Tracker_Protocol>
+
 {-----------------------------------------------------------------------
   Scrape message
 -----------------------------------------------------------------------}