summaryrefslogtreecommitdiff
path: root/Connection
diff options
context:
space:
mode:
authorJames Crayne <jim.crayne@gmail.com>2018-06-14 06:18:04 +0000
committerJames Crayne <jim.crayne@gmail.com>2018-06-16 02:27:52 +0000
commitbc5a84c34ba400f3d319387f34a7259923ca64e6 (patch)
tree5dc429f3417d46a431c5d1f846edf854b79c2caa /Connection
parentb384cd2e1a806c882359d0cf619e6cce04784d58 (diff)
Experimental Connection.Tox integration
Diffstat (limited to 'Connection')
-rw-r--r--Connection/Tox.hs18
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
13import Data.Functor.Identity 13import Data.Functor.Identity
14import qualified Data.Map as Map 14import qualified Data.Map as Map
15import Connection.Tox.Threads 15import Connection.Tox.Threads
16import Network.Tox
17import Network.Tox.NodeId 16import Network.Tox.NodeId
18import Network.Tox.DHT.Handlers 17import Network.Tox.DHT.Handlers
18import Network.Tox.Crypto.Handlers
19import PingMachine 19import PingMachine
20import Text.Read 20import Text.Read
21#ifdef THREAD_DEBUG 21#ifdef THREAD_DEBUG
@@ -31,16 +31,12 @@ import GHC.Conc (threadStatus,ThreadStatus(..))
31 31
32data Parameters = Parameters 32data 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
40data Key = Key NodeId{-me-} NodeId{-them-}
41 deriving (Eq,Ord)
42
43instance 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
214showKey_ :: Key -> String
215showKey_ (Key me them) = show me ++ ":" ++ show them
216
217stringToKey_ :: String -> Maybe Key 209stringToKey_ :: String -> Maybe Key
218stringToKey_ s = let (xs,ys) = break (==':') s 210stringToKey_ s = let (xs,ys) = break (==':') s
219 in if null ys then Nothing 211 in if null ys then Nothing