summaryrefslogtreecommitdiff
path: root/ToxToXMPP.hs
diff options
context:
space:
mode:
Diffstat (limited to 'ToxToXMPP.hs')
-rw-r--r--ToxToXMPP.hs21
1 files changed, 13 insertions, 8 deletions
diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index f4a7cbab..2ab59568 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -83,18 +83,23 @@ xmppToTox = doNestingXML $ fix $ \loop -> do
83 dput DPut.XMan $ "xmppToTox: " ++ show e 83 dput DPut.XMan $ "xmppToTox: " ++ show e
84 loop 84 loop
85 85
86toxToXmpp :: Monad m => Text -> Conduit Tox.CryptoMessage m XML.Event 86toxToXmpp :: Monad m => SockAddr -> PublicKey -> Text -> Conduit Tox.CryptoMessage m XML.Event
87toxToXmpp toxhost = do 87toxToXmpp laddr me theirhost = do
88 CL.sourceList $ XMPP.greet' "jabber:server" toxhost 88 CL.sourceList $ XMPP.greet' "jabber:server" theirhost
89 let me_u = T.pack $ show (key2id me)
89 awaitForever $ \toxmsg -> do 90 awaitForever $ \toxmsg -> do
90 xmppInstantMessage "jabber:server" (Just toxhost) (T.pack $ show $ msgID toxmsg) 91 xmppInstantMessage "jabber:server"
92 (Just theirhost) -- /from/
93 (Just $ unsplitJID (me_u,T.pack (show laddr),Nothing)) -- /to/ should match local address of this node.
94 (T.pack $ show $ msgID toxmsg)
91 95
92xmppInstantMessage :: Monad m => Text -> Maybe Text -> Text -> ConduitM i Event m () 96xmppInstantMessage :: Monad m => Text -> Maybe Text -> Maybe Text -> Text -> ConduitM i Event m ()
93xmppInstantMessage namespace mfrom text = do 97xmppInstantMessage namespace mfrom mto text = do
94 let ns n = n { nameNamespace = Just namespace } 98 let ns n = n { nameNamespace = Just namespace }
95 C.yield $ EventBeginElement (ns "message") 99 C.yield $ EventBeginElement (ns "message")
96 ((maybe id (\t->(attr "from" t:)) mfrom) 100 ( maybe id (\t->(attr "from" t:)) mfrom
97 [attr "type" "normal" ]) 101 $ maybe id (\t->(attr "to" t:)) mto
102 $ [attr "type" "normal" ] )
98 C.yield $ EventBeginElement (ns "body") [] 103 C.yield $ EventBeginElement (ns "body") []
99 C.yield $ EventContent $ ContentText text 104 C.yield $ EventContent $ ContentText text
100 C.yield $ EventEndElement (ns "body") 105 C.yield $ EventEndElement (ns "body")