From 757ce3b4fa3de2d6e84307f79184a44b48ec0a29 Mon Sep 17 00:00:00 2001 From: Sam T Date: Fri, 7 Jun 2013 23:42:34 +0400 Subject: ~ Rename Message to Protocol. --- src/Network/BitTorrent/PeerWire.hs | 2 +- src/Network/BitTorrent/PeerWire/Message.hs | 154 --------------------------- src/Network/BitTorrent/PeerWire/Protocol.hs | 155 ++++++++++++++++++++++++++++ 3 files changed, 156 insertions(+), 155 deletions(-) delete mode 100644 src/Network/BitTorrent/PeerWire/Message.hs create mode 100644 src/Network/BitTorrent/PeerWire/Protocol.hs (limited to 'src') diff --git a/src/Network/BitTorrent/PeerWire.hs b/src/Network/BitTorrent/PeerWire.hs index d0583bff..5ac4c7f3 100644 --- a/src/Network/BitTorrent/PeerWire.hs +++ b/src/Network/BitTorrent/PeerWire.hs @@ -10,5 +10,5 @@ module Network.BitTorrent.PeerWire (module PW) where import Network.BitTorrent.PeerWire.Block as PW import Network.BitTorrent.PeerWire.Selection as PW -import Network.BitTorrent.PeerWire.Message as PW +import Network.BitTorrent.PeerWire.Protocol as PW import Network.BitTorrent.PeerWire.Handshake as PW diff --git a/src/Network/BitTorrent/PeerWire/Message.hs b/src/Network/BitTorrent/PeerWire/Message.hs deleted file mode 100644 index 3895ed5f..00000000 --- a/src/Network/BitTorrent/PeerWire/Message.hs +++ /dev/null @@ -1,154 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Network.BitTorrent.PeerWire.Message - ( Message(..) - , Bitfield - , ppMessage - ) where - -import Control.Applicative -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as Lazy -import Data.Serialize -import Text.PrettyPrint -import Network - -import Network.BitTorrent.PeerWire.Block -import Data.Bitfield - - - --- | 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 - - -- | 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 !Bitfield - - -- | 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 !PortNumber - - -- | 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) - - -instance Serialize Message where - get = do - len <- getInt --- _ <- lookAhead $ ensure len - if len == 0 then return KeepAlive - else do - mid <- getWord8 - case mid of - 0x00 -> return Choke - 0x01 -> return Unchoke - 0x02 -> return Interested - 0x03 -> return NotInterested - 0x04 -> Have <$> getInt - 0x05 -> (Bitfield . fromBitmap) <$> getByteString (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 - _ -> do - rm <- remaining >>= getBytes - fail $ "unknown message ID: " ++ show mid ++ "\n" - ++ "remaining available bytes: " ++ show rm - - where - getBlock :: Int -> Get Block - getBlock len = Block <$> getInt <*> getInt <*> getBytes len - {-# INLINE getBlock #-} - - - put KeepAlive = putInt 0 - 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 bf) = putInt l >> putWord8 0x05 >> putLazyByteString b - where b = toBitmap bf - l = succ (fromIntegral (Lazy.length b)) - {-# INLINE l #-} - 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) - putInt (blkOffset blk) - putByteString (blkData blk) - {-# INLINE putBlock #-} - - 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 - - --- | Format messages in human readable form. Note that output is --- compact and suitable for logging: only useful information but not --- payload bytes. --- -ppMessage :: Message -> Doc -ppMessage (Bitfield _) = "Bitfield" -ppMessage (Piece blk) = "Piece" <+> ppBlock blk -ppMessage (Cancel ix) = "Cancel" <+> ppBlockIx ix -ppMessage (SuggestPiece pix) = "Suggest" <+> int pix -ppMessage (RejectRequest ix) = "Reject" <+> ppBlockIx ix -ppMessage msg = text (show msg) \ No newline at end of file diff --git a/src/Network/BitTorrent/PeerWire/Protocol.hs b/src/Network/BitTorrent/PeerWire/Protocol.hs new file mode 100644 index 00000000..a4d987e6 --- /dev/null +++ b/src/Network/BitTorrent/PeerWire/Protocol.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE OverloadedStrings #-} +module Network.BitTorrent.PeerWire.Protocol + ( + -- * Messages + Message(..) + , ppMessage + ) where + +import Control.Applicative +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as Lazy +import Data.Serialize +import Text.PrettyPrint +import Network + +import Network.BitTorrent.PeerWire.Block +import Data.Bitfield + + + +-- | 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 + + -- | 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 !Bitfield + + -- | 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 !PortNumber + + -- | 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) + + +instance Serialize Message where + get = do + len <- getInt +-- _ <- lookAhead $ ensure len + if len == 0 then return KeepAlive + else do + mid <- getWord8 + case mid of + 0x00 -> return Choke + 0x01 -> return Unchoke + 0x02 -> return Interested + 0x03 -> return NotInterested + 0x04 -> Have <$> getInt + 0x05 -> (Bitfield . fromBitmap) <$> getByteString (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 + _ -> do + rm <- remaining >>= getBytes + fail $ "unknown message ID: " ++ show mid ++ "\n" + ++ "remaining available bytes: " ++ show rm + + where + getBlock :: Int -> Get Block + getBlock len = Block <$> getInt <*> getInt <*> getBytes len + {-# INLINE getBlock #-} + + + put KeepAlive = putInt 0 + 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 bf) = putInt l >> putWord8 0x05 >> putLazyByteString b + where b = toBitmap bf + l = succ (fromIntegral (Lazy.length b)) + {-# INLINE l #-} + 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) + putInt (blkOffset blk) + putByteString (blkData blk) + {-# INLINE putBlock #-} + + 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 + + +-- | Format messages in human readable form. Note that output is +-- compact and suitable for logging: only useful information but not +-- payload bytes. +-- +ppMessage :: Message -> Doc +ppMessage (Bitfield _) = "Bitfield" +ppMessage (Piece blk) = "Piece" <+> ppBlock blk +ppMessage (Cancel ix) = "Cancel" <+> ppBlockIx ix +ppMessage (SuggestPiece pix) = "Suggest" <+> int pix +ppMessage (RejectRequest ix) = "Reject" <+> ppBlockIx ix +ppMessage msg = text (show msg) \ No newline at end of file -- cgit v1.2.3