summaryrefslogtreecommitdiff
path: root/src/System
diff options
context:
space:
mode:
Diffstat (limited to 'src/System')
-rw-r--r--src/System/Torrent/Storage.hs48
1 files changed, 43 insertions, 5 deletions
diff --git a/src/System/Torrent/Storage.hs b/src/System/Torrent/Storage.hs
index f73f1a55..a5529fe6 100644
--- a/src/System/Torrent/Storage.hs
+++ b/src/System/Torrent/Storage.hs
@@ -29,6 +29,7 @@ module System.Torrent.Storage
29 ) where 29 ) where
30 30
31import Control.Applicative 31import Control.Applicative
32import Control.Concurrent.STM
32import Control.Exception 33import Control.Exception
33import Control.Monad 34import Control.Monad
34import Data.ByteString as B 35import Data.ByteString as B
@@ -37,6 +38,7 @@ import Data.List as L
37import System.FilePath 38import System.FilePath
38import System.Directory 39import System.Directory
39 40
41import Data.Bitfield
40import Data.Torrent 42import Data.Torrent
41import Network.BitTorrent.Exchange.Protocol 43import Network.BitTorrent.Exchange.Protocol
42import Network.BitTorrent.Internal 44import Network.BitTorrent.Internal
@@ -47,19 +49,28 @@ data Storage = Storage {
47 -- | 49 -- |
48 session :: !SwarmSession 50 session :: !SwarmSession
49 51
50 -- | Used to map linear block addresses to disjoint mallocated/mmaped adresses. 52 -- |
53 , blocks :: !(TVar Bitfield)
54
55 -- | Used to map linear block addresses to disjoint
56 -- mallocated/mmaped adresses.
51 , payload :: !Fixed 57 , payload :: !Fixed
52 } 58 }
53 59
54pieceSize :: Storage -> Int 60pieceSize :: Storage -> Int
55pieceSize = ciPieceLength . tInfo . torrentMeta . session 61pieceSize = ciPieceLength . tInfo . torrentMeta . session
56 62
63{-----------------------------------------------------------------------
64 Construction
65-----------------------------------------------------------------------}
66
57-- TODO doc args 67-- TODO doc args
58bindTo :: SwarmSession -> FilePath -> IO Storage 68bindTo :: SwarmSession -> FilePath -> IO Storage
59bindTo se @ SwarmSession {..} contentPath = do 69bindTo se @ SwarmSession {..} contentPath = do
60 let content_paths = contentLayout contentPath (tInfo torrentMeta) 70 let content_paths = contentLayout contentPath (tInfo torrentMeta)
61 mapM_ mkDir (L.map fst content_paths) 71 mapM_ mkDir (L.map fst content_paths)
62 Storage se <$> coalesceFiles content_paths 72 Storage se <$> newTVarIO (haveNone (ciPieceLength (tInfo torrentMeta)))
73 <*> coalesceFiles content_paths
63 where 74 where
64 mkDir path = do 75 mkDir path = do
65 let dirPath = fst (splitFileName path) 76 let dirPath = fst (splitFileName path)
@@ -74,17 +85,44 @@ unbind st = error "unmapStorage"
74withStorage :: SwarmSession -> FilePath -> (Storage -> IO a) -> IO a 85withStorage :: SwarmSession -> FilePath -> (Storage -> IO a) -> IO a
75withStorage se path = bracket (se `bindTo` path) unbind 86withStorage se path = bracket (se `bindTo` path) unbind
76 87
88{-----------------------------------------------------------------------
89 Modification
90-----------------------------------------------------------------------}
91
92-- TODO to avoid races we might need to try Control.Concurrent.yield
93-- TODO lazy block payload
77 94
95-- | Write a block to the storage. If block out of range then block is clipped.
78putBlk :: Block -> Storage -> IO () 96putBlk :: Block -> Storage -> IO ()
79putBlk blk @ Block {..} st @ Storage {..} = do 97putBlk blk @ Block {..} st @ Storage {..} = do
80 writeBytes (blkInterval (pieceSize st) blk) (Lazy.fromChunks [blkData]) payload 98-- let blkIx = undefined
81 99-- bm <- readTVarIO blocks
82-- TODO 100-- unless (member blkIx bm) $ do
101 writeBytes (blkInterval (pieceSize st) blk)
102 (Lazy.fromChunks [blkData])
103 payload
104-- when (undefined bm blkIx) $ do
105-- if checkPiece ci piIx piece
106-- then return True
107-- else do
108-- reset
109-- return False
110
111-- | Read a block by given block index. If lower or upper bound out of
112-- range then index is clipped.
83getBlk :: BlockIx -> Storage -> IO Block 113getBlk :: BlockIx -> Storage -> IO Block
84getBlk ix @ BlockIx {..} st @ Storage {..} = do 114getBlk ix @ BlockIx {..} st @ Storage {..} = do
85 bs <- readBytes (ixInterval (pieceSize st) ix) payload 115 bs <- readBytes (ixInterval (pieceSize st) ix) payload
86 return $ Block ixPiece ixOffset (Lazy.toStrict bs) 116 return $ Block ixPiece ixOffset (Lazy.toStrict bs)
87 117
118-- | Should be used to verify piece.
119getPiece :: PieceIx -> Storage -> IO ByteString
120getPiece ix st = blkData <$> getBlk (BlockIx ix 0 (pieceSize st)) st
121
122{-----------------------------------------------------------------------
123 Internal
124-----------------------------------------------------------------------}
125
88ixInterval :: Int -> BlockIx -> FixedInterval 126ixInterval :: Int -> BlockIx -> FixedInterval
89ixInterval pieceSize BlockIx {..} = 127ixInterval pieceSize BlockIx {..} =
90 interval (ixPiece * pieceSize + ixOffset) ixLength 128 interval (ixPiece * pieceSize + ixOffset) ixLength