1 files changed, 144 insertions, 0 deletions

diff --git a/bittorrent/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs b/bittorrent/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
new file mode 100644
index 00000000..73acb3fa
--- /dev/null
+++ b/bittorrent/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE RecordWildCards #-}
+module Network.BitTorrent.Tracker.RPC.UDPSpec (spec, rpcOpts) where
+import Control.Concurrent
+import Control.Concurrent.Async
+import Control.Exception
+import Control.Monad
+import Data.Default
+import Data.List as L
+import Data.Maybe
+import Test.Hspec
+
+import Network.BitTorrent.Address
+import Network.BitTorrent.Tracker.Message as Message
+
+import Network.BitTorrent.Tracker.TestData
+import Network.BitTorrent.Tracker.MessageSpec hiding (spec)
+import Network.BitTorrent.Tracker.RPC.UDP
+
+
+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)
+  where
+    peerList = getPeerList respPeers
+
+-- | Number of concurrent calls.
+rpcCount :: Int
+rpcCount = 100
+
+rpcOpts :: Options
+rpcOpts = def
+  { optMinTimeout = 1
+  , optMaxTimeout = 10
+  }
+
+isTimeoutExpired :: RpcException -> Bool
+isTimeoutExpired (TimeoutExpired _) = True
+isTimeoutExpired  _                 = False
+
+isSomeException :: SomeException -> Bool
+isSomeException _ = True
+
+isIOException :: IOException -> Bool
+isIOException _ = True
+
+spec :: Spec
+spec = parallel $ do
+  describe "newManager" $ do
+    it "should throw exception on zero optMaxPacketSize" $ do
+      let opts = def { optMaxPacketSize = 0 }
+      newManager opts `shouldThrow` isSomeException
+
+    it "should throw exception on zero optMinTimout" $ do
+      let opts = def { optMinTimeout = 0 }
+      newManager opts `shouldThrow` isSomeException
+
+    it "should throw exception on zero optMaxTimeout" $ do
+      let opts = def { optMaxTimeout = 0 }
+      newManager opts `shouldThrow` isSomeException
+
+    it "should throw exception on maxTimeout < minTimeout" $ do
+      let opts = def { optMinTimeout = 2, optMaxTimeout = 1 }
+      newManager opts `shouldThrow` isSomeException
+
+    it "should throw exception on zero optMultiplier" $ do
+      let opts = def { optMultiplier = 0 }
+      newManager opts `shouldThrow` isSomeException
+
+  describe "closeManager" $ do
+    it "unblock rpc calls" $ do
+      mgr <- newManager rpcOpts
+      _   <- forkIO $ do
+        threadDelay 10000000
+        closeManager mgr
+      q <- arbitrarySample
+      announce mgr (trackerURI badTracker) q `shouldThrow` (== ManagerClosed)
+
+    it "announce throw exception after manager closed" $ do
+      mgr <- newManager rpcOpts
+      closeManager mgr
+      q <- arbitrarySample
+      announce mgr (trackerURI badTracker) q `shouldThrow` isIOException
+
+    it "scrape throw exception after manager closed" $ do
+      mgr <- newManager rpcOpts
+      closeManager mgr
+      scrape mgr (trackerURI badTracker) [def] `shouldThrow` isIOException
+
+  describe "withManager" $ do
+    it "closesManager at exit" $ do
+      mgr <- withManager rpcOpts return
+      scrape mgr (trackerURI badTracker) [def] `shouldThrow` isSomeException
+
+  describe "RPC" $ do
+    describe "announce" $ do
+      it "must fail on bad scheme" $ do
+        withManager rpcOpts $ \ mgr -> do
+          q <- arbitrarySample
+          announce mgr "magnet://a.com" q
+            `shouldThrow` (== UnrecognizedScheme "magnet:")
+
+    describe "scrape" $ do
+      it "must fail on bad scheme" $ do
+        withManager rpcOpts $ \ mgr -> do
+          scrape mgr "magnet://a.com" []
+            `shouldThrow` (== UnrecognizedScheme "magnet:")
+
+    forM_ (L.filter isUdpTracker trackers) $ \ TrackerEntry {..} ->
+      context trackerName $ do
+
+        describe "announce" $ do
+          if tryAnnounce then do
+            it "have valid response" $ do
+              withManager rpcOpts $ \ mgr -> do
+                q <- arbitrarySample
+                announce mgr trackerURI q >>= validateInfo q
+          else do
+            it "should throw TimeoutExpired" $ do
+              withManager rpcOpts $ \ mgr -> do
+                q <- arbitrarySample
+                announce mgr trackerURI q `shouldThrow` isTimeoutExpired
+
+        describe "scrape" $ do
+          if tryScraping then do
+            it "have valid response" $ do
+              withManager rpcOpts $ \ mgr -> do
+                xs <- scrape mgr trackerURI [def]
+                L.length xs `shouldSatisfy` (>= 1)
+          else do
+            it "should throw TimeoutExpired" $ do
+              withManager rpcOpts $ \ mgr -> do
+                scrape mgr trackerURI [def] `shouldThrow` isTimeoutExpired
+
+        describe "Manager" $ do
+          when tryScraping $ do
+            it "should handle arbitrary intermixed concurrent queries" $ do
+              withManager rpcOpts $ \ mgr -> do
+                _ <- mapConcurrently (\ _ -> scrape mgr trackerURI [def]) [1..rpcCount]
+                return ()