summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange/Connection/Status.hs
diff options
context:
space:
mode:
authorSam Truzjan <pxqr.sta@gmail.com>2014-04-04 06:31:56 +0400
committerSam Truzjan <pxqr.sta@gmail.com>2014-04-04 06:31:56 +0400
commitd8e61484166fa6666e4aaa9689cb430f44f8242b (patch)
treea83720c470b7cee203abc45b8868ad24c0155d21 /src/Network/BitTorrent/Exchange/Connection/Status.hs
parent47e56d698e2c8837656600561874915cf40c0d4e (diff)
[Exchange] Move ConnectionStatus to Connection module
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Connection/Status.hs')
-rw-r--r--src/Network/BitTorrent/Exchange/Connection/Status.hs131
1 files changed, 0 insertions, 131 deletions
diff --git a/src/Network/BitTorrent/Exchange/Connection/Status.hs b/src/Network/BitTorrent/Exchange/Connection/Status.hs
deleted file mode 100644
index f6abc580..00000000
--- a/src/Network/BitTorrent/Exchange/Connection/Status.hs
+++ /dev/null
@@ -1,131 +0,0 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- Each P2P connection endpoint should keep track status of both
9-- sides.
10--
11{-# LANGUAGE TemplateHaskell #-}
12module Network.BitTorrent.Exchange.Connection.Status
13 ( -- * Peer status
14 PeerStatus(..)
15 , choking
16 , interested
17
18 -- ** Query
19 , updateStatus
20 , statusUpdates
21
22 -- * Connection status
23 , ConnectionStatus(..)
24 , clientStatus
25 , remoteStatus
26
27 -- ** Query
28 , canUpload
29 , canDownload
30
31 -- * Extra
32 , defaultUnchokeSlots
33 , defaultRechokeInterval
34 ) where
35
36import Control.Lens
37import Data.Default
38import Data.Maybe
39import Data.Monoid
40import Text.PrettyPrint as PP hiding ((<>))
41import Text.PrettyPrint.Class
42
43import Network.BitTorrent.Exchange.Message
44
45
46{-----------------------------------------------------------------------
47-- Peer status
48-----------------------------------------------------------------------}
49
50-- | Connections contain two bits of state on either end: choked or
51-- not, and interested or not.
52data PeerStatus = PeerStatus
53 { -- | Choking is a notification that no data will be sent until
54 -- unchoking happens.
55 _choking :: !Bool
56
57 -- |
58 , _interested :: !Bool
59 } deriving (Show, Eq, Ord)
60
61$(makeLenses ''PeerStatus)
62
63instance Pretty PeerStatus where
64 pretty PeerStatus {..} =
65 pretty (Choking _choking) <+> "and" <+> pretty (Interested _interested)
66
67-- | Connections start out choked and not interested.
68instance Default PeerStatus where
69 def = PeerStatus True False
70
71instance Monoid PeerStatus where
72 mempty = def
73 mappend a b = PeerStatus
74 { _choking = _choking a && _choking b
75 , _interested = _interested a || _interested b
76 }
77
78-- | Can be used to update remote peer status using incoming 'Status'
79-- message.
80updateStatus :: StatusUpdate -> PeerStatus -> PeerStatus
81updateStatus (Choking b) = choking .~ b
82updateStatus (Interested b) = interested .~ b
83
84-- | Can be used to generate outcoming messages.
85statusUpdates :: PeerStatus -> PeerStatus -> [StatusUpdate]
86statusUpdates a b = catMaybes $
87 [ if _choking a == _choking b then Nothing
88 else Just $ Choking $ _choking b
89 , if _interested a == _interested b then Nothing
90 else Just $ Interested $ _interested b
91 ]
92
93{-----------------------------------------------------------------------
94-- Connection status
95-----------------------------------------------------------------------}
96
97-- | Status of the both endpoints.
98data ConnectionStatus = ConnectionStatus
99 { _clientStatus :: !PeerStatus
100 , _remoteStatus :: !PeerStatus
101 } deriving (Show, Eq)
102
103$(makeLenses ''ConnectionStatus)
104
105instance Pretty ConnectionStatus where
106 pretty ConnectionStatus {..} =
107 "this " <+> pretty _clientStatus $$
108 "remote" <+> pretty _remoteStatus
109
110-- | Connections start out choked and not interested.
111instance Default ConnectionStatus where
112 def = ConnectionStatus def def
113
114-- | Can the client transfer to the remote peer?
115canUpload :: ConnectionStatus -> Bool
116canUpload ConnectionStatus {..}
117 = _interested _remoteStatus && not (_choking _clientStatus)
118
119-- | Can the client transfer from the remote peer?
120canDownload :: ConnectionStatus -> Bool
121canDownload ConnectionStatus {..}
122 = _interested _clientStatus && not (_choking _remoteStatus)
123
124-- | Indicates how many peers are allowed to download from the client
125-- by default.
126defaultUnchokeSlots :: Int
127defaultUnchokeSlots = 4
128
129-- |
130defaultRechokeInterval :: Int
131defaultRechokeInterval = 10 * 1000 * 1000 \ No newline at end of file