From 533068e7ebbf3ae5f15bd7b65312a69ab50052e5 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Thu, 28 Nov 2013 06:27:51 +0400 Subject: Add extended module for extended messages --- .../BitTorrent/Exchange/Message/Extended.hs | 51 ++++++++ src/Network/BitTorrent/Exchange/Protocol.hs | 135 ++++++++++++--------- 2 files changed, 127 insertions(+), 59 deletions(-) create mode 100644 src/Network/BitTorrent/Exchange/Message/Extended.hs (limited to 'src/Network') diff --git a/src/Network/BitTorrent/Exchange/Message/Extended.hs b/src/Network/BitTorrent/Exchange/Message/Extended.hs new file mode 100644 index 00000000..5d26b582 --- /dev/null +++ b/src/Network/BitTorrent/Exchange/Message/Extended.hs @@ -0,0 +1,51 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- For more info see +-- +{-# LANGUAGE DeriveDataTypeable #-} +module Network.BitTorrent.Exchange.Message.Extended + ( + ) where + +import Data.BEncode +import Data.IntMap as IM +import Data.Text +import Data.Typeable +import Network +import Network.Socket + +import Network.BitTorrent.Core.PeerAddr + + +type Extension = () + +type ExtMap = IntMap Extension + +data ExtendedHandshake = H + { extMap :: ExtMap + , port :: Maybe PortNumber + , version :: Maybe Text -- TODO ClientInfo + , yourip :: Maybe SockAddr +-- , ipv6 , ipv4 + + -- | The number of outstanding 'Request' messages this + -- client supports without dropping any. + , requestQueueLength :: Maybe Int + } deriving (Show, Typeable) + +instance BEncode ExtendedHandshake where + toBEncode H {..} = toDict $ + "p" .=? port + .: endDict + + fromBEncode = fromDict $ do + undefined + +data ExtendedMessage + = ExtendedHandshake + deriving (Show, Eq) diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs index 037ef31f..4ef7baf3 100644 --- a/src/Network/BitTorrent/Exchange/Protocol.hs +++ b/src/Network/BitTorrent/Exchange/Protocol.hs @@ -188,73 +188,88 @@ handshake sock hs = do Regular messages -----------------------------------------------------------------------} +data StatusUpdate + = Choke + | Unchoke + | Interested + | NotInterested + deriving (Show, Eq, Ord, Enum, Bounded) + +data RegularMessage = + -- | 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 to a request for a block. + | Piece !(Block BL.ByteString) + + -- | Used to cancel block requests. It is typically used during + -- "End Game". + | Cancel !BlockIx + deriving (Show, Eq) + +data DHTMessage + = Port !PortNumber + deriving (Show, Eq) + +-- | BEP6 messages. +data FastMessage = + -- | If a peer have all pieces it might send the 'HaveAll' message + -- instead of 'Bitfield' message. Used to save bandwidth. + HaveAll + + -- | If a peer have no pieces it might send 'HaveNone' message + -- intead of 'Bitfield' message. Used to save bandwidth. + | HaveNone + + -- | 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 + + -- | Notifies a requesting peer that its request will not be satisfied. + | RejectRequest !BlockIx + + -- | 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) + +-- TODO make Network.BitTorrent.Exchange.Session + -- | 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 - -- TODO data PeerStatusUpdate = Choke | Unchoke | Interested | NotInterested - | 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 BL.ByteString) - - -- | Used to cancel block requests. It is typically - -- used during "End Game". - | Cancel !BlockIx - - | Port !PortNumber - - -- TODO data FastMessage = HaveAll | HaveNone | ... - -- | 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) +data Message + -- core + = KeepAlive + | Status !StatusUpdate + | Regular !RegularMessage + + -- extensions + | DHT !DHTMessage + | Fast !FastMessage + deriving (Show, Eq) instance Default Message where def = KeepAlive {-# INLINE def #-} - +{- -- | Payload bytes are omitted. instance Pretty Message where pretty (Bitfield _) = "Bitfield" @@ -282,9 +297,9 @@ instance Serialize Message where 0x07 -> Piece <$> getBlock (len - 9) 0x08 -> Cancel <$> S.get 0x09 -> Port <$> S.get + 0x0D -> SuggestPiece <$> getInt 0x0E -> return HaveAll 0x0F -> return HaveNone - 0x0D -> SuggestPiece <$> getInt 0x10 -> RejectRequest <$> S.get 0x11 -> AllowedFast <$> getInt _ -> do @@ -324,7 +339,8 @@ instance Serialize Message where put (SuggestPiece pix) = putInt 5 >> S.putWord8 0x0D >> putInt pix put (RejectRequest i ) = putInt 13 >> S.putWord8 0x10 >> S.put i put (AllowedFast i ) = putInt 5 >> S.putWord8 0x11 >> putInt i - +-} +{- instance Binary Message where get = do len <- getIntB @@ -381,3 +397,4 @@ instance Binary Message where put (SuggestPiece pix) = putIntB 5 >> B.putWord8 0x0D >> putIntB pix put (RejectRequest i ) = putIntB 13 >> B.putWord8 0x10 >> B.put i put (AllowedFast i ) = putIntB 5 >> B.putWord8 0x11 >> putIntB i +-} \ No newline at end of file -- cgit v1.2.3