Add tests for http tracker protocol

2 files changed, 26 insertions, 24 deletions

diff --git a/tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs
index 8e95286a..f8cf052a 100644
--- a/tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs
@@ -1,7 +1,14 @@
+{-# LANGUAGE RecordWildCards  #-}
 {-# OPTIONS -fno-warn-orphans #-}
-module Network.BitTorrent.Tracker.RPC.MessageSpec (spec) where
+module Network.BitTorrent.Tracker.RPC.MessageSpec
+       ( spec
+       , validateInfo
+       , arbitrarySample
+       ) where
 
 import Control.Applicative
+import Data.List as L
+import Data.Maybe
 import Data.Word
 import Network
 import Test.Hspec
@@ -11,7 +18,8 @@ import Data.Torrent.InfoHashSpec ()
 import Data.Torrent.ProgressSpec ()
 import Network.BitTorrent.Core.PeerIdSpec ()
 
-import Network.BitTorrent.Tracker.RPC.Message
+import Network.BitTorrent.Tracker.RPC.Message as Message
+import Network.BitTorrent.Core.PeerAddr
 
 
 --prop_bencode :: Eq a => BEncode a => a -> Bool
@@ -31,6 +39,21 @@ instance Arbitrary AnnounceQuery where
     <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
     <*> arbitrary <*> arbitrary <*> arbitrary
 
+validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
+validateInfo _ Message.Failure {..} = error "validateInfo: failure"
+validateInfo AnnounceQuery {..}  AnnounceInfo {..} = do
+    respComplete    `shouldSatisfy` isJust
+    respIncomplete  `shouldSatisfy` isJust
+    respMinInterval `shouldSatisfy` isNothing
+    respWarning     `shouldSatisfy` isNothing
+    peerList `shouldSatisfy` L.all (isNothing . peerID)
+    fromJust respComplete + fromJust respIncomplete `shouldBe` L.length peerList
+  where
+    peerList = getPeerList respPeers
+
+arbitrarySample :: Arbitrary a => IO a
+arbitrarySample = L.head <$> sample' arbitrary
+
 spec :: Spec
 spec = do
   describe "Announce" $ do
diff --git a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
index 73cf07f3..4954ee25 100644
--- a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
@@ -1,44 +1,23 @@
 {-# LANGUAGE RecordWildCards #-}
 module Network.BitTorrent.Tracker.RPC.UDPSpec (spec) where
 
-import Control.Applicative
 import Control.Monad
 import Data.Default
 import Data.List as L
 import Data.Maybe
 import Network.URI
 import Test.Hspec
-import Test.QuickCheck
 
-import Network.BitTorrent.Core.PeerAddr
-import Network.BitTorrent.Tracker.RPC.Message as Message
+import Network.BitTorrent.Tracker.RPC.MessageSpec hiding (spec)
 import Network.BitTorrent.Tracker.RPC.UDP
-import Network.BitTorrent.Tracker.RPC.MessageSpec ()
 
 
-arbitrarySample :: Arbitrary a => IO a
-arbitrarySample = L.head <$> sample' arbitrary
-
 trackerURIs :: [URI]
 trackerURIs =
   [ fromJust $ parseURI "udp://tracker.openbittorrent.com:80/announce"
   , fromJust $ parseURI "udp://tracker.publicbt.com:80/announce"
   ]
 
--- relation with query: peer id, numwant
-validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
-validateInfo _ Message.Failure {..} = error "validateInfo: failure"
-validateInfo AnnounceQuery {..}  AnnounceInfo {..} = do
-    respComplete    `shouldSatisfy` isJust
-    respIncomplete  `shouldSatisfy` isJust
-    respMinInterval `shouldSatisfy` isNothing
-    respWarning     `shouldSatisfy` isNothing
-    peerList `shouldSatisfy` L.all (isNothing . peerID)
-    fromJust respComplete + fromJust respIncomplete `shouldBe` L.length peerList
-  where
-    peerList = getPeerList respPeers
-
-
 spec :: Spec
 spec = do
   forM_ trackerURIs $ \ uri ->