From 045dd2b47a76006bfa610cc26f5aceb63877ba02 Mon Sep 17 00:00:00 2001
From: Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
Date: Fri, 24 Jul 2015 18:16:27 +0530
Subject: [PATCH] split download of a piece into chunks of 16384 bytes

The pieceLenth can often be quite big, so we need to split the piece
into smaller blocks of size 16384 bytes. Why 16384? Just an arbit
number. It seem to work okay.
---
 src/FuncTorrent/Peer.hs  | 38 +++++++++++++++++++++++---------------
 src/FuncTorrent/Utils.hs |  5 +++++
 2 files changed, 28 insertions(+), 15 deletions(-)

diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index 6b84666..ba7f7a9 100644
--- 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
@@ -72,13 +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 -> Integer -> PieceMap
-mkPieceMap numPieces pieceHash pLen = fromList kvs
+mkPieceMap :: Integer -> ByteString -> [Integer] -> PieceMap
+mkPieceMap numPieces pieceHash pLengths = fromList kvs
   where kvs = [(i, PieceData { peers = []
                              , state = Pending
                              , hash = h
                              , len = pLen })
-              | (i, h) <- zip [0..numPieces] hashes]
+              | (i, h, pLen) <- zip3 [0..numPieces] hashes pLengths]
         hashes = splitN (fromIntegral numPieces) pieceHash
 
 havePiece :: PieceMap -> Integer -> Bool
@@ -188,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')
@@ -213,11 +211,12 @@ msgLoop state pieceStatus | meInterested state == False &&
                                Nothing -> putStrLn "Nothing to download"
                                Just workPiece -> do
                                  let pLen = len (pieceStatus ! workPiece)
-                                 sendMsg (handle state) (RequestMsg workPiece 0 pLen)
-                                 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
+                                 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)
@@ -268,7 +267,16 @@ handlePeerMsgs p m peerId logFn = do
                         , meChoking = True }
       pieceHash = pieces (info m)
       numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash
-      pLen = pieceLength (info m) :: Integer
-      pieceStatus = mkPieceMap numPieces pieceHash pLen
+      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)
diff --git a/src/FuncTorrent/Utils.hs b/src/FuncTorrent/Utils.hs
index e5a4a55..cf6c284 100644
--- a/src/FuncTorrent/Utils.hs
+++ b/src/FuncTorrent/Utils.hs
@@ -5,3 +5,8 @@ import qualified Data.ByteString.Char8 as BC
 splitN :: Int -> BC.ByteString -> [BC.ByteString]
 splitN n bs | BC.null bs = []
             | otherwise = BC.take n bs : splitN n (BC.drop n bs)
+
+splitNum :: Integer -> Integer -> [Integer]
+splitNum n d | n == 0 = []
+             | n < d = [n]
+             | otherwise = d : splitNum (n - d) d
-- 
2.37.2