diff options
Diffstat (limited to 'Connection/Tox.hs')
-rw-r--r-- | Connection/Tox.hs | 26 |
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 (..)) |
10 | import Control.Concurrent.STM | 10 | import Control.Concurrent.STM |
11 | import Control.Monad | 11 | import Control.Monad |
12 | import Data.Dependent.Sum | 12 | -- 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 |
@@ -128,6 +128,24 @@ setToxPolicy :: Parameters | |||
128 | setToxPolicy params conmap k policy = case policy of | 128 | setToxPolicy 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 |