summaryrefslogtreecommitdiff
path: root/src/System/Torrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/System/Torrent')
-rw-r--r--src/System/Torrent/Storage.hs54
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
45import Data.Bitfield as BF 45import Data.Bitfield as BF
46import Data.Torrent 46import Data.Torrent
47import Network.BitTorrent.Exchange.Protocol 47import Network.BitTorrent.Exchange.Protocol
48import Network.BitTorrent.Internal
49import System.IO.MMap.Fixed as Fixed 48import System.IO.MMap.Fixed as Fixed
50 49
51 50
52data Storage = Storage { 51data 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
79bindTo :: SwarmSession -> FilePath -> IO Storage 78openStorage :: Torrent -> FilePath -> IO Storage
80bindTo se @ SwarmSession {..} contentPath = do 79openStorage 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
98unbind :: Storage -> IO () 95closeStorage :: Storage -> IO ()
99unbind st = error "unmapStorage" 96closeStorage st = error "closeStorage"
100 97
101 98
102withStorage :: SwarmSession -> FilePath -> (Storage -> IO a) -> IO a 99withStorage :: Torrent -> FilePath -> (Storage -> IO a) -> IO a
103withStorage se path = bracket (se `bindTo` path) unbind 100withStorage 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
151markBlock :: Block -> Storage -> IO () 148markBlock :: Block -> Storage -> IO ()
152markBlock Block {..} Storage {..} = {-# SCC markBlock #-} do 149markBlock 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
163getBlk ix @ BlockIx {..} st @ Storage {..} 160getBlk 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
169getPiece :: PieceIx -> Storage -> IO ByteString 167getPiece :: PieceIx -> Storage -> IO ByteString
170getPiece pix st @ Storage {..} = {-# SCC getPiece #-} do 168getPiece 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
176resetPiece :: PieceIx -> Storage -> IO () 174resetPiece :: 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
224ixInterval :: Int -> BlockIx -> FixedInterval 222ixInterval :: Int -> BlockIx -> FixedInterval