summaryrefslogtreecommitdiff
path: root/tests/Network/BitTorrent/Exchange/Session/MetadataSpec.hs
blob: fc5236da43d7297d4ffc01be35b718ce4e056f9f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
{-# 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 as Torrent
import Network.BitTorrent.Address
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 = Torrent.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