Fixed handshake behavior

The handshake code would flood the network with interminable handshakes.

8 files changed, 108 insertions, 79 deletions

diff --git a/Announcer.hs b/Announcer.hs
index 41c1c2a6..89dc5c3b 100644
--- a/Announcer.hs
+++ b/Announcer.hs
@@ -46,11 +46,11 @@ newtype AnnounceKey = AnnounceKey ByteString
 instance Show AnnounceKey where
     show (AnnounceKey bs) = "AnnounceKey " ++ show (Char8.unpack bs)
 
-packAnnounceKey :: Announcer -> String -> STM AnnounceKey
-packAnnounceKey _ = return . AnnounceKey . Char8.pack
+packAnnounceKey :: Announcer -> String -> AnnounceKey
+packAnnounceKey _ = AnnounceKey . Char8.pack
 
-unpackAnnounceKey :: Announcer -> AnnounceKey -> STM String
-unpackAnnounceKey _ (AnnounceKey bs) = return $ Char8.unpack bs
+unpackAnnounceKey :: Announcer -> AnnounceKey -> String
+unpackAnnounceKey _ (AnnounceKey bs) = Char8.unpack bs
 
 -- | Actions that can be scheduled to occur at some particular time in the
 -- future.  Since periodic event handlers are responsible for re-scheduling
diff --git a/Connection/Tox.hs b/Connection/Tox.hs
index 3f5f7e2c..9612f1e5 100644
--- a/Connection/Tox.hs
+++ b/Connection/Tox.hs
@@ -193,12 +193,12 @@ setToxPolicy params conmap k@(Key me them) policy = do
                 registerNodeCallback routing $ NodeInfoCallback
                     { interestingNodeId = nid
                     , listenerId        = callbackId
-                    , observedAddress   = \now ni -> writeTVar (contactLastSeenAddr c) (Just (now,nodeAddr ni))
+                    , observedAddress   = \now ni -> writeTVar (contactLastSeenAddr c) (Just (now, ni))
                     , rumoredAddress    = \now 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 (now,nodeAddr ni))
+                                  Nothing -> writeTVar (contactLastSeenAddr c) (Just (now, ni))
                     }
             return ()
     RefusingToConnect -> do -- disconnect or cancel any pending connection
@@ -235,12 +235,12 @@ setToxPolicy params conmap k@(Key me them) policy = do
                 registerNodeCallback routing $ NodeInfoCallback
                     { interestingNodeId = nid
                     , listenerId        = callbackId
-                    , observedAddress   = \now ni -> writeTVar (contactLastSeenAddr c) (Just (now,nodeAddr ni))
+                    , observedAddress   = \now ni -> writeTVar (contactLastSeenAddr c) (Just (now, ni))
                     , rumoredAddress    = \now 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 (now,nodeAddr ni))
+                                  Nothing -> writeTVar (contactLastSeenAddr c) (Just (now, ni))
                     }
 
 stringToKey_ :: String -> Maybe Key
diff --git a/Connection/Tox/Threads.hs b/Connection/Tox/Threads.hs
index ba49b7dc..de719655 100644
--- a/Connection/Tox/Threads.hs
+++ b/Connection/Tox/Threads.hs
@@ -140,7 +140,7 @@ pursueContact getPolicy getStatus PursueContactMethods{..} statusVar = do
                    (do
                     (stamp_theirDhtKey,theirDhtKey) <- second DHT.dhtpk <$> retryUntilJust (contactKeyPacket contact)
                     (stamp_saddr,saddr) <- retryUntilJust (contactLastSeenAddr contact)
-                    ni <- either (const retry) return $ nodeInfo (key2id theirDhtKey) saddr
+                    ni <- either (const retry) return $ nodeInfo (key2id theirDhtKey) (_fixme saddr)
                     return $ do
                     -- AcquiringCookie
                     atomically $ writeTVar statusVar (InProgress AcquiringCookie)
@@ -166,11 +166,11 @@ pursueContact getPolicy getStatus PursueContactMethods{..} statusVar = do
                             newsession <- generateSecretKey
                             timestamp <- getPOSIXTime
                             (myhandshake,ioAction)
-                                    <- atomically $ freshCryptoSession allsessions saddr newsession timestamp hp
+                                    <- atomically $ freshCryptoSession allsessions (_fixme saddr) newsession timestamp hp
                             ioAction
                             -- send handshake
                             forM myhandshake $ \response_handshake -> do
-                                    sendHandshake allsessions saddr response_handshake
+                                    sendHandshake allsessions (_fixme saddr) response_handshake
                             atomically $ writeTVar statusVar $ InProgress AwaitingHandshake
                             return shortRetryInterval
                     -- AwaitingHandshake
diff --git a/ToxManager.hs b/ToxManager.hs
index bcc4d86d..360f78e8 100644
--- a/ToxManager.hs
+++ b/ToxManager.hs
@@ -78,7 +78,7 @@ toxman announcer toxbkts tox presence = ToxManager
         forM_ newlyActive $ \nearNodes -> do
             -- Schedule recurring announce.
             --
-            akey <- atomically $ packAnnounceKey announcer $ "toxid:" ++ show pubid
+            let akey = packAnnounceKey announcer $ "toxid:" ++ show pubid
             scheduleAnnounce announcer
                      akey
                      (AnnounceMethod (toxQSearch tox)
@@ -109,7 +109,7 @@ toxman announcer toxbkts tox presence = ToxManager
             --      Stop the recurring search for that contact
             --
             -- Stop recurring announce.
-            akey <- packAnnounceKey announcer ("toxid:" ++ show pubid)
+            let akey = packAnnounceKey announcer ("toxid:" ++ show pubid)
             fmap Just $ forM toxbkts $ \(nm,bkts) -> do
                 return (akey,bkts)
         else return Nothing
diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index adeb7455..2071ae9e 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -159,7 +159,7 @@ data Moot v     = Moot
 data NNS a b c = NNS { -- NetcryptoNegotiationState
   sessionDesired  :: Bool,
   theirPublicKey  :: a Tox.DHTPublicKey,
-  theirAddress    :: b SockAddr,
+  theirAddress    :: b NodeInfo,
   theirCookie     :: c (Tox.Cookie Encrypted),
   sessionIsActive :: Bool
 }
@@ -172,7 +172,7 @@ data NS
   | Stage5 (NNS Acquired Acquired Acquired)
 
 gotDhtPubkey :: Tox.DHTPublicKey -> ToxToXMPP -> PublicKey -> IO ()
-gotDhtPubkey pubkey tx theirKey = do
+gotDhtPubkey theirDhtKey tx theirKey = do
   contact <- atomically $ getContact theirKey (txAccount tx) >>= mapM (readTVar . contactLastSeenAddr)
   forM_ contact $ \lastSeen -> do
     case lastSeen of
@@ -188,33 +188,13 @@ gotDhtPubkey pubkey tx theirKey = do
     me = key2id myPublicKey
 
     doSearch = do
-      akey <- akeyConnect (txAnnouncer tx) me theirKey
+      let akey = akeyConnect (txAnnouncer tx) me theirKey
       atomically $ registerNodeCallback (toxRouting tox) (nic akey)
-      scheduleSearch (txAnnouncer tx) akey meth pubkey
-
-    byAddr :: TVar (Map.Map SockAddr Tox.NetCryptoSession)
-    byAddr = Tox.netCryptoSessions (toxCryptoSessions tox)
-
-    crypto = Tox.transportCrypto $ toxCryptoSessions tox
-
-    readNcVar :: (Tox.NetCryptoSession -> TVar b) -> SockAddr -> STM (Maybe b)
-    readNcVar v addr = traverse readTVar =<< fmap v . Map.lookup addr <$> readTVar byAddr
-
-    chillSesh :: SockAddr -> STM (Maybe (Status Tox.ToxProgress))
-    chillSesh = readNcVar Tox.ncState
-
-    activeSesh :: SockAddr -> STM Bool
-    activeSesh a = chillSesh a >>= return . \case
-      Just Established -> True
-      _                -> False
-
-    readCookie :: SockAddr -> STM (Maybe (UponCookie (Tox.Cookie Encrypted)))
-    readCookie = readNcVar Tox.ncCookie
-    readCookie' :: SockAddr -> STM (Maybe (Tox.Cookie Encrypted))
-    readCookie' = fmap join . (fmap.fmap) Tox.toMaybe . readCookie
+      scheduleSearch (txAnnouncer tx) akey meth theirDhtKey
 
     target :: NodeId
-    target = key2id $ dhtpk pubkey
+    target = key2id $ dhtpk theirDhtKey
+
     meth :: SearchMethod Tox.DHTPublicKey
     meth =
       SearchMethod
@@ -232,9 +212,6 @@ gotDhtPubkey pubkey tx theirKey = do
       , rumoredAddress    = assume akey
       }
 
-    client :: Network.Tox.DHT.Handlers.Client
-    client = toxDHT tox
-
     assume :: AnnounceKey -> POSIXTime -> SockAddr -> NodeInfo -> STM ()
     assume akey time addr ni =
       tput XNodeinfoSearch $ show ("rumor", akey, time, addr, ni)
@@ -242,17 +219,54 @@ gotDhtPubkey pubkey tx theirKey = do
     observe :: AnnounceKey -> POSIXTime -> NodeInfo -> STM ()
     observe akey time ni@(nodeAddr -> addr) = do
       tput XNodeinfoSearch $ show ("observation", akey, time, addr)
+      setContactAddr time theirKey ni (txAccount tx)
+
+gotAddr :: NodeInfo -> ToxToXMPP -> PublicKey -> IO ()
+gotAddr ni@(nodeAddr -> addr) tx theirKey = do
+  dhtkey <- (fmap.fmap) snd $
+            fmap join $
+            atomically $
+            traverse readTVar =<< fmap contactKeyPacket <$> getContact theirKey (txAccount tx)
+  forM_ dhtkey $ gotAddr' ni tx theirKey
+
+gotAddr' :: NodeInfo -> ToxToXMPP -> PublicKey -> Tox.DHTPublicKey -> IO ()
+gotAddr' ni@(nodeAddr -> addr) tx theirKey theirDhtKey = atomically blee
+
+  where
+    myPublicKey = toPublic $ userSecret (txAccount tx)
+    me          = key2id myPublicKey
+    akey        = akeyConnect (txAnnouncer tx) me theirKey
+
+    blee = do
+      scheduleImmediately (txAnnouncer tx) akey $
+        ScheduledItem $ getCookie ni (activeSesh addr) (getContact theirKey (txAccount tx))
+
+    tox :: Tox JabberClients
+    tox = txTox tx
+
+    byAddr :: TVar (Map.Map SockAddr Tox.NetCryptoSession)
+    byAddr = Tox.netCryptoSessions (toxCryptoSessions tox)
+
+    crypto = Tox.transportCrypto $ toxCryptoSessions tox
+
+    readNcVar :: (Tox.NetCryptoSession -> TVar b) -> SockAddr -> STM (Maybe b)
+    readNcVar v addr = traverse readTVar =<< fmap v . Map.lookup addr <$> readTVar byAddr
 
-      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
+    chillSesh :: SockAddr -> STM (Maybe (Status Tox.ToxProgress))
+    chillSesh = readNcVar Tox.ncState
+
+    activeSesh :: SockAddr -> STM Bool
+    activeSesh a = chillSesh a >>= return . \case
+      Just Established -> True
+      _                -> False
 
-          scheduleImmediately (txAnnouncer tx) akey $
-            ScheduledItem $ getCookie ni (activeSesh addr) (getContact theirKey (txAccount tx))
-          setContactAddr time theirKey addr (txAccount tx)
+    readCookie :: SockAddr -> STM (Maybe (UponCookie (Tox.Cookie Encrypted)))
+    readCookie = readNcVar Tox.ncCookie
+    readCookie' :: SockAddr -> STM (Maybe (Tox.Cookie Encrypted))
+    readCookie' = fmap join . (fmap.fmap) Tox.toMaybe . readCookie
+
+    client :: Network.Tox.DHT.Handlers.Client
+    client = toxDHT tox
 
     getCookie
       :: NodeInfo
@@ -265,6 +279,7 @@ gotDhtPubkey pubkey tx theirKey = do
     getCookie ni isActive getC ann akey now = getCookieAgain
       where
         getCookieAgain = do
+          tput XNodeinfoSearch $ show ("getCookieAgain", akey)
           mbContact  <- getC
           case mbContact of
             Nothing      -> return $ return ()
@@ -272,7 +287,7 @@ gotDhtPubkey pubkey tx theirKey = do
               active <- isActive
               return $ when (not active) getCookieIO
 
-        callRealShakeHands = realShakeHands (userSecret (txAccount tx)) theirKey (dhtpk pubkey) (toxCryptoSessions tox) (nodeAddr ni)
+        callRealShakeHands = realShakeHands (userSecret (txAccount tx)) theirKey (dhtpk theirDhtKey) (toxCryptoSessions tox) (nodeAddr ni)
 
         reschedule n f = scheduleRel ann akey f n
         reschedule' n f = reschedule n (ScheduledItem $ \_ _ now -> f now)
@@ -281,6 +296,7 @@ gotDhtPubkey pubkey tx theirKey = do
 
         getCookieIO :: IO ()
         getCookieIO = do
+          dput XUnused "getCookieIO - entered"
           cookieRequest crypto client myPublicKey ni >>= \case
             Nothing -> atomically $ reschedule' 5 (const getCookieAgain)
             Just cookie -> do
@@ -288,15 +304,21 @@ gotDhtPubkey pubkey tx theirKey = do
               cookieCreationStamp <- getPOSIXTime
               let shaker :: POSIXTime -> STM (IO ())
                   shaker now = do
-                    if (now > cookieCreationStamp + cookieMaxAge)
-                      then return $ dput XUnused "getCookieIO"
-                      else do
-                        reschedule' 5 shaker
-                        return . void $ callRealShakeHands cookie
+                    active <- isActive
+                    if (active)
+                      then return $ return ()
+                      else if (now > cookieCreationStamp + cookieMaxAge)
+                             then return $
+                                  dput XUnused "getCookieIO/shaker - cookie expired" >>
+                                  getCookieIO
+                             else do
+                               reschedule' 5 shaker
+                               return . void $ callRealShakeHands cookie
               atomically $ reschedule' 5 shaker
 
 realShakeHands :: SecretKey -> PublicKey -> PublicKey -> Tox.NetCryptoSessions -> SockAddr -> Tox.Cookie Encrypted -> IO Bool
 realShakeHands myseckey theirpubkey theirDhtKey allsessions saddr cookie = do
+  dput XUnused "realShakeHands"
   let hp =
         HParam
         { hpOtherCookie = cookie
@@ -318,7 +340,7 @@ realShakeHands myseckey theirpubkey theirDhtKey allsessions saddr cookie = do
 dispatch :: ToxToXMPP -> ContactEvent -> IO ()
 dispatch tx (SessionEstablished theirKey)                    = stopConnecting tx theirKey
 dispatch tx (SessionTerminated theirKey)                     = startConnecting tx theirKey
-dispatch tx (AddrChange   theirkey saddr)                    = return () -- todo
+dispatch tx (AddrChange   theirKey saddr)                    = gotAddr saddr tx theirKey
 dispatch tx (PolicyChange theirkey TryingToConnect         ) = startConnecting tx theirkey
 dispatch tx (PolicyChange theirkey policy                  ) = stopConnecting tx theirkey
 dispatch tx (OnionRouted  theirKey (OnionDHTPublicKey pkey)) = gotDhtPubkey pkey tx theirKey
@@ -352,12 +374,12 @@ interweave :: [a] -> [a] -> [a]
 interweave []     ys = ys
 interweave (x:xs) ys = x : interweave ys xs
 
-akeyDHTKeyShare :: Announcer -> NodeId -> PublicKey -> IO AnnounceKey
-akeyDHTKeyShare announcer me them = atomically $ do
+akeyDHTKeyShare :: Announcer -> NodeId -> PublicKey -> AnnounceKey
+akeyDHTKeyShare announcer me them =
     packAnnounceKey announcer $ "dhtkey:" ++ (take 8 $ show me) ++ ":" ++ show (key2id them)
 
-akeyConnect :: Announcer -> NodeId -> PublicKey -> IO AnnounceKey
-akeyConnect announcer me them = atomically $ do
+akeyConnect :: Announcer -> NodeId -> PublicKey -> AnnounceKey
+akeyConnect announcer me them =
     packAnnounceKey announcer $ "connect:" ++ (take 8 $ show me) ++ ":" ++ show (key2id them)
 
 
@@ -407,7 +429,7 @@ startConnecting0 tx them contact = do
             me  = key2id mypub
         soliciting <- checkSoliciting (txPresence tx) mypub them contact
         when wanted $ do
-            akey <- akeyDHTKeyShare announcer me them
+            akey <- return $ akeyDHTKeyShare announcer me them
                     -- We send this packet every 30 seconds if there is more
                     -- than one peer (in the 8) that says they our friend is
                     -- announced on them. This packet can also be sent through
@@ -464,9 +486,9 @@ startConnecting tx them = do
 stopConnecting :: ToxToXMPP -> PublicKey -> IO ()
 stopConnecting ToxToXMPP{txAnnouncer=announcer,txAccount=acnt} them = do
     dput XMan $ "STOP CONNECTING " ++ show (key2id them)
-    let pub = toPublic $ userSecret acnt
-        me  = key2id pub
-    akey <- akeyDHTKeyShare announcer me them
+    let pub  = toPublic $ userSecret acnt
+        me   = key2id pub
+        akey = akeyDHTKeyShare announcer me them
     cancel announcer akey
 
 forkAccountWatcher :: Account JabberClients -> Tox JabberClients -> PresenceState -> Announcer -> IO ThreadId
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index c03df3cc..9b5abb22 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -1065,7 +1065,7 @@ clientSession s@Session{..} sock cnum h = do
                         rs <- atomically $ do
                             as <- scheduleToList announcer
                             forM (as) $ \(k,ptm,item) -> do
-                                kstr <- unpackAnnounceKey announcer k
+                                let kstr = unpackAnnounceKey announcer k
                                 return [ if ptm==0 then "now"
                                                    else show (ptm - now)
                                        , show (itemStatusNum item)
@@ -1124,7 +1124,7 @@ clientSession s@Session{..} sock cnum h = do
                                 -- return $ hPutClient h "Type matches."
                                 dta <- either (const Nothing) Just $ announceParseData dtastr
                                 return $ do
-                                    akey <- atomically $ packAnnounceKey announcer (method ++ ":" ++ dtastr)
+                                    let akey = packAnnounceKey announcer (method ++ ":" ++ dtastr)
                                     doitR op announcer
                                             akey
                                             (AnnounceMethod qsearch asend
@@ -1150,7 +1150,7 @@ clientSession s@Session{..} sock cnum h = do
                                 dta <- either (const Nothing) Just $ announceParseData dtastr
                                 pub <- selectedKey
                                 return $ do
-                                    akey <- atomically $ packAnnounceKey announcer (method ++ ":" ++ dtastr)
+                                    let akey = packAnnounceKey announcer (method ++ ":" ++ dtastr)
                                     doitL op announcer
                                             akey
                                             (SearchMethod qsearch (asend pub)
@@ -1352,7 +1352,7 @@ netcrypto (Just (DHT {..})) (Just mypubkey) h roster (Just tox) exes paramStr =
             Nothing -> hPutClient h "Unable to find account for selected key"
             Just account -> do
               now <- getPOSIXTime
-              atomically $ setContactAddr now their_pub their_addr account
+              atomically $ setContactAddr now their_pub (_fixme their_addr) account
               sessions <- Tox.netCrypto tox sec their_pub
               exeDir <- takeDirectory <$> getExecutablePath
               forM_ sessions $ \session -> do
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index f7cf7b1e..cebbebfb 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -261,7 +261,7 @@ netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
                 -- Convert to NodeInfo, so we can send cookieRequest
                 let crypto = toxCryptoKeys tox
                     client = toxDHT tox
-                case nodeInfo (key2id theirDhtKey) saddr of
+                case nodeInfo (key2id theirDhtKey) (nodeAddr saddr) of
                    Left e   -> dput XNetCrypto ("netCrypto: nodeInfo fail... " ++ e) >> return []
                    Right ni -> do
                     mbCookie <- DHT.cookieRequest crypto client (toPublic myseckey) ni
@@ -282,11 +282,11 @@ netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
                         newsession <- generateSecretKey
                         timestamp <- getPOSIXTime
                         (myhandshake,ioAction)
-                                <- atomically $ freshCryptoSession (toxCryptoSessions tox) saddr newsession timestamp hp
+                                <- atomically $ freshCryptoSession (toxCryptoSessions tox) (nodeAddr saddr) newsession timestamp hp
                         ioAction
                         -- send handshake
                         forM myhandshake $ \response_handshake -> do
-                                sendHandshake (toxCryptoSessions tox) saddr response_handshake
+                                sendHandshake (toxCryptoSessions tox) (nodeAddr saddr) response_handshake
                         let secnum :: Double
                             secnum = fromIntegral millisecs / 1000000
                             delay = (millisecs * 5 `div` 4)
diff --git a/src/Network/Tox/ContactInfo.hs b/src/Network/Tox/ContactInfo.hs
index 3f794197..1970b782 100644
--- a/src/Network/Tox/ContactInfo.hs
+++ b/src/Network/Tox/ContactInfo.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE LambdaCase #-}
 module Network.Tox.ContactInfo where
 
 import Connection
@@ -30,13 +31,13 @@ data Account extra = Account
 
 data ContactEvent = OnionRouted  { contact :: PublicKey, onionRouted :: OnionData }
                   | PolicyChange { contact :: PublicKey, policyChange :: Policy }
-                  | AddrChange   { contact :: PublicKey, addrChange :: SockAddr }
+                  | AddrChange   { contact :: PublicKey, addrChange :: NodeInfo }
                   | SessionEstablished { contact :: PublicKey }
                   | SessionTerminated  { contact :: PublicKey }
 
 data Contact = Contact
     { contactKeyPacket     :: TVar (Maybe (POSIXTime,DHT.DHTPublicKey))
-    , contactLastSeenAddr  :: TVar (Maybe (POSIXTime,SockAddr))
+    , contactLastSeenAddr  :: TVar (Maybe (POSIXTime,NodeInfo))
     , contactFriendRequest :: TVar (Maybe (POSIXTime,DHT.FriendRequest))
     , contactPolicy        :: TVar (Maybe Connection.Policy)
     }
@@ -97,7 +98,7 @@ onionUpdate now (Onion.OnionFriendRequest fr)   contact
 policyUpdate :: Policy -> Contact -> STM ()
 policyUpdate policy contact = writeTVar (contactPolicy contact) $ Just policy
 
-addrUpdate :: POSIXTime -> SockAddr -> Contact -> STM ()
+addrUpdate :: POSIXTime -> NodeInfo -> Contact -> STM ()
 addrUpdate now addr contact = writeTVar (contactLastSeenAddr contact) $ Just (now,addr)
 
 setContactPolicy :: PublicKey -> Policy -> Account extra -> STM ()
@@ -105,10 +106,16 @@ setContactPolicy remoteUserKey policy acc = do
     updateAccount' remoteUserKey acc $ policyUpdate policy
     writeTChan (eventChan acc) $ PolicyChange remoteUserKey policy
 
-setContactAddr :: POSIXTime -> PublicKey -> SockAddr -> Account extra -> STM ()
+setContactAddr :: POSIXTime -> PublicKey -> NodeInfo -> Account extra -> STM ()
 setContactAddr now remoteUserKey addr acc = do
-    updateAccount' remoteUserKey acc $ addrUpdate now addr
-    writeTChan (eventChan acc) $ AddrChange remoteUserKey addr
+    contact <- getContact remoteUserKey acc
+    let update = updateAccount' remoteUserKey acc $ addrUpdate now addr
+    let notify = writeTChan (eventChan acc) $ AddrChange remoteUserKey addr
+    join <$> traverse (readTVar . contactLastSeenAddr) contact >>= \case
+      Just (_, a) | addr == a    -> update -- updates time only
+      Just (t, _) | now > t + 60 -> update >> notify -- update IP if existing one is old
+      Nothing                    -> update >> notify -- or if we don't have any
+      _                          -> return () -- otherwise just wait
 
 setEstablished :: POSIXTime -> PublicKey -> Account extra -> STM ()
 setEstablished now remoteUserKey acc =