pickPiece: a simple algorithm to download the pieces in order

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

diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index 0d70f9f391b385e241ddc88f1dde16902b4dec34..4da3d0b3b17ec1e7a2a005d4d39f859932e2eeb8 100644 (file)
--- a/src/FuncTorrent/Peer.hs
+++ b/src/FuncTorrent/Peer.hs
@@ -4,7 +4,7 @@ module FuncTorrent.Peer
      handlePeerMsgs
     ) where
 
-import Prelude hiding (lookup, concat, replicate, splitAt, empty, writeFile)
+import Prelude hiding (lookup, concat, replicate, splitAt, writeFile)
 
 import System.IO (Handle, BufferMode(..), hSetBuffering)
 import Data.ByteString (ByteString, pack, unpack, concat, hGet, hPut, singleton, writeFile)
@@ -18,7 +18,7 @@ import Control.Monad (replicateM, liftM, forever)
 import Control.Applicative ((<$>), liftA3)
 import Data.Bits
 import Data.Word (Word8)
-import Data.Map (Map(..), fromList, (!))
+import Data.Map (Map(..), fromList, toList, (!), mapWithKey)
 
 import FuncTorrent.Metainfo (Info(..), Metainfo(..))
 import FuncTorrent.Utils (splitN)
@@ -90,13 +90,14 @@ genHandShakeMsg infoHash peer_id = concat [pstrlen, pstr, reserved, infoHash, pe
         peerID = BC.pack peer_id
 
 handShake :: Peer -> ByteString -> String -> IO Handle
-handShake (Peer _ ip port) infoHash peerid = do
+handShake peer@(Peer _ ip port) infoHash peerid = do
   let hs = genHandShakeMsg infoHash peerid
   h <- connectTo ip (PortNumber (fromIntegral port))
   hSetBuffering h LineBuffering
   hPut h hs
-  rlenBS <- hGet h (length (unpack hs))
-  putStrLn $ "got handshake from peer: " ++ show rlenBS
+  putStrLn $ "--> handhake to peer: " ++ show peer
+  _ <- hGet h (length (unpack hs))
+  putStrLn $ "<-- handshake from peer: " ++ show peer
   return h
 
 instance Binary PeerMsg where
@@ -192,38 +193,69 @@ createDummyFile path size =
 
 -- loop1 :: shake hands with all peers, find out the pieces they have, form PieceData.
 -- recvMsg :: Peer -> Handle -> Msg
-msgLoop :: PeerState -> ByteString -> IO ()
-msgLoop state pieceHash =
-  let numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash
-      pieceStatus = mkPieceMap numPieces pieceHash
+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
+
+-- simple algorithm to pick piece.
+-- pick the first piece from 0 that is not downloaded yet.
+pickPiece :: PieceMap -> Maybe Integer
+pickPiece m =
+  let pieceList = toList m
+      allPending = filter (\(k, v) -> state v == Pending) pieceList
   in
-   forever $ do
-     -- if meInterested and he NOT Choking, pick a piece to download
-     -- and send a requestmsg.
-     msg <- getMsg (handle state)
-     putStrLn $ "got a " ++ show msg
-     case msg of
-      BitFieldMsg bss -> do
-        let pieceList = bitfieldToList (unpack bss)
-        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
-      UnChokeMsg -> do
-        print msg
-        msgLoop (state {heChoking = False}) pieceHash
-      _ -> print msg
+   case allPending of
+    [] -> Nothing
+    ((i, _):_) -> Just i
+
+updatePieceAvailability :: PieceMap -> Peer -> [Integer] -> PieceMap
+updatePieceAvailability pieceStatus p pieceList =
+  mapWithKey (\k pd -> if k `elem` pieceList
+                       then (pd { peers = p : (peers pd) })
+                       else pd) pieceStatus
 
 handlePeerMsgs :: Peer -> Metainfo -> String -> (String -> IO ()) -> IO ()
 handlePeerMsgs p m peerId logFn = do
   h <- handShake p (infoHash m) peerId
-  logFn "handShake"
+  -- logFn "handShake"
   let state = PeerState { handle = h
                         , peer = p
                         , heInterested = False
                         , heChoking = True
-                        , meInterested = True
-                        , meChoking = False }
-  msgLoop state (pieces (info m))
+                        , meInterested = False
+                        , meChoking = True }
+      pieceHash = (pieces (info m))
+      numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash
+      pieceStatus = mkPieceMap numPieces pieceHash
+  msgLoop state pieceStatus