2 files changed, 207 insertions, 0 deletions

diff --git a/dht/bittorrent/tests/System/Torrent/FileMapSpec.hs b/dht/bittorrent/tests/System/Torrent/FileMapSpec.hs
new file mode 100644
index 00000000..29252925
--- /dev/null
+++ b/dht/bittorrent/tests/System/Torrent/FileMapSpec.hs
@@ -0,0 +1,116 @@
+-- this is test string used in the 'spec' --- don't touch me!
+module System.Torrent.FileMapSpec (spec) where
+
+import Control.Monad.Loops
+import Data.List as L
+import Data.ByteString.Lazy as BL
+import System.Directory
+import System.FilePath
+import System.IO.Temp
+import Test.Hspec
+
+import Data.Torrent
+import System.Torrent.FileMap as FM
+
+
+withLayout :: (FileLayout FileSize -> IO ()) -> IO ()
+withLayout f = do
+  tmp <- getTemporaryDirectory
+  withTempDirectory tmp "bittorrentTestDir" $ \dir ->
+    f [ (dir </> "a", 2)
+      , (dir </> "b", 3)
+      , (dir </> "c", 2)
+      ] `seq` return ()
+
+spec :: Spec
+spec = do
+  describe "mmapFiles" $ do
+    it "creates new files" $ withLayout $ \layout -> do
+      m <- mmapFiles ReadWriteEx layout
+      unmapFiles m
+
+      (doesFileExist . fst) `allM` layout
+        `shouldReturn` True
+
+  describe "size" $ do
+    it "is equal to the layout size" $ withLayout $ \layout -> do
+      m <- mmapFiles ReadOnly layout
+      FM.size m `shouldBe` L.sum (L.map snd layout)
+      unmapFiles m
+
+  describe "readBytes" $ do
+    it "read from files" $ do
+      let thisFile = [("tests/System/Torrent/FileMapSpec.hs", 15)]
+      m <- mmapFiles ReadOnly thisFile
+      readBytes 3 15 m `shouldReturn` "this is test"
+      unmapFiles m
+
+    it "ignore underflow reads" $ withLayout $ \layout -> do
+      m <- mmapFiles ReadOnly layout
+      readBytes (-1) 1  m `shouldReturn` ""
+      readBytes (-5) 12 m `shouldReturn` ""
+      unmapFiles m
+
+    it "crop overflow reads" $ withLayout $ \layout -> do
+      _m <- mmapFiles ReadWrite layout
+      writeBytes 5 "cc" _m
+      unmapFiles _m
+
+      m <- mmapFiles ReadOnly layout
+      readBytes 5 10 m `shouldReturn` "cc"
+      unmapFiles m
+
+  describe "writeBytes" $ do
+    it "writes to files" $ withLayout $ \layout -> do
+      m <- mmapFiles ReadWriteEx layout
+      writeBytes 0 "a"   m
+      readBytes  0 1 m `shouldReturn` "a"
+      writeBytes 1 "ab"  m
+      readBytes  1 2 m `shouldReturn` "ab"
+      writeBytes 3 "b"   m
+      readBytes  3 1 m `shouldReturn` "b"
+      writeBytes 4 "bc"  m
+      readBytes  4 2 m `shouldReturn` "bc"
+      writeBytes 6 "c"   m
+      readBytes  6 1 m `shouldReturn` "c"
+      readBytes  0 7 m `shouldReturn` "aabbbcc"
+      unmapFiles m
+
+      BL.readFile (fst (layout !! 0)) `shouldReturn` "aa"
+      BL.readFile (fst (layout !! 1)) `shouldReturn` "bbb"
+      BL.readFile (fst (layout !! 2)) `shouldReturn` "cc"
+
+    let max_page_size = 4 * 1024 * 1024
+    let long_bs = BL.replicate (fromIntegral max_page_size) 0
+
+    it "no buffer underflow errors" $ withLayout $ \layout -> do
+      m <- mmapFiles ReadWrite layout
+      writeBytes (1 - max_page_size) long_bs m
+      unmapFiles m
+
+    it "no buffer overflow errors" $ withLayout $ \layout -> do
+      m <- mmapFiles ReadWrite layout
+      writeBytes 5 long_bs m
+      unmapFiles m
+
+    it "ignore underflow writes" $ withLayout $ \layout -> do
+      _m <- mmapFiles ReadWrite layout
+      writeBytes 0 "aa" _m
+      unmapFiles _m
+
+      m <- mmapFiles ReadWrite layout
+      writeBytes (-1) "hhh" m
+      unmapFiles m
+      BL.readFile (fst (layout !! 0)) `shouldReturn` "aa"
+
+    it "crop overflow writes" $ withLayout $ \layout -> do
+      m <- mmapFiles ReadWrite layout
+      writeBytes 5 "ddddddddd" m
+      unmapFiles m
+      BL.readFile (fst (layout !! 2)) `shouldReturn` "dd"
+
+  describe "from/to lazy bytestring" $ do
+    it "isomorphic to lazy bytestring" $ withLayout $ \layout -> do
+      m <- mmapFiles ReadOnly layout
+      fromLazyByteString (toLazyByteString m) `shouldBe` m
+      unmapFiles m
diff --git a/dht/bittorrent/tests/System/Torrent/StorageSpec.hs b/dht/bittorrent/tests/System/Torrent/StorageSpec.hs
new file mode 100644
index 00000000..b5e49078
--- /dev/null
+++ b/dht/bittorrent/tests/System/Torrent/StorageSpec.hs
@@ -0,0 +1,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
\ No newline at end of file