summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/System/Torrent/Storage.hs57
1 files changed, 45 insertions, 12 deletions
diff --git a/src/System/Torrent/Storage.hs b/src/System/Torrent/Storage.hs
index fafdab98..71e0616b 100644
--- a/src/System/Torrent/Storage.hs
+++ b/src/System/Torrent/Storage.hs
@@ -14,8 +14,11 @@
14-- data in the filesystem. 14-- data in the filesystem.
15-- 15--
16{-# LANGUAGE RecordWildCards #-} 16{-# LANGUAGE RecordWildCards #-}
17{-# LANGUAGE DeriveDataTypeable #-}
17module System.Torrent.Storage 18module System.Torrent.Storage
18 ( Storage 19 ( -- * Storage
20 Storage
21 , StorageFailure (..)
19 22
20 -- * Construction 23 -- * Construction
21 , Mode (..) 24 , Mode (..)
@@ -34,7 +37,9 @@ module System.Torrent.Storage
34 ) where 37 ) where
35 38
36import Control.Applicative 39import Control.Applicative
40import Control.Exception
37import Data.ByteString.Lazy as BL 41import Data.ByteString.Lazy as BL
42import Data.Typeable
38 43
39import Data.Torrent.Bitfield 44import Data.Torrent.Bitfield
40import Data.Torrent.Layout 45import Data.Torrent.Layout
@@ -42,34 +47,62 @@ import Data.Torrent.Piece
42import System.Torrent.FileMap 47import System.Torrent.FileMap
43 48
44 49
50data StorageFailure
51 -- | Occurs on a write operation if the storage has been opened
52 -- using 'ReadOnly' mode.
53 = StorageIsRO
54
55 -- | Piece index is out of bounds.
56 | InvalidIndex PieceIx
57
58 -- | Piece size do not match with one passed to the 'open'
59 -- function.
60 | InvalidSize PieceSize
61 deriving (Show, Typeable)
62
63instance Exception StorageFailure
64
45-- TODO validation 65-- TODO validation
46data Storage = Storage 66data Storage = Storage
47 { pieceLen :: {-# UNPACK #-} !PieceSize 67 { mode :: !Mode
68 , pieceLen :: {-# UNPACK #-} !PieceSize
48 , fileMap :: {-# UNPACK #-} !FileMap 69 , fileMap :: {-# UNPACK #-} !FileMap
49 } 70 }
50 71
51-- ResourceT ? 72-- ResourceT ?
52open :: Mode -> PieceSize -> FileLayout FileSize -> IO Storage 73open :: Mode -> PieceSize -> FileLayout FileSize -> IO Storage
53open mode s l = Storage s <$> mmapFiles mode l 74open mode s l = Storage mode s <$> mmapFiles mode l
54 75
55close :: Storage -> IO () 76close :: Storage -> IO ()
56close Storage {..} = unmapFiles fileMap 77close Storage {..} = unmapFiles fileMap
57 78
79isValidIx :: PieceIx -> Storage -> Bool
80isValidIx i s = 0 <= i && i < undefined s
81
58writePiece :: Piece BL.ByteString -> Storage -> IO () 82writePiece :: Piece BL.ByteString -> Storage -> IO ()
59writePiece Piece {..} Storage {..} = do 83writePiece p @ Piece {..} s @ Storage {..}
60 writeBytes (fromIntegral (pieceIndex * pieceLen)) pieceData fileMap 84 | mode == ReadOnly = throwIO StorageIsRO
85 | pieceSize p /= pieceLen = throwIO (InvalidSize (pieceSize p))
86 | not (isValidIx pieceIndex s) = throwIO (InvalidIndex pieceIndex)
87 | otherwise = writeBytes offset pieceData fileMap
88 where
89 offset = fromIntegral pieceIndex * fromIntegral pieceLen
61 90
62readPiece :: PieceIx -> Storage -> IO (Piece BL.ByteString) 91readPiece :: PieceIx -> Storage -> IO (Piece BL.ByteString)
63readPiece pix Storage {..} = do 92readPiece pix s @ Storage {..}
64 bs <- readBytes (fromIntegral (pix * pieceLen)) 93 | not (isValidIx pix s) = throwIO (InvalidIndex pix)
65 (fromIntegral pieceLen) fileMap 94 | otherwise = Piece pix <$> readBytes offset sz fileMap
66 return $ Piece pix bs 95 where
96 offset = fromIntegral pix * fromIntegral pieceLen
97 sz = fromIntegral pieceLen
67 98
68unsafeReadPiece :: PieceIx -> Storage -> IO (Piece BL.ByteString) 99unsafeReadPiece :: PieceIx -> Storage -> IO (Piece BL.ByteString)
69unsafeReadPiece pix Storage {..} = return $ Piece pix lbs 100unsafeReadPiece pix s @ Storage {..}
101 | not (isValidIx pix s) = throwIO (InvalidIndex pix)
102 | otherwise = return $ Piece pix (unsafeReadBytes offset sz fileMap)
70 where 103 where
71 lbs = unsafeReadBytes (fromIntegral (pix * pieceLen)) 104 offset = fromIntegral pix * fromIntegral pieceLen
72 (fromIntegral pieceLen) fileMap 105 sz = fromIntegral pieceLen
73 106
74-- | TODO examples of use 107-- | TODO examples of use
75genPieceInfo :: Storage -> IO PieceInfo 108genPieceInfo :: Storage -> IO PieceInfo