~singpolyma/cheogram-smtp

073dafa4a91bbafb5edecea3bc6f37a526c0301b — Stephen Paul Weber 2 years ago 0abb8ad
Add discovery identity response
2 files changed, 42 insertions(+), 0 deletions(-)

M Util.hs
M gateway.hs
M Util.hs => Util.hs +26 -0
@@ 165,5 165,31 @@ mkElement :: XML.Name -> Text -> XML.Element
mkElement name content = XML.Element name []
	[XML.NodeContent $ XML.ContentText content]

mkDiscoIdentity :: Text -> Text -> Text -> XML.Element
mkDiscoIdentity category typ name =
	XML.Element (s"{http://jabber.org/protocol/disco#info}identity") [
		(
			s"{http://jabber.org/protocol/disco#info}category",
			[XML.ContentText category]
		),
		(
			s"{http://jabber.org/protocol/disco#info}type",
			[XML.ContentText typ]
		),
		(
			s"{http://jabber.org/protocol/disco#info}name",
			[XML.ContentText name]
		)
	] []

mkDiscoFeature :: Text -> XML.Element
mkDiscoFeature var =
	XML.Element (s"{http://jabber.org/protocol/disco#info}feature") [
		(
			s"{http://jabber.org/protocol/disco#info}var",
			[XML.ContentText var]
		)
	] []

(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(.:) = (.) . (.)

M gateway.hs => gateway.hs +16 -0
@@ 134,6 134,21 @@ messageErrorHandler replyMap message = do
		XMPP.putStanza $ iqError errorElement originalIQ
	-- TODO: else, manual bounce?

iqGetHandler :: XMPP.IQ -> XMPP.XMPP ()
iqGetHandler iq@XMPP.IQ {
	XMPP.iqType = XMPP.IQGet,
	XMPP.iqTo = Just to,
	XMPP.iqPayload = Just p
} | Nothing <- XMPP.jidNode to,
    [_] <- XML.isNamed (s"{http://jabber.org/protocol/disco#info}query") p =
	XMPP.putStanza $ iqReply (Just $ XML.Element
		(s"{http://jabber.org/protocol/disco#info}query") [] [
			XML.NodeElement $ mkDiscoIdentity
				(s"gateway") (s"smtp") (s"Cheogram SMTP")
		]
	) iq
iqGetHandler iq = XMPP.putStanza $ iqError notImplemented iq

main :: IO ()
main = do
	hSetBuffering stdout LineBuffering


@@ 153,6 168,7 @@ main = do
	exceptT print return $ runRoutedComponent server secret $ do
		(sendIQ, iqReceived) <- iqManager
		return $ defaultRoutes {
			iqGetRoute = iqGetHandler,
			iqSetRoute =
				iqSetHandler replyMap componentJid trustedJids,
			iqResultRoute = iqReceived,