diff options
-rw-r--r-- | bittorrent.cabal | 1 | ||||
-rw-r--r-- | src/System/Torrent/Storage.hs | 24 | ||||
-rw-r--r-- | tests/System/Torrent/StorageSpec.hs | 26 |
3 files changed, 51 insertions, 0 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal index 2f30d848..67f1ef18 100644 --- a/bittorrent.cabal +++ b/bittorrent.cabal | |||
@@ -212,6 +212,7 @@ test-suite spec | |||
212 | 212 | ||
213 | , mtl | 213 | , mtl |
214 | , resourcet | 214 | , resourcet |
215 | , conduit | ||
215 | 216 | ||
216 | , hspec >= 1.8.1.1 | 217 | , hspec >= 1.8.1.1 |
217 | , QuickCheck | 218 | , QuickCheck |
diff --git a/src/System/Torrent/Storage.hs b/src/System/Torrent/Storage.hs index 1c84bf69..3bb229a4 100644 --- a/src/System/Torrent/Storage.hs +++ b/src/System/Torrent/Storage.hs | |||
@@ -36,11 +36,17 @@ module System.Torrent.Storage | |||
36 | , readPiece | 36 | , readPiece |
37 | , hintRead | 37 | , hintRead |
38 | , unsafeReadPiece | 38 | , unsafeReadPiece |
39 | |||
40 | -- * Streaming | ||
41 | , sourceStorage | ||
42 | , sinkStorage | ||
39 | ) where | 43 | ) where |
40 | 44 | ||
41 | import Control.Applicative | 45 | import Control.Applicative |
42 | import Control.Exception | 46 | import Control.Exception |
47 | import Control.Monad.Trans | ||
43 | import Data.ByteString.Lazy as BL | 48 | import Data.ByteString.Lazy as BL |
49 | import Data.Conduit | ||
44 | import Data.Typeable | 50 | import Data.Typeable |
45 | 51 | ||
46 | import Data.Torrent.Bitfield as BF | 52 | import Data.Torrent.Bitfield as BF |
@@ -120,6 +126,24 @@ unsafeReadPiece pix s @ Storage {..} | |||
120 | offset = fromIntegral pix * fromIntegral pieceLen | 126 | offset = fromIntegral pix * fromIntegral pieceLen |
121 | sz = fromIntegral pieceLen | 127 | sz = fromIntegral pieceLen |
122 | 128 | ||
129 | -- | Stream storage pieces from first to the last. | ||
130 | sourceStorage :: Storage -> Source IO (Piece BL.ByteString) | ||
131 | sourceStorage s = go 0 | ||
132 | where | ||
133 | go pix | ||
134 | | pix < totalPieces s = do | ||
135 | piece <- liftIO $ readPiece pix s | ||
136 | liftIO $ hintRead (succ pix) s | ||
137 | yield piece | ||
138 | go (succ pix) | ||
139 | | otherwise = return () | ||
140 | |||
141 | -- | Write stream of pieces to the storage. Fail if storage is 'ReadOnly'. | ||
142 | sinkStorage :: Storage -> Sink (Piece BL.ByteString) IO () | ||
143 | sinkStorage s = do | ||
144 | awaitForever $ \ piece -> | ||
145 | liftIO $ writePiece piece s | ||
146 | |||
123 | -- | TODO examples of use | 147 | -- | TODO examples of use |
124 | genPieceInfo :: Storage -> IO PieceInfo | 148 | genPieceInfo :: Storage -> IO PieceInfo |
125 | genPieceInfo = undefined | 149 | genPieceInfo = undefined |
diff --git a/tests/System/Torrent/StorageSpec.hs b/tests/System/Torrent/StorageSpec.hs index 8267b7a5..d2185961 100644 --- a/tests/System/Torrent/StorageSpec.hs +++ b/tests/System/Torrent/StorageSpec.hs | |||
@@ -1,6 +1,8 @@ | |||
1 | module System.Torrent.StorageSpec (spec) where | 1 | module System.Torrent.StorageSpec (spec) where |
2 | import Control.Exception | 2 | import Control.Exception |
3 | import Data.ByteString.Lazy as BL | 3 | import Data.ByteString.Lazy as BL |
4 | import Data.Conduit as C | ||
5 | import Data.Conduit.List as C | ||
4 | import System.FilePath | 6 | import System.FilePath |
5 | import System.Directory | 7 | import System.Directory |
6 | import System.IO.Unsafe | 8 | import System.IO.Unsafe |
@@ -25,6 +27,12 @@ createLayout :: IO () | |||
25 | createLayout = | 27 | createLayout = |
26 | bracket (open ReadWriteEx 0 layout) close (const (return ())) | 28 | bracket (open ReadWriteEx 0 layout) close (const (return ())) |
27 | 29 | ||
30 | psize :: PieceSize | ||
31 | psize = 16 | ||
32 | |||
33 | pcount :: PieceCount | ||
34 | pcount = 11 | ||
35 | |||
28 | spec :: Spec | 36 | spec :: Spec |
29 | spec = before createLayout $ do | 37 | spec = before createLayout $ do |
30 | describe "writePiece" $ do | 38 | describe "writePiece" $ do |
@@ -56,3 +64,21 @@ spec = before createLayout $ do | |||
56 | withStorage ReadOnly 100 layout $ \ s -> do | 64 | withStorage ReadOnly 100 layout $ \ s -> do |
57 | _ <- readPiece 1 s | 65 | _ <- readPiece 1 s |
58 | readPiece 2 s `shouldThrow` (== InvalidIndex 2) | 66 | readPiece 2 s `shouldThrow` (== InvalidIndex 2) |
67 | |||
68 | describe "sourceStorage" $ do | ||
69 | it "should source all chunks" $ do | ||
70 | withStorage ReadOnly psize layout $ \ s -> do | ||
71 | n <- sourceStorage s $$ C.fold (\ n _ -> succ n) 0 | ||
72 | n `shouldBe` pcount | ||
73 | |||
74 | -- this test should fail if 'sourceStorage' test fail | ||
75 | describe "sinkStorage" $ do | ||
76 | it "should write all chunks" $ do | ||
77 | let byteVal = 0 | ||
78 | let bzeroPiece p = p { pieceData = BL.replicate (BL.length (pieceData p)) byteVal } | ||
79 | let isZeroPiece p = (== byteVal) `BL.all` pieceData p | ||
80 | |||
81 | withStorage ReadWrite psize layout $ \ s -> do | ||
82 | sourceStorage s $= C.map bzeroPiece $$ sinkStorage s | ||
83 | b <- sourceStorage s $$ C.fold (\ b p -> b && isZeroPiece p) True | ||
84 | b `shouldBe` True | ||