summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange
diff options
context:
space:
mode:
authorSam T <pxqr.sta@gmail.com>2013-06-08 19:08:04 +0400
committerSam T <pxqr.sta@gmail.com>2013-06-08 19:08:04 +0400
commit7bbd628732ec65f9428d7792aa265152a88b5483 (patch)
tree3179ec440e8016830b0634c2edad92bde4c3ce88 /src/Network/BitTorrent/Exchange
parent55f7a4944ed4642d988c2634807ca2c4d74cd369 (diff)
+ Add some docs.
Diffstat (limited to 'src/Network/BitTorrent/Exchange')
-rw-r--r--src/Network/BitTorrent/Exchange/Protocol.hs64
1 files changed, 47 insertions, 17 deletions
diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs
index 505f6ac6..dc25a9c9 100644
--- a/src/Network/BitTorrent/Exchange/Protocol.hs
+++ b/src/Network/BitTorrent/Exchange/Protocol.hs
@@ -5,10 +5,25 @@
5-- Stability : experimental 5-- Stability : experimental
6-- Portability : portable 6-- Portability : portable
7-- 7--
8-- In order to establish the connection between peers we should send 8-- Normally peer to peer communication consisting of the following
9-- 'Handshake' message. The 'Handshake' is a required message and 9-- steps:
10-- must be the first message transmitted by the peer to the another 10--
11-- peer. 11-- * In order to establish the connection between peers we should
12-- send 'Handshake' message. The 'Handshake' is a required message
13-- and must be the first message transmitted by the peer to the
14-- another peer. Another peer should reply with a handshake as well.
15--
16-- * Next peer might sent bitfield message, but might not. In the
17-- former case we should update bitfield peer have. Again, if we
18-- have some pieces we should send bitfield. Normally bitfield
19-- message should sent after the handshake message.
20--
21-- * Regular exchange messages. TODO docs
22--
23-- For more high level API see "Network.BitTorrent.Exchange" module.
24--
25-- For more infomation see:
26-- <https://wiki.theory.org/BitTorrentSpecification#Peer_wire_protocol_.28TCP.29>
12-- 27--
13{-# LANGUAGE OverloadedStrings #-} 28{-# LANGUAGE OverloadedStrings #-}
14{-# LANGUAGE RecordWildCards #-} 29{-# LANGUAGE RecordWildCards #-}
@@ -77,6 +92,9 @@ import Network.BitTorrent.Peer
77 Handshake 92 Handshake
78-----------------------------------------------------------------------} 93-----------------------------------------------------------------------}
79 94
95-- | Handshake message is used to exchange all information necessary
96-- to establish connection between peers.
97--
80data Handshake = Handshake { 98data Handshake = Handshake {
81 -- | Identifier of the protocol. 99 -- | Identifier of the protocol.
82 hsProtocol :: ByteString 100 hsProtocol :: ByteString
@@ -113,7 +131,7 @@ instance Serialize Handshake where
113 <*> get 131 <*> get
114 <*> get 132 <*> get
115 133
116 134-- | Extract capabilities from a peer handshake message.
117handshakeCaps :: Handshake -> Capabilities 135handshakeCaps :: Handshake -> Capabilities
118handshakeCaps = hsReserved 136handshakeCaps = hsReserved
119 137
@@ -122,7 +140,8 @@ ppHandshake :: Handshake -> Doc
122ppHandshake Handshake {..} = 140ppHandshake Handshake {..} =
123 text (BC.unpack hsProtocol) <+> ppClientInfo (clientInfo hsPeerID) 141 text (BC.unpack hsProtocol) <+> ppClientInfo (clientInfo hsPeerID)
124 142
125-- | Get handshake message size in bytes from the length of protocol string. 143-- | Get handshake message size in bytes from the length of protocol
144-- string.
126handshakeSize :: Word8 -> Int 145handshakeSize :: Word8 -> Int
127handshakeSize n = 1 + fromIntegral n + 8 + 20 + 20 146handshakeSize n = 1 + fromIntegral n + 8 + 20 + 20
128 147
@@ -138,7 +157,8 @@ defaultBTProtocol = "BitTorrent protocol"
138defaultReserved :: Word64 157defaultReserved :: Word64
139defaultReserved = 0 158defaultReserved = 0
140 159
141-- | Length of info hash and peer id is unchecked, so it /should/ be equal 20. 160-- | Length of info hash and peer id is unchecked, so it /should/ be
161-- equal 20.
142defaultHandshake :: InfoHash -> PeerID -> Handshake 162defaultHandshake :: InfoHash -> PeerID -> Handshake
143defaultHandshake = Handshake defaultBTProtocol defaultReserved 163defaultHandshake = Handshake defaultBTProtocol defaultReserved
144 164
@@ -202,6 +222,7 @@ instance Serialize BlockIx where
202 putInt (ixLength ix) 222 putInt (ixLength ix)
203 {-# INLINE put #-} 223 {-# INLINE put #-}
204 224
225-- | Format block index in human readable form.
205ppBlockIx :: BlockIx -> Doc 226ppBlockIx :: BlockIx -> Doc
206ppBlockIx BlockIx {..} = 227ppBlockIx BlockIx {..} =
207 "piece = " <> int ixPiece <> "," <+> 228 "piece = " <> int ixPiece <> "," <+>
@@ -219,6 +240,7 @@ data Block = Block {
219 , blkData :: !ByteString 240 , blkData :: !ByteString
220 } deriving (Show, Eq) 241 } deriving (Show, Eq)
221 242
243-- | Format block in human readable form. Payload is ommitted.
222ppBlock :: Block -> Doc 244ppBlock :: Block -> Doc
223ppBlock = ppBlockIx . blockIx 245ppBlock = ppBlockIx . blockIx
224 246
@@ -262,7 +284,7 @@ ixRange pieceSize ix = (offset, offset + len)
262 284
263 285
264{----------------------------------------------------------------------- 286{-----------------------------------------------------------------------
265 Handshake 287 Regular messages
266-----------------------------------------------------------------------} 288-----------------------------------------------------------------------}
267 289
268-- | Messages used in communication between peers. 290-- | Messages used in communication between peers.
@@ -405,6 +427,7 @@ ppMessage msg = text (show msg)
405 Peer Status 427 Peer Status
406-----------------------------------------------------------------------} 428-----------------------------------------------------------------------}
407 429
430-- |
408data PeerStatus = PeerStatus { 431data PeerStatus = PeerStatus {
409 psChoking :: Bool 432 psChoking :: Bool
410 , psInterested :: Bool 433 , psInterested :: Bool
@@ -414,38 +437,45 @@ data PeerStatus = PeerStatus {
414initPeerStatus :: PeerStatus 437initPeerStatus :: PeerStatus
415initPeerStatus = PeerStatus True False 438initPeerStatus = PeerStatus True False
416 439
440-- | Update choking field.
417setChoking :: Bool -> PeerStatus -> PeerStatus 441setChoking :: Bool -> PeerStatus -> PeerStatus
418setChoking b ps = ps { psChoking = b } 442setChoking b ps = ps { psChoking = b }
419 443
444-- | Update interested field.
420setInterested :: Bool -> PeerStatus -> PeerStatus 445setInterested :: Bool -> PeerStatus -> PeerStatus
421setInterested b ps = ps { psInterested = b } 446setInterested b ps = ps { psInterested = b }
422 447
423 448-- |
424
425data SessionStatus = SessionStatus { 449data SessionStatus = SessionStatus {
426 seClientStatus :: PeerStatus 450 seClientStatus :: PeerStatus
427 , sePeerStatus :: PeerStatus 451 , sePeerStatus :: PeerStatus
428 } 452 }
429 453
454-- | Initial session status after two peers handshaked.
430initSessionStatus :: SessionStatus 455initSessionStatus :: SessionStatus
431initSessionStatus = SessionStatus initPeerStatus initPeerStatus 456initSessionStatus = SessionStatus initPeerStatus initPeerStatus
432 457
433setClientStatus :: (PeerStatus -> PeerStatus) -> SessionStatus -> SessionStatus 458-- | Update client status.
459setClientStatus :: (PeerStatus -> PeerStatus)
460 -> SessionStatus -> SessionStatus
434setClientStatus f ss = ss { seClientStatus = f (seClientStatus ss) } 461setClientStatus f ss = ss { seClientStatus = f (seClientStatus ss) }
435 462
436setPeerStatus :: (PeerStatus -> PeerStatus) -> SessionStatus -> SessionStatus 463-- | Update peer status.
464setPeerStatus :: (PeerStatus -> PeerStatus)
465 -> SessionStatus -> SessionStatus
437setPeerStatus f ss = ss { sePeerStatus = f (sePeerStatus ss) } 466setPeerStatus f ss = ss { sePeerStatus = f (sePeerStatus ss) }
438 467
439-- | Can the /client/ to upload to the /peer/? 468-- | Can the /client/ to upload to the /peer/?
440canUpload :: SessionStatus -> Bool 469canUpload :: SessionStatus -> Bool
441canUpload SessionStatus { seClientStatus = client, sePeerStatus = peer} = 470canUpload SessionStatus {..}
442 psInterested peer && not (psChoking client) 471 = psInterested sePeerStatus && not (psChoking seClientStatus)
443 472
444-- | Can the /client/ download from the /peer/? 473-- | Can the /client/ download from the /peer/?
445canDownload :: SessionStatus -> Bool 474canDownload :: SessionStatus -> Bool
446canDownload SessionStatus { seClientStatus = client, sePeerStatus = peer } = 475canDownload SessionStatus {..}
447 psInterested client && not (psChoking peer) 476 = psInterested seClientStatus && not (psChoking sePeerStatus)
448 477
449-- | Indicates have many peers are allowed to download from the client. 478-- | Indicates how many peers are allowed to download from the client
479-- by default.
450defaultUnchokeSlots :: Int 480defaultUnchokeSlots :: Int
451defaultUnchokeSlots = 4 \ No newline at end of file 481defaultUnchokeSlots = 4 \ No newline at end of file