diff options
Diffstat (limited to 'tests/Network/BitTorrent/Exchange/Session/MetadataSpec.hs')
-rw-r--r-- | tests/Network/BitTorrent/Exchange/Session/MetadataSpec.hs | 71 |
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 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | ||
2 | module Network.BitTorrent.Exchange.Session.MetadataSpec (spec) where | ||
3 | import Control.Concurrent | ||
4 | import Data.ByteString as BS | ||
5 | import Data.ByteString.Lazy as BL | ||
6 | import Test.Hspec | ||
7 | import Test.QuickCheck | ||
8 | |||
9 | import Data.BEncode as BE | ||
10 | import Data.Torrent | ||
11 | import Data.Torrent.Piece as P | ||
12 | import Network.BitTorrent.Core | ||
13 | import Network.BitTorrent.Exchange.Message | ||
14 | import Network.BitTorrent.Exchange.Session.Metadata | ||
15 | |||
16 | import Config | ||
17 | import Network.BitTorrent.CoreSpec () | ||
18 | |||
19 | |||
20 | placeholderAddr :: PeerAddr IP | ||
21 | placeholderAddr = "0.0.0.0:0" | ||
22 | |||
23 | chunkBy :: Int -> BS.ByteString -> [BS.ByteString] | ||
24 | chunkBy s bs | ||
25 | | BS.null bs = [] | ||
26 | | otherwise = BS.take s bs : chunkBy s (BS.drop s bs) | ||
27 | |||
28 | withUpdates :: Updates a -> IO a | ||
29 | withUpdates m = do | ||
30 | Torrent {..} <- getTestTorrent | ||
31 | let infoDictLen = fromIntegral $ BL.length $ BE.encode tInfoDict | ||
32 | mvar <- newMVar (nullStatus infoDictLen) | ||
33 | runUpdates mvar placeholderAddr m | ||
34 | |||
35 | simulateFetch :: InfoDict -> Updates (Maybe InfoDict) | ||
36 | simulateFetch dict = go | ||
37 | where | ||
38 | blocks = chunkBy metadataPieceSize (BL.toStrict (BE.encode dict)) | ||
39 | packPiece ix = P.Piece ix (blocks !! ix) | ||
40 | ih = idInfoHash dict | ||
41 | |||
42 | go = do | ||
43 | mix <- scheduleBlock | ||
44 | case mix of | ||
45 | Nothing -> return Nothing | ||
46 | Just ix -> do | ||
47 | mdict <- pushBlock (packPiece ix) ih | ||
48 | maybe go (return . Just) mdict | ||
49 | |||
50 | spec :: Spec | ||
51 | spec = do | ||
52 | describe "scheduleBlock" $ do | ||
53 | it "never schedule the same index twice" $ do | ||
54 | pending | ||
55 | |||
56 | describe "resetPending" $ do | ||
57 | it "" $ do | ||
58 | pending | ||
59 | |||
60 | describe "cancelPending" $ do | ||
61 | it "must not throw an exception if cancel the same piece twice" $ do | ||
62 | pending | ||
63 | |||
64 | describe "pushBlock" $ do | ||
65 | it "assemble infodict from chunks" $ do | ||
66 | Torrent {..} <- getTestTorrent | ||
67 | mdict <- withUpdates $ simulateFetch tInfoDict | ||
68 | mdict `shouldBe` Just tInfoDict | ||
69 | |||
70 | it "must throw an exception if block if not requested" $ do | ||
71 | pending \ No newline at end of file | ||