update piece availability list based on the bitmap

diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index 830c1fa43cdfeb95e9d68caa894bbfdcceea3854..6a47a35cd658926e1d85d60a9bac3aa98b3f9cc9 100644 (file)
--- a/src/FuncTorrent/Peer.hs
+++ b/src/FuncTorrent/Peer.hs
@@ -4,7 +4,7 @@ module FuncTorrent.Peer
      handlePeerMsgs
     ) where
 
      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 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 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)
 
 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
   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
 
   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)
          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
          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
 
        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
 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
   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
       pieceHash = (pieces (info m))
       numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash
       pieceStatus = mkPieceMap numPieces pieceHash