1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
{-# LANGUAGE TemplateHaskell #-}
module Network.BitTorrent.Exchange.Status
( -- * Peer status
PeerStatus(..)
, choking
, interested
, updateStatus
-- * Session status
, SessionStatus(..)
, clientStatus
, peerStatus
-- ** Query
, canUpload
, canDownload
-- * Extra
, inverseStatus
, defaultUnchokeSlots
) where
import Control.Lens
import Data.Aeson.TH
import Data.List as L
import Data.Default
import Network.BitTorrent.Exchange.Message
-- |
data PeerStatus = PeerStatus {
_choking :: !Bool
, _interested :: !Bool
} deriving (Show, Eq)
$(makeLenses ''PeerStatus)
$(deriveJSON defaultOptions { fieldLabelModifier = L.tail } ''PeerStatus)
instance Default PeerStatus where
def = PeerStatus True False
updateStatus :: StatusUpdate -> PeerStatus -> PeerStatus
updateStatus Choke = choking .~ True
updateStatus Unchoke = choking .~ False
updateStatus Interested = interested .~ True
updateStatus NotInterested = interested .~ False
statusUpdates :: PeerStatus -> PeerStatus -> [StatusUpdate]
statusUpdates a b = undefined
-- |
data SessionStatus = SessionStatus {
_clientStatus :: !PeerStatus
, _peerStatus :: !PeerStatus
} deriving (Show, Eq)
$(makeLenses ''SessionStatus)
$(deriveJSON defaultOptions { fieldLabelModifier = L.tail } ''SessionStatus)
instance Default SessionStatus where
def = SessionStatus def def
-- | Can the /client/ transfer to the /peer/?
canUpload :: SessionStatus -> Bool
canUpload SessionStatus {..}
= _interested _peerStatus && not (_choking _clientStatus)
-- | Can the /client/ transfer from the /peer/?
canDownload :: SessionStatus -> Bool
canDownload SessionStatus {..}
= _interested _clientStatus && not (_choking _peerStatus)
inverseStatus :: SessionStatus -> SessionStatus
inverseStatus SessionStatus {..} = SessionStatus _peerStatus _clientStatus
-- | Indicates how many peers are allowed to download from the client
-- by default.
defaultUnchokeSlots :: Int
defaultUnchokeSlots = 4
|
