2 files changed, 42 insertions(+), 0 deletions(-)

M Util.hs
M gateway.hs

@@ 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
 (.:) = (.) . (.)

@@ 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,