~singpolyma/jabber-iq-gateway-web

d8c4fc36e6bd0f95e384de517ad8362d9f373828 — Stephen Paul Weber 4 months ago 1a4ff87
Allow passing server when needed
1 files changed, 14 insertions(+), 9 deletions(-)

M jabber-iq-gateway-web.hs
M jabber-iq-gateway-web.hs => jabber-iq-gateway-web.hs +14 -9
@@ 18,16 18,11 @@ import IQManager
import Router
import Util

runClient :: XMPP.JID -> Text -> XMPP.XMPP a -> IO (Either XMPP.Error a)
runClient jid =
runClient :: XMPP.Server -> XMPP.JID -> Text -> XMPP.XMPP a -> IO (Either XMPP.Error a)
runClient server jid =
	XMPP.runClient server jid jidStrNode
	where
	-- This is right unless there is an SRV record, which we don't check for
	Just jidStrNode = XMPP.strNode <$> XMPP.jidNode jid
	jidStrDomain = XMPP.strDomain $ XMPP.jidDomain jid
	Just domainJid = XMPP.parseJID jidStrDomain
	domainStr = textToString jidStrDomain
	server = XMPP.Server domainJid domainStr (PortNumber 5222)

webPost :: (XMPP.IQ -> IO (Maybe XMPP.IQ)) -> XMPP.JID -> Wai.Application
webPost sendIQ toJid req = (>>=) $ do


@@ 110,12 105,22 @@ web sendIQ req

main :: IO ()
main = do
	[rpcJidStr, rpcPassword] <- getArgs
	rpcJidStr:rpcPassword:rest <- getArgs

	-- This is right unless there is an SRV record, which we don't check for
	let Just rpcJid = XMPP.parseJID rpcJidStr
	let jidStrDomain = XMPP.strDomain $ XMPP.jidDomain rpcJid
	let Just domainJid = XMPP.parseJID jidStrDomain
	let domainStr = textToString jidStrDomain

	let server = case (fmap textToString rest, map XMPP.parseJID rest) of
		([serverStr], [Just serverJid]) -> XMPP.Server serverJid serverStr (PortNumber 5222)
		_ -> XMPP.Server domainJid domainStr (PortNumber 5222)

	sendIQChan <- atomicUIO STM.newTChan

	void $ UIO.fork $ do
		fmap (either (error . show) (const ())) $ fromIO_ $ runClient rpcJid rpcPassword $ do
		fmap (either (error . show) (const ())) $ fromIO_ $ runClient server rpcJid rpcPassword $ do
			void $ XMPP.bindJID rpcJid
			(sendIQ, iqReceived) <- iqManager
			void $ forkXMPP $ runRouted $ defaultRoutes {