diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2014-04-04 06:31:56 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2014-04-04 06:31:56 +0400 |
commit | d8e61484166fa6666e4aaa9689cb430f44f8242b (patch) | |
tree | a83720c470b7cee203abc45b8868ad24c0155d21 /src/Network/BitTorrent/Exchange/Connection/Status.hs | |
parent | 47e56d698e2c8837656600561874915cf40c0d4e (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.hs | 131 |
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 #-} | ||
12 | module 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 | |||
36 | import Control.Lens | ||
37 | import Data.Default | ||
38 | import Data.Maybe | ||
39 | import Data.Monoid | ||
40 | import Text.PrettyPrint as PP hiding ((<>)) | ||
41 | import Text.PrettyPrint.Class | ||
42 | |||
43 | import 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. | ||
52 | data 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 | |||
63 | instance Pretty PeerStatus where | ||
64 | pretty PeerStatus {..} = | ||
65 | pretty (Choking _choking) <+> "and" <+> pretty (Interested _interested) | ||
66 | |||
67 | -- | Connections start out choked and not interested. | ||
68 | instance Default PeerStatus where | ||
69 | def = PeerStatus True False | ||
70 | |||
71 | instance 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. | ||
80 | updateStatus :: StatusUpdate -> PeerStatus -> PeerStatus | ||
81 | updateStatus (Choking b) = choking .~ b | ||
82 | updateStatus (Interested b) = interested .~ b | ||
83 | |||
84 | -- | Can be used to generate outcoming messages. | ||
85 | statusUpdates :: PeerStatus -> PeerStatus -> [StatusUpdate] | ||
86 | statusUpdates 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. | ||
98 | data ConnectionStatus = ConnectionStatus | ||
99 | { _clientStatus :: !PeerStatus | ||
100 | , _remoteStatus :: !PeerStatus | ||
101 | } deriving (Show, Eq) | ||
102 | |||
103 | $(makeLenses ''ConnectionStatus) | ||
104 | |||
105 | instance Pretty ConnectionStatus where | ||
106 | pretty ConnectionStatus {..} = | ||
107 | "this " <+> pretty _clientStatus $$ | ||
108 | "remote" <+> pretty _remoteStatus | ||
109 | |||
110 | -- | Connections start out choked and not interested. | ||
111 | instance Default ConnectionStatus where | ||
112 | def = ConnectionStatus def def | ||
113 | |||
114 | -- | Can the client transfer to the remote peer? | ||
115 | canUpload :: ConnectionStatus -> Bool | ||
116 | canUpload ConnectionStatus {..} | ||
117 | = _interested _remoteStatus && not (_choking _clientStatus) | ||
118 | |||
119 | -- | Can the client transfer from the remote peer? | ||
120 | canDownload :: ConnectionStatus -> Bool | ||
121 | canDownload ConnectionStatus {..} | ||
122 | = _interested _clientStatus && not (_choking _remoteStatus) | ||
123 | |||
124 | -- | Indicates how many peers are allowed to download from the client | ||
125 | -- by default. | ||
126 | defaultUnchokeSlots :: Int | ||
127 | defaultUnchokeSlots = 4 | ||
128 | |||
129 | -- | | ||
130 | defaultRechokeInterval :: Int | ||
131 | defaultRechokeInterval = 10 * 1000 * 1000 \ No newline at end of file | ||