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
|
-- |
-- Copyright : (c) Sam T. 2013
-- License : MIT
-- Maintainer : pxqr.sta@gmail.com
-- Stability : experimental
-- Portability : portable
--
module Network.BitTorrent.Exchange.Status
( PeerStatus(..)
, setChoking, setInterested
, initPeerStatus
, SessionStatus(..)
, initSessionStatus
, setClientStatus, setPeerStatus
, canUpload, canDownload
-- * Defaults
, defaultUnchokeSlots
) where
data PeerStatus = PeerStatus {
psChoking :: Bool
, psInterested :: Bool
}
-- | Any session between peers starts as choking and not interested.
initPeerStatus :: PeerStatus
initPeerStatus = PeerStatus True False
setChoking :: Bool -> PeerStatus -> PeerStatus
setChoking b ps = ps { psChoking = b }
setInterested :: Bool -> PeerStatus -> PeerStatus
setInterested b ps = ps { psInterested = b }
data SessionStatus = SessionStatus {
seClientStatus :: PeerStatus
, sePeerStatus :: PeerStatus
}
initSessionStatus :: SessionStatus
initSessionStatus = SessionStatus initPeerStatus initPeerStatus
setClientStatus :: (PeerStatus -> PeerStatus) -> SessionStatus -> SessionStatus
setClientStatus f ss = ss { seClientStatus = f (seClientStatus ss) }
setPeerStatus :: (PeerStatus -> PeerStatus) -> SessionStatus -> SessionStatus
setPeerStatus f ss = ss { sePeerStatus = f (sePeerStatus ss) }
-- | Can the /client/ to upload to the /peer/?
canUpload :: SessionStatus -> Bool
canUpload SessionStatus { seClientStatus = client, sePeerStatus = peer} =
psInterested peer && not (psChoking client)
-- | Can the /client/ download from the /peer/?
canDownload :: SessionStatus -> Bool
canDownload SessionStatus { seClientStatus = client, sePeerStatus = peer } =
psInterested client && not (psChoking peer)
-- | Indicates have many peers are allowed to download from the client.
defaultUnchokeSlots :: Int
defaultUnchokeSlots = 4
|
