update piece availability list based on the bitmap

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

diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index 54761211d38eaa98fe1c7ee58bd97465df7a8ac7..6a47a35cd658926e1d85d60a9bac3aa98b3f9cc9 100644 (file)
--- a/src/FuncTorrent/Peer.hs
+++ b/src/FuncTorrent/Peer.hs
@@ -4,21 +4,21 @@ 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)
-import Data.ByteString.Lazy (fromStrict, fromChunks)
+import Data.ByteString.Lazy (fromStrict, fromChunks, toStrict)
 import qualified Data.ByteString.Char8 as BC (replicate, pack, length)
 import Network (connectTo, PortID(..))
-import Data.Binary (Binary(..), decode)
+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.Applicative ((<$>), liftA3)
 import Data.Bits
 import Data.Word (Word8)
-import Data.Map (Map(..), fromList, (!))
+import Data.Map (Map(..), fromList, (!), mapWithKey)
 
 import FuncTorrent.Metainfo (Info(..), Metainfo(..))
 import FuncTorrent.Utils (splitN)
@@ -27,11 +27,13 @@ type ID = String
 type IP = String
 type Port = Integer
 
+-- PeerState is a misnomer
 data PeerState = PeerState { handle :: Handle
-                           , amChoking :: Bool
-                           , amInterested :: Bool
-                           , peerChoking :: Bool
-                           , peerInterested :: Bool}
+                           , peer :: Peer
+                           , meChoking :: Bool
+                           , meInterested :: Bool
+                           , heChoking :: Bool
+                           , heInterested :: Bool}
 
 -- Maintain info on every piece and the current state of it.
 -- should probably be a TVar.
@@ -88,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
@@ -165,6 +168,11 @@ getMsg h = do
     msg <- hGet h l
     return $ decode $ fromStrict $ concat [lBS, msg]
 
+sendMsg :: Handle -> PeerMsg -> IO ()
+sendMsg h msg =
+  let bsMsg = toStrict $ encode msg
+  in
+   hPut h bsMsg
 
 bsToInt :: ByteString -> Int
 bsToInt x = fromIntegral (runGet getWord32be (fromChunks (return x)))
@@ -185,24 +193,58 @@ createDummyFile path size =
 
 -- loop1 :: shake hands with all peers, find out the pieces they have, form PieceData.
 -- recvMsg :: Peer -> Handle -> Msg
-msgLoop :: Handle -> ByteString -> IO ()
-msgLoop h pieceHash =
-  let numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash
-      pieceStatus = mkPieceMap numPieces pieceHash
-  in
-   forever $ do
-     msg <- getMsg h
-     putStrLn $ "got a " ++ show msg
-     case msg of
-      BitFieldMsg bss -> do
-        let pieceList = bitfieldToList (unpack bss)
-        print pieceList
-        -- download each of the piece in order
-      _ -> print 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 (isMeInterested && isHeChoking)
+    then
+    do
+      let h = handle state
+      sendMsg h InterestedMsg
+      putStrLn $ "--> InterestedMsg to peer: " ++ show (peer state)
+      msgLoop state 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
+
+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"
-  msgLoop h (pieces (info m))
+  -- logFn "handShake"
+  let state = PeerState { handle = h
+                        , peer = p
+                        , heInterested = False
+                        , heChoking = True
+                        , meInterested = False
+                        , meChoking = True }
+      pieceHash = (pieces (info m))
+      numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash
+      pieceStatus = mkPieceMap numPieces pieceHash
+  msgLoop state pieceStatus