From: Ramakrishnan Muthukrishnan Date: Mon, 4 May 2015 16:59:58 +0000 (+0530) Subject: WIP: Peer protocol message marshalling X-Git-Url: https://git.rkrishnan.org/?a=commitdiff_plain;h=72f029586552ffb94c0a8811be9fe3e7c20865cd;p=functorrent.git WIP: Peer protocol message marshalling --- diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs index 798f60a..6b2ec72 100644 --- a/src/FuncTorrent/Peer.hs +++ b/src/FuncTorrent/Peer.hs @@ -10,33 +10,48 @@ import System.IO import Data.ByteString (ByteString, unpack, concat, hGet, hPut, singleton) import Data.ByteString.Char8 (replicate, pack) import Network (connectTo, PortID(..)) +import Data.Binary (Binary(..)) +import Data.Binary.Put (putWord32be, putWord8) type ID = String type IP = String type Port = Integer -data PeerState = PeerState { am_choking :: Bool +data PeerState = PeerState { handle :: Handle + , am_choking :: Bool , am_interested :: Bool , peer_choking :: Bool , peer_interested :: Bool } +-- Maintain info on every piece and the current state of it. +-- should probably be a TVar. +type Pieces = [PieceData] + +data PieceState = Pending + | InProgress + | Have + deriving (Show) + +data PieceData = PieceData { index :: Int -- ^ Piece number + , peers :: [Peer] -- ^ list of peers who have this piece + , state :: PieceState } -- ^ state of the piece from download perspective. + -- | Peer is a PeerID, IP address, port tuple data Peer = Peer ID IP Port deriving (Show, Eq) -data Msg = HandShakeMsg ByteString ID - | KeepAliveMsg - | ChokeMsg - | UnChokeMsg - | InterestedMsg - | NotInterestedMsg - | HaveMsg Integer - | BitFieldMsg Integer - | RequestMsg Integer Integer Integer - | PieceMsg Integer Integer Integer - | CancelMsg Integer Integer Integer - | PortMsg Port - deriving (Show) +data PeerMsg = KeepAliveMsg + | ChokeMsg + | UnChokeMsg + | InterestedMsg + | NotInterestedMsg + | HaveMsg Integer + | BitFieldMsg ByteString + | RequestMsg Integer Integer Integer + | PieceMsg Integer Integer ByteString + | CancelMsg Integer Integer Integer + | PortMsg Port + deriving (Show) genHandShakeMsg :: ByteString -> String -> ByteString genHandShakeMsg infoHash peer_id = concat [pstrlen, pstr, reserved, infoHash, peerID] @@ -45,7 +60,7 @@ genHandShakeMsg infoHash peer_id = concat [pstrlen, pstr, reserved, infoHash, pe reserved = replicate 8 '\0' peerID = pack peer_id -handShake :: Peer -> ByteString -> String -> IO ByteString +handShake :: Peer -> ByteString -> String -> IO Handle handShake (Peer _ ip port) infoHash peerid = do let hs = genHandShakeMsg infoHash peerid handle <- connectTo ip (PortNumber (fromIntegral port)) @@ -54,6 +69,42 @@ handShake (Peer _ ip port) infoHash peerid = do rlenBS <- hGet handle 1 let rlen = fromIntegral $ (unpack rlenBS) !! 0 hGet handle rlen + return handle + +instance Binary PeerMsg where + put msg = case msg of + KeepAliveMsg -> putWord32be 0 + ChokeMsg -> do putWord32be 1 + putWord8 0 + UnChokeMsg -> do putWord32be 1 + putWord8 1 + InterestedMsg -> do putWord32be 1 + putWord8 2 + NotInterestedMsg -> do putWord32be 1 + putWord8 3 + HaveMsg index -> do putWord32be 5 + putWord8 4 + putWord32be (fromIntegral index) + BitFieldMsg bf -> do putWord32be $ fromIntegral (1 + bfListLen) + putWord8 5 + mapM_ putWord8 bfList + where bfList = unpack bf + bfListLen = length bfList + RequestMsg i o l -> do putWord32be 13 + putWord8 6 + putWord32be (fromIntegral i) + putWord32be (fromIntegral o) + putWord32be (fromIntegral l) + PieceMsg i o b -> do putWord32be $ fromIntegral (9 + blocklen) + putWord8 7 + putWord32be (fromIntegral i) + putWord32be (fromIntegral o) + mapM_ putWord8 blockList + where blockList = unpack b + blocklen = length blockList + CancelMsg i o l -> undefined + PortMsg p -> undefined + get = undefined --- sendMsg :: Peer -> Handle -> PeerMsg -> IO () +-- loop1 :: shake hands with all peers, find out the pieces they have, form PieceData. -- recvMsg :: Peer -> Handle -> Msg