1 files changed, 17 insertions, 14 deletions

diff --git a/Connection/Tox.hs b/Connection/Tox.hs
index 436e7599..2b39ef1c 100644
--- a/Connection/Tox.hs
+++ b/Connection/Tox.hs
@@ -12,14 +12,13 @@ import Connection.Tox.Threads
 import Control.Concurrent.STM
 import Control.Monad
 import Crypto.Tox
-import Data.Functor.Identity
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Map            as Map
+import Data.Maybe
 import Network.Tox.ContactInfo
 import Network.Tox.Crypto.Handlers
 import Network.Tox.DHT.Handlers      as DHT
 import Network.Tox.DHT.Transport     as DHT
-import Network.Tox.NodeId
 import PingMachine
 import Text.Read
 #ifdef THREAD_DEBUG
@@ -139,12 +138,7 @@ setToxPolicy params conmap k@(Key me them) policy = case policy of
         mst <- lookupForPolicyChange conmap k policy
         r <- atomically $ lookupContact k (roster params)
         forM_ r $ \(sec,c) -> do
-        let accept_methods = AcceptContactMethods
-                { getHandshake        = retry -- :: STM (Handshake Identity)
-                , handshakeIsSuitable = (\_ -> return False) -- :: Handshake Identity -> STM Bool
-                , transitionToState   = (\_ -> return ()) :: G.Status ToxProgress -> STM ()
-                }
-            persue_methods = PersueContactMethods
+        let persue_methods = PersueContactMethods
                 { allsessions        = sessions params
                 , myseckey           = sec
                 , theirpubkey        = id2key them
@@ -156,21 +150,26 @@ setToxPolicy params conmap k@(Key me them) policy = case policy of
             freshen_methods = FreshenContactMethods
                 { dhtkeyInterval   = _todo :: Int
                 , sockAddrInterval = _todo :: Int
-                , nodeSch          = _todo :: NodeSearch
+                , nodeSch          = nodeSearch (dhtClient params)
+                                                (nodesOfInterest $ dhtRouting params)
                 , getDHTKey        = retry :: STM (Maybe NodeId)
                 , getSockAddr      = retry -- :: STM (Maybe SockAddr)
                 , getBuckets       = retry -- :: STM (BucketList NodeInfo)
                 }
-            get_status = readTVar (ncState _todo)
+            get_status = do
+                sbk <- readTVar $ netCryptoSessionsByKey (sessions params)
+                fmap (fromMaybe G.Dormant) $ forM (Map.lookup (id2key them) sbk) $ \ss -> do
+                    stats <- mapM (readTVar . ncState) ss
+                    return $ maximum stats
         forM_ mst $ \st -> do
             let getPolicy = readTVar $ connPolicy st
             tasks <- atomically $ readTVar (sessionTasks st)
             persuing <- launch ("persue:"++show k)
                                 (G.InProgress $ toEnum 0)
-                               $ persueContact  getPolicy _get_status persue_methods
+                               $ persueContact  getPolicy get_status persue_methods
             refreshing <- launch ("refresh:"++show k)
                                 (G.InProgress $ toEnum 0)
-                               $ freshenContact getPolicy _get_status freshen_methods
+                               $ freshenContact getPolicy get_status freshen_methods
             atomically $ do
                 writeTVar (sessionTasks st) $ SessionTasks persuing refreshing
                 let routing   = dhtRouting params
@@ -178,8 +177,12 @@ setToxPolicy params conmap k@(Key me them) policy = case policy of
                 registerNodeCallback routing $ NodeInfoCallback
                     { interestingNodeId = nid
                     , listenerId        = callbackId
-                    , observedAddress   = \ni -> return () -- TODO
-                    , rumoredAddress    = \saddr ni -> return () -- TODO
+                    , observedAddress   = \ni -> writeTVar (contactLastSeenAddr c) (Just $ nodeAddr ni)
+                    , rumoredAddress    = \saddr ni -> do
+                        m <- readTVar (contactLastSeenAddr c)
+                        -- TODO remember information source and handle multiple rumors.
+                        case m of Just _  -> return ()
+                                  Nothing -> writeTVar (contactLastSeenAddr c) (Just $ nodeAddr ni)
                     }
             return ()
     RefusingToConnect -> do -- disconnect or cancel any pending connection