diff options
author | James Crayne <jim.crayne@gmail.com> | 2018-06-14 06:18:04 +0000 |
---|---|---|
committer | James Crayne <jim.crayne@gmail.com> | 2018-06-16 02:27:52 +0000 |
commit | bc5a84c34ba400f3d319387f34a7259923ca64e6 (patch) | |
tree | 5dc429f3417d46a431c5d1f846edf854b79c2caa /Connection | |
parent | b384cd2e1a806c882359d0cf619e6cce04784d58 (diff) |
Experimental Connection.Tox integration
Diffstat (limited to 'Connection')
-rw-r--r-- | Connection/Tox.hs | 18 |
1 files changed, 5 insertions, 13 deletions
diff --git a/Connection/Tox.hs b/Connection/Tox.hs index 5a9dc5eb..08a930bf 100644 --- a/Connection/Tox.hs +++ b/Connection/Tox.hs | |||
@@ -13,9 +13,9 @@ import Control.Monad | |||
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 | ||
17 | import Network.Tox.NodeId | 16 | import Network.Tox.NodeId |
18 | import Network.Tox.DHT.Handlers | 17 | import Network.Tox.DHT.Handlers |
18 | import Network.Tox.Crypto.Handlers | ||
19 | import PingMachine | 19 | import PingMachine |
20 | import Text.Read | 20 | import Text.Read |
21 | #ifdef THREAD_DEBUG | 21 | #ifdef THREAD_DEBUG |
@@ -31,16 +31,12 @@ import GHC.Conc (threadStatus,ThreadStatus(..)) | |||
31 | 31 | ||
32 | data Parameters = Parameters | 32 | data Parameters = Parameters |
33 | { -- | Various Tox transports and clients. | 33 | { -- | Various Tox transports and clients. |
34 | toxTransports :: Tox | 34 | dhtRouting :: Routing |
35 | -- | Thread to be forked when a connection is established. | 35 | -- | Thread to be forked when a connection is established. |
36 | -- TODO: this function should accept relevant parameters. | 36 | -- TODO: this function should accept relevant parameters. |
37 | , onToxSession :: IO () | 37 | , onToxSession :: IO () |
38 | } | 38 | } |
39 | 39 | ||
40 | data Key = Key NodeId{-me-} NodeId{-them-} | ||
41 | deriving (Eq,Ord) | ||
42 | |||
43 | instance Show Key where show = show . showKey_ | ||
44 | 40 | ||
45 | {- | 41 | {- |
46 | -- | A conneciton status that is tagged with a state type that is specific to | 42 | -- | A conneciton status that is tagged with a state type that is specific to |
@@ -165,7 +161,7 @@ setToxPolicy params conmap k policy = case policy of | |||
165 | $ freshenContact getPolicy _get_status freshen_methods | 161 | $ freshenContact getPolicy _get_status freshen_methods |
166 | atomically $ do | 162 | atomically $ do |
167 | writeTVar (sessionTasks st) $ SessionTasks accepting persuing refreshing | 163 | writeTVar (sessionTasks st) $ SessionTasks accepting persuing refreshing |
168 | let routing = toxRouting $ toxTransports params | 164 | let routing = dhtRouting params |
169 | Key _ nid = k | 165 | Key _ nid = k |
170 | registerNodeCallback routing $ NodeInfoCallback | 166 | registerNodeCallback routing $ NodeInfoCallback |
171 | { interestingNodeId = nid | 167 | { interestingNodeId = nid |
@@ -182,7 +178,7 @@ setToxPolicy params conmap k policy = case policy of | |||
182 | -- Here we block until they finish. | 178 | -- Here we block until they finish. |
183 | forM_ mst $ \st -> do | 179 | forM_ mst $ \st -> do |
184 | atomically $ do | 180 | atomically $ do |
185 | let routing = toxRouting $ toxTransports params | 181 | let routing = dhtRouting params |
186 | Key _ nid = k | 182 | Key _ nid = k |
187 | unregisterNodeCallback callbackId routing nid | 183 | unregisterNodeCallback callbackId routing nid |
188 | atomically $ do | 184 | atomically $ do |
@@ -201,7 +197,7 @@ setToxPolicy params conmap k policy = case policy of | |||
201 | (G.InProgress $ toEnum 0) | 197 | (G.InProgress $ toEnum 0) |
202 | $ acceptContact getPolicy _accept_methods | 198 | $ acceptContact getPolicy _accept_methods |
203 | atomically $ do | 199 | atomically $ do |
204 | let routing = toxRouting $ toxTransports params | 200 | let routing = dhtRouting params |
205 | Key _ nid = k | 201 | Key _ nid = k |
206 | registerNodeCallback routing $ NodeInfoCallback | 202 | registerNodeCallback routing $ NodeInfoCallback |
207 | { interestingNodeId = nid | 203 | { interestingNodeId = nid |
@@ -210,10 +206,6 @@ setToxPolicy params conmap k policy = case policy of | |||
210 | , rumoredAddress = \saddr ni -> return () -- TODO | 206 | , rumoredAddress = \saddr ni -> return () -- TODO |
211 | } | 207 | } |
212 | 208 | ||
213 | |||
214 | showKey_ :: Key -> String | ||
215 | showKey_ (Key me them) = show me ++ ":" ++ show them | ||
216 | |||
217 | stringToKey_ :: String -> Maybe Key | 209 | stringToKey_ :: String -> Maybe Key |
218 | stringToKey_ s = let (xs,ys) = break (==':') s | 210 | stringToKey_ s = let (xs,ys) = break (==':') s |
219 | in if null ys then Nothing | 211 | in if null ys then Nothing |