split download of a piece into chunks of 16384 bytes

[functorrent.git] / src / FuncTorrent / Peer.hs

diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index 33d72a384047bc9c1b0a37a0875a416a8e1fc5f4..ba7f7a9dfda977055193eb4bade6c7f41c2ef576 100644 (file)
--- a/src/FuncTorrent/Peer.hs
+++ b/src/FuncTorrent/Peer.hs
@@ -14,14 +14,14 @@ import Network (connectTo, PortID(..))
 import Data.Binary (Binary(..), decode, encode)
 import Data.Binary.Put (putWord32be, putWord16be, putWord8)
 import Data.Binary.Get (getWord32be, getWord16be, getWord8, runGet)
-import Control.Monad (replicateM, liftM, forever)
+import Control.Monad (replicateM, liftM, forM, forever)
 import Control.Applicative ((<$>), liftA3)
 import Data.Bits
 import Data.Word (Word8)
-import Data.Map (Map(..), fromList, toList, (!), mapWithKey)
+import Data.Map (Map(..), fromList, toList, (!), mapWithKey, adjust)
 
 import FuncTorrent.Metainfo (Info(..), Metainfo(..))
-import FuncTorrent.Utils (splitN)
+import FuncTorrent.Utils (splitN, splitNum)
 
 type ID = String
 type IP = String
@@ -47,7 +47,8 @@ data PieceDlState = Pending
 -- todo - map with index to a new data structure (peers who have that piece amd state)
 data PieceData = PieceData { peers :: [Peer]        -- ^ list of peers who have this piece
                            , state :: PieceDlState  -- ^ state of the piece from download perspective.
-                           , hash  :: ByteString }      -- ^ piece hash
+                           , hash  :: ByteString    -- ^ piece hash
+                           , len :: Integer }       -- ^ piece length
 
 -- which piece is with which peers
 type PieceMap = Map Integer PieceData
@@ -71,11 +72,13 @@ data PeerMsg = KeepAliveMsg
 
 -- Make the initial Piece map, with the assumption that no peer has the
 -- piece and that every piece is pending download.
-mkPieceMap :: Integer -> ByteString -> PieceMap
-mkPieceMap numPieces pieceHash = fromList kvs
+mkPieceMap :: Integer -> ByteString -> [Integer] -> PieceMap
+mkPieceMap numPieces pieceHash pLengths = fromList kvs
   where kvs = [(i, PieceData { peers = []
                              , state = Pending
-                             , hash = h }) | (i, h) <- zip [0..numPieces] hashes]
+                             , hash = h
+                             , len = pLen })
+              | (i, h, pLen) <- zip3 [0..numPieces] hashes pLengths]
         hashes = splitN (fromIntegral numPieces) pieceHash
 
 havePiece :: PieceMap -> Integer -> Bool
@@ -185,8 +188,6 @@ bitfieldToList bs = go bs 0
           in
            setBits ++ go bs' (pos + 1)
 
--- downloadPiece :: Integer -> Handle -> IO ()
-
 createDummyFile :: FilePath -> Int -> IO ()
 createDummyFile path size =
   writeFile path (BC.replicate size '\0')
@@ -196,22 +197,26 @@ createDummyFile path size =
 msgLoop :: PeerState -> PieceMap -> IO ()
 msgLoop state pieceStatus | meInterested state == False &&
                             heChoking state == True = do
-                              -- if meInterested and he NOT Choking, pick a piece to download
-                              -- and send a requestmsg.
+                              -- if me NOT Interested and she is Choking, tell her that
+                              -- I am interested.
                               let h = handle state
                               sendMsg h InterestedMsg
                               putStrLn $ "--> InterestedMsg to peer: " ++ show (peer state)
                               msgLoop (state { meInterested = True }) pieceStatus
                           | meInterested state == True &&
                             heChoking state == False =
+                              -- if me Interested and she not Choking, send her a request
+                              -- for a piece.
                               case pickPiece pieceStatus of
                                Nothing -> putStrLn "Nothing to download"
                                Just workPiece -> do
-                                 sendMsg (handle state) (RequestMsg workPiece 0 16384)
-                                 putStrLn $ "--> RequestMsg for Piece " ++ (show workPiece) ++ "to peer: " ++ show (peer state)
-                                 msg <- getMsg (handle state)
-                                 putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state)
-                                 -- msgLoop state pieceStatus
+                                 let pLen = len (pieceStatus ! workPiece)
+                                 pBS <- downloadPiece (handle state) workPiece pLen
+                                 -- sendMsg (handle state) (RequestMsg workPiece 0 pLen)
+                                 -- putStrLn $ "--> RequestMsg for Piece " ++ (show workPiece) ++ "to peer: " ++ show (peer state) ++ " of length: " ++ show pLen
+                                 -- msg <- getMsg (handle state)
+                                 -- putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state)
+                                 msgLoop state (adjust (\pieceData -> pieceData { state = Have }) workPiece pieceStatus)
                           | otherwise = do
                               msg <- getMsg (handle state)
                               putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state)
@@ -260,8 +265,18 @@ handlePeerMsgs p m peerId logFn = do
                         , heChoking = True
                         , meInterested = False
                         , meChoking = True }
-      pieceHash = (pieces (info m))
+      pieceHash = pieces (info m)
       numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash
-      pieceStatus = mkPieceMap numPieces pieceHash
+      pLen = pieceLength (info m)
+      fileLen = lengthInBytes (info m)
+      pieceStatus = mkPieceMap numPieces pieceHash (splitNum fileLen pLen)
   msgLoop state pieceStatus
   
+downloadPiece :: Handle -> Integer -> Integer -> IO [PeerMsg]
+downloadPiece h index pieceLength = do
+  let chunks = splitNum pieceLength 16384
+  forM (zip [0..] chunks) (\(i, pLen) -> do
+                              sendMsg h (RequestMsg index (i*pLen) pLen)
+                              putStrLn $ "--> " ++ "RequestMsg for Piece " ++ (show index) ++ ", part: " ++ show i ++ " of length: " ++ show pLen
+                              -- putStrLn $ "--> RequestMsg for Piece " ++ (show workPiece) ++ "to peer: " ++ show (peer state) ++ " of length: " ++ show pLen
+                              getMsg h)