summaryrefslogtreecommitdiff
path: root/dht/bittorrent/tests/System/Torrent/StorageSpec.hs
blob: b5e49078a2ca0532095bbf1f84b1260c95380655 (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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
module System.Torrent.StorageSpec (spec) where
import Data.ByteString.Lazy as BL
import Data.Conduit as C
import Data.Conduit.List as C
import System.FilePath
import System.Directory
import System.IO.Unsafe
import Test.Hspec

import Data.Torrent
import Network.BitTorrent.Exchange.Bitfield as BF
import System.Torrent.Storage


layout :: FileLayout FileSize
layout =
  [ (dir </> "_a", 20)
  , (dir </> "_b", 50)
  , (dir </> "_c", 100)
  , (dir </> "_d", 5)
  ]
  where
    dir = unsafePerformIO $ getTemporaryDirectory

createLayout :: IO ()
createLayout = withStorage ReadWriteEx 1 layout (const (return ()))

psize :: PieceSize
psize = 16

pcount :: PieceCount
pcount = 11

spec :: Spec
spec = before createLayout $ do
  describe "writePiece" $ do
    it "should fail gracefully on write operation in RO mode" $ do
      withStorage ReadOnly 1 layout $ \ s ->
        writePiece (Piece 0 "a") s `shouldThrow` (== StorageIsRO)

    it "should fail if piece size do not match" $ do
      withStorage ReadWrite 1 layout $ \ s ->
        writePiece (Piece 0 "") s `shouldThrow` (== InvalidSize 0)

    it "should fail on negative index" $ do
      withStorage ReadWrite 1 layout $ \ s ->
        writePiece (Piece (-1) "") s `shouldThrow` (== InvalidIndex (-1))

    it "should fail on out of upper bound index" $ do
      withStorage ReadWrite 100 layout $ \ s -> do
        let bs = BL.replicate 100 0
        writePiece (Piece 0 bs) s

        let bs' = BL.replicate 75 0
        writePiece (Piece 1 bs') s

        writePiece (Piece 2 bs') s `shouldThrow` (== InvalidIndex 2)

  describe "readPiece" $ do
    it "should fail on negative index" $
      withStorage ReadOnly 1 layout $ \ s ->
        readPiece (-1) s `shouldThrow` (== InvalidIndex (-1))

    it "should fail on out of upper bound index" $ do
      withStorage ReadOnly 100 layout $ \ s -> do
        _ <- readPiece 1 s
        readPiece 2 s `shouldThrow` (== InvalidIndex 2)

  describe "sourceStorage" $ do
    it "should source all chunks" $ do
      withStorage ReadOnly psize layout $ \ s -> do
        n <- sourceStorage s $$ C.fold (\ n _ -> succ n) 0
        n `shouldBe` pcount

  -- this test should fail if 'sourceStorage' test fail
  describe "sinkStorage" $ do
    it "should write all chunks" $ do
      let byteVal       = 0
      let bzeroPiece  p = p { pieceData = BL.replicate (BL.length (pieceData p)) byteVal }
      let isZeroPiece p = (== byteVal) `BL.all` pieceData p

      withStorage ReadWrite psize layout $ \ s -> do
        sourceStorage s $= C.map bzeroPiece $$ sinkStorage s
        b <- sourceStorage s $$ C.fold (\ b p -> b && isZeroPiece p) True
        b `shouldBe` True

  describe "genPieceInfo" $ do
    it "" $ do
      withStorage ReadWrite psize layout $ \ s -> do
        bf <- genPieceInfo s >>= getBitfield s
        bf `shouldSatisfy` BF.full