1 files changed, 40 insertions, 14 deletions

diff --git a/Roster.hs b/Roster.hs
index ab2f9911..7c40e371 100644
--- a/Roster.hs
+++ b/Roster.hs
@@ -1,23 +1,41 @@
 {-# LANGUAGE NamedFieldPuns #-}
 module Roster where
 
-import System.IO
-import Control.Monad
 import Control.Concurrent.STM
+import Control.Monad
 import Crypto.PubKey.Curve25519
 import qualified Data.HashMap.Strict as HashMap
          ;import Data.HashMap.Strict (HashMap)
+import Data.Maybe
 import Network.Tox.DHT.Transport     as DHT
 import Network.Tox.NodeId
 import Network.Tox.Onion.Transport   as Onion
+import System.IO
 
 newtype Roster = Roster { accounts :: TVar (HashMap NodeId Account) }
 
 data Account = Account
-    { userSecret :: SecretKey                            -- local secret key
-    , contacts :: TVar (HashMap NodeId DHT.DHTPublicKey) -- received contact info
+    { userSecret :: SecretKey                   -- local secret key
+    , contacts :: TVar (HashMap NodeId Contact) -- received contact info
     }
 
+data Contact = Contact
+    { contactKeyPacket     :: Maybe (DHT.DHTPublicKey)
+    , contactFriendRequest :: Maybe (DHT.FriendRequest)
+    }
+
+mergeContact :: Contact -> Maybe Contact -> Maybe Contact
+mergeContact (Contact newk newf) (Just (Contact oldk oldf)) =
+    Just (Contact mergek mergef)
+ where
+    mergek = 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
+
 newRoster :: IO Roster
 newRoster = atomically $ Roster <$> newTVar HashMap.empty
 
@@ -42,20 +60,14 @@ updateRoster roster Onion.AnnouncedRendezvous{remoteUserKey} (localUserKey,omsg)
               $ HashMap.lookup (key2id localUserKey) as
 
 
-updateConcts :: DHT.DHTPublicKey -> Maybe DHT.DHTPublicKey -> Maybe DHT.DHTPublicKey
-updateConcts new (Just old) | DHT.dhtpkNonce old < DHT.dhtpkNonce new = Just new
-updateConcts new Nothing                                              = Just new
-updateConcts _   old                                                  = old
-
-
 updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM ()
 updateAccount remoteUserKey (Onion.OnionDHTPublicKey dhtpk) acc = do
-    modifyTVar' (contacts acc) $ HashMap.alter (updateConcts dhtpk)
+    modifyTVar' (contacts acc) $ HashMap.alter (mergeContact $ Contact (Just dhtpk) Nothing)
                                                (key2id remoteUserKey)
 
 updateAccount remoteUserKey (Onion.OnionFriendRequest fr) acc = do
-    -- TODO
-    return ()
+    modifyTVar' (contacts acc) $ HashMap.alter (mergeContact $ Contact Nothing (Just fr))
+                                               (key2id remoteUserKey)
 
 dnsPresentation :: Roster -> STM String
 dnsPresentation (Roster accsvar) = do
@@ -64,7 +76,9 @@ dnsPresentation (Roster accsvar) = do
         cs <- readTVar cvar
         return $
             "; local key = " ++ show (key2id $ toPublic sec) ++ "\n"
-             ++ concatMap dnsPresentation1 (HashMap.toList cs)
+             ++ concatMap dnsPresentation1
+                          (mapMaybe (\(nid,m) -> ((,) nid) <$> contactKeyPacket m)
+                                    $ HashMap.toList cs)
     return $ concat ms
 
 dnsPresentation1 :: (NodeId,DHTPublicKey) -> String
@@ -72,3 +86,15 @@ dnsPresentation1 (nid,dk) = unlines
     [ concat [ show nid, ".tox. IN CNAME ", show (key2id $ dhtpk dk), ".dht." ]
     ]
 
+type LocalKey = NodeId
+type RemoteKey = NodeId
+
+friendRequests :: Roster -> STM (HashMap LocalKey [(RemoteKey,DHT.FriendRequest)])
+friendRequests (Roster roster) = do
+    accs <- readTVar roster
+    forM accs $ \Account { userSecret = sec, contacts = cvar } -> do
+        cs <- readTVar cvar
+        let remotes = mapMaybe (\(nid,m) -> ((,) nid) <$> contactFriendRequest m)
+                               $ HashMap.toList cs
+        return remotes
+