X-Git-Url: https://git.rkrishnan.org/?a=blobdiff_plain;f=src%2FFuncTorrent%2FPeer.hs;h=ba7f7a9dfda977055193eb4bade6c7f41c2ef576;hb=045dd2b47a76006bfa610cc26f5aceb63877ba02;hp=6b8466629a93705046485e3d4b121ce29f577b65;hpb=3bf44f2412b00eb6d4d61467d2fa4171ef330d7c;p=functorrent.git

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)