import Data.Binary (Binary(..), decode, encode)
import Data.Binary.Put (putWord32be, putWord16be, putWord8)
import Data.Binary.Get (getWord32be, getWord16be, getWord8, runGet)
-import Control.Monad (replicateM, liftM, forM, forever)
+import Control.Monad (replicateM, liftM, forM)
import Control.Applicative ((<$>), liftA3)
import Data.Bits
import Data.Word (Word8)
-import Data.Map (Map(..), fromList, toList, (!), mapWithKey, adjust)
+import Data.Map (Map, fromList, toList, (!), mapWithKey, adjust)
import FuncTorrent.Metainfo (Info(..), Metainfo(..))
import FuncTorrent.Utils (splitN, splitNum)
, heChoking :: Bool
, heInterested :: Bool}
--- Maintain info on every piece and the current state of it.
--- should probably be a TVar.
-type Pieces = [PieceData]
-
data PieceDlState = Pending
| InProgress
| Have
-- 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 | meInterested state == False &&
- heChoking state == True = do
+msgLoop pState pieceStatus | meInterested pState == False &&
+ heChoking pState == True = do
-- if me NOT Interested and she is Choking, tell her that
-- I am interested.
- let h = handle state
+ let h = handle pState
sendMsg h InterestedMsg
- putStrLn $ "--> InterestedMsg to peer: " ++ show (peer state)
- msgLoop (state { meInterested = True }) pieceStatus
- | meInterested state == True &&
- heChoking state == False =
+ putStrLn $ "--> InterestedMsg to peer: " ++ show (peer pState)
+ msgLoop (pState { meInterested = True }) pieceStatus
+ | meInterested pState == True &&
+ heChoking pState == False =
-- if me Interested and she not Choking, send her a request
-- for a piece.
case pickPiece pieceStatus of
Nothing -> putStrLn "Nothing to download"
Just workPiece -> do
let pLen = len (pieceStatus ! workPiece)
- pBS <- downloadPiece (handle state) workPiece pLen
- -- sendMsg (handle state) (RequestMsg workPiece 0 pLen)
- -- putStrLn $ "--> RequestMsg for Piece " ++ (show workPiece) ++ "to peer: " ++ show (peer state) ++ " of length: " ++ show pLen
- -- msg <- getMsg (handle state)
- -- putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state)
- msgLoop state (adjust (\pieceData -> pieceData { state = Have }) workPiece pieceStatus)
+ _ <- downloadPiece (handle pState) workPiece pLen
+ msgLoop pState (adjust (\pieceData -> pieceData { state = Have }) workPiece pieceStatus)
| otherwise = do
- msg <- getMsg (handle state)
- putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state)
+ msg <- getMsg (handle pState)
+ putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer pState)
case msg of
KeepAliveMsg -> do
- sendMsg (handle state) KeepAliveMsg
- putStrLn $ "--> " ++ "KeepAliveMsg to peer: " ++ show (peer state)
- msgLoop state pieceStatus
+ sendMsg (handle pState) KeepAliveMsg
+ putStrLn $ "--> " ++ "KeepAliveMsg to peer: " ++ show (peer pState)
+ msgLoop pState pieceStatus
BitFieldMsg bss -> do
let pieceList = bitfieldToList (unpack bss)
- pieceStatus' = updatePieceAvailability pieceStatus (peer state) pieceList
+ pieceStatus' = updatePieceAvailability pieceStatus (peer pState) 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 pState pieceStatus'
UnChokeMsg -> do
- msgLoop (state { heChoking = False }) pieceStatus
+ msgLoop (pState { heChoking = False }) pieceStatus
_ -> do
- msgLoop state pieceStatus
+ msgLoop pState 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
+ allPending = filter (\(_, v) -> state v == Pending) pieceList
in
case allPending of
[] -> Nothing
then (pd { peers = p : (peers pd) })
else pd) pieceStatus
-handlePeerMsgs :: Peer -> Metainfo -> String -> (String -> IO ()) -> IO ()
-handlePeerMsgs p m peerId logFn = do
+handlePeerMsgs :: Peer -> Metainfo -> String -> IO ()
+handlePeerMsgs p m peerId = do
h <- handShake p (infoHash m) peerId
- -- logFn "handShake"
let state = PeerState { handle = h
, peer = p
, heInterested = False
pieceStatus = mkPieceMap numPieces pieceHash (splitNum fileLen pLen)
msgLoop state pieceStatus
-downloadPiece :: Handle -> Integer -> Integer -> IO [PeerMsg]
+downloadPiece :: Handle -> Integer -> Integer -> IO [ByteString]
downloadPiece h index pieceLength = do
let chunks = splitNum pieceLength 16384
forM (zip [0..] chunks) (\(i, pLen) -> do
sendMsg h (RequestMsg index (i*pLen) pLen)
- putStrLn $ "--> " ++ "RequestMsg for Piece " ++ (show index) ++ ", part: " ++ show i ++ " of length: " ++ show pLen
- -- putStrLn $ "--> RequestMsg for Piece " ++ (show workPiece) ++ "to peer: " ++ show (peer state) ++ " of length: " ++ show pLen
- getMsg h)
+ putStrLn $ "--> " ++ "RequestMsg for Piece "
+ ++ (show index) ++ ", part: " ++ show i ++ " of length: "
+ ++ show pLen
+ PieceMsg index begin block <- getMsg h
+ putStrLn $ " <-- PieceMsg for Piece: "
+ ++ show index
+ ++ ", offset: "
+ ++ show begin
+ return block)
projects / functorrent.git / blobdiff