From a7c82906934d7e640cda5c26448ce4fa232d2b46 Mon Sep 17 00:00:00 2001 From: Sam T Date: Wed, 24 Apr 2013 19:44:32 +0400 Subject: + Add BEP 6 messages. --- src/Network/BitTorrent/PeerWire/Block.hs | 4 +- src/Network/BitTorrent/PeerWire/Message.hs | 106 ++++++++++++++++++++++------- 2 files changed, 84 insertions(+), 26 deletions(-) (limited to 'src') diff --git a/src/Network/BitTorrent/PeerWire/Block.hs b/src/Network/BitTorrent/PeerWire/Block.hs index 8e4a1f24..ddbc1020 100644 --- a/src/Network/BitTorrent/PeerWire/Block.hs +++ b/src/Network/BitTorrent/PeerWire/Block.hs @@ -1,5 +1,5 @@ module Network.BitTorrent.PeerWire.Block - ( BlockIx(..), Block(..) + ( BlockIx(..), Block(..), PieceIx , BlockLIx, PieceLIx , defaultBlockSize , pieceIx, blockIx @@ -17,7 +17,7 @@ import Data.Serialize type BlockLIx = Int type PieceLIx = Int - +type PieceIx = Int data BlockIx = BlockIx { -- ^ Zero-based piece index. diff --git a/src/Network/BitTorrent/PeerWire/Message.hs b/src/Network/BitTorrent/PeerWire/Message.hs index 66021487..650e0082 100644 --- a/src/Network/BitTorrent/PeerWire/Message.hs +++ b/src/Network/BitTorrent/PeerWire/Message.hs @@ -11,18 +11,65 @@ import Data.Serialize import Network.BitTorrent.PeerWire.Block --- TODO comment message constructors +-- | Messages used in communication between peers. +-- +-- Note: If some extensions are disabled (not present in extension +-- mask) and client receive message used by the disabled +-- extension then the client MUST close the connection. +-- data Message = KeepAlive | Choke | Unchoke | Interested | NotInterested - | Have Int + + -- | Zero-based index of a piece that has just been + -- successfully downloaded and verified via the hash. + | Have PieceIx + + -- | The bitfield message may only be sent immediately + -- after the handshaking sequence is complete, and + -- before any other message are sent. If client have no + -- pieces then bitfield need not to be sent. | Bitfield ByteString + + -- | Request for a particular block. If a client is + -- requested a block that another peer do not have the + -- peer might not answer at all. | Request BlockIx + + -- | Response for a request for a block. | Piece Block + + -- | Used to cancel block requests. It is typically + -- used during "End Game". | Cancel BlockIx + | Port Int + + -- | BEP 6: Then peer have all pieces it might send the + -- 'HaveAll' message instead of 'Bitfield' + -- message. Used to save bandwidth. + | HaveAll + + -- | BEP 6: Then peer have no pieces it might send + -- 'HaveNone' message intead of 'Bitfield' + -- message. Used to save bandwidth. + | HaveNone + + -- | BEP 6: This is an advisory message meaning "you + -- might like to download this piece." Used to avoid + -- excessive disk seeks and amount of IO. + | SuggestPiece PieceIx + + -- | BEP 6: Notifies a requesting peer that its request + -- will not be satisfied. + | RejectRequest BlockIx + + -- | BEP 6: This is an advisory messsage meaning "if + -- you ask for this piece, I'll give it to you even if + -- you're choked." Used to shorten starting phase. + | AllowedFast PieceIx deriving (Show, Eq) @@ -30,38 +77,44 @@ instance Serialize Message where get = do len <- getInt lookAhead $ ensure len - if len == 0 then return KeepAlive -- FIX check if BS is empty instead of reading len + if len == 0 then return KeepAlive else do mid <- getWord8 case mid of - 0 -> return Choke - 1 -> return Unchoke - 2 -> return Interested - 3 -> return NotInterested - 4 -> Have <$> getInt - 5 -> Bitfield <$> getBytes (pred len) - 6 -> Request <$> get - 7 -> Piece <$> getBlock (len - 9) - 8 -> Cancel <$> get - 9 -> (Port . fromIntegral) <$> getWord16be - _ -> fail $ "unknown message ID: " ++ show mid + 0x00 -> return Choke + 0x01 -> return Unchoke + 0x02 -> return Interested + 0x03 -> return NotInterested + 0x04 -> Have <$> getInt + 0x05 -> Bitfield <$> getBytes (pred len) + 0x06 -> Request <$> get + 0x07 -> Piece <$> getBlock (len - 9) + 0x08 -> Cancel <$> get + 0x09 -> (Port . fromIntegral) <$> getWord16be + 0x0E -> return HaveAll + 0x0F -> return HaveNone + 0x0D -> SuggestPiece <$> getInt + 0x10 -> RejectRequest <$> get + 0x11 -> AllowedFast <$> getInt + _ -> fail $ "unknown message ID: " ++ show mid where getBlock :: Int -> Get Block getBlock len = Block <$> getInt <*> getInt <*> getBytes len {-# INLINE getBlock #-} + put KeepAlive = putInt 0 - put Choke = putInt 1 >> putWord8 0 - put Unchoke = putInt 1 >> putWord8 1 - put Interested = putInt 1 >> putWord8 2 - put NotInterested = putInt 1 >> putWord8 3 - put (Have i) = putInt 5 >> putWord8 4 >> putInt i - put (Bitfield b) = putInt l >> putWord8 5 >> putByteString b + put Choke = putInt 1 >> putWord8 0x00 + put Unchoke = putInt 1 >> putWord8 0x01 + put Interested = putInt 1 >> putWord8 0x02 + put NotInterested = putInt 1 >> putWord8 0x03 + put (Have i) = putInt 5 >> putWord8 0x04 >> putInt i + put (Bitfield b) = putInt l >> putWord8 0x05 >> putByteString b where l = succ (B.length b) {-# INLINE l #-} - put (Request blk) = putInt 13 >> putWord8 6 >> put blk - put (Piece blk) = putInt l >> putWord8 7 >> putBlock + put (Request blk) = putInt 13 >> putWord8 0x06 >> put blk + put (Piece blk) = putInt l >> putWord8 0x07 >> putBlock where l = 9 + B.length (blkData blk) {-# INLINE l #-} putBlock = do putInt (blkPiece blk) @@ -69,5 +122,10 @@ instance Serialize Message where putByteString (blkData blk) {-# INLINE putBlock #-} - put (Cancel blk) = putInt 13 >> putWord8 8 >> put blk - put (Port p ) = putInt 3 >> putWord8 9 >> putWord16be (fromIntegral p) + put (Cancel blk) = putInt 13 >> putWord8 0x08 >> put blk + put (Port p ) = putInt 3 >> putWord8 0x09 >> putWord16be (fromIntegral p) + put HaveAll = putInt 1 >> putWord8 0x0E + put HaveNone = putInt 1 >> putWord8 0x0F + put (SuggestPiece pix) = putInt 5 >> putWord8 0x0D >> putInt pix + put (RejectRequest ix) = putInt 13 >> putWord8 0x10 >> put ix + put (AllowedFast ix) = putInt 5 >> putWord8 0x11 >> putInt ix -- cgit v1.2.3