When an XMPP server has SRV records, try them, but don't then fall back to the regular host if they all fail.

gmail.com has some XMPP SRV records, but does not itself respond to XMPP
traffic, although it does accept connections on port 5222. So if a user
entered the wrong password, it would try all the SRVs and fall back to
trying gmail, and hang at that point.

This seems the right thing to do, not just a workaround.

1 files changed, 6 insertions, 3 deletions

diff --git a/Assistant/XMPP/Client.hs b/Assistant/XMPP/Client.hs
index 960073036..677bb2ff3 100644
--- a/Assistant/XMPP/Client.hs
+++ b/Assistant/XMPP/Client.hs
@@ -34,17 +34,20 @@ connectXMPP c a = case parseJID (xmppJID c) of
 
 {- Do a SRV lookup, but if it fails, fall back to the cached xmppHostname. -}
 connectXMPP' :: JID -> XMPPCreds -> (JID -> XMPP a) -> IO [(HostPort, Either SomeException ())]
-connectXMPP' jid c a = reverse <$> (go [] =<< lookupSRV srvrecord)
+connectXMPP' jid c a = reverse <$> (handle =<< lookupSRV srvrecord)
   where
 	srvrecord = mkSRVTcp "xmpp-client" $
 		T.unpack $ strDomain $ jidDomain jid
 	serverjid = JID Nothing (jidDomain jid) Nothing
 
-	go l [] = do
+	handle [] = do
 		let h = xmppHostname c
 		let p = PortNumber $ fromIntegral $ xmppPort c
 		r <- run h p $ a jid
-		return (r : l)
+		return [r]
+	handle srvs = go [] srvs
+
+	go l [] = return l
 	go l ((h,p):rest) = do
 		{- Try each SRV record in turn, until one connects,
 		 - at which point the MVar will be full. -}