]> git.rkrishnan.org Git - functorrent.git/blobdiff - src/FuncTorrent/Peer.hs
get the piece length and store it as piecestate
[functorrent.git] / src / FuncTorrent / Peer.hs
index 4da3d0b3b17ec1e7a2a005d4d39f859932e2eeb8..bd44076a813258eabf0388933d5e43a66b6dbbb4 100644 (file)
@@ -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 pLen = fromList kvs
   where kvs = [(i, PieceData { peers = []
                              , state = Pending
-                             , hash = h }) | (i, h) <- zip [0..numPieces] hashes]
+                             , hash = h
+                             , len = pLen })
+              | (i, h) <- zip [0..numPieces] hashes]
         hashes = splitN (fromIntegral numPieces) pieceHash
 
 havePiece :: PieceMap -> Integer -> Bool
@@ -194,38 +197,45 @@ createDummyFile path size =
 -- loop1 :: shake hands with all peers, find out the pieces they have, form PieceData.
 -- recvMsg :: Peer -> Handle -> Msg
 msgLoop :: PeerState -> PieceMap -> IO ()
-msgLoop state pieceStatus = do
-  -- if meInterested and he NOT Choking, pick a piece to download
-  -- and send a requestmsg.
-  let isMeInterested = meInterested state
-      isHeChoking = heChoking state
-  if (not isMeInterested && isHeChoking)
-    then
-    do
-      let h = handle state
-      sendMsg h InterestedMsg
-      putStrLn $ "--> InterestedMsg to peer: " ++ show (peer state)
-      msgLoop (state { meInterested = True }) pieceStatus
-    else
-    do
-      msg <- getMsg (handle state)
-      putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state)
-      case msg of
-       KeepAliveMsg -> do
-         sendMsg (handle state) KeepAliveMsg
-         msgLoop state pieceStatus
-       BitFieldMsg bss -> do
-         let pieceList = bitfieldToList (unpack bss)
-             pieceStatus' = updatePieceAvailability pieceStatus (peer state) pieceList
-         print pieceList
-         -- for each pieceIndex in pieceList, make an entry in the pieceStatus
-         -- map with pieceIndex as the key and modify the value to add the peer.
-         -- download each of the piece in order
-         msgLoop state pieceStatus'
-       UnChokeMsg -> do
-         msgLoop (state { heChoking = False }) pieceStatus
-       _ -> do
-         msgLoop state pieceStatus
+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.
+                              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 =
+                              case pickPiece pieceStatus of
+                               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
+                          | otherwise = do
+                              msg <- getMsg (handle state)
+                              putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state)
+                              case msg of
+                               KeepAliveMsg -> do
+                                 sendMsg (handle state) KeepAliveMsg
+                                 putStrLn $ "--> " ++ "KeepAliveMsg to peer: " ++ show (peer state)
+                                 msgLoop state pieceStatus
+                               BitFieldMsg bss -> do
+                                 let pieceList = bitfieldToList (unpack bss)
+                                     pieceStatus' = updatePieceAvailability pieceStatus (peer state) pieceList
+                                 print pieceList
+                                 -- for each pieceIndex in pieceList, make an entry in the pieceStatus
+                                 -- map with pieceIndex as the key and modify the value to add the peer.
+                                 -- download each of the piece in order
+                                 msgLoop state pieceStatus'
+                               UnChokeMsg -> do
+                                 msgLoop (state { heChoking = False }) pieceStatus
+                               _ -> do
+                                 msgLoop state pieceStatus
 
 -- simple algorithm to pick piece.
 -- pick the first piece from 0 that is not downloaded yet.
@@ -254,8 +264,9 @@ 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) :: Integer
+      pieceStatus = mkPieceMap numPieces pieceHash pLen
   msgLoop state pieceStatus