Prefer newer info in mergeContact and store connection policy.

1 files changed, 26 insertions, 9 deletions

diff --git a/src/Network/Tox/ContactInfo.hs b/src/Network/Tox/ContactInfo.hs
index 0d8a9f8a..6cadc944 100644
--- a/src/Network/Tox/ContactInfo.hs
+++ b/src/Network/Tox/ContactInfo.hs
@@ -2,6 +2,7 @@
 module Network.Tox.ContactInfo where
 
 import ConnectionKey
+import Connection
 
 import Control.Concurrent.STM
 import Control.Monad
@@ -16,7 +17,10 @@ import Network.Tox.NodeId
 import Network.Tox.Onion.Transport   as Onion
 import System.IO
 
-newtype ContactInfo = ContactInfo { accounts :: TVar (HashMap NodeId Account) }
+newtype ContactInfo = ContactInfo
+      -- | Map our toxid public key to an Account record.
+    { accounts :: TVar (HashMap NodeId Account)
+    }
 
 data Account = Account
     { userSecret :: SecretKey                     -- local secret key
@@ -27,18 +31,29 @@ data Account = Account
 data Contact = Contact
     { contactKeyPacket     :: Maybe (DHT.DHTPublicKey)
     , contactFriendRequest :: Maybe (DHT.FriendRequest)
+    , contactPolicy        :: Maybe (Connection.Policy)
+    }
+
+nullContact :: Contact
+nullContact = Contact
+    { contactKeyPacket     = Nothing
+    , contactFriendRequest = Nothing
+    , contactPolicy        = Nothing
     }
 
 mergeContact :: Contact -> Maybe Contact -> Maybe Contact
-mergeContact (Contact newk newf) (Just (Contact oldk oldf)) =
-    Just (Contact mergek mergef)
+mergeContact (Contact newk newf newp) (Just (Contact oldk oldf oldp)) =
+    Just $ Contact mergek -- Prefer newer public key packet as long as its stamp
+                          -- is later than the stored one.
+                  (mplus newf oldf) -- Prefer newer friend request.
+                  (mplus newp oldp) -- Prefer newer connection policy.
  where
-    mergek = mplus oldk $ do
+    mergek = flip mplus oldk $ do
         n <- newk
         stamp <- fmap DHT.dhtpkNonce oldk `mplus` return minBound
         guard (stamp <= DHT.dhtpkNonce n)
         return n
-    mergef = mplus oldf newf
+
 mergeContact new Nothing = Just new
 
 newContactInfo :: IO ContactInfo
@@ -68,12 +83,14 @@ updateContactInfo roster Onion.AnnouncedRendezvous{remoteUserKey} (localUserKey,
 
 updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM ()
 updateAccount remoteUserKey (Onion.OnionDHTPublicKey dhtpk) acc = do
-    modifyTVar' (contacts acc) $ HashMap.alter (mergeContact $ Contact (Just dhtpk) Nothing)
-                                               (key2id remoteUserKey)
+    modifyTVar' (contacts acc)
+        $ HashMap.alter (mergeContact nullContact { contactKeyPacket = Just dhtpk })
+                        (key2id remoteUserKey)
 
 updateAccount remoteUserKey (Onion.OnionFriendRequest fr) acc = do
-    modifyTVar' (contacts acc) $ HashMap.alter (mergeContact $ Contact Nothing (Just fr))
-                                               (key2id remoteUserKey)
+    modifyTVar' (contacts acc)
+        $ HashMap.alter (mergeContact nullContact { contactFriendRequest = Just fr })
+                        (key2id remoteUserKey)
 
 dnsPresentation :: ContactInfo -> STM String
 dnsPresentation (ContactInfo accsvar) = do