diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-06-08 19:08:04 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-06-08 19:08:04 +0400 |
commit | 7bbd628732ec65f9428d7792aa265152a88b5483 (patch) | |
tree | 3179ec440e8016830b0634c2edad92bde4c3ce88 /src/Network | |
parent | 55f7a4944ed4642d988c2634807ca2c4d74cd369 (diff) |
+ Add some docs.
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Protocol.hs | 64 | ||||
-rw-r--r-- | src/Network/BitTorrent/Peer.hs | 14 |
2 files changed, 57 insertions, 21 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 | -- | ||
80 | data Handshake = Handshake { | 98 | data 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. | |
117 | handshakeCaps :: Handshake -> Capabilities | 135 | handshakeCaps :: Handshake -> Capabilities |
118 | handshakeCaps = hsReserved | 136 | handshakeCaps = hsReserved |
119 | 137 | ||
@@ -122,7 +140,8 @@ ppHandshake :: Handshake -> Doc | |||
122 | ppHandshake Handshake {..} = | 140 | ppHandshake 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. | ||
126 | handshakeSize :: Word8 -> Int | 145 | handshakeSize :: Word8 -> Int |
127 | handshakeSize n = 1 + fromIntegral n + 8 + 20 + 20 | 146 | handshakeSize n = 1 + fromIntegral n + 8 + 20 + 20 |
128 | 147 | ||
@@ -138,7 +157,8 @@ defaultBTProtocol = "BitTorrent protocol" | |||
138 | defaultReserved :: Word64 | 157 | defaultReserved :: Word64 |
139 | defaultReserved = 0 | 158 | defaultReserved = 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. | ||
142 | defaultHandshake :: InfoHash -> PeerID -> Handshake | 162 | defaultHandshake :: InfoHash -> PeerID -> Handshake |
143 | defaultHandshake = Handshake defaultBTProtocol defaultReserved | 163 | defaultHandshake = 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. | ||
205 | ppBlockIx :: BlockIx -> Doc | 226 | ppBlockIx :: BlockIx -> Doc |
206 | ppBlockIx BlockIx {..} = | 227 | ppBlockIx 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. | ||
222 | ppBlock :: Block -> Doc | 244 | ppBlock :: Block -> Doc |
223 | ppBlock = ppBlockIx . blockIx | 245 | ppBlock = 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 | -- | | ||
408 | data PeerStatus = PeerStatus { | 431 | data PeerStatus = PeerStatus { |
409 | psChoking :: Bool | 432 | psChoking :: Bool |
410 | , psInterested :: Bool | 433 | , psInterested :: Bool |
@@ -414,38 +437,45 @@ data PeerStatus = PeerStatus { | |||
414 | initPeerStatus :: PeerStatus | 437 | initPeerStatus :: PeerStatus |
415 | initPeerStatus = PeerStatus True False | 438 | initPeerStatus = PeerStatus True False |
416 | 439 | ||
440 | -- | Update choking field. | ||
417 | setChoking :: Bool -> PeerStatus -> PeerStatus | 441 | setChoking :: Bool -> PeerStatus -> PeerStatus |
418 | setChoking b ps = ps { psChoking = b } | 442 | setChoking b ps = ps { psChoking = b } |
419 | 443 | ||
444 | -- | Update interested field. | ||
420 | setInterested :: Bool -> PeerStatus -> PeerStatus | 445 | setInterested :: Bool -> PeerStatus -> PeerStatus |
421 | setInterested b ps = ps { psInterested = b } | 446 | setInterested b ps = ps { psInterested = b } |
422 | 447 | ||
423 | 448 | -- | | |
424 | |||
425 | data SessionStatus = SessionStatus { | 449 | data 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. | ||
430 | initSessionStatus :: SessionStatus | 455 | initSessionStatus :: SessionStatus |
431 | initSessionStatus = SessionStatus initPeerStatus initPeerStatus | 456 | initSessionStatus = SessionStatus initPeerStatus initPeerStatus |
432 | 457 | ||
433 | setClientStatus :: (PeerStatus -> PeerStatus) -> SessionStatus -> SessionStatus | 458 | -- | Update client status. |
459 | setClientStatus :: (PeerStatus -> PeerStatus) | ||
460 | -> SessionStatus -> SessionStatus | ||
434 | setClientStatus f ss = ss { seClientStatus = f (seClientStatus ss) } | 461 | setClientStatus f ss = ss { seClientStatus = f (seClientStatus ss) } |
435 | 462 | ||
436 | setPeerStatus :: (PeerStatus -> PeerStatus) -> SessionStatus -> SessionStatus | 463 | -- | Update peer status. |
464 | setPeerStatus :: (PeerStatus -> PeerStatus) | ||
465 | -> SessionStatus -> SessionStatus | ||
437 | setPeerStatus f ss = ss { sePeerStatus = f (sePeerStatus ss) } | 466 | setPeerStatus 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/? |
440 | canUpload :: SessionStatus -> Bool | 469 | canUpload :: SessionStatus -> Bool |
441 | canUpload SessionStatus { seClientStatus = client, sePeerStatus = peer} = | 470 | canUpload 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/? |
445 | canDownload :: SessionStatus -> Bool | 474 | canDownload :: SessionStatus -> Bool |
446 | canDownload SessionStatus { seClientStatus = client, sePeerStatus = peer } = | 475 | canDownload 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. | ||
450 | defaultUnchokeSlots :: Int | 480 | defaultUnchokeSlots :: Int |
451 | defaultUnchokeSlots = 4 \ No newline at end of file | 481 | defaultUnchokeSlots = 4 \ No newline at end of file |
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs index f4502f8b..6ab80fb6 100644 --- a/src/Network/BitTorrent/Peer.hs +++ b/src/Network/BitTorrent/Peer.hs | |||
@@ -89,7 +89,8 @@ import Network.Socket | |||
89 | 89 | ||
90 | 90 | ||
91 | 91 | ||
92 | -- TODO we have linker error here, so manual hardcoded version for a while. | 92 | -- TODO we have linker error here, so manual hardcoded version for a |
93 | -- while. | ||
93 | -- import Paths_network_bittorrent (version) | 94 | -- import Paths_network_bittorrent (version) |
94 | version :: Version | 95 | version :: Version |
95 | version = Version [0, 10, 0, 0] [] | 96 | version = Version [0, 10, 0, 0] [] |
@@ -109,6 +110,7 @@ instance Serialize PeerID where | |||
109 | instance URLShow PeerID where | 110 | instance URLShow PeerID where |
110 | urlShow = BC.unpack . getPeerID | 111 | urlShow = BC.unpack . getPeerID |
111 | 112 | ||
113 | -- | Format peer id in human readable form. | ||
112 | ppPeerID :: PeerID -> Doc | 114 | ppPeerID :: PeerID -> Doc |
113 | ppPeerID = text . BC.unpack . getPeerID | 115 | ppPeerID = text . BC.unpack . getPeerID |
114 | 116 | ||
@@ -354,11 +356,13 @@ parseImpl = f . BC.unpack | |||
354 | ppClientImpl :: ClientImpl -> Doc | 356 | ppClientImpl :: ClientImpl -> Doc |
355 | ppClientImpl = text . tail . show | 357 | ppClientImpl = text . tail . show |
356 | 358 | ||
359 | -- | Used to represent not recognized implementation | ||
357 | unknownImpl :: ClientImpl | 360 | unknownImpl :: ClientImpl |
358 | unknownImpl = IUnknown | 361 | unknownImpl = IUnknown |
359 | 362 | ||
363 | -- TODO use Data.Version | ||
360 | 364 | ||
361 | 365 | -- | Raw version of client, normally extracted from peer id. | |
362 | type ClientVersion = ByteString | 366 | type ClientVersion = ByteString |
363 | 367 | ||
364 | -- | Format client implementation version in human readable form. | 368 | -- | Format client implementation version in human readable form. |
@@ -391,7 +395,8 @@ unknownClient = ClientInfo unknownImpl unknownVersion | |||
391 | -- 'unknownClient'. | 395 | -- 'unknownClient'. |
392 | -- | 396 | -- |
393 | clientInfo :: PeerID -> ClientInfo | 397 | clientInfo :: PeerID -> ClientInfo |
394 | clientInfo pid = either (const unknownClient) id $ runGet getCI (getPeerID pid) | 398 | clientInfo pid = either (const unknownClient) id $ |
399 | runGet getCI (getPeerID pid) | ||
395 | where -- TODO other styles | 400 | where -- TODO other styles |
396 | getCI = do | 401 | getCI = do |
397 | _ <- getWord8 | 402 | _ <- getWord8 |
@@ -477,7 +482,8 @@ nameMap = | |||
477 | Peer address | 482 | Peer address |
478 | -----------------------------------------------------------------------} | 483 | -----------------------------------------------------------------------} |
479 | 484 | ||
480 | 485 | -- | Peer address info normally extracted from peer list or peer | |
486 | -- compact list encoding. | ||
481 | data PeerAddr = PeerAddr { | 487 | data PeerAddr = PeerAddr { |
482 | peerID :: Maybe PeerID | 488 | peerID :: Maybe PeerID |
483 | , peerIP :: HostAddress | 489 | , peerIP :: HostAddress |