summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Exchange')
-rw-r--r--src/Network/BitTorrent/Exchange/Protocol.hs33
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 #-}
30module Network.BitTorrent.Exchange.Protocol 31module 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
62import Control.Applicative 66import Control.Applicative
63import Control.Monad
64import Control.Exception 67import Control.Exception
68import Control.Monad
69import Control.Lens
65import Data.ByteString (ByteString) 70import Data.ByteString (ByteString)
66import qualified Data.ByteString as B 71import qualified Data.ByteString as B
67import qualified Data.ByteString.Char8 as BC 72import 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
430instance Default PeerStatus where 437instance Default PeerStatus where
431 def = PeerStatus True False 438 def = PeerStatus True False
432 439
433-- | 440-- |
434data SessionStatus = SessionStatus { 441data SessionStatus = SessionStatus {
435 seClientStatus :: PeerStatus 442 _clientStatus :: PeerStatus
436 , sePeerStatus :: PeerStatus 443 , _peerStatus :: PeerStatus
437 } 444 }
438 445
446$(makeLenses ''SessionStatus)
447
439instance Default SessionStatus where 448instance 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/?
444canUpload :: SessionStatus -> Bool 452canUpload :: SessionStatus -> Bool
445canUpload SessionStatus {..} 453canUpload 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/?
449canDownload :: SessionStatus -> Bool 457canDownload :: SessionStatus -> Bool
450canDownload SessionStatus {..} 458canDownload 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.