Add client state updates eventstream

2 files changed, 22 insertions, 0 deletions

diff --git a/src/Network/BitTorrent/Client.hs b/src/Network/BitTorrent/Client.hs
index b9099736..03b7301d 100644
--- a/src/Network/BitTorrent/Client.hs
+++ b/src/Network/BitTorrent/Client.hs
@@ -21,6 +21,10 @@ module Network.BitTorrent.Client
        , withClient
        , simpleClient
 
+         -- ** Events
+       , ClientEvent (..)
+       , subscription
+
          -- * BitTorrent monad
        , MonadBitTorrent (..)
        , BitTorrent
@@ -50,6 +54,7 @@ module Network.BitTorrent.Client
 import Control.Applicative
 import Control.Exception
 import Control.Concurrent
+import Control.Concurrent.Chan.Split as CS
 import Control.Monad.Logger
 import Control.Monad.Trans
 import Control.Monad.Trans.Resource
@@ -119,6 +124,8 @@ initClient opts @ Options {..} logFun = do
   (_, node) <- allocate mkNode DHT.closeNode
 
   resourceMap <- getInternalState
+  eventStream <- liftIO newSendPort
+
   return Client
     { clientPeerId       = pid
     , clientListenerPort = optPort
@@ -129,6 +136,7 @@ initClient opts @ Options {..} logFun = do
     , clientNode         = node
     , clientTorrents     = tmap
     , clientLogger       = logFun
+    , clientEvents       = eventStream
     }
 
 newClient :: Options -> LogFun -> IO Client
@@ -158,6 +166,11 @@ simpleClient m = do
   runStderrLoggingT $ LoggingT $ \ logger -> do
     withClient def logger (`runBitTorrent` m)
 
+subscription :: BitTorrent (ReceivePort ClientEvent)
+subscription = do
+  Client {..} <- getClient
+  liftIO $ listen clientEvents
+
 {-----------------------------------------------------------------------
 --  Torrent identifiers
 -----------------------------------------------------------------------}
diff --git a/src/Network/BitTorrent/Client/Types.hs b/src/Network/BitTorrent/Client/Types.hs
index 3e62f0fa..d6b08efe 100644
--- a/src/Network/BitTorrent/Client/Types.hs
+++ b/src/Network/BitTorrent/Client/Types.hs
@@ -12,10 +12,14 @@ module Network.BitTorrent.Client.Types
        , getClient
 
        , MonadBitTorrent (..)
+
+         -- * Events
+       , ClientEvent (..)
        ) where
 
 import Control.Applicative
 import Control.Concurrent
+import Control.Concurrent.Chan.Split
 import Control.Monad.Logger
 import Control.Monad.Reader
 import Control.Monad.Trans.Resource
@@ -48,6 +52,7 @@ data Client = Client
   , clientNode         :: !(Node IPv4)
   , clientTorrents     :: !(MVar (HashMap InfoHash Handle))
   , clientLogger       :: !LogFun
+  , clientEvents       :: !(SendPort ClientEvent)
   }
 
 instance Eq Client where
@@ -66,6 +71,10 @@ externalAddr Client {..} = PeerAddr
   , peerPort = clientListenerPort
   }
 
+data ClientEvent
+  = TorrentAdded InfoHash
+    deriving (Show, Eq)
+
 {-----------------------------------------------------------------------
 --  BitTorrent monad
 -----------------------------------------------------------------------}