From: Ramakrishnan Muthukrishnan Date: Fri, 24 Jul 2015 06:17:38 +0000 (+0530) Subject: msgLoop: more refactoring, better debug prints X-Git-Url: https://git.rkrishnan.org/module-simplejson.tests.html?a=commitdiff_plain;h=47bae3b28a3700b3c3ded4637fb21a9185da68a0;p=functorrent.git msgLoop: more refactoring, better debug prints --- diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs index 605d9ff..830c1fa 100644 --- a/src/FuncTorrent/Peer.hs +++ b/src/FuncTorrent/Peer.hs @@ -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))