summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange/Protocol.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Protocol.hs')
-rw-r--r--src/Network/BitTorrent/Exchange/Protocol.hs44
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)
73import qualified Data.ByteString as B 66import qualified Data.ByteString as B
74import qualified Data.ByteString.Char8 as BC 67import qualified Data.ByteString.Char8 as BC
75import qualified Data.ByteString.Lazy as Lazy 68import qualified Data.ByteString.Lazy as Lazy
69import Data.Default
76import Data.Serialize as S 70import Data.Serialize as S
77import Data.Int 71import Data.Int
78import Data.Word 72import Data.Word
@@ -429,21 +423,12 @@ ppMessage msg = text (show msg)
429 423
430-- | 424-- |
431data PeerStatus = PeerStatus { 425data 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. 430instance Default PeerStatus where
437initPeerStatus :: PeerStatus 431 def = PeerStatus True False
438initPeerStatus = PeerStatus True False
439
440-- | Update choking field.
441setChoking :: Bool -> PeerStatus -> PeerStatus
442setChoking b ps = ps { psChoking = b }
443
444-- | Update interested field.
445setInterested :: Bool -> PeerStatus -> PeerStatus
446setInterested b ps = ps { psInterested = b }
447 432
448-- | 433-- |
449data SessionStatus = SessionStatus { 434data 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. 439instance Default SessionStatus where
455initSessionStatus :: SessionStatus 440 def = SessionStatus def def
456initSessionStatus = SessionStatus initPeerStatus initPeerStatus
457
458-- | Update client status.
459setClientStatus :: (PeerStatus -> PeerStatus)
460 -> SessionStatus -> SessionStatus
461setClientStatus f ss = ss { seClientStatus = f (seClientStatus ss) }
462
463-- | Update peer status.
464setPeerStatus :: (PeerStatus -> PeerStatus)
465 -> SessionStatus -> SessionStatus
466setPeerStatus 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/?
469canUpload :: SessionStatus -> Bool 444canUpload :: SessionStatus -> Bool
470canUpload SessionStatus {..} 445canUpload SessionStatus {..}
@@ -474,6 +449,7 @@ canUpload SessionStatus {..}
474canDownload :: SessionStatus -> Bool 449canDownload :: SessionStatus -> Bool
475canDownload SessionStatus {..} 450canDownload 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.