Fixed handshake behavior

The handshake code would flood the network with interminable handshakes.

1 files changed, 13 insertions, 6 deletions

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 =