Added Roster data and dhtkey handler.

1 files changed, 16 insertions, 7 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index aebf16cc..cf0328e8 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -73,6 +73,7 @@ import qualified Network.Tox.DHT.Handlers as Tox
 import qualified Network.Tox.Onion.Transport as Tox
 import qualified Network.Tox.Onion.Handlers as Tox
 import Data.Typeable
+import Roster
 
 showReport :: [(String,String)] -> String
 showReport kvs = showColumns $ map (\(x,y)->[x,y]) kvs
@@ -292,6 +293,7 @@ data Session = Session
     , swarms            :: Mainline.SwarmsDatabase
     , toxkeys           :: TVar Tox.AnnouncedKeys
     , userkeys          :: TVar [(SecretKey,PublicKey)]
+    , roster            :: Roster
     , signalQuit        :: MVar ()
     }
 
@@ -394,6 +396,7 @@ clientSession s@Session{..} sock cnum h = do
                         oldks <- atomically $ do
                             ks <- readTVar userkeys
                             modifyTVar userkeys ((secret,pubkey):)
+                            addRoster roster secret
                             return ks
                         let asString = show . Tox.key2id
                         hPutClient h $ unlines $ map (mappend "  " . show . Tox.key2id . snd) oldks
@@ -408,8 +411,11 @@ clientSession s@Session{..} sock cnum h = do
                             f x = error (concat ["Assertion fail at ", __FILE__, ":", show __LINE__])
                         let toPair x = (x,toPublic x)
                             pairs = map (toPair . f) mbSecs
-                        oldks <- atomically $ readTVar userkeys
-                        atomically $ modifyTVar userkeys (pairs ++)
+                        oldks <- atomically $ do
+                            oldks <- readTVar userkeys
+                            modifyTVar userkeys (pairs ++)
+                            forM pairs $ \(sk,_) -> addRoster roster sk
+                            return oldks
                         hPutClient h $ unlines $ map (mappend "  " . show . Tox.key2id . snd) oldks
                                                   ++ map (mappend " *" . show . Tox.key2id .snd) pairs
                  | ("del":secs) <- words s
@@ -421,6 +427,7 @@ clientSession s@Session{..} sock cnum h = do
                             pairs = map (toPair . f) mbSecs
                         ks <- atomically $ do
                             modifyTVar userkeys (filter (`notElem` pairs) )
+                            forM pairs $ \(_,pk) -> delRoster roster pk
                             readTVar userkeys
                         hPutClient h . showReport $ map mkrow ks
         ("g", s) | Just DHT{..} <- Map.lookup netname dhts
@@ -672,9 +679,8 @@ main = do
 
     keysdb <- Tox.newKeysDatabase
 
-    (toxids,quitTox,toxdhts,toxips,taddrs) <- case porttox opts of
-        "" -> do keys <- atomically $ newTVar []
-                 return (keys,return (), Map.empty, return [],[])
+    (mbtox,quitTox,toxdhts,toxips,taddrs) <- case porttox opts of
+        "" -> return (Nothing,return (), Map.empty, return [],[])
         toxport -> do
             addrTox <- getBindAddress toxport (ip6tox opts)
             tox <- Tox.newTox keysdb addrTox
@@ -755,14 +761,16 @@ main = do
                 ips :: IO [SockAddr]
                 ips = readExternals Tox.nodeAddr [ Tox.routing4 $ Tox.toxRouting tox
                                                  , Tox.routing6 $ Tox.toxRouting tox ]
-            return (userKeys (Tox.toxCryptoKeys tox), quitTox, dhts, ips, [addrTox])
-
+            return (Just tox, quitTox, dhts, ips, [addrTox])
     _ <- UPNP.requestPorts "dht-client" $ map (Datagram,) $ baddrs ++ taddrs
 
     let dhts = Map.union btdhts toxdhts
 
     waitForSignal <- do
         signalQuit <- newEmptyMVar
+        (toxids,rstr) <- fromMaybe ((,) <$> atomically (newTVar []) <*> newRoster) $ do
+            tox <- mbtox
+            return $ return ( userKeys (Tox.toxCryptoKeys tox), Tox.toxRoster tox )
         let session = clientSession $ Session
                 { netname           = concat $ take 1 $ Map.keys dhts -- initial default DHT
                 , dhts              = dhts  -- all DHTs
@@ -770,6 +778,7 @@ main = do
                 , swarms            = swarms
                 , toxkeys           = keysdb
                 , userkeys          = toxids
+                , roster            = rstr
                 , externalAddresses = liftM2 (++) btips toxips
                 }
         srv <- streamServer (withSession session) (SockAddrUnix "dht.sock")