MUC compliance: Issue missing-nick error.

1 files changed, 26 insertions, 4 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index a0d5a69b..1cf41f66 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DoAndIfThenElse           #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE MultiWayIf                #-}
 {-# LANGUAGE OverloadedStrings         #-}
 {-# LANGUAGE RankNTypes                #-}
 {-# LANGUAGE TupleSections             #-}
@@ -1195,7 +1196,11 @@ eventContent cs = maybe "" (foldr1 (<>) . map content1) cs
                   content1 (ContentEntity t) = t
 
 makeErrorStanza :: StanzaFirstTag a => StanzaWrap a -> IO [XML.Event]
-makeErrorStanza stanza = do
+makeErrorStanza stanza = makeErrorStanza' stanza RecipientUnavailable []
+
+makeErrorStanza' :: StanzaFirstTag a =>
+                          StanzaWrap a -> StanzaError -> [(Name, [Content])] -> IO [Event]
+makeErrorStanza' stanza err attrs = do
     startTag <- stanzaFirstTag stanza
     let n = tagName startTag
         endTag = EventEndElement n
@@ -1212,7 +1217,6 @@ makeErrorStanza stanza = do
                         (tagName startTag)
                         (Map.toList amap3)
         -- err = Gone -- FeatureNotImplemented -- UndefinedCondition -- RecipientUnavailable
-        err = RecipientUnavailable
         errname = n { nameLocalName = "error" }
         -- errattrs = [attr "type" "wait"] --  "modify"]
         errorAttribs e xs = ys ++ xs -- todo replace instead of append
@@ -1221,7 +1225,7 @@ makeErrorStanza stanza = do
         errorTagName = Name { nameNamespace = Just "urn:ietf:params:xml:ns:xmpp-stanzas"
                             , nameLocalName = errorTagLocalName err
                             , namePrefix = Nothing }
-        errattrs = errorAttribs err []
+        errattrs = errorAttribs err attrs
     {-
     let wlogd v s = do
             wlog $ "error "++show (lookupAttrib "id" $ tagAttrs startTag)++" " ++ v ++ " = " ++ show s
@@ -1404,7 +1408,25 @@ applyStanza sv quitVar xmpp stanza = case stanzaOrigin stanza of
                 sendRoster stanza xmpp k replyto
                 xmppSubscribeToRoster xmpp k
             PresenceStatus {} -> do
-                xmppInformClientPresence xmpp k stanza
+                let mucs = xmppGroupChat xmpp
+                me <- xmppTellMyNameToClient xmpp k
+                if | Available <- presenceShow (stanzaType stanza)
+                   , Just to <- stanzaTo stanza
+                   , (Just room,h,mnick) <- splitJID to
+                   , let roomjid = unsplitJID ((Just room,h,Nothing))
+                   , Service (Just _) mucname muc <- lookupService me mucs roomjid
+                        -> case mnick of
+                            Nothing -> do
+                                -- Missing nick.
+                                reply <- makeErrorStanza' stanza JidMalformed
+                                    [ ("by", [ContentText roomjid]) ]
+                                sendReply quitVar (Error JidMalformed (head reply)) reply replyto
+                            Just nick -> do
+                                -- TODO: join chat
+                                return ()
+                   | otherwise -> do
+                        -- Handle presence stanza that is not a chatroom join.
+                        xmppInformClientPresence xmpp k stanza
             PresenceRequestSubscription {} -> do
                 let fail = return () -- todo
                 xmppClientSubscriptionRequest xmpp fail k stanza replyto