2 files changed, 35 insertions, 6 deletions

diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index 1493827a..9e72da72 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -11,6 +11,7 @@ import qualified Data.Conduit.List  as CL
 import Data.Monoid
 import qualified Data.Text          as T
          ;import Data.Text          (Text)
+import Data.Word
 import Data.Text.Encoding           as T
 import Data.XML.Types               as XML
 import EventUtil
@@ -23,17 +24,21 @@ import XMPPServer                   as XMPP
 toxToXmpp :: Monad m => SockAddr -> PublicKey -> Text -> Conduit Tox.CryptoMessage m XML.Event
 toxToXmpp laddr me theirhost = do
     CL.sourceList $ XMPP.greet' "jabber:server" theirhost
-    let me_u = T.pack $ show (key2id me)
+    let me_u    = T.pack $ show (key2id me)
+        im_from = (Just $ "root@" <> theirhost)      -- /from/
+        im_to   = (Just $ unsplitJID
+                            ( Just me_u
+                            -- /to/ should match local address of this node.
+                            , T.pack (show laddr)
+                            , Nothing))
     awaitForever $ \case
 
         UpToN { msgID    = MESSAGE
               , msgBytes = bs      }
                -> do
-            xmppInstantMessage "jabber:server"
-                (Just $ "root@" <> theirhost)      -- /from/
-                (Just $ unsplitJID (Just me_u,T.pack (show laddr),Nothing)) -- /to/ should match local address of this node.
-                []
-                (T.decodeUtf8 bs)
+            xmppInstantMessage "jabber:server" im_from im_to [] (T.decodeUtf8 bs)
+
+        TwoByte TYPING st -> xmppTyping "jabber:server" im_from im_to st
 
         toxmsg | msgID toxmsg == PacketRequest -> return ()
 
@@ -44,6 +49,28 @@ toxToXmpp laddr me theirhost = do
                 [ attr "style" "font-weight:bold; color:red" ]
                 (T.pack $ show $ msgID toxmsg)
 
+xmppTyping :: Monad m => Text
+                              -> Maybe Text
+                              -> Maybe Text
+                              -> Word8
+                              -> ConduitM i Event m ()
+xmppTyping namespace mfrom mto x =
+    let ns n = n { nameNamespace = Just namespace }
+        st = case x of
+            0 -> "{http://jabber.org/protocol/chatstates}active"
+            1 -> "{http://jabber.org/protocol/chatstates}composing"
+            -- tox-core supports only 0 and 1
+            _ -> "{http://jabber.org/protocol/chatstates}paused"
+    in mapM_ C.yield
+        [ EventBeginElement (ns "message")
+               (  maybe id (\t->(attr "from" t:)) mfrom
+                $ maybe id (\t->(attr "to" t:)) mto
+                $ [attr "type" "chat" ] )
+        , EventBeginElement st []
+        , EventEndElement st
+        , EventEndElement (ns "message")
+        ]
+
 xmppInstantMessage :: Monad m => Text
                               -> Maybe Text
                               -> Maybe Text
diff --git a/todo.txt b/todo.txt
index 94fe6cd3..5c5b57b6 100644
--- a/todo.txt
+++ b/todo.txt
@@ -1,3 +1,5 @@
+kademlia: when <10 nodes in routing table, save-nodes should merge instead of overwrite.
+
 tox: XEdDSA signature algorithm and key conversion.
 
 maint: send patch to Vincent Hanquez to implement crypto_box_*