diff options
author | joe <joe@jerkface.net> | 2018-06-13 20:50:00 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2018-06-13 20:50:00 -0400 |
commit | d8ac778e803ac6de7c01ab4c8af767647ebc2d07 (patch) | |
tree | 98b4ff2acb4533c078ff0ced369a7cac69bc089c /Connection/Tox.hs | |
parent | 2ad144b323122c5eecfc9156a6d65a7018f003ad (diff) |
tox: mechanism to register node-info callbacks.
Diffstat (limited to 'Connection/Tox.hs')
-rw-r--r-- | Connection/Tox.hs | 36 |
1 files changed, 30 insertions, 6 deletions
diff --git a/Connection/Tox.hs b/Connection/Tox.hs index 41361d8f..de2bb879 100644 --- a/Connection/Tox.hs +++ b/Connection/Tox.hs | |||
@@ -13,7 +13,9 @@ import Data.Dependent.Sum | |||
13 | import Data.Functor.Identity | 13 | import Data.Functor.Identity |
14 | import qualified Data.Map as Map | 14 | import qualified Data.Map as Map |
15 | import Connection.Tox.Threads | 15 | import Connection.Tox.Threads |
16 | import Network.Tox | ||
16 | import Network.Tox.NodeId | 17 | import Network.Tox.NodeId |
18 | import Network.Tox.DHT.Handlers | ||
17 | import PingMachine | 19 | import PingMachine |
18 | import Text.Read | 20 | import Text.Read |
19 | #ifdef THREAD_DEBUG | 21 | #ifdef THREAD_DEBUG |
@@ -29,10 +31,10 @@ import GHC.Conc (threadStatus,ThreadStatus(..)) | |||
29 | 31 | ||
30 | data Parameters = Parameters | 32 | data Parameters = Parameters |
31 | { -- | Various Tox transports and clients. | 33 | { -- | Various Tox transports and clients. |
32 | -- toxTransports :: Tox | 34 | toxTransports :: Tox |
33 | -- | Thread to be forked when a connection is established. | 35 | -- | Thread to be forked when a connection is established. |
34 | -- TODO: this function should accept relevant parameters. | 36 | -- TODO: this function should accept relevant parameters. |
35 | onToxSession :: IO () | 37 | , onToxSession :: IO () |
36 | } | 38 | } |
37 | 39 | ||
38 | data Key = Key NodeId{-me-} NodeId{-them-} | 40 | data Key = Key NodeId{-me-} NodeId{-them-} |
@@ -114,6 +116,9 @@ lookupForPolicyChange conmap k policy = atomically $ do | |||
114 | guard $ p /= policy | 116 | guard $ p /= policy |
115 | return st | 117 | return st |
116 | 118 | ||
119 | callbackId :: Int | ||
120 | callbackId = 1 | ||
121 | |||
117 | -- | This function will fork threads as necessary. | 122 | -- | This function will fork threads as necessary. |
118 | setToxPolicy :: Parameters | 123 | setToxPolicy :: Parameters |
119 | -> TVar (Map.Map Key SessionState) | 124 | -> TVar (Map.Map Key SessionState) |
@@ -140,10 +145,17 @@ setToxPolicy params conmap k policy = case policy of | |||
140 | refreshing <- launch ("refresh:"++show k) | 145 | refreshing <- launch ("refresh:"++show k) |
141 | (G.InProgress $ toEnum 0) | 146 | (G.InProgress $ toEnum 0) |
142 | $ freshenContact getPolicy _get_status _freshen_methods | 147 | $ freshenContact getPolicy _get_status _freshen_methods |
143 | atomically $ writeTVar (sessionTasks st) | 148 | atomically $ do |
144 | $ SessionTasks accepting persuing refreshing | 149 | writeTVar (sessionTasks st) $ SessionTasks accepting persuing refreshing |
150 | let routing = toxRouting $ toxTransports params | ||
151 | Key _ nid = k | ||
152 | registerNodeCallback routing $ NodeInfoCallback | ||
153 | { interestingNodeId = nid | ||
154 | , listenerId = callbackId | ||
155 | , observedAddress = \ni -> return () -- TODO | ||
156 | , rumoredAddress = \saddr ni -> return () -- TODO | ||
157 | } | ||
145 | return () | 158 | return () |
146 | return () | ||
147 | RefusingToConnect -> do -- disconnect or cancel any pending connection | 159 | RefusingToConnect -> do -- disconnect or cancel any pending connection |
148 | mst <- lookupForPolicyChange conmap k policy | 160 | mst <- lookupForPolicyChange conmap k policy |
149 | -- Since the 3 connection threads poll the current policy, they should | 161 | -- Since the 3 connection threads poll the current policy, they should |
@@ -152,6 +164,10 @@ setToxPolicy params conmap k policy = case policy of | |||
152 | -- Here we block until they finish. | 164 | -- Here we block until they finish. |
153 | forM_ mst $ \st -> do | 165 | forM_ mst $ \st -> do |
154 | atomically $ do | 166 | atomically $ do |
167 | let routing = toxRouting $ toxTransports params | ||
168 | Key _ nid = k | ||
169 | unregisterNodeCallback callbackId routing nid | ||
170 | atomically $ do | ||
155 | tasks <- readTVar (sessionTasks st) | 171 | tasks <- readTVar (sessionTasks st) |
156 | a <- readTVar $ taskState (accepting tasks) | 172 | a <- readTVar $ taskState (accepting tasks) |
157 | p <- readTVar $ taskState (persuing tasks) | 173 | p <- readTVar $ taskState (persuing tasks) |
@@ -166,7 +182,15 @@ setToxPolicy params conmap k policy = case policy of | |||
166 | accept_thread <- launch ("accept:"++show k) | 182 | accept_thread <- launch ("accept:"++show k) |
167 | (G.InProgress $ toEnum 0) | 183 | (G.InProgress $ toEnum 0) |
168 | $ acceptContact getPolicy _accept_methods | 184 | $ acceptContact getPolicy _accept_methods |
169 | return () | 185 | atomically $ do |
186 | let routing = toxRouting $ toxTransports params | ||
187 | Key _ nid = k | ||
188 | registerNodeCallback routing $ NodeInfoCallback | ||
189 | { interestingNodeId = nid | ||
190 | , listenerId = callbackId | ||
191 | , observedAddress = \ni -> return () -- TODO | ||
192 | , rumoredAddress = \saddr ni -> return () -- TODO | ||
193 | } | ||
170 | 194 | ||
171 | 195 | ||
172 | showKey_ :: Key -> String | 196 | showKey_ :: Key -> String |