[Client] Emit StatusChanged event

2 files changed, 16 insertions, 0 deletions

diff --git a/src/Network/BitTorrent/Client/Handle.hs b/src/Network/BitTorrent/Client/Handle.hs
index fcc0adad..25316a0a 100644
--- a/src/Network/BitTorrent/Client/Handle.hs
+++ b/src/Network/BitTorrent/Client/Handle.hs
@@ -16,6 +16,9 @@ module Network.BitTorrent.Client.Handle
        , getHandle
        , HandleStatus (..)
        , getStatus
+
+         -- * Events
+       , HandleEvent (..)
        ) where
 
 import Control.Concurrent.Chan.Split
@@ -89,12 +92,14 @@ openTorrent rootPath t @ Torrent {..} = do
     statusVar <- newMVar Types.Stopped
     tses <- liftIO $ Tracker.newSession ih (trackerList t)
     eses <- newExchangeSession rootPath (Right tInfoDict)
+    eventStream <- liftIO newSendPort
     return $ Handle
       { handleTopic    = ih
       , handlePrivate  = idPrivate tInfoDict
       , handleStatus   = statusVar
       , handleTrackers = tses
       , handleExchange = eses
+      , handleEvents   = eventStream
       }
 
 -- | Use 'nullMagnet' to open handle from 'InfoHash'.
@@ -104,12 +109,14 @@ openMagnet rootPath Magnet {..} = do
     statusVar <- newMVar Types.Stopped
     tses <- liftIO $ Tracker.newSession exactTopic def
     eses <- newExchangeSession rootPath (Left exactTopic)
+    eventStream <- liftIO newSendPort
     return $ Handle
       { handleTopic    = exactTopic
       , handlePrivate  = False
       , handleStatus   = statusVar
       , handleTrackers = tses
       , handleExchange = eses
+      , handleEvents   = eventStream
       }
 
 -- | Stop torrent and destroy all sessions. You don't need to close
@@ -134,6 +141,7 @@ modifyStatus targetStatus Handle {..} targetAction = do
     unless (actualStatus == targetStatus) $ do
       targetAction actualStatus
     return targetStatus
+  liftIO $ send handleEvents (StatusChanged targetStatus)
 
 -- | Start downloading, uploading and announcing this torrent.
 --
@@ -184,3 +192,6 @@ getHandle ih = do
 
 getStatus :: Handle -> IO HandleStatus
 getStatus Handle {..} = readMVar handleStatus
+
+subscription :: Handle -> IO (ReceivePort HandleEvent)
+subscription Handle {..} = listen handleEvents
diff --git a/src/Network/BitTorrent/Client/Types.hs b/src/Network/BitTorrent/Client/Types.hs
index 5ceb4119..aa876ff1 100644
--- a/src/Network/BitTorrent/Client/Types.hs
+++ b/src/Network/BitTorrent/Client/Types.hs
@@ -18,6 +18,7 @@ module Network.BitTorrent.Client.Types
 
          -- * Events
        , ClientEvent (..)
+       , HandleEvent (..)
        ) where
 
 import Control.Applicative
@@ -45,6 +46,9 @@ data HandleStatus
   | Stopped
     deriving (Show, Eq)
 
+data HandleEvent
+  = StatusChanged HandleStatus
+
 data Handle = Handle
   { handleTopic    :: !InfoHash
   , handlePrivate  :: !Bool
@@ -52,6 +56,7 @@ data Handle = Handle
   , handleStatus   :: !(MVar HandleStatus)
   , handleTrackers :: !Tracker.Session
   , handleExchange :: !Exchange.Session
+  , handleEvents   :: !(SendPort HandleEvent)
   }
 
 data Client = Client