@@ 43,8 43,9 @@ data Invite = Invite {
invitePassword :: Maybe Text
} deriving (Show)
-getMediatedInvitation (Message {messageFrom = Just from, messagePayloads = payload}) = do
- x <- listToMaybe $ isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< payload
+getMediatedInvitation m = do
+ from <- messageFrom m
+ x <- listToMaybe $ isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< messagePayloads m
invite <- listToMaybe $ isNamed (fromString "{http://jabber.org/protocol/muc#user}invite") =<< elementChildren x
inviteFrom <- parseJID =<< attributeText (fromString "from") invite
return $ Invite {
@@ 60,6 61,18 @@ getMediatedInvitation (Message {messageFrom = Just from, messagePayloads = paylo
(isNamed (fromString "{http://jabber.org/protocol/muc#user}password") =<< elementChildren x)
}
+getDirectInvitation m = do
+ x <- listToMaybe $ isNamed (fromString "{jabber:x:conference}x") =<< messagePayloads m
+ Invite <$>
+ (parseJID =<< attributeText (fromString "jid") x) <*>
+ messageFrom m <*>
+ Just (do
+ txt <- attributeText (fromString "reason") x
+ guard (not $ T.null txt)
+ return txt
+ ) <*>
+ Just (attributeText (fromString "password") x)
+
forkXMPP :: XMPP () -> XMPP ThreadId
forkXMPP kid = do
session <- getSession
@@ 98,7 111,7 @@ componentMessage _ toVitelity _ _ existingRoom bareFrom resourceFrom tel body =
componentStanza db toVitelity _ (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
| Just tel <- strNode <$> jidNode to,
- Just invite <- getMediatedInvitation m = do
+ Just invite <- getMediatedInvitation m <|> getDirectInvitation m = do
let txt = mconcat [
fromString "* ",
bareTxt (inviteFrom invite), -- TODO: or MUC nick