~singpolyma/cheogram-sip

d2e4c20473310fb57eb8dd00173dfd80be6958ac — Stephen Paul Weber 2 months ago 9a0e1c3
Seperate presence/disco for the gateway itself
1 files changed, 39 insertions(+), 5 deletions(-)

M gateway.hs
M gateway.hs => gateway.hs +39 -5
@@ 58,6 58,34 @@ sipDiscoInfo q = XML.Element (s"{http://jabber.org/protocol/disco#info}query")
			(map (\node -> (s"{http://jabber.org/protocol/disco#info}node", [XML.ContentText node])) $ maybeToList $ XML.attributeText (s"node") q) $
			XML.NodeElement (mkDiscoIdentity (s"client") (s"phone") (s"Cheogram SIP")) : map (XML.NodeElement . mkDiscoFeature) sipDiscoFeatures

gatewayDiscoFeatures :: [Text]
gatewayDiscoFeatures = [
		s"http://jabber.org/protocol/caps",
		s"http://jabber.org/protocol/disco#info"
	]

gatewayCapsHash :: Text
gatewayCapsHash = decodeUtf8 $ Base64.encode $ discoToCapsHash (gatewayDiscoInfo $ XML.Element (s"x") [] [])

gatewayDiscoInfo :: XML.Element -> XML.Element
gatewayDiscoInfo q = XML.Element (s"{http://jabber.org/protocol/disco#info}query")
			(map (\node -> (s"{http://jabber.org/protocol/disco#info}node", [XML.ContentText node])) $ maybeToList $ XML.attributeText (s"node") q) $
			XML.NodeElement (mkDiscoIdentity (s"gateway") (s"sip") (s"Cheogram SIP")) : map (XML.NodeElement . mkDiscoFeature) gatewayDiscoFeatures

gatewayAvailable :: XMPP.JID -> XMPP.JID -> XMPP.Presence
gatewayAvailable from to =
	(XMPP.emptyPresence XMPP.PresenceAvailable) {
		XMPP.presenceTo = Just to,
		XMPP.presenceFrom = XMPP.parseJID $ bareTxt from ++ s"/gateway",
		XMPP.presencePayloads = [
			XML.Element (s"{http://jabber.org/protocol/caps}c") [
				(s"{http://jabber.org/protocol/caps}hash", [XML.ContentText $ s"sha-1"]),
				(s"{http://jabber.org/protocol/caps}node", [XML.ContentText $ s "xmpp:sip.cheogram.com"]),
				(s"{http://jabber.org/protocol/caps}ver", [XML.ContentText gatewayCapsHash])
			] []
		]
	}

rewriteJingleInitiatorResponder :: XMPP.IQ -> XMPP.IQ
rewriteJingleInitiatorResponder iq
	| Just jingle <- child (s"{urn:xmpp:jingle:1}jingle") iq = iq {


@@ 240,17 268,23 @@ main = do
							XMPP.presenceTo = Just from,
							XMPP.presenceFrom = Just to
						}
					XMPP.putStanza $ sipAvailable to from
					XMPP.putStanza $ case XMPP.jidNode to of
						Just _ -> sipAvailable to from
						Nothing -> gatewayAvailable to from
				| XMPP.ReceivedPresence presence <- stanza,
				  Just from <- sfrom,
				  Just to <- XMPP.stanzaTo presence,
				  XMPP.PresenceProbe <- XMPP.presenceType presence -> do
					XMPP.putStanza $ sipAvailable to from
				  XMPP.PresenceProbe <- XMPP.presenceType presence ->
					XMPP.putStanza $ case XMPP.jidNode to of
						Just _ -> sipAvailable to from
						Nothing -> gatewayAvailable to from
				| XMPP.ReceivedIQ iq <- stanza,
				  Just _ <- sfrom,
				  Just _ <- XMPP.stanzaTo iq,
				  Just to <- XMPP.stanzaTo iq,
				  Just query <- child (s"{http://jabber.org/protocol/disco#info}query") iq ->
					XMPP.putStanza $ iqReply (Just $ sipDiscoInfo query) iq
					XMPP.putStanza $ case XMPP.jidNode to of
						Just _ -> iqReply (Just $ sipDiscoInfo query) iq
						Nothing -> iqReply (Just $ gatewayDiscoInfo query) iq
				| XMPP.ReceivedMessage m <- stanza,
				  Just from <- sfrom,
				  Just to <- XMPP.stanzaTo m,