diff options
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Wire.hs')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Wire.hs | 11 |
1 files changed, 11 insertions, 0 deletions
diff --git a/src/Network/BitTorrent/Exchange/Wire.hs b/src/Network/BitTorrent/Exchange/Wire.hs index 6b6abde1..6ef33b85 100644 --- a/src/Network/BitTorrent/Exchange/Wire.hs +++ b/src/Network/BitTorrent/Exchange/Wire.hs | |||
@@ -53,6 +53,7 @@ module Network.BitTorrent.Exchange.Wire | |||
53 | -- ** Messaging | 53 | -- ** Messaging |
54 | , recvMessage | 54 | , recvMessage |
55 | , sendMessage | 55 | , sendMessage |
56 | , filterQueue | ||
56 | 57 | ||
57 | -- ** Query | 58 | -- ** Query |
58 | , getConnection | 59 | , getConnection |
@@ -76,6 +77,7 @@ import Data.Conduit.List | |||
76 | import Data.Conduit.Network | 77 | import Data.Conduit.Network |
77 | import Data.Default | 78 | import Data.Default |
78 | import Data.IORef | 79 | import Data.IORef |
80 | import Data.List as L | ||
79 | import Data.Maybe | 81 | import Data.Maybe |
80 | import Data.Monoid | 82 | import Data.Monoid |
81 | import Data.Serialize as S | 83 | import Data.Serialize as S |
@@ -483,6 +485,8 @@ data Connection s = Connection | |||
483 | 485 | ||
484 | -- | Environment data. | 486 | -- | Environment data. |
485 | , connSession :: !s | 487 | , connSession :: !s |
488 | |||
489 | , connChan :: !(Chan Message) | ||
486 | } | 490 | } |
487 | 491 | ||
488 | instance Pretty (Connection s) where | 492 | instance Pretty (Connection s) where |
@@ -635,6 +639,12 @@ sendMessage msg = do | |||
635 | ecaps <- use connExtCaps | 639 | ecaps <- use connExtCaps |
636 | yield $ envelop ecaps msg | 640 | yield $ envelop ecaps msg |
637 | 641 | ||
642 | -- | Filter pending messages from send buffer. | ||
643 | filterQueue :: (Message -> Bool) -> Wire s () | ||
644 | filterQueue p = lift $ do | ||
645 | chan <- asks connChan | ||
646 | liftIO $ getChanContents chan >>= writeList2Chan chan . L.filter p | ||
647 | |||
638 | -- | Forcefully terminate wire session and close socket. | 648 | -- | Forcefully terminate wire session and close socket. |
639 | disconnectPeer :: Wire s a | 649 | disconnectPeer :: Wire s a |
640 | disconnectPeer = monadThrow DisconnectPeer | 650 | disconnectPeer = monadThrow DisconnectPeer |
@@ -708,6 +718,7 @@ connectWire session hs addr extCaps chan wire = | |||
708 | , connOptions = def | 718 | , connOptions = def |
709 | , connState = cstate | 719 | , connState = cstate |
710 | , connSession = session | 720 | , connSession = session |
721 | , connChan = chan | ||
711 | } | 722 | } |
712 | 723 | ||
713 | -- | Accept 'Wire' connection using already 'Network.Socket.accept'ed | 724 | -- | Accept 'Wire' connection using already 'Network.Socket.accept'ed |