diff options
Diffstat (limited to 'src/System')
-rw-r--r-- | src/System/Torrent/Storage.hs | 54 |
1 files changed, 26 insertions, 28 deletions
diff --git a/src/System/Torrent/Storage.hs b/src/System/Torrent/Storage.hs index 98cccccd..6a748fe3 100644 --- a/src/System/Torrent/Storage.hs +++ b/src/System/Torrent/Storage.hs | |||
@@ -23,7 +23,7 @@ module System.Torrent.Storage | |||
23 | , ppStorage | 23 | , ppStorage |
24 | 24 | ||
25 | -- * Construction | 25 | -- * Construction |
26 | , bindTo, unbind, withStorage | 26 | , openStorage, closeStorage, withStorage |
27 | 27 | ||
28 | -- * Modification | 28 | -- * Modification |
29 | , getBlk, putBlk, selBlk | 29 | , getBlk, putBlk, selBlk |
@@ -45,13 +45,12 @@ import System.Directory | |||
45 | import Data.Bitfield as BF | 45 | import Data.Bitfield as BF |
46 | import Data.Torrent | 46 | import Data.Torrent |
47 | import Network.BitTorrent.Exchange.Protocol | 47 | import Network.BitTorrent.Exchange.Protocol |
48 | import Network.BitTorrent.Internal | ||
49 | import System.IO.MMap.Fixed as Fixed | 48 | import System.IO.MMap.Fixed as Fixed |
50 | 49 | ||
51 | 50 | ||
52 | data Storage = Storage { | 51 | data Storage = Storage { |
53 | -- | | 52 | -- | |
54 | session :: !SwarmSession | 53 | metainfo:: !Torrent |
55 | 54 | ||
56 | -- | | 55 | -- | |
57 | , blocks :: !(TVar Bitfield) | 56 | , blocks :: !(TVar Bitfield) |
@@ -76,18 +75,16 @@ ppStorage Storage {..} = pp <$> readTVarIO blocks | |||
76 | -----------------------------------------------------------------------} | 75 | -----------------------------------------------------------------------} |
77 | 76 | ||
78 | -- TODO doc args | 77 | -- TODO doc args |
79 | bindTo :: SwarmSession -> FilePath -> IO Storage | 78 | openStorage :: Torrent -> FilePath -> IO Storage |
80 | bindTo se @ SwarmSession {..} contentPath = do | 79 | openStorage t @ Torrent {..} contentPath = do |
81 | let contentInfo = tInfo torrentMeta | 80 | let content_paths = contentLayout contentPath tInfo |
82 | let content_paths = contentLayout contentPath contentInfo | 81 | mapM_ (mkDir . fst) content_paths |
83 | mapM_ mkDir (L.map fst content_paths) | 82 | |
84 | 83 | let blockSize = defaultBlockSize `min` ciPieceLength tInfo | |
85 | let pieceLen = pieceLength se | 84 | print $ "content length " ++ show (contentLength tInfo) |
86 | let blockSize = min defaultBlockSize pieceLen | 85 | Storage t <$> newTVarIO (haveNone (blockCount blockSize tInfo)) |
87 | print $ "content length " ++ show (contentLength contentInfo) | 86 | <*> pure blockSize |
88 | Storage se <$> newTVarIO (haveNone (blockCount blockSize contentInfo)) | 87 | <*> coalesceFiles content_paths |
89 | <*> pure blockSize | ||
90 | <*> coalesceFiles content_paths | ||
91 | where | 88 | where |
92 | mkDir path = do | 89 | mkDir path = do |
93 | let dirPath = fst (splitFileName path) | 90 | let dirPath = fst (splitFileName path) |
@@ -95,12 +92,12 @@ bindTo se @ SwarmSession {..} contentPath = do | |||
95 | unless exist $ do | 92 | unless exist $ do |
96 | createDirectoryIfMissing True dirPath | 93 | createDirectoryIfMissing True dirPath |
97 | 94 | ||
98 | unbind :: Storage -> IO () | 95 | closeStorage :: Storage -> IO () |
99 | unbind st = error "unmapStorage" | 96 | closeStorage st = error "closeStorage" |
100 | 97 | ||
101 | 98 | ||
102 | withStorage :: SwarmSession -> FilePath -> (Storage -> IO a) -> IO a | 99 | withStorage :: Torrent -> FilePath -> (Storage -> IO a) -> IO a |
103 | withStorage se path = bracket (se `bindTo` path) unbind | 100 | withStorage se path = bracket (openStorage se path) closeStorage |
104 | 101 | ||
105 | {----------------------------------------------------------------------- | 102 | {----------------------------------------------------------------------- |
106 | Modification | 103 | Modification |
@@ -120,7 +117,7 @@ selBlk pix st @ Storage {..} | |||
120 | mkBix ix = BlockIx pix (blockSize * (ix - offset)) blockSize | 117 | mkBix ix = BlockIx pix (blockSize * (ix - offset)) blockSize |
121 | 118 | ||
122 | offset = coeff * pix | 119 | offset = coeff * pix |
123 | coeff = pieceLength session `div` blockSize | 120 | coeff = ciPieceLength (tInfo metainfo) `div` blockSize |
124 | 121 | ||
125 | -- | 122 | -- |
126 | -- TODO make global lock map -- otherwise we might get broken pieces | 123 | -- TODO make global lock map -- otherwise we might get broken pieces |
@@ -143,14 +140,14 @@ putBlk blk @ Block {..} st @ Storage {..} | |||
143 | -- let blkIx = undefined | 140 | -- let blkIx = undefined |
144 | -- bm <- readTVarIO blocks | 141 | -- bm <- readTVarIO blocks |
145 | -- unless (member blkIx bm) $ do | 142 | -- unless (member blkIx bm) $ do |
146 | writeBytes (blkInterval (pieceLength session) blk) blkData payload | 143 | writeBytes (blkInterval (ciPieceLength (tInfo metainfo)) blk) blkData payload |
147 | 144 | ||
148 | markBlock blk st | 145 | markBlock blk st |
149 | validatePiece blkPiece st | 146 | validatePiece blkPiece st |
150 | 147 | ||
151 | markBlock :: Block -> Storage -> IO () | 148 | markBlock :: Block -> Storage -> IO () |
152 | markBlock Block {..} Storage {..} = {-# SCC markBlock #-} do | 149 | markBlock Block {..} Storage {..} = {-# SCC markBlock #-} do |
153 | let piLen = pieceLength session | 150 | let piLen = ciPieceLength (tInfo metainfo) |
154 | let glIx = (piLen `div` blockSize) * blkPiece + (blkOffset `div` blockSize) | 151 | let glIx = (piLen `div` blockSize) * blkPiece + (blkOffset `div` blockSize) |
155 | atomically $ modifyTVar' blocks (have glIx) | 152 | atomically $ modifyTVar' blocks (have glIx) |
156 | 153 | ||
@@ -163,14 +160,15 @@ getBlk :: MonadIO m => BlockIx -> Storage -> m Block | |||
163 | getBlk ix @ BlockIx {..} st @ Storage {..} | 160 | getBlk ix @ BlockIx {..} st @ Storage {..} |
164 | = liftIO $ {-# SCC getBlk #-} do | 161 | = liftIO $ {-# SCC getBlk #-} do |
165 | -- TODO check if __piece__ is available | 162 | -- TODO check if __piece__ is available |
166 | bs <- readBytes (ixInterval (pieceLength session) ix) payload | 163 | let piLen = ciPieceLength (tInfo metainfo) |
164 | bs <- readBytes (ixInterval piLen ix) payload | ||
167 | return $ Block ixPiece ixOffset bs | 165 | return $ Block ixPiece ixOffset bs |
168 | 166 | ||
169 | getPiece :: PieceIx -> Storage -> IO ByteString | 167 | getPiece :: PieceIx -> Storage -> IO ByteString |
170 | getPiece pix st @ Storage {..} = {-# SCC getPiece #-} do | 168 | getPiece pix st @ Storage {..} = {-# SCC getPiece #-} do |
171 | let pieceLen = pieceLength session | 169 | let piLen = ciPieceLength (tInfo metainfo) |
172 | let bix = BlockIx pix 0 (pieceLength session) | 170 | let bix = BlockIx pix 0 piLen |
173 | let bs = viewBytes (ixInterval pieceLen bix) payload | 171 | let bs = viewBytes (ixInterval piLen bix) payload |
174 | return $! Lazy.toStrict bs | 172 | return $! Lazy.toStrict bs |
175 | 173 | ||
176 | resetPiece :: PieceIx -> Storage -> IO () | 174 | resetPiece :: PieceIx -> Storage -> IO () |
@@ -186,7 +184,7 @@ validatePiece pix st @ Storage {..} = {-# SCC validatePiece #-} do | |||
186 | else do | 184 | else do |
187 | print $ show pix ++ " downloaded" | 185 | print $ show pix ++ " downloaded" |
188 | piece <- getPiece pix st | 186 | piece <- getPiece pix st |
189 | if checkPiece (tInfo (torrentMeta session)) pix piece | 187 | if checkPiece (tInfo metainfo) pix piece |
190 | then return True | 188 | then return True |
191 | else do | 189 | else do |
192 | print $ "----------------------------- invalid " ++ show pix | 190 | print $ "----------------------------- invalid " ++ show pix |
@@ -218,7 +216,7 @@ pieceMask pix Storage {..} = do | |||
218 | return $ BF.interval (totalCount bf) offset (offset + coeff - 1) | 216 | return $ BF.interval (totalCount bf) offset (offset + coeff - 1) |
219 | where | 217 | where |
220 | offset = coeff * pix | 218 | offset = coeff * pix |
221 | coeff = pieceLength session `div` blockSize | 219 | coeff = ciPieceLength (tInfo metainfo) `div` blockSize |
222 | 220 | ||
223 | 221 | ||
224 | ixInterval :: Int -> BlockIx -> FixedInterval | 222 | ixInterval :: Int -> BlockIx -> FixedInterval |