try to avoid bug where NodeInfo rapidly cycles between ipv4 and ipv6 addresses

1 files changed, 22 insertions, 14 deletions

diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index 56cc297f..d8b704b7 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -242,9 +242,17 @@ gotDhtPubkey pubkey tx theirKey = do
     observe :: AnnounceKey -> POSIXTime -> NodeInfo -> STM ()
     observe akey time ni@(nodeAddr -> addr) = do
       tput XNodeinfoSearch $ show ("observation", akey, time, addr)
-      scheduleImmediately (txAnnouncer tx) akey $
-        ScheduledItem $ getCookie ni (activeSesh addr) (getContact theirKey (txAccount tx))
-      setContactAddr time theirKey addr (txAccount tx)
+
+      contact <- getContact theirKey (txAccount tx)
+      join <$> traverse (readTVar . contactLastSeenAddr) contact >>= \case
+        -- Don't update address if we already have one from the last minute.
+        -- Really we need to be collecting a list of these.  :-(
+        Just (t, addr') | addr == addr' && time - t < 60 -> return ()
+        _ -> do
+
+          scheduleImmediately (txAnnouncer tx) akey $
+            ScheduledItem $ getCookie ni (activeSesh addr) (getContact theirKey (txAccount tx))
+          setContactAddr time theirKey addr (txAccount tx)
 
     getCookie
       :: NodeInfo
@@ -254,15 +262,15 @@ gotDhtPubkey pubkey tx theirKey = do
       -> AnnounceKey
       -> POSIXTime
       -> STM (IO ())
-    getCookie ni isActive getC ann akey now = fix $ \goBack -> do
-      mbContact <- getC
-      case mbContact of
-        Nothing -> return $ return ()
-        Just contact -> do
-          active <- isActive
-          return $ when (not active) (getCookieIO goBack)
-
+    getCookie ni isActive getC ann akey now = getCookieAgain
       where
+        getCookieAgain = do
+          mbContact  <- getC
+          case mbContact of
+            Nothing      -> return $ return ()
+            Just contact -> do
+              active <- isActive
+              return $ when (not active) getCookieIO
 
         callRealShakeHands = realShakeHands (userSecret (txAccount tx)) theirKey (dhtpk pubkey) (toxCryptoSessions tox) (nodeAddr ni)
 
@@ -271,8 +279,8 @@ gotDhtPubkey pubkey tx theirKey = do
 
         cookieMaxAge = 60 * 5
 
-        getCookieIO :: STM (IO ()) -> IO ()
-        getCookieIO getCookieAgain = do
+        getCookieIO :: IO ()
+        getCookieIO = do
           cookieRequest crypto client myPublicKey ni >>= \case
             Nothing -> atomically $ reschedule' 5 (const getCookieAgain)
             Just cookie -> do
@@ -281,7 +289,7 @@ gotDhtPubkey pubkey tx theirKey = do
               let shaker :: POSIXTime -> STM (IO ())
                   shaker now = do
                     if (now > cookieCreationStamp + cookieMaxAge)
-                      then return (getCookieIO getCookieAgain)
+                      then return $ dput XUnused "getCookieIO"
                       else do
                         reschedule' 5 shaker
                         return . void $ callRealShakeHands cookie