~singpolyma/cheogram

cd9bdf4f7eaec319fa26a6a6e4c5e14b71af731f — Stephen Paul Weber 1 year, 3 months ago 00ac243 + 179d292
Merge branch 'cv_forward_jingle'

* cv_forward_jingle:
  Support Backend Default Sip Proxies
  Support Jingle Message Outbound
  Double Slashes
  Forward Unhandled Calls to sip.cheogram.com
  Add Resource to Presence Queries
  Allow Removing Sip Proxy
  Add Audio to Caps if SIP Proxy is Present
2 files changed, 126 insertions(+), 36 deletions(-)

M Main.hs
M Util.hs
M Main.hs => Main.hs +118 -36
@@ 9,7 9,7 @@ import Control.Concurrent.STM
import Data.Foldable (forM_, mapM_, toList)
import Data.Traversable (forM, mapM)
import System.Environment (getArgs)
import Control.Error (readZ, MaybeT(..), hoistMaybe, headZ, hush)
import Control.Error (readZ, MaybeT(..), hoistMaybe, headZ, justZ, hush)
import Data.Time (UTCTime, addUTCTime, diffUTCTime, getCurrentTime)
import Network (PortID(PortNumber))
import Network.URI (parseURI, uriPath, escapeURIString)


@@ 63,16 63,16 @@ tcPut db cheoJid key val = liftIO $ do
	True <- TC.runTCM (TC.put db tck val)
	return ()

queryDisco to from = queryDiscoWithNode Nothing to from
queryDisco to from = (:[]) . mkStanzaRec <$> queryDiscoWithNode Nothing to from

queryDiscoWithNode node to from = do
	uuid <- (fmap.fmap) (fromString . UUID.toString) UUID.nextUUID
	return [mkStanzaRec $ (emptyIQ IQGet) {
	return $ (emptyIQ IQGet) {
		iqTo = Just to,
		iqFrom = Just from,
		iqID = uuid,
		iqPayload = Just $ Element (fromString "{http://jabber.org/protocol/disco#info}query") (map (\node -> (s"{http://jabber.org/protocol/disco#info}node", [ContentText node])) $ maybeToList node) []
	}]
	}

fillFormField var value form = form {
		elementNodes = map (\node ->


@@ 170,13 170,40 @@ telDiscoFeatures = [
		s"urn:xmpp:jingle:transports:ibb:1"
	]

getSipProxy :: TC.HDB -> JID -> (IQ -> UIO (STM (Maybe IQ))) -> JID -> IO (Maybe Text)
getSipProxy db componentJid sendIQ jid = do
	maybeProxy <- TC.runTCM $ TC.get db $ T.unpack (bareTxt jid) ++ "\0sip-proxy"
	case maybeProxy of
		Just proxy -> return $ Just $ T.pack proxy
		Nothing ->
			(extractSip =<<) <$> routeQueryStateful db componentJid sendIQ jid Nothing query
	where
	query jidTo jidFrom = return $ (emptyIQ IQGet) {
			iqTo = Just jidTo,
			iqFrom = Just jidFrom,
			iqPayload = Just $ XML.Element (s"{urn:xmpp:extdisco:2}services") [
				(s"type", [XML.ContentText $ s"sip"])
			] []
		}
	extractSip (IQ { iqPayload = payload }) =
		headZ $
		(mapMaybe (attributeText (s"host")) $
		filter (\el -> attributeText (s"type") el == Just (s"sip")) $
		isNamed (s"{urn:xmpp:extdisco:2}service") =<<
		elementChildren =<< (justZ payload))

getTelFeatures db componentJid sendIQ jid = do
	maybeProxy <- getSipProxy db componentJid sendIQ jid
	log "TELFEATURES" (jid, maybeProxy)
	return $ maybe [] (const $ [s"urn:xmpp:jingle:transports:ice-udp:1", s"urn:xmpp:jingle:apps:dtls:0", s"urn:xmpp:jingle:apps:rtp:1", s"urn:xmpp:jingle:apps:rtp:audio", s"urn:xmpp:jingle-message:0"]) maybeProxy

telCapsStr extraVars =
	s"client/sms//Cheogram<" ++ mconcat (intersperse (s"<") (sort (nub (telDiscoFeatures ++ extraVars)))) ++ s"<"

telAvailable from to disco =
	(emptyPresence PresenceAvailable) {
		presenceTo = Just to,
		presenceFrom = Just from,
		presenceFrom = Just fromWithResource,
		presencePayloads = [
			Element (s"{http://jabber.org/protocol/caps}c") [
				(s"{http://jabber.org/protocol/caps}hash", [ContentText $ fromString "sha-1"]),


@@ 186,6 213,10 @@ telAvailable from to disco =
		]
	}
	where
	fromWithResource
		| Nothing <- jidResource from,
		  Just newFrom <- parseJID (bareTxt from ++ s"/tel") = newFrom
		| otherwise = from
	hash = T.decodeUtf8 $ Base64.encode $ LZ.toStrict $ bytestringDigest $ sha1 $ LZ.fromStrict $ T.encodeUtf8 $ telCapsStr disco

nodeAttribute el =


@@ 222,8 253,23 @@ routeQueryOrReply db componentJid from smsJid resource query reply = do
	where
	maybeRouteFrom = parseJID $ escapeJid (bareTxt from) ++ s"@" ++ formatJID componentJid ++ s"/" ++ (fromString resource)

routeQueryStateful db componentJid sendIQ from targetNode query = do
	maybeRoute <- TC.runTCM $ TC.get db (T.unpack (bareTxt from) ++ "\0direct-message-route")
	case (fmap fromString maybeRoute, maybeRouteFrom) of
		(Just route, Just routeFrom) -> do
			let Just routeTo = parseJID $ (maybe mempty (++ s"@") $ strNode <$> targetNode) ++ route
			iqToSend <- query routeTo routeFrom
			result <- atomicUIO =<< UIO.lift (sendIQ iqToSend)
			return $ mfilter ((==IQResult) . iqType) result
		_ -> return Nothing
	where
	maybeRouteFrom = parseJID $ escapeJid (bareTxt from) ++ s"@" ++ formatJID componentJid ++ s"/IQMANAGER"

routeDiscoStateful db componentJid sendIQ from targetNode node =
	routeQueryStateful db componentJid sendIQ from targetNode (queryDiscoWithNode node)

routeDiscoOrReply db componentJid from smsJid resource node reply =
	routeQueryOrReply db componentJid from smsJid resource (queryDiscoWithNode node) reply
	routeQueryOrReply db componentJid from smsJid resource (fmap (pure . mkStanzaRec) .: queryDiscoWithNode node) reply

deliveryReceipt id from to =
	(emptyMessage MessageNormal) {


@@ 638,7 684,8 @@ data ComponentContext = ComponentContext {
	toRejoinManager :: TChan RejoinManagerCommand,
	toJoinPartDebouncer :: TChan JoinPartDebounce,
	processDirectMessageRouteConfig :: IQ -> IO IQ,
	componentJid :: JID
	componentJid :: JID,
	sendIQ :: IQ -> UIO (STM (Maybe IQ))
}

componentStanza :: ComponentContext -> ReceivedStanza -> IO [StanzaRec]


@@ 652,6 699,20 @@ componentStanza (ComponentContext { adhocBotMessage, ctxCacheOOB, componentJid }
		atomicUIO $ adhocBotMessage m
		return []
	| otherwise = log "WEIRD BODYLESS MESSAGE DIRECT TO COMPONENT" m >> return []
componentStanza (ComponentContext { db, componentJid, sendIQ, smsJid = Just smsJid }) (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
	| [propose] <- isNamed (fromString "{urn:xmpp:jingle-message:0}propose") =<< messagePayloads m = do
		let sid = fromMaybe mempty $ XML.attributeText (s"id") propose
		telFeatures <- getTelFeatures db componentJid sendIQ from
		stanzas <- routeDiscoOrReply db componentJid from smsJid "CHEOGRAM%query-then-send-presence" Nothing $ telAvailable to from telFeatures
		return $ (mkStanzaRec $ (XMPP.emptyMessage XMPP.MessageNormal) {
				XMPP.messageID = Just $ s"proceed%" ++ sid,
				XMPP.messageTo = Just from,
				XMPP.messageFrom = XMPP.parseJID $ bareTxt to ++ s"/tel",
				XMPP.messagePayloads = [
					XML.Element (s"{urn:xmpp:jingle-message:0}proceed")
						[(s"id", [XML.ContentText sid])] []
				]
			}) : stanzas
componentStanza _ (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
	| [x] <- isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< messagePayloads m,
	  not $ null $ code "104" =<< isNamed (fromString "{http://jabber.org/protocol/muc#user}status") =<< elementChildren x = do


@@ 774,6 835,17 @@ componentStanza (ComponentContext { processDirectMessageRouteConfig, componentJi
		return [mkStanzaRec $ replyIQ {
			iqFrom = parseJID (fromLocalpart ++ formatJID componentJid ++ s"/CHEOGRAM%" ++ ConfigureDirectMessageRoute.nodeName)
		}]
componentStanza (ComponentContext { db, processDirectMessageRouteConfig, componentJid }) (ReceivedIQ iq@(IQ { iqTo = Just to, iqPayload = Just payload, iqFrom = Just from }))
	| jidNode to == Nothing,
	  elementName payload == s"{http://jabber.org/protocol/commands}command",
	  attributeText (s"node") payload == Just (s"sip-proxy-set"),
	  [form] <- isNamed (fromString "{jabber:x:data}x") =<< elementChildren payload,
	  Just proxy <- getFormField form (s"sip-proxy") = do
		True <- if T.null proxy then
			TC.runTCM $ TC.out db $ T.unpack (bareTxt from) ++ "\0sip-proxy"
		else
			TC.runTCM $ TC.put db (T.unpack (bareTxt from) ++ "\0sip-proxy") $ T.unpack proxy
		return [mkStanzaRec $ iqReply Nothing iq]
componentStanza _ (ReceivedIQ iq@(IQ { iqFrom = Just _, iqTo = Just (JID { jidNode = Nothing }), iqPayload = Just p }))
	| iqType iq `elem` [IQGet, IQSet],
	  [_] <- isNamed (fromString "{jabber:iq:register}query") p = do


@@ 829,11 901,17 @@ componentStanza (ComponentContext { db, componentJid }) (ReceivedIQ (IQ { iqType
	where
	extra = T.unpack $ escapeJid $ T.pack $ show (id, fromMaybe mempty resourceFrom)
	resourceFrom = strResource <$> jidResource from
componentStanza (ComponentContext { db, smsJid = (Just smsJid), componentJid }) (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqID = Just id, iqPayload = Just p }))
componentStanza (ComponentContext { db, sendIQ, smsJid = (Just smsJid), componentJid }) (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqID = Just id, iqPayload = Just p }))
	| Just _ <- jidNode to,
	  [q] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p = do
		routeDiscoOrReply db componentJid from smsJid ("CHEOGRAM%query-then-send-disco-info%" ++ extra) (nodeAttribute q) $
			telDiscoInfo q id to from []
		maybeDiscoResult <- routeDiscoStateful db componentJid sendIQ from (jidNode smsJid) (nodeAttribute q)
		telFeatures <- getTelFeatures db componentJid sendIQ from
		case maybeDiscoResult of
			Just (IQ { iqPayload = Just discoResult }) -> return [
					mkStanzaRec $ telDiscoInfo q id to from $ (telFeatures ++) $ mapMaybe (attributeText (fromString "var")) $
					isNamed (fromString "{http://jabber.org/protocol/disco#info}feature") =<< elementChildren discoResult
				]
			Nothing -> return [mkStanzaRec $ telDiscoInfo q id to from telFeatures]
	| Just tel <- strNode <$> jidNode to,
	  [_] <- isNamed (s"{vcard-temp}vCard") p = do
		--owners <- (fromMaybe [] . (readZ =<<)) <$>


@@ 955,13 1033,14 @@ componentStanza (ComponentContext { componentJid }) (ReceivedIQ (IQ { iqType = t
		else do
			let items = isNamed (s"{http://jabber.org/protocol/disco#items}item") =<< elementChildren p
			return [mkStanzaRec $ commandList componentJid iqId componentJid routeTo items]
componentStanza (ComponentContext { componentJid }) (ReceivedIQ (IQ { iqType = IQError, iqTo = Just to@(JID { jidNode = Just toNode }), iqFrom = Just from }))
componentStanza (ComponentContext { db, componentJid, sendIQ }) (ReceivedIQ (IQ { iqType = IQError, iqTo = Just to@(JID { jidNode = Just toNode }), iqFrom = Just from }))
	| fmap strResource (jidResource to) == Just (s"CHEOGRAM%query-then-send-presence"),
	  Just routeTo <- parseJID (unescapeJid (strNode toNode)),
	  Just fromNode <- jidNode from,
	  Just routeFrom <- parseJID (strNode fromNode ++ s"@" ++ formatJID componentJid) =
		return [ mkStanzaRec $ telAvailable routeFrom routeTo [] ]
componentStanza (ComponentContext { db, componentJid }) (ReceivedIQ (IQ { iqType = IQResult, iqTo = Just to@(JID { jidNode = Just toNode }), iqFrom = Just from, iqPayload = Just p }))
	  Just routeFrom <- parseJID (strNode fromNode ++ s"@" ++ formatJID componentJid) = do
		telFeatures <- getTelFeatures db componentJid sendIQ routeTo
		return [ mkStanzaRec $ telAvailable routeFrom routeTo telFeatures ]
componentStanza (ComponentContext { db, componentJid, sendIQ }) (ReceivedIQ (IQ { iqType = IQResult, iqTo = Just to@(JID { jidNode = Just toNode }), iqFrom = Just from, iqPayload = Just p }))
	| Just idAndResource <- T.stripPrefix (s"CHEOGRAM%query-then-send-ack%") . strResource =<< jidResource to,
	  Just (messageId, resource) <- readZ $ T.unpack $ unescapeJid idAndResource,
	  [query] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p,


@@ 973,23 1052,14 @@ componentStanza (ComponentContext { db, componentJid }) (ReceivedIQ (IQ { iqType
			return []
		else do
			return [mkStanzaRec $ deliveryReceipt messageId routeFrom routeTo]
	| Just idAndResource <- T.stripPrefix (s"CHEOGRAM%query-then-send-disco-info%") . strResource =<< jidResource to,
	  Just (iqID, resource) <- readZ $ T.unpack $ unescapeJid idAndResource,
	  [query] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p,
	  Just routeTo <- parseJID (unescapeJid (strNode toNode) ++ if T.null resource then mempty else s"/" ++ resource),
	  Just fromNode <- jidNode from,
	  Just routeFrom <- parseJID (strNode fromNode ++ s"@" ++ formatJID componentJid) = do
		return [
				mkStanzaRec $ telDiscoInfo query iqID routeFrom routeTo $ mapMaybe (attributeText (fromString "var")) $
				isNamed (fromString "{http://jabber.org/protocol/disco#info}feature") =<< elementChildren query
			]
	| fmap strResource (jidResource to) == Just (s"CHEOGRAM%query-then-send-presence"),
	  [query] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p,
	  Just routeTo <- parseJID (unescapeJid (strNode toNode)),
	  Just fromNode <- jidNode from,
	  Just routeFrom <- parseJID (strNode fromNode ++ s"@" ++ formatJID componentJid) = do
		telFeatures <- getTelFeatures db componentJid sendIQ routeTo
		return [
				mkStanzaRec $ telAvailable routeFrom routeTo $ mapMaybe (attributeText (fromString "var")) $
				mkStanzaRec $ telAvailable routeFrom routeTo $ (telFeatures ++) $ mapMaybe (attributeText (fromString "var")) $
				isNamed (fromString "{http://jabber.org/protocol/disco#info}feature") =<< elementChildren query
			]
	| [query] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p = do


@@ 1093,7 1163,7 @@ cacheOOB pushStatsd jingleStore jingleStoreURL m@(XMPP.Message { XMPP.messagePay
	(body, noOobsNoBody) = partition (\el -> XML.elementName el == bodyName) noOobs
	(oobs, noOobs) = partition (\el -> XML.elementName el == oobName) payloads

component db redis pushStatsd backendHost did cacheOOB adhocBotIQReceiver adhocBotMessage toRoomPresences toRejoinManager toJoinPartDebouncer toComponent toStanzaProcessor processDirectMessageRouteConfig jingleHandler componentJid registrationJids conferenceServers = do
component db redis pushStatsd backendHost did cacheOOB sendIQ iqReceiver adhocBotMessage toRoomPresences toRejoinManager toJoinPartDebouncer toComponent toStanzaProcessor processDirectMessageRouteConfig jingleHandler componentJid registrationJids conferenceServers = do
	sendThread <- forkXMPP $ forever $ flip catchError (log "component EXCEPTION") $ do
		stanza <- liftIO $ atomically $ readTChan toComponent



@@ 1143,7 1213,7 @@ component db redis pushStatsd backendHost did cacheOOB adhocBotIQReceiver adhocB
							Redis.exists bver
					-- Yes: done
					-- No: send disco query, with node
						when (not exists) $ mapM_ sendToComponent =<< queryDiscoWithNode (Just $ node ++ s"#" ++ ver) from returnFrom
						when (not exists) $ sendToComponent . mkStanzaRec =<< queryDiscoWithNode (Just $ node ++ s"#" ++ ver) from returnFrom
				-- No: write only availableness to redis. send disco query, no node
					_ -> do
						let val = LZ.toStrict $ Builder.toLazyByteString (Builder.word16BE pavailableness)


@@ 1172,8 1242,8 @@ component db redis pushStatsd backendHost did cacheOOB adhocBotIQReceiver adhocB
			_ -> return ()
		flip forkFinallyXMPP (either (log "RECEIVE ONE" . show) return) $ case (stanzaFrom $ receivedStanza stanza, stanzaTo $ receivedStanza stanza, mapToBackend backendHost =<< stanzaTo (receivedStanza stanza), fmap strNode . jidNode =<< stanzaTo (receivedStanza stanza), stanza) of
			(_, Just to, _, _, ReceivedIQ iq@(IQ { iqType = IQResult }))
			  | (strResource <$> jidResource to) == Just (s"adhocbot") ->
				adhocBotIQReceiver iq
			  | (strResource <$> jidResource to) `elem` map Just [s"adhocbot", s"IQMANAGER"] ->
				iqReceiver iq
			(Just from, Just to, _, _, _)
				| strDomain (jidDomain from) == backendHost,
				  to == componentJid ->


@@ 1219,10 1289,13 @@ component db redis pushStatsd backendHost did cacheOOB adhocBotIQReceiver adhocB
					-- TODO: should check if backend supports XEP-0033
					-- TODO: fallback for no-backend case should work
					mapM_ sendToComponent =<< componentMessage db componentJid m' Nothing (bareTxt from) (strResource <$> jidResource from) backendJid (getBody "jabber:component:accept" m')
				| (s"sip.cheogram.com") == strDomain (jidDomain from) -> liftIO $
					case (mapLocalpartToBackend (formatJID componentJid) =<< sanitizeSipLocalpart (maybe mempty strNode $ jidNode from), parseJID (unescapeJid localpart ++ (maybe mempty (s"/"++) (strResource <$> jidResource to)))) of
				| (s"sip.cheogram.com") == strDomain (jidDomain from) -> liftIO $ do
					let (toResource, fromResource)
						| Just toResource <- T.stripPrefix (s"CHEOGRAM%outbound-sip%") =<< (strResource <$> jidResource to) = (toResource, s"tel")
						| otherwise = (fromMaybe mempty (strResource <$> jidResource to), s"sip:" ++ escapeJid (formatJID from))
					case (mapLocalpartToBackend (formatJID componentJid) =<< sanitizeSipLocalpart (maybe mempty strNode $ jidNode from), parseJID (unescapeJid localpart ++ s"/" ++ toResource)) of
						(Just componentFrom, Just routeTo) -> liftIO $ do
							Just componentFromSip <- return $ parseJID (formatJID componentFrom ++ s"/sip:" ++ escapeJid (formatJID from))
							Just componentFromSip <- return $ parseJID (formatJID componentFrom ++ s"/" ++ fromResource)
							sendToComponent $ mkStanzaRec $ receivedStanza $ receivedStanzaFromTo componentFromSip routeTo stanza
						_ ->
							sendToComponent $ stanzaError stanza $


@@ 1263,7 1336,7 @@ component db redis pushStatsd backendHost did cacheOOB adhocBotIQReceiver adhocB
				  (nameNamespace $ elementName p) `elem` [Just (s"urn:xmpp:jingle:1"), Just (s"http://jabber.org/protocol/ibb")] -> do
					jingleHandler iq
				| otherwise -> liftIO $
					mapM_ sendToComponent =<< componentStanza (ComponentContext db backendTo registrationJids adhocBotMessage cacheOOB toRoomPresences toRejoinManager toJoinPartDebouncer processDirectMessageRouteConfig componentJid) stanza
					mapM_ sendToComponent =<< componentStanza (ComponentContext db backendTo registrationJids adhocBotMessage cacheOOB toRoomPresences toRejoinManager toJoinPartDebouncer processDirectMessageRouteConfig componentJid sendIQ) stanza
	where
	mapToComponent = mapToBackend (formatJID componentJid)
	sendToComponent = atomically . writeTChan toComponent


@@ 1897,9 1970,9 @@ main = do

			statsd <- openStatsD statsdHost (show statsdPort) ["cheogram"]

			(adhocBotIQSender, adhocBotIQReceiver) <- iqManager $ atomicUIO . writeTChan sendToComponent . mkStanzaRec
			(sendIQ, iqReceiver) <- iqManager $ atomicUIO . writeTChan sendToComponent . mkStanzaRec
			adhocBotMessages <- atomically newTChan
			void $ forkIO $ adhocBotManager db componentJid (atomicUIO . writeTChan sendToComponent . mkStanzaRec) adhocBotIQSender (readTChan adhocBotMessages)
			void $ forkIO $ adhocBotManager db componentJid (atomicUIO . writeTChan sendToComponent . mkStanzaRec) sendIQ (readTChan adhocBotMessages)

			void $ forkIO $ joinPartDebouncer db backendHost (atomically . writeTChan sendToComponent) componentJid toRoomPresences toJoinPartDebouncer
			void $ forkIO $ roomPresences db toRoomPresences


@@ 1991,6 2064,15 @@ main = do
								]
							]
						}
				) (\iq@(IQ { iqFrom = Just from, iqTo = Just to }) -> do
					maybeProxy <- fmap (join . hush) $ UIO.fromIO $ getSipProxy db componentJid sendIQ from
					fromIO_ $ atomically $ writeTChan sendToComponent $ mkStanzaRec $ case maybeProxy of
						Just proxy ->
							rewriteJingleInitiatorResponder $ iq {
								iqFrom = parseJID $ escapeJid (bareTxt from) ++ s"@" ++ formatJID componentJid ++ s"/CHEOGRAM%outbound-sip%" ++ fromMaybe mempty (strResource <$> jidResource from),
								iqTo = parseJID $ escapeJid (fromMaybe mempty (strNode <$> jidNode to) ++ s"@" ++ proxy) ++ s"@sip.cheogram.com/sip"
							}
						Nothing -> iqNotImplemented iq
				)

			let pushStatsd = void . UIO.fromIO . StatsD.push statsd


@@ 1998,5 2080,5 @@ main = do
			log "" "runComponent STARTING"

			log "runComponent ENDED" =<< runComponent (Server componentJid host (PortNumber port)) secret
				(component db redis (UIO.lift . pushStatsd) backendHost did (cacheOOB (UIO.lift . pushStatsd) jingleStore jingleStoreURL) adhocBotIQReceiver (writeTChan adhocBotMessages) toRoomPresences toRejoinManager toJoinPartDebouncer sendToComponent toStanzaProcessor processDirectMessageRouteConfig jingleHandler componentJid [registrationJid] conferences)
				(component db redis (UIO.lift . pushStatsd) backendHost did (cacheOOB (UIO.lift . pushStatsd) jingleStore jingleStoreURL) sendIQ iqReceiver (writeTChan adhocBotMessages) toRoomPresences toRejoinManager toJoinPartDebouncer sendToComponent toStanzaProcessor processDirectMessageRouteConfig jingleHandler componentJid [registrationJid] conferences)
		_ -> log "ERROR" "Bad arguments"

M Util.hs => Util.hs +8 -0
@@ 253,3 253,11 @@ mapReceivedMessageM :: (Applicative f) =>
	-> f XMPP.ReceivedStanza
mapReceivedMessageM f (XMPP.ReceivedMessage m) = XMPP.ReceivedMessage <$> f m
mapReceivedMessageM _ s = pure s

iqReply :: Maybe XML.Element -> XMPP.IQ -> XMPP.IQ
iqReply payload iq = iq {
	XMPP.iqType = XMPP.IQResult,
	XMPP.iqFrom = XMPP.iqTo iq,
	XMPP.iqTo = XMPP.iqFrom iq,
	XMPP.iqPayload = payload
}