1 files changed, 100 insertions, 0 deletions

diff --git a/src/Network/Tox/ContactInfo.hs b/src/Network/Tox/ContactInfo.hs
new file mode 100644
index 00000000..f4c4bf12
--- /dev/null
+++ b/src/Network/Tox/ContactInfo.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE NamedFieldPuns #-}
+module Network.Tox.ContactInfo where
+
+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 ContactInfo = ContactInfo { accounts :: TVar (HashMap NodeId Account) }
+
+data Account = Account
+    { 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
+
+newContactInfo :: IO ContactInfo
+newContactInfo = atomically $ ContactInfo <$> newTVar HashMap.empty
+
+newAccount :: SecretKey -> STM Account
+newAccount sk = Account sk <$> newTVar HashMap.empty
+
+addContactInfo :: ContactInfo -> SecretKey -> STM ()
+addContactInfo (ContactInfo as) sk = do
+    a <- newAccount sk
+    modifyTVar' as $ HashMap.insert (key2id $ toPublic sk) a
+
+delContactInfo :: ContactInfo -> PublicKey -> STM ()
+delContactInfo (ContactInfo as) pk = modifyTVar' as $ HashMap.delete (key2id pk)
+
+updateContactInfo :: ContactInfo -> Onion.AnnouncedRendezvous -> (PublicKey,Onion.OnionData) -> IO ()
+updateContactInfo roster Onion.AnnouncedRendezvous{remoteUserKey} (localUserKey,omsg) = do
+    hPutStrLn stderr "updateContactInfo!!!"
+    atomically $ do
+        as <- readTVar (accounts roster)
+        maybe (return ())
+              (updateAccount remoteUserKey omsg)
+              $ HashMap.lookup (key2id localUserKey) as
+
+
+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)
+
+updateAccount remoteUserKey (Onion.OnionFriendRequest fr) acc = do
+    modifyTVar' (contacts acc) $ HashMap.alter (mergeContact $ Contact Nothing (Just fr))
+                                               (key2id remoteUserKey)
+
+dnsPresentation :: ContactInfo -> STM String
+dnsPresentation (ContactInfo accsvar) = do
+    accs <- readTVar accsvar
+    ms <- forM accs $ \Account { userSecret = sec, contacts = cvar } -> do
+        cs <- readTVar cvar
+        return $
+            "; local key = " ++ show (key2id $ toPublic sec) ++ "\n"
+             ++ concatMap dnsPresentation1
+                          (mapMaybe (\(nid,m) -> ((,) nid) <$> contactKeyPacket m)
+                                    $ HashMap.toList cs)
+    return $ concat ms
+
+dnsPresentation1 :: (NodeId,DHTPublicKey) -> String
+dnsPresentation1 (nid,dk) = unlines
+    [ concat [ show nid, ".tox. IN CNAME ", show (key2id $ dhtpk dk), ".dht." ]
+    ]
+
+type LocalKey = NodeId
+type RemoteKey = NodeId
+
+friendRequests :: ContactInfo -> STM (HashMap LocalKey [(RemoteKey,DHT.FriendRequest)])
+friendRequests (ContactInfo 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
+