diff options
Diffstat (limited to 'src/Network/BitTorrent/Exchange')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Protocol.hs | 33 |
1 files changed, 20 insertions, 13 deletions
diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs index 46e25fa3..718e339d 100644 --- a/src/Network/BitTorrent/Exchange/Protocol.hs +++ b/src/Network/BitTorrent/Exchange/Protocol.hs | |||
@@ -26,7 +26,8 @@ | |||
26 | -- <https://wiki.theory.org/BitTorrentSpecification#Peer_wire_protocol_.28TCP.29> | 26 | -- <https://wiki.theory.org/BitTorrentSpecification#Peer_wire_protocol_.28TCP.29> |
27 | -- | 27 | -- |
28 | {-# LANGUAGE OverloadedStrings #-} | 28 | {-# LANGUAGE OverloadedStrings #-} |
29 | {-# LANGUAGE RecordWildCards #-} | 29 | {-# LANGUAGE RecordWildCards #-} |
30 | {-# LANGUAGE TemplateHaskell #-} | ||
30 | module Network.BitTorrent.Exchange.Protocol | 31 | module Network.BitTorrent.Exchange.Protocol |
31 | ( -- * Inital handshake | 32 | ( -- * Inital handshake |
32 | Handshake(..), ppHandshake | 33 | Handshake(..), ppHandshake |
@@ -50,18 +51,22 @@ module Network.BitTorrent.Exchange.Protocol | |||
50 | , Message(..) | 51 | , Message(..) |
51 | , ppMessage | 52 | , ppMessage |
52 | 53 | ||
53 | -- * Exchange control | 54 | -- * control |
54 | , PeerStatus(..) | 55 | , PeerStatus(..) |
56 | , choking, interested | ||
57 | |||
55 | , SessionStatus(..) | 58 | , SessionStatus(..) |
56 | -- , canUpload, canDownload | 59 | , clientStatus, peerStatus |
60 | , canUpload, canDownload | ||
57 | 61 | ||
58 | -- ** Defaults | 62 | -- ** Defaults |
59 | , defaultUnchokeSlots | 63 | , defaultUnchokeSlots |
60 | ) where | 64 | ) where |
61 | 65 | ||
62 | import Control.Applicative | 66 | import Control.Applicative |
63 | import Control.Monad | ||
64 | import Control.Exception | 67 | import Control.Exception |
68 | import Control.Monad | ||
69 | import Control.Lens | ||
65 | import Data.ByteString (ByteString) | 70 | import Data.ByteString (ByteString) |
66 | import qualified Data.ByteString as B | 71 | import qualified Data.ByteString as B |
67 | import qualified Data.ByteString.Char8 as BC | 72 | import qualified Data.ByteString.Char8 as BC |
@@ -427,29 +432,31 @@ data PeerStatus = PeerStatus { | |||
427 | , _interested :: Bool | 432 | , _interested :: Bool |
428 | } | 433 | } |
429 | 434 | ||
435 | $(makeLenses ''PeerStatus) | ||
436 | |||
430 | instance Default PeerStatus where | 437 | instance Default PeerStatus where |
431 | def = PeerStatus True False | 438 | def = PeerStatus True False |
432 | 439 | ||
433 | -- | | 440 | -- | |
434 | data SessionStatus = SessionStatus { | 441 | data SessionStatus = SessionStatus { |
435 | seClientStatus :: PeerStatus | 442 | _clientStatus :: PeerStatus |
436 | , sePeerStatus :: PeerStatus | 443 | , _peerStatus :: PeerStatus |
437 | } | 444 | } |
438 | 445 | ||
446 | $(makeLenses ''SessionStatus) | ||
447 | |||
439 | instance Default SessionStatus where | 448 | instance Default SessionStatus where |
440 | def = SessionStatus def def | 449 | def = SessionStatus def def |
441 | 450 | ||
442 | {- | 451 | -- | Can the /client/ transfer to the /peer/? |
443 | -- | Can the /client/ to upload to the /peer/? | ||
444 | canUpload :: SessionStatus -> Bool | 452 | canUpload :: SessionStatus -> Bool |
445 | canUpload SessionStatus {..} | 453 | canUpload SessionStatus {..} |
446 | = psInterested sePeerStatus && not (psChoking seClientStatus) | 454 | = _interested _peerStatus && not (_choking _clientStatus) |
447 | 455 | ||
448 | -- | Can the /client/ download from the /peer/? | 456 | -- | Can the /client/ transfer from the /peer/? |
449 | canDownload :: SessionStatus -> Bool | 457 | canDownload :: SessionStatus -> Bool |
450 | canDownload SessionStatus {..} | 458 | canDownload SessionStatus {..} |
451 | = psInterested seClientStatus && not (psChoking sePeerStatus) | 459 | = _interested _clientStatus && not (_choking _peerStatus) |
452 | -} | ||
453 | 460 | ||
454 | -- | Indicates how many peers are allowed to download from the client | 461 | -- | Indicates how many peers are allowed to download from the client |
455 | -- by default. | 462 | -- by default. |