summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Connection/Tox.hs26
1 files changed, 22 insertions, 4 deletions
diff --git a/Connection/Tox.hs b/Connection/Tox.hs
index de2bb879..5a9dc5eb 100644
--- a/Connection/Tox.hs
+++ b/Connection/Tox.hs
@@ -9,7 +9,7 @@ import qualified Connection as G
9 ;import Connection (Manager (..), Policy (..)) 9 ;import Connection (Manager (..), Policy (..))
10import Control.Concurrent.STM 10import Control.Concurrent.STM
11import Control.Monad 11import Control.Monad
12import Data.Dependent.Sum 12-- import Data.Dependent.Sum
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
@@ -128,6 +128,24 @@ setToxPolicy :: Parameters
128setToxPolicy params conmap k policy = case policy of 128setToxPolicy params conmap k policy = case policy of
129 TryingToConnect -> do 129 TryingToConnect -> do
130 mst <- lookupForPolicyChange conmap k policy 130 mst <- lookupForPolicyChange conmap k policy
131 let accept_methods = AcceptContactMethods
132 { getHandshake = retry -- :: STM (Handshake Identity)
133 , handshakeIsSuitable = (\_ -> return False) -- :: Handshake Identity -> STM Bool
134 , transitionToState = (\_ -> return ()) :: G.Status ToxProgress -> STM ()
135 }
136 persue_methods = PersueContactMethods
137 { getHandshakeParams = retry -- :: STM params
138 , sendHandshake = \_ -> return () -- :: params -> IO ()
139 , retryInterval = _todo :: Int
140 }
141 freshen_methods = FreshenContactMethods
142 { dhtkeyInterval = _todo :: Int
143 , sockAddrInterval = _todo :: Int
144 , nodeSch = _todo :: NodeSearch
145 , getDHTKey = retry :: STM (Maybe NodeId)
146 , getSockAddr = retry -- :: STM (Maybe SockAddr)
147 , getBuckets = retry -- :: STM (BucketList NodeInfo)
148 }
131 forM_ mst $ \st -> do 149 forM_ mst $ \st -> do
132 let getPolicy = readTVar $ connPolicy st 150 let getPolicy = readTVar $ connPolicy st
133 tasks <- atomically $ readTVar (sessionTasks st) 151 tasks <- atomically $ readTVar (sessionTasks st)
@@ -137,14 +155,14 @@ setToxPolicy params conmap k policy = case policy of
137 accepting <- if astat /= ThreadRunning 155 accepting <- if astat /= ThreadRunning
138 then launch ("accept:"++show k) 156 then launch ("accept:"++show k)
139 (G.InProgress $ toEnum 0) 157 (G.InProgress $ toEnum 0)
140 $ acceptContact getPolicy _accept_methods 158 $ acceptContact getPolicy accept_methods
141 else return $ accepting tasks 159 else return $ accepting tasks
142 persuing <- launch ("persue:"++show k) 160 persuing <- launch ("persue:"++show k)
143 (G.InProgress $ toEnum 0) 161 (G.InProgress $ toEnum 0)
144 $ persueContact getPolicy _get_status _persue_methods 162 $ persueContact getPolicy _get_status persue_methods
145 refreshing <- launch ("refresh:"++show k) 163 refreshing <- launch ("refresh:"++show k)
146 (G.InProgress $ toEnum 0) 164 (G.InProgress $ toEnum 0)
147 $ freshenContact getPolicy _get_status _freshen_methods 165 $ freshenContact getPolicy _get_status freshen_methods
148 atomically $ do 166 atomically $ do
149 writeTVar (sessionTasks st) $ SessionTasks accepting persuing refreshing 167 writeTVar (sessionTasks st) $ SessionTasks accepting persuing refreshing
150 let routing = toxRouting $ toxTransports params 168 let routing = toxRouting $ toxTransports params