diff options
-rw-r--r-- | ToxToXMPP.hs | 22 |
1 files changed, 21 insertions, 1 deletions
diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs index 89022b2c..65faff9d 100644 --- a/ToxToXMPP.hs +++ b/ToxToXMPP.hs | |||
@@ -13,6 +13,7 @@ import qualified Data.Conduit.List as CL | |||
13 | import Data.Dependent.Sum | 13 | import Data.Dependent.Sum |
14 | import Data.Function | 14 | import Data.Function |
15 | import Data.Functor.Identity | 15 | import Data.Functor.Identity |
16 | import Data.Maybe | ||
16 | import Data.Monoid | 17 | import Data.Monoid |
17 | import qualified Data.Text as T | 18 | import qualified Data.Text as T |
18 | ;import Data.Text (Text) | 19 | ;import Data.Text (Text) |
@@ -69,10 +70,11 @@ toxToXmpp laddr me theirhost = do | |||
69 | 70 | ||
70 | toxmsg | msgID toxmsg == M PacketRequest -> return () | 71 | toxmsg | msgID toxmsg == M PacketRequest -> return () |
71 | 72 | ||
72 | Pkt INVITE_GROUPCHAT :=> Identity ginv -> | 73 | Pkt INVITE_GROUPCHAT :=> Identity ginv -> do |
73 | xmppInstantMessage "jabber:server" im_from im_to | 74 | xmppInstantMessage "jabber:server" im_from im_to |
74 | [ attr "style" "font-weight:bold; color:red" ] | 75 | [ attr "style" "font-weight:bold; color:red" ] |
75 | ("INVITE(todo)" <> (T.pack $ show ginv)) | 76 | ("INVITE(todo)" <> (T.pack $ show ginv)) |
77 | xmppInvite "jabber:server" me_h (fromJust im_from) (fromJust im_to) ginv | ||
76 | 78 | ||
77 | toxmsg -> do | 79 | toxmsg -> do |
78 | xmppInstantMessage "jabber:server" im_from im_to | 80 | xmppInstantMessage "jabber:server" im_from im_to |
@@ -130,6 +132,24 @@ xmppPresence namespace mjid p = do | |||
130 | C.yield $ EventEndElement (ns "status") | 132 | C.yield $ EventEndElement (ns "status") |
131 | C.yield $ EventEndElement (ns "presence") | 133 | C.yield $ EventEndElement (ns "presence") |
132 | 134 | ||
135 | chatRoomJID me cid = T.pack (show cid) <> "@ngc." <> me | ||
136 | |||
137 | xmppInvite :: Monad m => Text -> Text -> Text -> Text -> Invite -> ConduitM i XML.Event m () | ||
138 | xmppInvite namespace me them to inv = | ||
139 | let ns n = n { nameNamespace = Just namespace } | ||
140 | in mapM_ C.yield | ||
141 | [ EventBeginElement (ns "message") | ||
142 | [ attr "from" (chatRoomJID me $ inviteChatID inv) | ||
143 | , attr "to" to | ||
144 | ] | ||
145 | , EventBeginElement "{http://jabber.org/protocol/muc#user}x" [] | ||
146 | , EventBeginElement "{http://jabber.org/protocol/muc#user}invite" | ||
147 | [ attr "from" them ] | ||
148 | , EventEndElement "{http://jabber.org/protocol/muc#user}invite" | ||
149 | , EventEndElement "{http://jabber.org/protocol/muc#user}x" | ||
150 | , EventEndElement (ns "message") | ||
151 | ] | ||
152 | |||
133 | xmppTyping :: Monad m => Text | 153 | xmppTyping :: Monad m => Text |
134 | -> Maybe Text | 154 | -> Maybe Text |
135 | -> Maybe Text | 155 | -> Maybe Text |