diff options
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Protocol.hs')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Protocol.hs | 44 |
1 files changed, 10 insertions, 34 deletions
diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs index dc25a9c9..46e25fa3 100644 --- a/src/Network/BitTorrent/Exchange/Protocol.hs +++ b/src/Network/BitTorrent/Exchange/Protocol.hs | |||
@@ -51,16 +51,9 @@ module Network.BitTorrent.Exchange.Protocol | |||
51 | , ppMessage | 51 | , ppMessage |
52 | 52 | ||
53 | -- * Exchange control | 53 | -- * Exchange control |
54 | -- ** Peer status | ||
55 | , PeerStatus(..) | 54 | , PeerStatus(..) |
56 | , setChoking, setInterested | ||
57 | , initPeerStatus | ||
58 | |||
59 | -- ** Session status | ||
60 | , SessionStatus(..) | 55 | , SessionStatus(..) |
61 | , initSessionStatus | 56 | -- , canUpload, canDownload |
62 | , setClientStatus, setPeerStatus | ||
63 | , canUpload, canDownload | ||
64 | 57 | ||
65 | -- ** Defaults | 58 | -- ** Defaults |
66 | , defaultUnchokeSlots | 59 | , defaultUnchokeSlots |
@@ -73,6 +66,7 @@ import Data.ByteString (ByteString) | |||
73 | import qualified Data.ByteString as B | 66 | import qualified Data.ByteString as B |
74 | import qualified Data.ByteString.Char8 as BC | 67 | import qualified Data.ByteString.Char8 as BC |
75 | import qualified Data.ByteString.Lazy as Lazy | 68 | import qualified Data.ByteString.Lazy as Lazy |
69 | import Data.Default | ||
76 | import Data.Serialize as S | 70 | import Data.Serialize as S |
77 | import Data.Int | 71 | import Data.Int |
78 | import Data.Word | 72 | import Data.Word |
@@ -429,21 +423,12 @@ ppMessage msg = text (show msg) | |||
429 | 423 | ||
430 | -- | | 424 | -- | |
431 | data PeerStatus = PeerStatus { | 425 | data PeerStatus = PeerStatus { |
432 | psChoking :: Bool | 426 | _choking :: Bool |
433 | , psInterested :: Bool | 427 | , _interested :: Bool |
434 | } | 428 | } |
435 | 429 | ||
436 | -- | Any session between peers starts as choking and not interested. | 430 | instance Default PeerStatus where |
437 | initPeerStatus :: PeerStatus | 431 | def = PeerStatus True False |
438 | initPeerStatus = PeerStatus True False | ||
439 | |||
440 | -- | Update choking field. | ||
441 | setChoking :: Bool -> PeerStatus -> PeerStatus | ||
442 | setChoking b ps = ps { psChoking = b } | ||
443 | |||
444 | -- | Update interested field. | ||
445 | setInterested :: Bool -> PeerStatus -> PeerStatus | ||
446 | setInterested b ps = ps { psInterested = b } | ||
447 | 432 | ||
448 | -- | | 433 | -- | |
449 | data SessionStatus = SessionStatus { | 434 | data SessionStatus = SessionStatus { |
@@ -451,20 +436,10 @@ data SessionStatus = SessionStatus { | |||
451 | , sePeerStatus :: PeerStatus | 436 | , sePeerStatus :: PeerStatus |
452 | } | 437 | } |
453 | 438 | ||
454 | -- | Initial session status after two peers handshaked. | 439 | instance Default SessionStatus where |
455 | initSessionStatus :: SessionStatus | 440 | def = SessionStatus def def |
456 | initSessionStatus = SessionStatus initPeerStatus initPeerStatus | ||
457 | |||
458 | -- | Update client status. | ||
459 | setClientStatus :: (PeerStatus -> PeerStatus) | ||
460 | -> SessionStatus -> SessionStatus | ||
461 | setClientStatus f ss = ss { seClientStatus = f (seClientStatus ss) } | ||
462 | |||
463 | -- | Update peer status. | ||
464 | setPeerStatus :: (PeerStatus -> PeerStatus) | ||
465 | -> SessionStatus -> SessionStatus | ||
466 | setPeerStatus f ss = ss { sePeerStatus = f (sePeerStatus ss) } | ||
467 | 441 | ||
442 | {- | ||
468 | -- | Can the /client/ to upload to the /peer/? | 443 | -- | Can the /client/ to upload to the /peer/? |
469 | canUpload :: SessionStatus -> Bool | 444 | canUpload :: SessionStatus -> Bool |
470 | canUpload SessionStatus {..} | 445 | canUpload SessionStatus {..} |
@@ -474,6 +449,7 @@ canUpload SessionStatus {..} | |||
474 | canDownload :: SessionStatus -> Bool | 449 | canDownload :: SessionStatus -> Bool |
475 | canDownload SessionStatus {..} | 450 | canDownload SessionStatus {..} |
476 | = psInterested seClientStatus && not (psChoking sePeerStatus) | 451 | = psInterested seClientStatus && not (psChoking sePeerStatus) |
452 | -} | ||
477 | 453 | ||
478 | -- | Indicates how many peers are allowed to download from the client | 454 | -- | Indicates how many peers are allowed to download from the client |
479 | -- by default. | 455 | -- by default. |