summaryrefslogtreecommitdiff
path: root/bittorrent/tests/System/Torrent
diff options
context:
space:
mode:
Diffstat (limited to 'bittorrent/tests/System/Torrent')
-rw-r--r--bittorrent/tests/System/Torrent/FileMapSpec.hs116
-rw-r--r--bittorrent/tests/System/Torrent/StorageSpec.hs91
2 files changed, 0 insertions, 207 deletions
diff --git a/bittorrent/tests/System/Torrent/FileMapSpec.hs b/bittorrent/tests/System/Torrent/FileMapSpec.hs
deleted file mode 100644
index 29252925..00000000
--- a/bittorrent/tests/System/Torrent/FileMapSpec.hs
+++ /dev/null
@@ -1,116 +0,0 @@
1-- this is test string used in the 'spec' --- don't touch me!
2module System.Torrent.FileMapSpec (spec) where
3
4import Control.Monad.Loops
5import Data.List as L
6import Data.ByteString.Lazy as BL
7import System.Directory
8import System.FilePath
9import System.IO.Temp
10import Test.Hspec
11
12import Data.Torrent
13import System.Torrent.FileMap as FM
14
15
16withLayout :: (FileLayout FileSize -> IO ()) -> IO ()
17withLayout f = do
18 tmp <- getTemporaryDirectory
19 withTempDirectory tmp "bittorrentTestDir" $ \dir ->
20 f [ (dir </> "a", 2)
21 , (dir </> "b", 3)
22 , (dir </> "c", 2)
23 ] `seq` return ()
24
25spec :: Spec
26spec = do
27 describe "mmapFiles" $ do
28 it "creates new files" $ withLayout $ \layout -> do
29 m <- mmapFiles ReadWriteEx layout
30 unmapFiles m
31
32 (doesFileExist . fst) `allM` layout
33 `shouldReturn` True
34
35 describe "size" $ do
36 it "is equal to the layout size" $ withLayout $ \layout -> do
37 m <- mmapFiles ReadOnly layout
38 FM.size m `shouldBe` L.sum (L.map snd layout)
39 unmapFiles m
40
41 describe "readBytes" $ do
42 it "read from files" $ do
43 let thisFile = [("tests/System/Torrent/FileMapSpec.hs", 15)]
44 m <- mmapFiles ReadOnly thisFile
45 readBytes 3 15 m `shouldReturn` "this is test"
46 unmapFiles m
47
48 it "ignore underflow reads" $ withLayout $ \layout -> do
49 m <- mmapFiles ReadOnly layout
50 readBytes (-1) 1 m `shouldReturn` ""
51 readBytes (-5) 12 m `shouldReturn` ""
52 unmapFiles m
53
54 it "crop overflow reads" $ withLayout $ \layout -> do
55 _m <- mmapFiles ReadWrite layout
56 writeBytes 5 "cc" _m
57 unmapFiles _m
58
59 m <- mmapFiles ReadOnly layout
60 readBytes 5 10 m `shouldReturn` "cc"
61 unmapFiles m
62
63 describe "writeBytes" $ do
64 it "writes to files" $ withLayout $ \layout -> do
65 m <- mmapFiles ReadWriteEx layout
66 writeBytes 0 "a" m
67 readBytes 0 1 m `shouldReturn` "a"
68 writeBytes 1 "ab" m
69 readBytes 1 2 m `shouldReturn` "ab"
70 writeBytes 3 "b" m
71 readBytes 3 1 m `shouldReturn` "b"
72 writeBytes 4 "bc" m
73 readBytes 4 2 m `shouldReturn` "bc"
74 writeBytes 6 "c" m
75 readBytes 6 1 m `shouldReturn` "c"
76 readBytes 0 7 m `shouldReturn` "aabbbcc"
77 unmapFiles m
78
79 BL.readFile (fst (layout !! 0)) `shouldReturn` "aa"
80 BL.readFile (fst (layout !! 1)) `shouldReturn` "bbb"
81 BL.readFile (fst (layout !! 2)) `shouldReturn` "cc"
82
83 let max_page_size = 4 * 1024 * 1024
84 let long_bs = BL.replicate (fromIntegral max_page_size) 0
85
86 it "no buffer underflow errors" $ withLayout $ \layout -> do
87 m <- mmapFiles ReadWrite layout
88 writeBytes (1 - max_page_size) long_bs m
89 unmapFiles m
90
91 it "no buffer overflow errors" $ withLayout $ \layout -> do
92 m <- mmapFiles ReadWrite layout
93 writeBytes 5 long_bs m
94 unmapFiles m
95
96 it "ignore underflow writes" $ withLayout $ \layout -> do
97 _m <- mmapFiles ReadWrite layout
98 writeBytes 0 "aa" _m
99 unmapFiles _m
100
101 m <- mmapFiles ReadWrite layout
102 writeBytes (-1) "hhh" m
103 unmapFiles m
104 BL.readFile (fst (layout !! 0)) `shouldReturn` "aa"
105
106 it "crop overflow writes" $ withLayout $ \layout -> do
107 m <- mmapFiles ReadWrite layout
108 writeBytes 5 "ddddddddd" m
109 unmapFiles m
110 BL.readFile (fst (layout !! 2)) `shouldReturn` "dd"
111
112 describe "from/to lazy bytestring" $ do
113 it "isomorphic to lazy bytestring" $ withLayout $ \layout -> do
114 m <- mmapFiles ReadOnly layout
115 fromLazyByteString (toLazyByteString m) `shouldBe` m
116 unmapFiles m
diff --git a/bittorrent/tests/System/Torrent/StorageSpec.hs b/bittorrent/tests/System/Torrent/StorageSpec.hs
deleted file mode 100644
index b5e49078..00000000
--- a/bittorrent/tests/System/Torrent/StorageSpec.hs
+++ /dev/null
@@ -1,91 +0,0 @@
1module System.Torrent.StorageSpec (spec) where
2import Data.ByteString.Lazy as BL
3import Data.Conduit as C
4import Data.Conduit.List as C
5import System.FilePath
6import System.Directory
7import System.IO.Unsafe
8import Test.Hspec
9
10import Data.Torrent
11import Network.BitTorrent.Exchange.Bitfield as BF
12import System.Torrent.Storage
13
14
15layout :: FileLayout FileSize
16layout =
17 [ (dir </> "_a", 20)
18 , (dir </> "_b", 50)
19 , (dir </> "_c", 100)
20 , (dir </> "_d", 5)
21 ]
22 where
23 dir = unsafePerformIO $ getTemporaryDirectory
24
25createLayout :: IO ()
26createLayout = withStorage ReadWriteEx 1 layout (const (return ()))
27
28psize :: PieceSize
29psize = 16
30
31pcount :: PieceCount
32pcount = 11
33
34spec :: Spec
35spec = before createLayout $ do
36 describe "writePiece" $ do
37 it "should fail gracefully on write operation in RO mode" $ do
38 withStorage ReadOnly 1 layout $ \ s ->
39 writePiece (Piece 0 "a") s `shouldThrow` (== StorageIsRO)
40
41 it "should fail if piece size do not match" $ do
42 withStorage ReadWrite 1 layout $ \ s ->
43 writePiece (Piece 0 "") s `shouldThrow` (== InvalidSize 0)
44
45 it "should fail on negative index" $ do
46 withStorage ReadWrite 1 layout $ \ s ->
47 writePiece (Piece (-1) "") s `shouldThrow` (== InvalidIndex (-1))
48
49 it "should fail on out of upper bound index" $ do
50 withStorage ReadWrite 100 layout $ \ s -> do
51 let bs = BL.replicate 100 0
52 writePiece (Piece 0 bs) s
53
54 let bs' = BL.replicate 75 0
55 writePiece (Piece 1 bs') s
56
57 writePiece (Piece 2 bs') s `shouldThrow` (== InvalidIndex 2)
58
59 describe "readPiece" $ do
60 it "should fail on negative index" $
61 withStorage ReadOnly 1 layout $ \ s ->
62 readPiece (-1) s `shouldThrow` (== InvalidIndex (-1))
63
64 it "should fail on out of upper bound index" $ do
65 withStorage ReadOnly 100 layout $ \ s -> do
66 _ <- readPiece 1 s
67 readPiece 2 s `shouldThrow` (== InvalidIndex 2)
68
69 describe "sourceStorage" $ do
70 it "should source all chunks" $ do
71 withStorage ReadOnly psize layout $ \ s -> do
72 n <- sourceStorage s $$ C.fold (\ n _ -> succ n) 0
73 n `shouldBe` pcount
74
75 -- this test should fail if 'sourceStorage' test fail
76 describe "sinkStorage" $ do
77 it "should write all chunks" $ do
78 let byteVal = 0
79 let bzeroPiece p = p { pieceData = BL.replicate (BL.length (pieceData p)) byteVal }
80 let isZeroPiece p = (== byteVal) `BL.all` pieceData p
81
82 withStorage ReadWrite psize layout $ \ s -> do
83 sourceStorage s $= C.map bzeroPiece $$ sinkStorage s
84 b <- sourceStorage s $$ C.fold (\ b p -> b && isZeroPiece p) True
85 b `shouldBe` True
86
87 describe "genPieceInfo" $ do
88 it "" $ do
89 withStorage ReadWrite psize layout $ \ s -> do
90 bf <- genPieceInfo s >>= getBitfield s
91 bf `shouldSatisfy` BF.full \ No newline at end of file
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 14:35:25 +0000