1 files changed, 29 insertions, 8 deletions

diff --git a/Connection/Tox.hs b/Connection/Tox.hs
index b0da494a..0156806e 100644
--- a/Connection/Tox.hs
+++ b/Connection/Tox.hs
@@ -80,6 +80,8 @@ launch lbl st f = do
     stvar <- newTVarIO st
     tid <- forkIO (f stvar)
     labelThread tid lbl
+    stat <- threadStatus tid
+    hPutStrLn stderr $ "launch "++lbl++" "++show stat
     return $ StatefulTask tid stvar
 
 
@@ -95,6 +97,20 @@ data SessionState = SessionState
     -- , transient     :: TVar (DSum Transient Identity)
     }
 
+newSessionState :: IO SessionState
+newSessionState = do
+    pings <- forkPingMachine "SessionState"
+                             25000 -- 25 ms send ping
+                             30000 -- 30 ms timed out
+    a <- fork $ return ()
+    b <- fork $ return ()
+    atomically $ do
+        av <- newTVar G.Dormant
+        bv <- newTVar G.Dormant
+        let tasks = SessionTasks (StatefulTask a av) (StatefulTask b bv)
+        SessionState <$> newTVar G.RefusingToConnect <*> pure pings <*> newTVar tasks
+
+
 sessionStatus :: SessionState -> G.Connection ToxProgress
 sessionStatus st = G.Connection
     { G.connStatus    = combinedStatus =<< readTVar (sessionTasks st)
@@ -110,14 +126,17 @@ combinedStatus tasks = do
 
 lookupForPolicyChange :: TVar (Map.Map Key SessionState)
                          -> Key -> Policy -> IO (Maybe SessionState)
-lookupForPolicyChange conmap k policy = atomically $ do
-    cons <- readTVar conmap
-    fmap join $ forM (Map.lookup k cons) $ \st -> do
-        p <- readTVar (connPolicy st)
-        writeTVar (connPolicy st) policy
-        return $ do
-            guard $ p /= policy
-            return st
+lookupForPolicyChange conmap k policy = do
+    cons <- atomically $ readTVar conmap
+    st <- case Map.lookup k cons of
+            Nothing -> newSessionState
+            Just st -> return st
+    atomically $ do
+    p <- readTVar (connPolicy st)
+    writeTVar (connPolicy st) policy
+    return $ do
+        guard $ p /= policy
+        return st
 
 callbackId :: Int
 callbackId = 1
@@ -142,6 +161,7 @@ setToxPolicy params conmap k@(Key me them) policy = do
     TryingToConnect -> do
         mst <- lookupForPolicyChange conmap k policy
         r <- atomically $ lookupContact k (roster params)
+        hPutStrLn stderr $ "C.r="++show (fmap (const ()) r)
         forM_ r $ \(sec,c) -> do
         let persue_methods = PersueContactMethods
                 { allsessions        = sessions params
@@ -172,6 +192,7 @@ setToxPolicy params conmap k@(Key me them) policy = do
                 fmap (fromMaybe G.Dormant) $ forM (Map.lookup (id2key them) sbk) $ \ss -> do
                     stats <- mapM (readTVar . ncState) ss
                     return $ maximum stats
+        hPutStrLn stderr $ "C.mst="++show (fmap (const ()) mst)
         forM_ mst $ \st -> do
             let getPolicy = readTVar $ connPolicy st
             tasks <- atomically $ readTVar (sessionTasks st)