Add metadata transfer scheduler spec

1 files changed, 71 insertions, 0 deletions

diff --git a/tests/Network/BitTorrent/Exchange/Session/MetadataSpec.hs b/tests/Network/BitTorrent/Exchange/Session/MetadataSpec.hs
new file mode 100644
index 00000000..975ceb5b
--- /dev/null
+++ b/tests/Network/BitTorrent/Exchange/Session/MetadataSpec.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE RecordWildCards #-}
+module Network.BitTorrent.Exchange.Session.MetadataSpec (spec) where
+import Control.Concurrent
+import Data.ByteString as BS
+import Data.ByteString.Lazy as BL
+import Test.Hspec
+import Test.QuickCheck
+
+import Data.BEncode as BE
+import Data.Torrent
+import Data.Torrent.Piece as P
+import Network.BitTorrent.Core
+import Network.BitTorrent.Exchange.Message
+import Network.BitTorrent.Exchange.Session.Metadata
+
+import Config
+import Network.BitTorrent.CoreSpec ()
+
+
+placeholderAddr :: PeerAddr IP
+placeholderAddr = "0.0.0.0:0"
+
+chunkBy :: Int -> BS.ByteString -> [BS.ByteString]
+chunkBy s bs
+  | BS.null bs = []
+  | otherwise  = BS.take s bs : chunkBy s (BS.drop s bs)
+
+withUpdates :: Updates a -> IO a
+withUpdates m = do
+  Torrent {..} <- getTestTorrent
+  let infoDictLen = fromIntegral $ BL.length $ BE.encode tInfoDict
+  mvar <- newMVar (nullStatus infoDictLen)
+  runUpdates mvar placeholderAddr m
+
+simulateFetch :: InfoDict -> Updates (Maybe InfoDict)
+simulateFetch dict = go
+  where
+    blocks = chunkBy metadataPieceSize (BL.toStrict (BE.encode dict))
+    packPiece ix = P.Piece ix (blocks !! ix)
+    ih     = idInfoHash dict
+
+    go = do
+      mix <- scheduleBlock
+      case mix of
+        Nothing -> return Nothing
+        Just ix -> do
+          mdict <- pushBlock (packPiece ix) ih
+          maybe go (return . Just) mdict
+
+spec :: Spec
+spec = do
+  describe "scheduleBlock" $ do
+    it "never schedule the same index twice" $ do
+      pending
+
+  describe "resetPending" $ do
+    it "" $ do
+      pending
+
+  describe "cancelPending" $ do
+    it "must not throw an exception if cancel the same piece twice" $ do
+      pending
+
+  describe "pushBlock" $ do
+    it "assemble infodict from chunks" $ do
+      Torrent {..} <- getTestTorrent
+      mdict <- withUpdates $ simulateFetch tInfoDict
+      mdict `shouldBe` Just tInfoDict
+
+    it "must throw an exception if block if not requested" $ do
+      pending
\ No newline at end of file