From: Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
Date: Fri, 24 Jul 2015 07:11:03 +0000 (+0530)
Subject: update piece availability list based on the bitmap
X-Git-Url: https://git.rkrishnan.org/frontends/module-simplejson.html?a=commitdiff_plain;h=a0d180c7ab2c16f3a0f15dba85117dd24ba29660;p=functorrent.git

update piece availability list based on the bitmap
---

diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index 830c1fa..6a47a35 100644
--- 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, (!), mapWithKey)
 
 import FuncTorrent.Metainfo (Info(..), Metainfo(..))
 import FuncTorrent.Utils (splitN)
@@ -96,7 +96,7 @@ handShake peer@(Peer _ ip port) infoHash peerid = do
   hSetBuffering h LineBuffering
   hPut h hs
   putStrLn $ "--> handhake to peer: " ++ show peer
-  rlenBS <- hGet h (length (unpack hs))
+  _ <- hGet h (length (unpack hs))
   putStrLn $ "<-- handshake from peer: " ++ show peer
   return h
 
@@ -216,17 +216,23 @@ msgLoop state pieceStatus = do
          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
+         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
@@ -234,9 +240,9 @@ handlePeerMsgs p m peerId logFn = do
   let state = PeerState { handle = h
                         , peer = p
                         , heInterested = False
-                        , heChoking = False
-                        , meInterested = True
-                        , meChoking = False }
+                        , heChoking = True
+                        , meInterested = False
+                        , meChoking = True }
       pieceHash = (pieces (info m))
       numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash
       pieceStatus = mkPieceMap numPieces pieceHash