diff options
Diffstat (limited to 'src/Network/BitTorrent/Exchange')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Wire.hs | 20 |
1 files changed, 20 insertions, 0 deletions
diff --git a/src/Network/BitTorrent/Exchange/Wire.hs b/src/Network/BitTorrent/Exchange/Wire.hs index 6ef33b85..5cd9ec70 100644 --- a/src/Network/BitTorrent/Exchange/Wire.hs +++ b/src/Network/BitTorrent/Exchange/Wire.hs | |||
@@ -58,6 +58,8 @@ module Network.BitTorrent.Exchange.Wire | |||
58 | -- ** Query | 58 | -- ** Query |
59 | , getConnection | 59 | , getConnection |
60 | , getSession | 60 | , getSession |
61 | , getStatus | ||
62 | , updateConnStatus | ||
61 | , getExtCaps | 63 | , getExtCaps |
62 | , getStats | 64 | , getStats |
63 | , getMetadata | 65 | , getMetadata |
@@ -97,6 +99,7 @@ import Data.Torrent.InfoHash | |||
97 | import Data.Torrent.Piece | 99 | import Data.Torrent.Piece |
98 | import Network.BitTorrent.Core | 100 | import Network.BitTorrent.Core |
99 | import Network.BitTorrent.Exchange.Message as Msg | 101 | import Network.BitTorrent.Exchange.Message as Msg |
102 | import Network.BitTorrent.Exchange.Status | ||
100 | 103 | ||
101 | -- TODO handle port message? | 104 | -- TODO handle port message? |
102 | -- TODO handle limits? | 105 | -- TODO handle limits? |
@@ -445,6 +448,8 @@ data ConnectionState = ConnectionState { | |||
445 | -- used to protect /this/ peer against flood attacks. | 448 | -- used to protect /this/ peer against flood attacks. |
446 | , _connStats :: !ConnectionStats | 449 | , _connStats :: !ConnectionStats |
447 | 450 | ||
451 | , _connStatus :: !ConnectionStatus | ||
452 | |||
448 | -- | Infodict associated with this Connection's connTopic. | 453 | -- | Infodict associated with this Connection's connTopic. |
449 | , _connMetadata :: Maybe (Cached InfoDict) | 454 | , _connMetadata :: Maybe (Cached InfoDict) |
450 | } | 455 | } |
@@ -701,6 +706,7 @@ connectWire session hs addr extCaps chan wire = | |||
701 | outcomingFlow = FlowStats 1 $ handshakeStats hs | 706 | outcomingFlow = FlowStats 1 $ handshakeStats hs |
702 | , incomingFlow = FlowStats 1 $ handshakeStats hs' | 707 | , incomingFlow = FlowStats 1 $ handshakeStats hs' |
703 | } | 708 | } |
709 | , _connStatus = def | ||
704 | , _connMetadata = Nothing | 710 | , _connMetadata = Nothing |
705 | } | 711 | } |
706 | 712 | ||
@@ -733,6 +739,20 @@ acceptWire sock peerAddr wire = do | |||
733 | error "acceptWire: not implemented" | 739 | error "acceptWire: not implemented" |
734 | 740 | ||
735 | {----------------------------------------------------------------------- | 741 | {----------------------------------------------------------------------- |
742 | -- Connection Status | ||
743 | -----------------------------------------------------------------------} | ||
744 | |||
745 | getStatus :: Wire s ConnectionStatus | ||
746 | getStatus = lift $ use connStatus | ||
747 | |||
748 | updateConnStatus :: ChannelSide -> StatusUpdate -> Wire s () | ||
749 | updateConnStatus side u = lift $ do | ||
750 | connStatus %= (over (statusSide side) (updateStatus u)) | ||
751 | where | ||
752 | statusSide ThisPeer = clientStatus | ||
753 | statusSide RemotePeer = remoteStatus | ||
754 | |||
755 | {----------------------------------------------------------------------- | ||
736 | -- Metadata exchange | 756 | -- Metadata exchange |
737 | -----------------------------------------------------------------------} | 757 | -----------------------------------------------------------------------} |
738 | -- TODO introduce new metadata exchange specific exceptions | 758 | -- TODO introduce new metadata exchange specific exceptions |