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 Control.Applicative ((<$>), liftA3)
import Data.Bits
import Data.Word (Word8)
-import Data.Map (Map(..), fromList, (!))
+import Data.Map (Map(..), fromList, toList, (!), mapWithKey)
import FuncTorrent.Metainfo (Info(..), Metainfo(..))
import FuncTorrent.Utils (splitN)
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
-- and send a requestmsg.
let isMeInterested = meInterested state
isHeChoking = heChoking state
- if (isMeInterested && isHeChoking)
+ if (not isMeInterested && isHeChoking)
then
do
let h = handle state
sendMsg h InterestedMsg
putStrLn $ "--> InterestedMsg to peer: " ++ show (peer state)
- msgLoop state pieceStatus
+ msgLoop (state { meInterested = True }) pieceStatus
else
do
msg <- getMsg (handle 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
+ msgLoop state pieceStatus'
UnChokeMsg -> do
- msgLoop (state {heChoking = False}) pieceStatus
+ 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.
+pickPiece :: PieceMap -> Maybe Integer
+pickPiece m =
+ let pieceList = toList m
+ allPending = filter (\(k, v) -> state v == Pending) pieceList
+ in
+ case allPending of
+ [] -> Nothing
+ ((i, _):_) -> Just i
+
+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
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