From f393a2ec1611d2e5587f6fc97317294377c72d5d Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Mon, 16 Dec 2013 15:32:01 +0400
Subject: Test peer list encoding

---
 src/Network/BitTorrent/Core/PeerAddr.hs   |  6 +++---
 src/Network/BitTorrent/Tracker/Message.hs | 23 +++++++++++------------
 2 files changed, 14 insertions(+), 15 deletions(-)

(limited to 'src')

diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index c9ec6b96..6c6056c9 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -154,11 +154,11 @@ instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where
     .: endDict
 
   fromBEncode = fromDict $ do
-    peerAddr <$>? peer_id_key
-             <*>! peer_ip_key
+    peerAddr <$>! peer_ip_key
+             <*>? peer_id_key
              <*>! peer_port_key
     where
-      peerAddr ip pid port = PeerAddr ip pid port
+      peerAddr = flip PeerAddr
 
 mergeIPLists :: [PeerAddr IPv4] -> Maybe [PeerAddr IPv6] -> [PeerAddr IP]
 mergeIPLists v4 v6 = (fmap IPv4 `L.map` v4)
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs
index 0d720471..d0be1c36 100644
--- a/src/Network/BitTorrent/Tracker/Message.hs
+++ b/src/Network/BitTorrent/Tracker/Message.hs
@@ -45,6 +45,7 @@ module Network.BitTorrent.Tracker.Message
 
          -- ** Info
        , PeerList (..)
+       , getPeerList
        , AnnounceInfo(..)
        , defaultNumWant
        , defaultMaxNumWant
@@ -435,24 +436,22 @@ renderAnnounceRequest = queryToSimpleQuery . toQuery
 --
 --   For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
 --
-data PeerList a
-  =        PeerList { getPeerList :: [PeerAddr a] }
-  | CompactPeerList { getPeerList :: [PeerAddr a] }
+data PeerList ip
+  = PeerList        [PeerAddr IP]
+  | CompactPeerList [PeerAddr ip]
     deriving (Show, Eq, Typeable, Functor)
 
-putCompactPeerList :: (Serialize a) => S.Putter [PeerAddr a]
-putCompactPeerList = mapM_ put
+getPeerList :: PeerList IP -> [PeerAddr IP]
+getPeerList (PeerList        xs) = xs
+getPeerList (CompactPeerList xs) = xs
 
-getCompactPeerList :: (Serialize a) => S.Get [PeerAddr a]
-getCompactPeerList = many get
-
-instance (Typeable a, BEncode a, Serialize a) => BEncode (PeerList a) where
+instance Serialize a => BEncode (PeerList a) where
   toBEncode (PeerList        xs) = toBEncode xs
-  toBEncode (CompactPeerList xs) = toBEncode $ runPut (putCompactPeerList xs)
+  toBEncode (CompactPeerList xs) = toBEncode $ runPut (mapM_ put xs)
 
   fromBEncode (BList    l ) = PeerList        <$> fromBEncode (BList l)
-  fromBEncode (BString  s ) = CompactPeerList <$> runGet getCompactPeerList s
-  fromBEncode  _            = decodingError "Peer list"
+  fromBEncode (BString  s ) = CompactPeerList <$> runGet (many get) s
+  fromBEncode  _ = decodingError "PeerList: should be a BString or BList"
 
 -- | The tracker response includes a peer list that helps the client
 --   participate in the torrent. The most important is 'respPeer' list
-- 
cgit v1.2.3