3 files changed, 32 insertions, 43 deletions

diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs
index 06df77dd..acb3700c 100644
--- a/src/Network/BitTorrent.hs
+++ b/src/Network/BitTorrent.hs
@@ -37,13 +37,6 @@ module Network.BitTorrent
        , SessionCount
        , getSessionCount
 
-         -- * Storage
-       , Storage
-       , ppStorage
-
-       , bindTo
-       , unbind
-
          -- * Discovery
        , discover
        , exchange
@@ -132,7 +125,7 @@ addTorrent clientSession loc @ TorrentLoc {..} = do
 --  when (bf is not full)
 
   swarm   <- newLeecher  clientSession torrent
-  storage <- swarm `bindTo` dataDirPath
+  storage <- openStorage (torrentMeta swarm) dataDirPath
   forkIO $ discover swarm $ do
     liftIO $ putStrLn "connected to peer"
     forever $ do
diff --git a/src/Network/BitTorrent/Internal.lhs b/src/Network/BitTorrent/Internal.lhs
index 5f6ad458..d30057f7 100644
--- a/src/Network/BitTorrent/Internal.lhs
+++ b/src/Network/BitTorrent/Internal.lhs
@@ -59,8 +59,6 @@
 >        , waitVacancy
 >        , forkThrottle
 >
->        , pieceLength
->
 >          -- * Peer
 >        , PeerSession( PeerSession, connectedPeerAddr
 >                     , swarmSession, enabledExtensions
@@ -125,6 +123,7 @@
 > import Network.BitTorrent.Exchange.Protocol as BT
 > import Network.BitTorrent.Tracker.Protocol as BT
 > import Network.BitTorrent.DHT.Protocol as BT
+> import System.Torrent.Storage
 
 Progress
 ------------------------------------------------------------------------
@@ -499,6 +498,8 @@ Modify this carefully always updating global progress.
 
 >   , clientBitfield    :: !(TVar  Bitfield)
 
+-- >   , storage           :: Storage
+
 We keep set of the all connected peers for the each particular torrent
 to prevent duplicated and therefore reduntant TCP connections. For
 example consider the following very simle and realistic scenario:
@@ -576,10 +577,6 @@ INVARIANT: max_sessions_count - sizeof connectedPeers = value vacantPeers
 > getClientBitfield :: SwarmSession -> IO Bitfield
 > getClientBitfield = readTVarIO . clientBitfield
 
-> pieceLength :: SwarmSession -> Int
-> pieceLength = ciPieceLength . tInfo . torrentMeta
-> {-# INLINE pieceLength #-}
-
 > swarmHandshake :: SwarmSession   ->   Handshake
 > swarmHandshake    SwarmSession {..} = Handshake {
 >     hsProtocol = defaultBTProtocol
@@ -857,7 +854,8 @@ messages & events we should send.
 >     mark >> atomically broadcast
 >   where
 >     mark = do
->       let bytes = pieceLength se * BF.haveCount bf
+>       let piLen = ciPieceLength $ tInfo $ torrentMeta
+>       let bytes = piLen * BF.haveCount bf
 >       atomically $ do
 >         modifyTVar' clientBitfield (BF.union bf)
 >         modifyTVar' (currentProgress clientSession) (downloadedProgress bytes)
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
        , ppStorage
 
          -- * Construction
-       , bindTo, unbind, withStorage
+       , openStorage, closeStorage, withStorage
 
          -- * Modification
        , getBlk, putBlk, selBlk
@@ -45,13 +45,12 @@ import System.Directory
 import Data.Bitfield as BF
 import Data.Torrent
 import Network.BitTorrent.Exchange.Protocol
-import Network.BitTorrent.Internal
 import System.IO.MMap.Fixed as Fixed
 
 
 data Storage = Storage {
     -- |
-    session :: !SwarmSession
+    metainfo:: !Torrent
 
     -- |
   , blocks  :: !(TVar Bitfield)
@@ -76,18 +75,16 @@ ppStorage Storage {..} = pp <$> readTVarIO blocks
 -----------------------------------------------------------------------}
 
 -- TODO doc args
-bindTo :: SwarmSession -> FilePath -> IO Storage
-bindTo se @ SwarmSession {..} contentPath = do
-    let contentInfo   = tInfo torrentMeta
-    let content_paths = contentLayout contentPath contentInfo
-    mapM_ mkDir (L.map fst content_paths)
-
-    let pieceLen  = pieceLength se
-    let blockSize = min defaultBlockSize pieceLen
-    print $ "content length " ++ show (contentLength contentInfo)
-    Storage se <$> newTVarIO (haveNone (blockCount blockSize contentInfo))
-               <*> pure blockSize
-               <*> coalesceFiles content_paths
+openStorage :: Torrent -> FilePath -> IO Storage
+openStorage t @ Torrent {..} contentPath = do
+    let content_paths = contentLayout contentPath tInfo
+    mapM_ (mkDir . fst)  content_paths
+
+    let blockSize = defaultBlockSize `min` ciPieceLength tInfo
+    print $ "content length " ++ show (contentLength tInfo)
+    Storage t <$> newTVarIO (haveNone (blockCount blockSize tInfo))
+              <*> pure blockSize
+              <*> coalesceFiles content_paths
   where
     mkDir path = do
       let dirPath = fst (splitFileName path)
@@ -95,12 +92,12 @@ bindTo se @ SwarmSession {..} contentPath = do
       unless exist $ do
         createDirectoryIfMissing True dirPath
 
-unbind :: Storage -> IO ()
-unbind st = error "unmapStorage"
+closeStorage :: Storage -> IO ()
+closeStorage st = error "closeStorage"
 
 
-withStorage :: SwarmSession -> FilePath -> (Storage -> IO a) -> IO a
-withStorage se path = bracket (se `bindTo` path) unbind
+withStorage :: Torrent -> FilePath -> (Storage -> IO a) -> IO a
+withStorage se path = bracket (openStorage se path) closeStorage
 
 {-----------------------------------------------------------------------
     Modification
@@ -120,7 +117,7 @@ selBlk pix st @ Storage {..}
     mkBix ix  = BlockIx pix (blockSize * (ix - offset)) blockSize
 
     offset    = coeff * pix
-    coeff     = pieceLength session `div` blockSize
+    coeff     = ciPieceLength (tInfo metainfo)  `div` blockSize
 
 --
 -- TODO make global lock map -- otherwise we might get broken pieces
@@ -143,14 +140,14 @@ putBlk blk @ Block {..}  st @ Storage {..}
 --  let blkIx = undefined
 --  bm <- readTVarIO blocks
 --  unless (member blkIx bm) $ do
-    writeBytes (blkInterval (pieceLength session) blk)  blkData  payload
+    writeBytes (blkInterval (ciPieceLength (tInfo metainfo)) blk)  blkData  payload
 
     markBlock blk st
     validatePiece blkPiece st
 
 markBlock :: Block -> Storage -> IO ()
 markBlock Block {..} Storage {..} = {-# SCC markBlock #-} do
-  let piLen = pieceLength session
+  let piLen = ciPieceLength (tInfo metainfo)
   let glIx  = (piLen `div` blockSize) * blkPiece + (blkOffset `div` blockSize)
   atomically $ modifyTVar' blocks (have glIx)
 
@@ -163,14 +160,15 @@ getBlk :: MonadIO m => BlockIx -> Storage -> m Block
 getBlk ix @ BlockIx {..}  st @ Storage {..}
   = liftIO $ {-# SCC getBlk #-} do
   -- TODO check if __piece__ is available
-  bs <- readBytes (ixInterval (pieceLength session) ix) payload
+  let piLen = ciPieceLength (tInfo metainfo)
+  bs <- readBytes (ixInterval piLen ix) payload
   return $ Block ixPiece ixOffset bs
 
 getPiece :: PieceIx -> Storage -> IO ByteString
 getPiece pix st @ Storage {..} = {-# SCC getPiece #-} do
-  let pieceLen = pieceLength session
-  let bix      = BlockIx pix 0 (pieceLength session)
-  let bs       = viewBytes (ixInterval pieceLen bix) payload
+  let piLen = ciPieceLength (tInfo metainfo)
+  let bix   = BlockIx pix 0 piLen
+  let bs    = viewBytes (ixInterval piLen bix) payload
   return $! Lazy.toStrict bs
 
 resetPiece :: PieceIx -> Storage -> IO ()
@@ -186,7 +184,7 @@ validatePiece pix st @ Storage {..} = {-# SCC validatePiece #-} do
     else do
       print $ show pix ++ " downloaded"
       piece <- getPiece pix st
-      if checkPiece (tInfo (torrentMeta session)) pix piece
+      if checkPiece (tInfo metainfo) pix piece
         then return True
         else do
           print $ "----------------------------- invalid " ++ show pix
@@ -218,7 +216,7 @@ pieceMask pix Storage {..} =  do
     return $ BF.interval (totalCount bf) offset (offset + coeff - 1)
   where
     offset    = coeff * pix
-    coeff     = pieceLength session `div` blockSize
+    coeff     = ciPieceLength (tInfo metainfo) `div` blockSize
 
 
 ixInterval :: Int -> BlockIx -> FixedInterval