summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/Client/Handle.hs11
-rw-r--r--src/Network/BitTorrent/Client/Types.hs5
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
16 , getHandle 16 , getHandle
17 , HandleStatus (..) 17 , HandleStatus (..)
18 , getStatus 18 , getStatus
19
20 -- * Events
21 , HandleEvent (..)
19 ) where 22 ) where
20 23
21import Control.Concurrent.Chan.Split 24import Control.Concurrent.Chan.Split
@@ -89,12 +92,14 @@ openTorrent rootPath t @ Torrent {..} = do
89 statusVar <- newMVar Types.Stopped 92 statusVar <- newMVar Types.Stopped
90 tses <- liftIO $ Tracker.newSession ih (trackerList t) 93 tses <- liftIO $ Tracker.newSession ih (trackerList t)
91 eses <- newExchangeSession rootPath (Right tInfoDict) 94 eses <- newExchangeSession rootPath (Right tInfoDict)
95 eventStream <- liftIO newSendPort
92 return $ Handle 96 return $ Handle
93 { handleTopic = ih 97 { handleTopic = ih
94 , handlePrivate = idPrivate tInfoDict 98 , handlePrivate = idPrivate tInfoDict
95 , handleStatus = statusVar 99 , handleStatus = statusVar
96 , handleTrackers = tses 100 , handleTrackers = tses
97 , handleExchange = eses 101 , handleExchange = eses
102 , handleEvents = eventStream
98 } 103 }
99 104
100-- | Use 'nullMagnet' to open handle from 'InfoHash'. 105-- | Use 'nullMagnet' to open handle from 'InfoHash'.
@@ -104,12 +109,14 @@ openMagnet rootPath Magnet {..} = do
104 statusVar <- newMVar Types.Stopped 109 statusVar <- newMVar Types.Stopped
105 tses <- liftIO $ Tracker.newSession exactTopic def 110 tses <- liftIO $ Tracker.newSession exactTopic def
106 eses <- newExchangeSession rootPath (Left exactTopic) 111 eses <- newExchangeSession rootPath (Left exactTopic)
112 eventStream <- liftIO newSendPort
107 return $ Handle 113 return $ Handle
108 { handleTopic = exactTopic 114 { handleTopic = exactTopic
109 , handlePrivate = False 115 , handlePrivate = False
110 , handleStatus = statusVar 116 , handleStatus = statusVar
111 , handleTrackers = tses 117 , handleTrackers = tses
112 , handleExchange = eses 118 , handleExchange = eses
119 , handleEvents = eventStream
113 } 120 }
114 121
115-- | Stop torrent and destroy all sessions. You don't need to close 122-- | Stop torrent and destroy all sessions. You don't need to close
@@ -134,6 +141,7 @@ modifyStatus targetStatus Handle {..} targetAction = do
134 unless (actualStatus == targetStatus) $ do 141 unless (actualStatus == targetStatus) $ do
135 targetAction actualStatus 142 targetAction actualStatus
136 return targetStatus 143 return targetStatus
144 liftIO $ send handleEvents (StatusChanged targetStatus)
137 145
138-- | Start downloading, uploading and announcing this torrent. 146-- | Start downloading, uploading and announcing this torrent.
139-- 147--
@@ -184,3 +192,6 @@ getHandle ih = do
184 192
185getStatus :: Handle -> IO HandleStatus 193getStatus :: Handle -> IO HandleStatus
186getStatus Handle {..} = readMVar handleStatus 194getStatus Handle {..} = readMVar handleStatus
195
196subscription :: Handle -> IO (ReceivePort HandleEvent)
197subscription 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
18 18
19 -- * Events 19 -- * Events
20 , ClientEvent (..) 20 , ClientEvent (..)
21 , HandleEvent (..)
21 ) where 22 ) where
22 23
23import Control.Applicative 24import Control.Applicative
@@ -45,6 +46,9 @@ data HandleStatus
45 | Stopped 46 | Stopped
46 deriving (Show, Eq) 47 deriving (Show, Eq)
47 48
49data HandleEvent
50 = StatusChanged HandleStatus
51
48data Handle = Handle 52data Handle = Handle
49 { handleTopic :: !InfoHash 53 { handleTopic :: !InfoHash
50 , handlePrivate :: !Bool 54 , handlePrivate :: !Bool
@@ -52,6 +56,7 @@ data Handle = Handle
52 , handleStatus :: !(MVar HandleStatus) 56 , handleStatus :: !(MVar HandleStatus)
53 , handleTrackers :: !Tracker.Session 57 , handleTrackers :: !Tracker.Session
54 , handleExchange :: !Exchange.Session 58 , handleExchange :: !Exchange.Session
59 , handleEvents :: !(SendPort HandleEvent)
55 } 60 }
56 61
57data Client = Client 62data Client = Client