diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent/Exchange.hs | 5 | ||||
-rw-r--r-- | src/Network/BitTorrent/Exchange/Session.hs | 25 |
2 files changed, 29 insertions, 1 deletions
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs index 015bae3d..3843addf 100644 --- a/src/Network/BitTorrent/Exchange.hs +++ b/src/Network/BitTorrent/Exchange.hs | |||
@@ -27,8 +27,13 @@ module Network.BitTorrent.Exchange | |||
27 | 27 | ||
28 | -- * Connections | 28 | -- * Connections |
29 | , connect | 29 | , connect |
30 | |||
31 | -- * Events | ||
32 | , SessionEvent (..) | ||
33 | , subscribe | ||
30 | ) where | 34 | ) where |
31 | 35 | ||
36 | import Network.BitTorrent.Exchange.Connection hiding (Options) | ||
32 | import Network.BitTorrent.Exchange.Manager | 37 | import Network.BitTorrent.Exchange.Manager |
33 | import Network.BitTorrent.Exchange.Message | 38 | import Network.BitTorrent.Exchange.Message |
34 | import Network.BitTorrent.Exchange.Session \ No newline at end of file | 39 | import Network.BitTorrent.Exchange.Session \ No newline at end of file |
diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs index 32f8eabd..c4664827 100644 --- a/src/Network/BitTorrent/Exchange/Session.hs +++ b/src/Network/BitTorrent/Exchange/Session.hs | |||
@@ -16,13 +16,18 @@ module Network.BitTorrent.Exchange.Session | |||
16 | , connect | 16 | , connect |
17 | , establish | 17 | , establish |
18 | 18 | ||
19 | -- * Events | 19 | -- * Query |
20 | , waitMetadata | 20 | , waitMetadata |
21 | , takeMetadata | 21 | , takeMetadata |
22 | |||
23 | -- * Events | ||
24 | , SessionEvent (..) | ||
25 | , subscription | ||
22 | ) where | 26 | ) where |
23 | 27 | ||
24 | import Control.Applicative | 28 | import Control.Applicative |
25 | import Control.Concurrent | 29 | import Control.Concurrent |
30 | import Control.Concurrent.Chan.Split as CS | ||
26 | import Control.Concurrent.STM | 31 | import Control.Concurrent.STM |
27 | import Control.Exception hiding (Handler) | 32 | import Control.Exception hiding (Handler) |
28 | import Control.Lens | 33 | import Control.Lens |
@@ -91,6 +96,7 @@ data Session = Session | |||
91 | { sessionPeerId :: !(PeerId) | 96 | { sessionPeerId :: !(PeerId) |
92 | , sessionTopic :: !(InfoHash) | 97 | , sessionTopic :: !(InfoHash) |
93 | , sessionLogger :: !(LogFun) | 98 | , sessionLogger :: !(LogFun) |
99 | , sessionEvents :: !(SendPort SessionEvent) | ||
94 | 100 | ||
95 | , metadata :: !(MVar Metadata.Status) | 101 | , metadata :: !(MVar Metadata.Status) |
96 | , infodict :: !(MVar (Cached InfoDict)) | 102 | , infodict :: !(MVar (Cached InfoDict)) |
@@ -137,11 +143,13 @@ newSession logFun addr rootPath dict = do | |||
137 | pSetVar <- newTVarIO S.empty | 143 | pSetVar <- newTVarIO S.empty |
138 | eSetVar <- newTVarIO M.empty | 144 | eSetVar <- newTVarIO M.empty |
139 | chan <- newChan | 145 | chan <- newChan |
146 | eventStream <- newSendPort | ||
140 | 147 | ||
141 | return Session | 148 | return Session |
142 | { sessionPeerId = pid | 149 | { sessionPeerId = pid |
143 | , sessionTopic = idInfoHash dict | 150 | , sessionTopic = idInfoHash dict |
144 | , sessionLogger = logFun | 151 | , sessionLogger = logFun |
152 | , sessionEvents = eventStream | ||
145 | 153 | ||
146 | , metadata = metadataVar | 154 | , metadata = metadataVar |
147 | , infodict = infodictVar | 155 | , infodict = infodictVar |
@@ -171,6 +179,21 @@ withSession :: () | |||
171 | withSession = error "withSession" | 179 | withSession = error "withSession" |
172 | 180 | ||
173 | {----------------------------------------------------------------------- | 181 | {----------------------------------------------------------------------- |
182 | -- Session events | ||
183 | -----------------------------------------------------------------------} | ||
184 | |||
185 | data SessionEvent | ||
186 | = ConnectingTo (PeerAddr IP) | ||
187 | | ConnectionEstablished (PeerAddr IP) | ||
188 | | ConnectionAborted | ||
189 | | ConnectionClosed (PeerAddr IP) | ||
190 | | SessionClosed | ||
191 | deriving Show | ||
192 | |||
193 | subscription :: Session -> IO (ReceivePort SessionEvent) | ||
194 | subscription Session {..} = listen sessionEvents | ||
195 | |||
196 | {----------------------------------------------------------------------- | ||
174 | -- Logging | 197 | -- Logging |
175 | -----------------------------------------------------------------------} | 198 | -----------------------------------------------------------------------} |
176 | 199 | ||