Test peer list encoding

1 files changed, 48 insertions, 8 deletions

diff --git a/tests/Network/BitTorrent/Tracker/MessageSpec.hs b/tests/Network/BitTorrent/Tracker/MessageSpec.hs
index bf89e717..c3de7b30 100644
--- a/tests/Network/BitTorrent/Tracker/MessageSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/MessageSpec.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE RecordWildCards  #-}
+{-# LANGUAGE ViewPatterns     #-}
 {-# OPTIONS -fno-warn-orphans #-}
 module Network.BitTorrent.Tracker.MessageSpec
        ( spec
@@ -9,19 +10,19 @@ module Network.BitTorrent.Tracker.MessageSpec
 import Control.Applicative
 import Control.Exception
 import Data.BEncode as BE
+import Data.ByteString.Lazy as BL
 import Data.List as L
 import Data.Maybe
-import Data.Word
-import Network
 import Test.Hspec
 import Test.QuickCheck
 
 import Data.Torrent.InfoHashSpec ()
 import Data.Torrent.ProgressSpec ()
 import Network.BitTorrent.Core.PeerIdSpec ()
+import Network.BitTorrent.Core.PeerAddrSpec ()
 
 import Network.BitTorrent.Tracker.Message as Message
-import Network.BitTorrent.Core.PeerAddr
+import Network.BitTorrent.Core
 
 
 --prop_bencode :: Eq a => BEncode a => a -> Bool
@@ -33,9 +34,6 @@ import Network.BitTorrent.Core.PeerAddr
 instance Arbitrary Event where
   arbitrary = elements [minBound..maxBound]
 
-instance Arbitrary PortNumber where
-  arbitrary = fromIntegral <$> (arbitrary :: Gen Word16)
-
 instance Arbitrary AnnounceQuery where
   arbitrary = AnnounceQuery
     <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
@@ -56,6 +54,9 @@ validateInfo AnnounceQuery {..}  AnnounceInfo {..} = do
 arbitrarySample :: Arbitrary a => IO a
 arbitrarySample = L.head <$> sample' arbitrary
 
+zeroPeerId :: PeerAddr a -> PeerAddr a
+zeroPeerId addr = addr { peerId = Nothing }
+
 spec :: Spec
 spec = do
   describe "AnnounceQuery" $ do
@@ -63,6 +64,39 @@ spec = do
       parseAnnounceQuery (renderAnnounceQuery q)
         `shouldBe` Right q
 
+  describe "PeerList" $ do
+    context "Non compact" $ do
+      it "properly encoded (both ipv4 and ipv6)" $ do
+        BE.decode "ld2:ip7:1.2.3.44:porti80eed2:ip3:::14:porti8080eee"
+          `shouldBe` Right
+          (PeerList ["1.2.3.4:80", "[::1]:8080"] :: PeerList IPv4)
+
+      it "properly encoded (iso)" $ property $ \ xs ->
+        BE.decode (BL.toStrict (BE.encode (PeerList xs :: PeerList IPv4)))
+          `shouldBe` Right (PeerList xs :: PeerList IPv4)
+
+    context "Compact" $ do
+      it "properly encodes (ipv4)" $ do
+        BE.decode "12:\x1\x2\x3\x4\x1\x2\x9\x8\x7\x6\x1\x2"
+          `shouldBe` Right
+          (CompactPeerList ["1.2.3.4:258", "9.8.7.6:258"] :: PeerList IPv4)
+
+      it "properly encodes (ipv6)" $ do
+        BE.decode "18:\x1\x2\x3\x4\x5\x6\x7\x8\x1\x2\x3\x4\x5\x6\x7\x8\x1\x2"
+          `shouldBe` Right
+          (CompactPeerList ["[102:304:506:708:102:304:506:708]:258"]
+           :: PeerList IPv6)
+
+      it "properly encoded (ipv4, iso)" $
+        property $ \ (fmap zeroPeerId -> xs) ->
+          BE.decode (BL.toStrict (BE.encode (CompactPeerList xs)))
+            `shouldBe` Right (CompactPeerList xs :: PeerList IPv4)
+
+      it "properly encoded (ipv6, iso)" $
+        property $ \ (fmap zeroPeerId -> xs) ->
+          BE.decode (BL.toStrict (BE.encode (CompactPeerList xs)))
+            `shouldBe` Right (CompactPeerList xs :: PeerList IPv6)
+
   describe "AnnounceInfo" $ do
     it "parses minimal sample" $ do
       "d8:intervali0e5:peerslee"
@@ -92,8 +126,14 @@ spec = do
                    \required field `peers' not found"
 
     it "parses peer list" $ do -- TODO
-      "d8:intervali0e5:peerslee" `shouldBe`
-        AnnounceInfo Nothing Nothing 0 Nothing (PeerList []) Nothing
+      "d8:intervali0e\
+       \5:peersl\
+               \d2:ip7:1.2.3.4\
+               \4:porti80e\
+               \e\
+              \e\
+       \e" `shouldBe`
+        AnnounceInfo Nothing Nothing 0 Nothing (PeerList ["1.2.3.4:80"]) Nothing
 
   describe "Scrape" $ do
     return ()