From e7f07c7e57527f60ee093c04419c99663526a372 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Thu, 13 Feb 2014 13:36:10 +0400
Subject: Add connection status to wire

---
 src/Network/BitTorrent/Exchange/Wire.hs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

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
          -- ** Query
        , getConnection
        , getSession
+       , getStatus
+       , updateConnStatus
        , getExtCaps
        , getStats
        , getMetadata
@@ -97,6 +99,7 @@ import Data.Torrent.InfoHash
 import Data.Torrent.Piece
 import Network.BitTorrent.Core
 import Network.BitTorrent.Exchange.Message as Msg
+import Network.BitTorrent.Exchange.Status
 
 -- TODO handle port message?
 -- TODO handle limits?
@@ -445,6 +448,8 @@ data ConnectionState = ConnectionState {
     -- used to protect /this/ peer against flood attacks.
   , _connStats        :: !ConnectionStats
 
+  , _connStatus       :: !ConnectionStatus
+
     -- | Infodict associated with this Connection's connTopic.
   , _connMetadata     :: Maybe (Cached InfoDict)
   }
@@ -701,6 +706,7 @@ connectWire session hs addr extCaps chan wire =
                              outcomingFlow = FlowStats 1 $ handshakeStats hs
                            , incomingFlow  = FlowStats 1 $ handshakeStats hs'
                            }
+      , _connStatus       = def
       , _connMetadata     = Nothing
       }
 
@@ -732,6 +738,20 @@ acceptWire sock peerAddr wire = do
   bracket (return sock) close $ \ _ -> do
     error "acceptWire: not implemented"
 
+{-----------------------------------------------------------------------
+--  Connection Status
+-----------------------------------------------------------------------}
+
+getStatus :: Wire s ConnectionStatus
+getStatus = lift $ use connStatus
+
+updateConnStatus :: ChannelSide -> StatusUpdate -> Wire s ()
+updateConnStatus side u = lift $ do
+    connStatus %= (over (statusSide side) (updateStatus u))
+  where
+    statusSide ThisPeer   = clientStatus
+    statusSide RemotePeer = remoteStatus
+
 {-----------------------------------------------------------------------
 --  Metadata exchange
 -----------------------------------------------------------------------}
-- 
cgit v1.2.3