From: Ramakrishnan Muthukrishnan Date: Fri, 24 Jul 2015 09:23:05 +0000 (+0530) Subject: send request msg and get the piecemsg back X-Git-Url: https://git.rkrishnan.org/Site/Content/Exhibitors/%22news.html/%22file:/cyclelanguage?a=commitdiff_plain;h=6851f654c413b599ba7a71bb059637c1b0579c51;p=functorrent.git send request msg and get the piecemsg back --- diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs index 4da3d0b..33d72a3 100644 --- a/src/FuncTorrent/Peer.hs +++ b/src/FuncTorrent/Peer.hs @@ -194,38 +194,44 @@ 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 = do - -- if meInterested and he NOT Choking, pick a piece to download - -- and send a requestmsg. - let isMeInterested = meInterested state - isHeChoking = heChoking state - if (not isMeInterested && isHeChoking) - then - do - let h = handle state - sendMsg h InterestedMsg - putStrLn $ "--> InterestedMsg to peer: " ++ show (peer state) - msgLoop (state { meInterested = True }) 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 +msgLoop state pieceStatus | meInterested state == False && + heChoking state == True = do + -- if meInterested and he NOT Choking, pick a piece to download + -- and send a requestmsg. + let h = handle state + sendMsg h InterestedMsg + putStrLn $ "--> InterestedMsg to peer: " ++ show (peer state) + msgLoop (state { meInterested = True }) pieceStatus + | meInterested state == True && + heChoking state == False = + case pickPiece pieceStatus of + Nothing -> putStrLn "Nothing to download" + Just workPiece -> do + sendMsg (handle state) (RequestMsg workPiece 0 16384) + putStrLn $ "--> RequestMsg for Piece " ++ (show workPiece) ++ "to peer: " ++ show (peer state) + msg <- getMsg (handle state) + putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state) + -- msgLoop state pieceStatus + | otherwise = do + msg <- getMsg (handle state) + putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state) + case msg of + KeepAliveMsg -> do + sendMsg (handle state) KeepAliveMsg + putStrLn $ "--> " ++ "KeepAliveMsg to peer: " ++ show (peer state) + 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 -- simple algorithm to pick piece. -- pick the first piece from 0 that is not downloaded yet.