group chat invite accepted message.

1 files changed, 20 insertions, 10 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index a602b772..6756b14b 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -115,6 +115,7 @@ import qualified Connection.Tcp as Tcp (ConnectionEvent(..),noCleanUp,TCPStatus)
 import DPut
 import DebugTag
 import LocalChat
+import ToxChat
 import MUC
 
 
@@ -1022,7 +1023,7 @@ clientSession s@Session{..} sock cnum h = do
                                ]
                 rs = map mkrow cs
             return $ do
-            hPutClient h $ showColumns rs
+            hPutClient h $ "connections\n" ++ showColumns rs
 
         ("help", s) | Just DHT{..} <- Map.lookup netname dhts
                     -> cmd0 $ do
@@ -1157,11 +1158,12 @@ newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = outGoingQVar }) = C.awaitFo
 
 onNewToxSession :: XMPPServer
                      -> TVar (Map.Map Uniq24 AggregateSession)
+                     -> InviteCache IO
                      -> ContactInfo extra
                      -> SockAddr
                      -> Tox.Session
                      -> IO ()
-onNewToxSession sv ssvar ContactInfo{accounts} addrTox netcrypto = do
+onNewToxSession sv ssvar invc ContactInfo{accounts} addrTox netcrypto = do
     let them s = Tox.longTermKey $ runIdentity cookie -- remote tox key
          where Tox.Cookie _ cookie = Tox.handshakeCookie (sReceivedHandshake s)
 
@@ -1193,7 +1195,7 @@ onNewToxSession sv ssvar ContactInfo{accounts} addrTox netcrypto = do
                                                     _       -> retry)
                                  (return ())
             toxSnk  = C.mapM_ (uncurry $ dispatchMessage c)
-            xmppSrc = toxSrc .| C.map snd .| toxToXmpp addrTox (me s) (xmppHostname $ them s)
+            xmppSrc = toxSrc .| toxToXmpp (rememberInvite invc c) addrTox (me s) (xmppHostname $ them s)
             xmppSnk = flushPassThrough xmppToTox
                         .| C.mapMaybe (\case Flush   -> Nothing
                                              Chunk x -> Just (Nothing,x))
@@ -1288,11 +1290,14 @@ selectManager mtman tcp profile = case T.splitAt 43 profile of
 
 initTox :: Options
            -> TVar (Map.Map Uniq24 AggregateSession)
-           -> TVar Tox.AnnouncedKeys -> Maybe XMPPServer -> IO ( Maybe (Tox.Tox JabberClients) , IO ()
+           -> TVar Tox.AnnouncedKeys
+           -> Maybe XMPPServer
+           -> InviteCache IO
+           -> IO ( Maybe (Tox.Tox JabberClients) , IO ()
                  , Map.Map String DHT
                  , IO [SockAddr]
                  , [SockAddr])
-initTox opts ssvar keysdb mbxmpp = case porttox opts of
+initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
         "" -> return (Nothing,return (), Map.empty, return [],[])
         toxport -> do
             addrTox <- getBindAddress toxport (ip6tox opts)
@@ -1301,7 +1306,7 @@ initTox opts ssvar keysdb mbxmpp = case porttox opts of
                               addrTox
                               (case mbxmpp of
                                 Nothing   -> \_ _ _ -> return ()
-                                Just xmpp -> onNewToxSession xmpp ssvar)
+                                Just xmpp -> onNewToxSession xmpp ssvar invc)
                               (dhtkey opts)
                               (\_ _ -> return ()) -- TODO: TCP relay send
             (quitTox, toxStrap4, toxStrap6) <- Tox.forkTox tox True
@@ -1493,11 +1498,12 @@ initJabber :: Options
               -> Announcer
               -> Maybe (Tox.Tox JabberClients)
               -> Map.Map String DHT
+              -> MUC
               -> IO ( Maybe XMPPServer
                     , Maybe (Manager TCPStatus T.Text)
                     , Maybe (PresenceState Pending)
                     )
-initJabber opts ssvar announcer mbtox toxdhts = case portxmpp opts of
+initJabber opts ssvar announcer mbtox toxdhts toxchat = case portxmpp opts of
         "" -> return (Nothing,Nothing,Nothing)
         p  -> do
             cport <- getBindAddress p True{-IPv6 supported-}
@@ -1522,7 +1528,8 @@ initJabber opts ssvar announcer mbtox toxdhts = case portxmpp opts of
             state     <- newPresenceState cw tman sv (selectManager tman tcp)
             chat <- atomically newMUC
             quitChatService <- forkLocalChat chat
-            let chats = Map.singleton "chat" chat
+            let chats = Map.fromList [ ("local", chat)
+                                     , ("ngc", toxchat) ]
             forkXmpp sv (presenceHooks state chats (verbosity opts) (Just cport) (Just sport))
             conns     <- xmppConnections  sv
             return (Just sv, Just conns, Just state)
@@ -1546,6 +1553,9 @@ main = do
     forM ([minBound .. maxBound]::[DebugTag]) setQuiet
     forM (verboseTags opts) setVerbose
 
+    toxchat <- atomically newMUC
+    (quitToxChat,invc) <- forkToxChat toxchat
+
     (quitBt,btdhts,btips,baddrs) <- case portbt opts of
         "" -> return (return (), Map.empty,return [],[])
         p  -> do
@@ -1638,9 +1648,9 @@ main = do
     ssvar <- atomically $ newTVar Map.empty
     rec (mbtox,quitTox,toxdhts,toxips,(taddrs::[SockAddr]),msv,mconns,mstate) <- do
 
-        (mbtox,quitTox,toxdhts,toxips,(taddrs::[SockAddr])) <- initTox opts ssvar keysdb msv
+        (mbtox,quitTox,toxdhts,toxips,(taddrs::[SockAddr])) <- initTox opts ssvar keysdb msv invc
 
-        (msv,mconns,mstate) <- initJabber opts ssvar announcer mbtox toxdhts
+        (msv,mconns,mstate) <- initJabber opts ssvar announcer mbtox toxdhts toxchat
 
         return (mbtox,quitTox,toxdhts,toxips,(taddrs::[SockAddr]),msv,mconns,mstate)