diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-08-16 08:50:08 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-08-16 08:50:08 +0400 |
commit | 6bb92a610c4874ea3fa37fb15cd55c48f219d6ed (patch) | |
tree | e9362f06242d11a55cade4d8705155c6d388a85e /src/System | |
parent | 1c19636c20e918388ef7f16faa8c6fb617d917d8 (diff) |
~ Remove torrent-content modules.
Diffstat (limited to 'src/System')
-rw-r--r-- | src/System/IO/MMap/Fixed.hs | 212 | ||||
-rw-r--r-- | src/System/Torrent/Storage.hs | 332 |
2 files changed, 0 insertions, 544 deletions
diff --git a/src/System/IO/MMap/Fixed.hs b/src/System/IO/MMap/Fixed.hs deleted file mode 100644 index 1e83c350..00000000 --- a/src/System/IO/MMap/Fixed.hs +++ /dev/null | |||
@@ -1,212 +0,0 @@ | |||
1 | -- TODO pprint | ||
2 | -- TODO see if this IntervalMap is overkill: Interval dataty have 4 constrs | ||
3 | -- TODO clarify lifetime in docs | ||
4 | -- TODO use madvise | ||
5 | -- TODO unmap selected interval | ||
6 | -- TODO tests | ||
7 | -- TODO benchmarks | ||
8 | -- TODO unmap overlapped regions | ||
9 | -- [A] TODO lazy mapping for 32 bit arch; | ||
10 | -- we need tricky algorithm and a lot of perf tests | ||
11 | -- TODO use memmove in write bytes | ||
12 | -- TODO write elem, write byte, read byte | ||
13 | -- | | ||
14 | -- Copyright : (c) Sam T. 2013 | ||
15 | -- License : MIT | ||
16 | -- Maintainer : pxqr.sta@gmail.com | ||
17 | -- Stability : experimental | ||
18 | -- Portability : portable | ||
19 | -- | ||
20 | -- This library provides mechanism to mmap files to fixed address | ||
21 | -- with fine-grained control. Hovewer, instead of using MAP_FIXED we | ||
22 | -- create our own address space upon virtual address space. If you | ||
23 | -- would like you could call this space as "fixed address space". | ||
24 | -- | ||
25 | -- This solves a few problems: | ||
26 | -- | ||
27 | -- * Page already in use. If you mmap one file at 0..x addresses and | ||
28 | -- want to map second file to x..y addresses using MAP_FIXED you | ||
29 | -- can get in troubles: page might be mapped already. Raw call to | ||
30 | -- mmap will silently unmap x..y addresses and then mmap our second | ||
31 | -- file. So here we have extra unmap we would like to avoid. | ||
32 | -- | ||
33 | -- * Page boundaries. If you mmap one file at x..x+1 you could | ||
34 | -- not map next file to say addresses x+1..x+2. | ||
35 | -- | ||
36 | -- Internally we make ordinary call to mmap to map a file and then | ||
37 | -- using /interval map/ we map fixed address space to virtual | ||
38 | -- address space. It takes TODO time in TODO cases. | ||
39 | -- | ||
40 | -- Basically this library could be used when we need coalesce | ||
41 | -- several files in arbitrary way. We could map at any position as | ||
42 | -- long as offset + size fit in 'Int'. | ||
43 | -- | ||
44 | -- For other details see: | ||
45 | -- | ||
46 | -- > http://hackage.haskell.org/package/mmap | ||
47 | -- > man mmap | ||
48 | -- | ||
49 | {-# LANGUAGE RecordWildCards #-} | ||
50 | module System.IO.MMap.Fixed | ||
51 | ( -- * Intervals | ||
52 | FixedOffset, FileOffset, FixedInterval, FileInterval | ||
53 | , interval, fileInterval | ||
54 | |||
55 | -- * Construction | ||
56 | , Fixed, Bytes | ||
57 | , System.IO.MMap.Fixed.empty, insertTo | ||
58 | , coalesceFiles | ||
59 | |||
60 | -- ** Specialized 'insertTo' | ||
61 | , mmapTo, mallocTo | ||
62 | , lookupRegion | ||
63 | |||
64 | -- * Query | ||
65 | , upperAddr | ||
66 | |||
67 | -- * Access | ||
68 | , viewBytes, readBytes, writeBytes | ||
69 | , readElem, writeElem | ||
70 | ) where | ||
71 | |||
72 | import Data.ByteString.Lazy as Lazy | ||
73 | import Data.ByteString.Lazy.Internal as Lazy | ||
74 | import Data.ByteString.Internal as B | ||
75 | import Data.List as L | ||
76 | import Data.Int | ||
77 | import Data.IntervalMap.Strict as M | ||
78 | import Data.IntervalMap.Interval | ||
79 | import System.IO.MMap | ||
80 | import Foreign | ||
81 | |||
82 | |||
83 | type FixedOffset = Int | ||
84 | type FileOffset = Int64 | ||
85 | type Size = Int | ||
86 | |||
87 | |||
88 | type FileInterval = (FileOffset, Size) | ||
89 | type FixedInterval = Interval FixedOffset | ||
90 | |||
91 | |||
92 | interval :: FixedOffset -> Size -> FixedInterval | ||
93 | interval off s = IntervalCO off (off + fromIntegral (max 0 s)) | ||
94 | {-# INLINE interval #-} | ||
95 | |||
96 | fileInterval :: FileOffset -> Size -> FileInterval | ||
97 | fileInterval off s = (off, s) | ||
98 | {-# INLINE fileInterval #-} | ||
99 | |||
100 | intervalSize :: FixedInterval -> Size | ||
101 | intervalSize i = upperBound i - lowerBound i | ||
102 | {-# INLINE intervalSize #-} | ||
103 | |||
104 | |||
105 | type Bytes = (ForeignPtr Word8, Size) | ||
106 | |||
107 | type FixedMap = IntervalMap FixedOffset Bytes | ||
108 | |||
109 | newtype Fixed = Fixed { imap :: FixedMap } | ||
110 | |||
111 | instance Show Fixed where | ||
112 | show = show . M.toList . imap | ||
113 | |||
114 | |||
115 | mapIM :: (FixedMap -> FixedMap) -> Fixed -> Fixed | ||
116 | mapIM f s = s { imap = f (imap s) } | ||
117 | |||
118 | empty :: Fixed | ||
119 | empty = Fixed M.empty | ||
120 | |||
121 | coalesceFiles :: [(FilePath, Int)] -> IO Fixed | ||
122 | coalesceFiles = go 0 System.IO.MMap.Fixed.empty | ||
123 | where | ||
124 | go _ s [] = return s | ||
125 | go offset s ((path, bsize) : xs) = do | ||
126 | s' <- mmapTo path (0, bsize) offset s | ||
127 | go (offset + bsize) s' xs | ||
128 | |||
129 | upperAddr :: Fixed -> FixedOffset | ||
130 | upperAddr = upperBound . fst . findLast . imap | ||
131 | |||
132 | insertTo :: FixedInterval -> Bytes -> Fixed -> Fixed | ||
133 | insertTo fi mm = mapIM (M.insert fi mm) | ||
134 | {-# INLINE insertTo #-} | ||
135 | |||
136 | mmapTo :: FilePath -> FileInterval -> FixedOffset -> Fixed -> IO Fixed | ||
137 | mmapTo path mrange to s = do | ||
138 | (fptr, offset, fsize) <- mmapFileForeignPtr path ReadWriteEx (Just mrange) | ||
139 | |||
140 | let fixed = interval to fsize | ||
141 | let mmaped = (fptr, offset) | ||
142 | |||
143 | return $ insertTo fixed mmaped s | ||
144 | |||
145 | mallocTo :: FixedInterval -> Fixed -> IO Fixed | ||
146 | mallocTo fi s = do | ||
147 | let bsize = intervalSize fi | ||
148 | fptr <- mallocForeignPtrBytes bsize | ||
149 | return (insertTo fi (fptr, 0) s) | ||
150 | |||
151 | lookupRegion :: FixedOffset -> Fixed -> Maybe B.ByteString | ||
152 | lookupRegion offset Fixed {..} = | ||
153 | case intersecting imap $ IntervalCO offset (succ offset) of | ||
154 | [(i, (fptr, off))] -> let s = upperBound i - lowerBound i | ||
155 | in Just $ fromForeignPtr fptr off (max 0 s) | ||
156 | _ -> Nothing | ||
157 | |||
158 | -- | Note: this is unsafe operation. | ||
159 | viewBytes :: FixedInterval -> Fixed -> Lazy.ByteString | ||
160 | viewBytes fi s = fromChunks $ L.map mk $ (imap s `intersecting` fi) | ||
161 | where | ||
162 | mk (i, (fptr, offset)) = | ||
163 | let dropB = max 0 (lowerBound fi - lowerBound i) | ||
164 | dropT = max 0 (upperBound i - upperBound fi) | ||
165 | bsize = intervalSize i - (dropT + dropB) | ||
166 | in fromForeignPtr fptr (offset + dropB) bsize | ||
167 | |||
168 | |||
169 | readBytes :: FixedInterval -> Fixed -> IO Lazy.ByteString | ||
170 | readBytes fi s = let c = Lazy.copy (viewBytes fi s) in mkCopy c >> return c | ||
171 | {-# INLINE readBytes #-} | ||
172 | |||
173 | writeBytes :: FixedInterval -> Lazy.ByteString -> Fixed -> IO () | ||
174 | writeBytes fi bs s = bscpy (viewBytes fi s) bs | ||
175 | {-# INLINE writeBytes #-} | ||
176 | |||
177 | -- | Note: this operation takes O(log(files count)) time, if possible | ||
178 | -- use readBytes. | ||
179 | readElem :: Storable a => Fixed -> FixedOffset -> IO a | ||
180 | readElem s offset = go undefined | ||
181 | where | ||
182 | go :: Storable a => a -> IO a | ||
183 | go dont_touch = do | ||
184 | let bsize = sizeOf dont_touch | ||
185 | let PS fptr off _ = Lazy.toStrict (viewBytes (interval offset bsize) s) | ||
186 | withForeignPtr fptr $ \ ptr -> peekByteOff ptr off | ||
187 | |||
188 | writeElem :: Storable a => Fixed -> FixedOffset -> a -> IO () | ||
189 | writeElem s offset x = do | ||
190 | let bsize = sizeOf x | ||
191 | let PS fptr off _ = Lazy.toStrict (viewBytes (interval offset bsize) s) | ||
192 | withForeignPtr fptr $ \ptr -> pokeByteOff ptr off x | ||
193 | |||
194 | |||
195 | mkCopy :: Lazy.ByteString -> IO () | ||
196 | mkCopy Empty = return () | ||
197 | mkCopy (Chunk _ x) = mkCopy x | ||
198 | |||
199 | bscpy :: Lazy.ByteString -> Lazy.ByteString -> IO () | ||
200 | bscpy (PS _ _ 0 `Chunk` dest_rest) src = bscpy dest_rest src | ||
201 | bscpy dest (PS _ _ 0 `Chunk` src_rest) = bscpy dest src_rest | ||
202 | bscpy (PS dest_fptr dest_off dest_size `Chunk` dest_rest) | ||
203 | (PS src_fptr src_off src_size `Chunk` src_rest) | ||
204 | = do let csize = min dest_size src_size | ||
205 | withForeignPtr dest_fptr $ \dest_ptr -> | ||
206 | withForeignPtr src_fptr $ \src_ptr -> | ||
207 | memcpy (dest_ptr `advancePtr` dest_off) | ||
208 | (src_ptr `advancePtr` src_off) | ||
209 | (fromIntegral csize) -- TODO memmove? | ||
210 | bscpy (PS dest_fptr (dest_off + csize) (dest_size - csize) `Chunk` dest_rest) | ||
211 | (PS src_fptr (src_off + csize) (src_size - csize) `Chunk` src_rest) | ||
212 | bscpy _ _ = return () \ No newline at end of file | ||
diff --git a/src/System/Torrent/Storage.hs b/src/System/Torrent/Storage.hs deleted file mode 100644 index 99d164f2..00000000 --- a/src/System/Torrent/Storage.hs +++ /dev/null | |||
@@ -1,332 +0,0 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam T. 2013 | ||
3 | -- License : MIT | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : non-portable | ||
7 | -- | ||
8 | -- This module implements mapping from single continious block space | ||
9 | -- to file storage. Storage can be used in two modes: | ||
10 | -- | ||
11 | -- * As in memory storage - in this case we don't touch filesystem. | ||
12 | -- | ||
13 | -- * As ordinary mmaped file storage - when we need to store | ||
14 | -- data in the filesystem. | ||
15 | -- | ||
16 | {-# LANGUAGE DoAndIfThenElse #-} | ||
17 | {-# LANGUAGE NamedFieldPuns #-} | ||
18 | {-# LANGUAGE RecordWildCards #-} | ||
19 | module System.Torrent.Storage | ||
20 | ( Storage | ||
21 | , ppStorage | ||
22 | |||
23 | -- * Construction | ||
24 | , openStorage, closeStorage, withStorage | ||
25 | , getCompleteBitfield | ||
26 | |||
27 | -- * Modification | ||
28 | , getBlk, putBlk, selBlk | ||
29 | |||
30 | -- * TODO expose only File interface! | ||
31 | -- * File interface | ||
32 | , FD | ||
33 | , openFD, flushFD, closeFD | ||
34 | , readFD, writeFD | ||
35 | ) where | ||
36 | |||
37 | import Control.Applicative | ||
38 | import Control.Concurrent.STM | ||
39 | import Control.Exception | ||
40 | import Control.Monad | ||
41 | import Control.Monad.Trans | ||
42 | |||
43 | import Data.ByteString as B | ||
44 | import qualified Data.ByteString.Lazy as Lazy | ||
45 | import Text.PrettyPrint | ||
46 | import System.FilePath | ||
47 | import System.Directory | ||
48 | import Foreign.C.Error | ||
49 | |||
50 | import Data.Bitfield as BF | ||
51 | import Data.Torrent | ||
52 | import Network.BitTorrent.Exchange.Protocol | ||
53 | import System.IO.MMap.Fixed as Fixed | ||
54 | |||
55 | -- TODO merge piece validation and Sessions.available into one transaction. | ||
56 | data Storage = Storage { | ||
57 | -- | | ||
58 | metainfo :: !Torrent | ||
59 | |||
60 | -- | Bitmask of complete and verified _pieces_. | ||
61 | , complete :: !(TVar Bitfield) | ||
62 | |||
63 | -- | Bitmask of complete _blocks_. | ||
64 | , blocks :: !(TVar Bitfield) | ||
65 | -- TODO use bytestring for fast serialization | ||
66 | -- because we need to write this bitmap to disc periodically | ||
67 | |||
68 | , blockSize :: !Int | ||
69 | |||
70 | -- | Used to map linear block addresses to disjoint | ||
71 | -- mallocated/mmaped adresses. | ||
72 | , payload :: !Fixed | ||
73 | } | ||
74 | |||
75 | ppStorage :: Storage -> IO Doc | ||
76 | ppStorage Storage {..} = pp <$> readTVarIO blocks | ||
77 | where | ||
78 | pp bf = int blockSize | ||
79 | |||
80 | getCompleteBitfield :: Storage -> STM Bitfield | ||
81 | getCompleteBitfield Storage {..} = readTVar complete | ||
82 | |||
83 | {----------------------------------------------------------------------- | ||
84 | Construction | ||
85 | -----------------------------------------------------------------------} | ||
86 | |||
87 | -- TODO doc args | ||
88 | openStorage :: Torrent -> FilePath -> Bitfield -> IO Storage | ||
89 | openStorage t @ Torrent {..} contentPath bf = do | ||
90 | let content_paths = contentLayout contentPath tInfo | ||
91 | mapM_ (mkDir . fst) content_paths | ||
92 | |||
93 | let blockSize = defaultBlockSize `min` ciPieceLength tInfo | ||
94 | print $ "content length " ++ show (contentLength tInfo) | ||
95 | Storage t <$> newTVarIO bf | ||
96 | <*> newTVarIO (haveNone (blockCount blockSize tInfo)) | ||
97 | <*> pure blockSize | ||
98 | <*> coalesceFiles content_paths | ||
99 | where | ||
100 | mkDir path = do | ||
101 | let dirPath = fst (splitFileName path) | ||
102 | exist <- doesDirectoryExist dirPath | ||
103 | unless exist $ do | ||
104 | createDirectoryIfMissing True dirPath | ||
105 | |||
106 | -- TODO | ||
107 | closeStorage :: Storage -> IO () | ||
108 | closeStorage st = return () | ||
109 | |||
110 | |||
111 | withStorage :: Torrent -> FilePath -> Bitfield -> (Storage -> IO a) -> IO a | ||
112 | withStorage se path bf = bracket (openStorage se path bf) closeStorage | ||
113 | |||
114 | {----------------------------------------------------------------------- | ||
115 | Modification | ||
116 | -----------------------------------------------------------------------} | ||
117 | |||
118 | -- TODO to avoid races we might need to try Control.Concurrent.yield | ||
119 | -- TODO make block_payload :: Lazy.ByteString | ||
120 | |||
121 | selBlk :: MonadIO m => PieceIx -> Storage -> m [BlockIx] | ||
122 | selBlk pix st @ Storage {..} | ||
123 | = liftIO $ {-# SCC selBlk #-} atomically $ do | ||
124 | mask <- pieceMask pix st | ||
125 | select mask <$> readTVar blocks | ||
126 | where | ||
127 | select mask = fmap mkBix . toList . difference mask | ||
128 | -- TODO clip upper bound of block index | ||
129 | mkBix ix = BlockIx pix (blockSize * (ix - offset)) blockSize | ||
130 | |||
131 | offset = coeff * pix | ||
132 | coeff = ciPieceLength (tInfo metainfo) `div` blockSize | ||
133 | |||
134 | -- | ||
135 | -- TODO make global lock map -- otherwise we might get broken pieces | ||
136 | -- | ||
137 | -- imagine the following situation: | ||
138 | -- | ||
139 | -- thread1: write | ||
140 | -- thread1: mark | ||
141 | -- | ||
142 | -- this let us avoid races as well | ||
143 | -- | ||
144 | |||
145 | -- | Write a block to the storage. If block out of range then block is clipped. | ||
146 | -- | ||
147 | -- | ||
148 | -- | ||
149 | putBlk :: MonadIO m => Block -> Storage -> m Bool | ||
150 | putBlk blk @ Block {..} st @ Storage {..} | ||
151 | = liftIO $ {-# SCC putBlk #-} do | ||
152 | -- let blkIx = undefined | ||
153 | -- bm <- readTVarIO blocks | ||
154 | -- unless (member blkIx bm) $ do | ||
155 | writeBytes (blkInterval (ciPieceLength (tInfo metainfo)) blk) blkData payload | ||
156 | |||
157 | markBlock blk st | ||
158 | validatePiece blkPiece st | ||
159 | |||
160 | markBlock :: Block -> Storage -> IO () | ||
161 | markBlock Block {..} Storage {..} = {-# SCC markBlock #-} do | ||
162 | let piLen = ciPieceLength (tInfo metainfo) | ||
163 | let glIx = (piLen `div` blockSize) * blkPiece + (blkOffset `div` blockSize) | ||
164 | atomically $ modifyTVar' blocks (have glIx) | ||
165 | |||
166 | -- | Read a block by given block index. If lower or upper bound out of | ||
167 | -- range then index is clipped. | ||
168 | -- | ||
169 | -- Do not block. | ||
170 | -- | ||
171 | getBlk :: MonadIO m => BlockIx -> Storage -> m Block | ||
172 | getBlk ix @ BlockIx {..} st @ Storage {..} | ||
173 | = liftIO $ {-# SCC getBlk #-} do | ||
174 | -- TODO check if __piece__ is available | ||
175 | let piLen = ciPieceLength (tInfo metainfo) | ||
176 | bs <- readBytes (ixInterval piLen ix) payload | ||
177 | return $ Block ixPiece ixOffset bs | ||
178 | |||
179 | getPiece :: PieceIx -> Storage -> IO ByteString | ||
180 | getPiece pix st @ Storage {..} = {-# SCC getPiece #-} do | ||
181 | let piLen = ciPieceLength (tInfo metainfo) | ||
182 | let bix = BlockIx pix 0 piLen | ||
183 | let bs = viewBytes (ixInterval piLen bix) payload | ||
184 | return $! Lazy.toStrict bs | ||
185 | |||
186 | resetPiece :: PieceIx -> Storage -> IO () | ||
187 | resetPiece pix st @ Storage {..} | ||
188 | = {-# SCC resetPiece #-} atomically $ do | ||
189 | mask <- pieceMask pix st | ||
190 | modifyTVar' blocks (`difference` mask) | ||
191 | |||
192 | validatePiece :: PieceIx -> Storage -> IO Bool | ||
193 | validatePiece pix st @ Storage {..} = {-# SCC validatePiece #-} do | ||
194 | downloaded <- atomically $ isDownloaded pix st | ||
195 | if not downloaded then return False | ||
196 | else do | ||
197 | piece <- getPiece pix st | ||
198 | if checkPiece (tInfo metainfo) pix piece | ||
199 | then do | ||
200 | atomically $ modifyTVar' complete (BF.have pix) | ||
201 | return True | ||
202 | else do | ||
203 | print $ "----------------------------- invalid " ++ show pix | ||
204 | -- resetPiece pix st | ||
205 | return True | ||
206 | |||
207 | -- | Check each piece in the storage against content info hash. | ||
208 | -- | ||
209 | -- Note that this function will block until each the entire storage | ||
210 | -- checked. This may take a long time for a big torrents use fork | ||
211 | -- if needed. | ||
212 | -- | ||
213 | validateStorage :: Storage -> IO () | ||
214 | validateStorage st = undefined -- (`validatePiece` st) [0..pieceCount st] | ||
215 | |||
216 | {----------------------------------------------------------------------- | ||
217 | POSIX-like file interface | ||
218 | ------------------------------------------------------------------------ | ||
219 | This is useful for virtual filesystem writers and just for per file | ||
220 | interface. | ||
221 | -----------------------------------------------------------------------} | ||
222 | -- TODO reference counting: storage might be closed before all FDs | ||
223 | -- gets closed! | ||
224 | -- or we can forbid to close storage and use finalizers only? | ||
225 | |||
226 | type Offset = Int | ||
227 | type Size = Int | ||
228 | |||
229 | data FD = FD { | ||
230 | fdData :: ByteString | ||
231 | , fdNoBlock :: Bool | ||
232 | } | ||
233 | |||
234 | |||
235 | -- TODO return "is dir" error | ||
236 | -- | This call correspond to open(2) with the following parameters: | ||
237 | -- | ||
238 | -- * OpenMode = ReadOnly; | ||
239 | -- | ||
240 | -- * OpenFileFlags = O_NONBLOCK. (not true yet) | ||
241 | -- | ||
242 | openFD :: FilePath -> Bool -> Storage -> IO (Either Errno FD) | ||
243 | openFD path nonblock Storage {..} | ||
244 | | Just offset <- fileOffset path (tInfo metainfo) | ||
245 | , Just bs <- lookupRegion (fromIntegral offset) payload | ||
246 | = return $ Right $ FD bs nonblock | ||
247 | | otherwise = return $ Left $ eNOENT | ||
248 | |||
249 | -- | Cancel all enqueued read operations and report any delayed | ||
250 | -- errors. | ||
251 | flushFD :: FD -> IO Errno | ||
252 | flushFD _ = return eOK | ||
253 | |||
254 | -- | This call correspond to close(2). | ||
255 | closeFD :: FD -> IO () | ||
256 | closeFD _ = return () | ||
257 | |||
258 | -- TODO | ||
259 | maskRegion :: FD -> Offset -> Size -> Maybe Size | ||
260 | maskRegion FD {..} offset siz = return siz | ||
261 | |||
262 | -- TODO | ||
263 | isComplete :: FD -> Offset -> Size -> IO Size | ||
264 | isComplete _ _ siz = return siz | ||
265 | |||
266 | -- TODO | ||
267 | enqueueRead :: FD -> Offset -> Size -> IO () | ||
268 | enqueueRead _ _ _ = return () | ||
269 | |||
270 | -- TODO | ||
271 | readAhead :: FD -> Offset -> Size -> IO () | ||
272 | readAhead _ _ _ = return () | ||
273 | |||
274 | -- TODO | ||
275 | waitRegion :: FD -> Offset -> Size -> IO ByteString | ||
276 | waitRegion _ _ _ = return B.empty | ||
277 | |||
278 | -- TODO implement blocking and non blocking modes? | ||
279 | -- TODO check if region completely downloaded | ||
280 | -- TODO if not we could return EAGAIN | ||
281 | -- TODO enqueue read to piece manager | ||
282 | -- | This call correspond to pread(2). | ||
283 | readFD :: FD -> Offset -> Size -> IO (Either Errno ByteString) | ||
284 | readFD fd @ FD {..} offset reqSize = | ||
285 | case maskRegion fd offset reqSize of | ||
286 | Nothing -> return $ Right B.empty | ||
287 | Just expSize -> do | ||
288 | availSize <- isComplete fd offset expSize | ||
289 | if availSize == expSize then haveAllReg expSize else haveSomeReg expSize | ||
290 | where | ||
291 | haveAllReg expSize = do | ||
292 | readAhead fd offset expSize | ||
293 | return $ Right $ slice offset expSize fdData | ||
294 | |||
295 | haveSomeReg expSize | ||
296 | | fdNoBlock = return $ Left $ eAGAIN | ||
297 | | otherwise = do | ||
298 | bs <- waitRegion fd offset expSize | ||
299 | readAhead fd offset expSize | ||
300 | return $ Right bs | ||
301 | |||
302 | -- TODO implement COW; needed for applications which want to change files. | ||
303 | writeFD :: FD -> ByteString -> Offset -> IO () | ||
304 | writeFD FD {..} bs offset = return () | ||
305 | |||
306 | {----------------------------------------------------------------------- | ||
307 | Internal | ||
308 | -----------------------------------------------------------------------} | ||
309 | |||
310 | isDownloaded :: PieceIx -> Storage -> STM Bool | ||
311 | isDownloaded pix st @ Storage {..} = do | ||
312 | bf <- readTVar blocks | ||
313 | mask <- pieceMask pix st | ||
314 | return $ intersection mask bf == mask | ||
315 | |||
316 | pieceMask :: PieceIx -> Storage -> STM Bitfield | ||
317 | pieceMask pix Storage {..} = do | ||
318 | bf <- readTVar blocks | ||
319 | return $ BF.interval (totalCount bf) offset (offset + coeff - 1) | ||
320 | where | ||
321 | offset = coeff * pix | ||
322 | coeff = ciPieceLength (tInfo metainfo) `div` blockSize | ||
323 | |||
324 | |||
325 | ixInterval :: Int -> BlockIx -> FixedInterval | ||
326 | ixInterval pieceSize BlockIx {..} = | ||
327 | Fixed.interval (ixPiece * pieceSize + ixOffset) ixLength | ||
328 | |||
329 | blkInterval :: Int -> Block -> FixedInterval | ||
330 | blkInterval pieceSize Block {..} = | ||
331 | Fixed.interval (blkPiece * pieceSize + blkOffset) | ||
332 | (fromIntegral (Lazy.length blkData)) \ No newline at end of file | ||