~singpolyma/cheogram

ce5dcf3d69dc736d25d121e4a82e609e3fc97e98 — Stephen Paul Weber 7 years ago e8e7e2b
All PresenceError is a join error

We only send presence when joining, so any error is a failure to join.

Also report error text if there is any.

Closes #2
1 files changed, 5 insertions(+), 3 deletions(-)

M Main.hs
M Main.hs => Main.hs +5 -3
@@ 218,9 218,11 @@ componentStanza db toVitelity toComponent componentHost (ReceivedMessage (m@Mess
	where
	resourceFrom = strResource <$> jidResource from
componentStanza _ toVitelity _ _ (ReceivedPresence p@(Presence { presenceType = PresenceError, presenceFrom = Just from, presenceTo = Just to }))
	| Just tel <- strNode <$> jidNode to,
	  [_] <- isNamed (fromString "{http://jabber.org/protocol/muc}x") =<< presencePayloads p =
		writeStanzaChan toVitelity $ mkSMS tel (fromString "* Failed to join " <> bareTxt from)
	| Just tel <- strNode <$> jidNode to = do
		let errorText = maybe mempty (mconcat . (fromString "\n":) . elementText) $ listToMaybe $
			isNamed (fromString "{urn:ietf:params:xml:ns:xmpp-stanzas}text") =<<
			elementChildren =<< isNamed (fromString "{jabber:component:accept}error") =<< presencePayloads p
		writeStanzaChan toVitelity $ mkSMS tel (fromString "* Failed to join " <> bareTxt from <> errorText)
componentStanza db toVitelity toComponent _ (ReceivedPresence p@(Presence { presenceType = PresenceAvailable, presenceFrom = Just from, presenceTo = Just to }))
	| Just tel <- strNode <$> jidNode to,
	  [x] <- isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< presencePayloads p,