mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

avoid duplicate srv lookup when testing xmpp

Browse source
This commit is contained in:
Joey Hess 2013-05-27 13:45:07 -04:00
parent eba9ee5bc6
commit 5a678244e2
1 changed files with 7 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

12
Assistant/WebApp/Configurators/XMPP.hs
View file

@ -187,18 +187,8 @@ jidField = checkBool (isJust . parseJID) bad textField
validateForm :: XMPPForm -> IO (Either SomeException XMPPCreds) validateForm :: XMPPForm -> IO (Either SomeException XMPPCreds)
validateForm f = do validateForm f = do
let jid = fromMaybe (error "bad JID") $ parseJID (formJID f) let jid = fromMaybe (error "bad JID") $ parseJID (formJID f)
let domain = T.unpack $ strDomain $ jidDomain jid
hostports <- lookupSRV $ mkSRVTcp "xmpp-client" domain
let username = fromMaybe "" (strNode <$> jidNode jid) let username = fromMaybe "" (strNode <$> jidNode jid)
case hostports of testXMPP $ XMPPCreds
((h, PortNumber p):_) -> testXMPP $ XMPPCreds
{ xmppUsername = username
, xmppPassword = formPassword f
, xmppHostname = h
, xmppPort = fromIntegral p
, xmppJID = formJID f
}
_ -> testXMPP $ XMPPCreds
{ xmppUsername = username { xmppUsername = username
, xmppPassword = formPassword f , xmppPassword = formPassword f
, xmppHostname = T.unpack $ strDomain $ jidDomain jid , xmppHostname = T.unpack $ strDomain $ jidDomain jid