summaryrefslogtreecommitdiff
path: root/src/System/Torrent/Storage.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/System/Torrent/Storage.hs')
-rw-r--r--src/System/Torrent/Storage.hs18
1 files changed, 11 insertions, 7 deletions
diff --git a/src/System/Torrent/Storage.hs b/src/System/Torrent/Storage.hs
index cb0494e8..8a884196 100644
--- a/src/System/Torrent/Storage.hs
+++ b/src/System/Torrent/Storage.hs
@@ -110,7 +110,8 @@ withStorage se path = bracket (se `bindTo` path) unbind
110-- TODO make block_payload :: Lazy.ByteString 110-- TODO make block_payload :: Lazy.ByteString
111 111
112selBlk :: MonadIO m => PieceIx -> Storage -> m [BlockIx] 112selBlk :: MonadIO m => PieceIx -> Storage -> m [BlockIx]
113selBlk pix st @ Storage {..} = liftIO $ atomically $ do 113selBlk pix st @ Storage {..}
114 = liftIO $ {-# SCC selBlk #-} atomically $ do
114 mask <- pieceMask pix st 115 mask <- pieceMask pix st
115 select mask <$> readTVar blocks 116 select mask <$> readTVar blocks
116 where 117 where
@@ -137,7 +138,8 @@ selBlk pix st @ Storage {..} = liftIO $ atomically $ do
137-- 138--
138-- 139--
139putBlk :: MonadIO m => Block -> Storage -> m Bool 140putBlk :: MonadIO m => Block -> Storage -> m Bool
140putBlk blk @ Block {..} st @ Storage {..} = liftIO $ do 141putBlk blk @ Block {..} st @ Storage {..}
142 = liftIO $ {-# SCC putBlk #-} do
141-- let blkIx = undefined 143-- let blkIx = undefined
142-- bm <- readTVarIO blocks 144-- bm <- readTVarIO blocks
143-- unless (member blkIx bm) $ do 145-- unless (member blkIx bm) $ do
@@ -149,7 +151,7 @@ putBlk blk @ Block {..} st @ Storage {..} = liftIO $ do
149 validatePiece blkPiece st 151 validatePiece blkPiece st
150 152
151markBlock :: Block -> Storage -> IO () 153markBlock :: Block -> Storage -> IO ()
152markBlock Block {..} Storage {..} = do 154markBlock Block {..} Storage {..} = {-# SCC markBlock #-} do
153 let piLen = pieceLength session 155 let piLen = pieceLength session
154 let glIx = (piLen `div` blockSize) * blkPiece + (blkOffset `div` blockSize) 156 let glIx = (piLen `div` blockSize) * blkPiece + (blkOffset `div` blockSize)
155 atomically $ modifyTVar' blocks (have glIx) 157 atomically $ modifyTVar' blocks (have glIx)
@@ -160,25 +162,27 @@ markBlock Block {..} Storage {..} = do
160-- Do not block. 162-- Do not block.
161-- 163--
162getBlk :: MonadIO m => BlockIx -> Storage -> m Block 164getBlk :: MonadIO m => BlockIx -> Storage -> m Block
163getBlk ix @ BlockIx {..} st @ Storage {..} = liftIO $ do 165getBlk ix @ BlockIx {..} st @ Storage {..}
166 = liftIO $ {-# SCC getBlk #-} do
164 -- TODO check if __piece__ is available 167 -- TODO check if __piece__ is available
165 bs <- readBytes (ixInterval (pieceLength session) ix) payload 168 bs <- readBytes (ixInterval (pieceLength session) ix) payload
166 return $ Block ixPiece ixOffset (Lazy.toStrict bs) 169 return $ Block ixPiece ixOffset (Lazy.toStrict bs)
167 170
168getPiece :: PieceIx -> Storage -> IO ByteString 171getPiece :: PieceIx -> Storage -> IO ByteString
169getPiece pix st @ Storage {..} = do 172getPiece pix st @ Storage {..} = {-# SCC getPiece #-} do
170 let pieceLen = pieceLength session 173 let pieceLen = pieceLength session
171 let bix = BlockIx pix 0 (pieceLength session) 174 let bix = BlockIx pix 0 (pieceLength session)
172 bs <- readBytes (ixInterval pieceLen bix) payload 175 bs <- readBytes (ixInterval pieceLen bix) payload
173 return (Lazy.toStrict bs) 176 return (Lazy.toStrict bs)
174 177
175resetPiece :: PieceIx -> Storage -> IO () 178resetPiece :: PieceIx -> Storage -> IO ()
176resetPiece pix st @ Storage {..} = atomically $ do 179resetPiece pix st @ Storage {..}
180 = {-# SCC resetPiece #-} atomically $ do
177 mask <- pieceMask pix st 181 mask <- pieceMask pix st
178 modifyTVar' blocks (`difference` mask) 182 modifyTVar' blocks (`difference` mask)
179 183
180validatePiece :: PieceIx -> Storage -> IO Bool 184validatePiece :: PieceIx -> Storage -> IO Bool
181validatePiece pix st @ Storage {..} = do 185validatePiece pix st @ Storage {..} = {-# SCC validatePiece #-} do
182 downloaded <- atomically $ isDownloaded pix st 186 downloaded <- atomically $ isDownloaded pix st
183 if not downloaded then return False 187 if not downloaded then return False
184 else do 188 else do