msgLoop: more refactoring, better debug prints
authorRamakrishnan Muthukrishnan <ram@rkrishnan.org>
Fri, 24 Jul 2015 06:17:38 +0000 (11:47 +0530)
committerRamakrishnan Muthukrishnan <ram@rkrishnan.org>
Fri, 24 Jul 2015 06:17:38 +0000 (11:47 +0530)
src/FuncTorrent/Peer.hs

index 605d9ff686e7835fa0e4045e2a6cd03777aba8b2..830c1fa43cdfeb95e9d68caa894bbfdcceea3854 100644 (file)
@@ -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
+  putStrLn $ "--> handhake to peer: " ++ show peer
   rlenBS <- hGet h (length (unpack hs))
-  putStrLn $ "got handshake from peer: " ++ show rlenBS
+  putStrLn $ "<-- handshake from peer: " ++ show peer
   return h
 
 instance Binary PeerMsg where
@@ -193,33 +194,47 @@ 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 =
-  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}) pieceStatus
-     _ -> print msg
+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)
+         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
 
 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
+                        , heChoking = False
                         , meInterested = True
                         , meChoking = False }
       pieceHash = (pieces (info m))