Show error message to user when testing XMPP creds.

Assistant/WebApp/Configurators/XMPP.hs

@@ -33,6 +33,7 @@ import Network
 import Network.Protocol.XMPP
 import Data.Text (Text)
 import qualified Data.Text as T
+import Control.Exception (SomeException)
 #endif
 
 {- Displays an alert suggesting to configure XMPP, with a button. -}
@@ -78,9 +79,9 @@ getXMPPR' redirto = xmppPage $ do
 		let authtoken = webAppFormAuthToken
 		$(widgetFile "configurators/xmpp")
 	case result of
-		FormSuccess f -> maybe (showform True) (lift . storecreds)
+		FormSuccess f -> either (showform . Just . show) (lift . storecreds)
 			=<< liftIO (validateForm f)
-		_ -> showform False
+		_ -> showform Nothing
   where
 	storecreds creds = do
 		void $ runAnnex undefined $ setXMPPCreds creds
@@ -133,7 +134,7 @@ jidField = checkBool (isJust . parseJID) bad textField
 	bad :: Text
 	bad = "This should look like an email address.."
 
-validateForm :: XMPPForm -> IO (Maybe XMPPCreds)
+validateForm :: XMPPForm -> IO (Either SomeException XMPPCreds)
 validateForm f = do
 	let jid = fromMaybe (error "bad JID") $ parseJID (formJID f)
 	let domain = T.unpack $ strDomain $ jidDomain jid
@@ -155,10 +156,9 @@ validateForm f = do
 			, xmppJID = formJID f
 			}
 
-testXMPP :: XMPPCreds -> IO (Maybe XMPPCreds)
-testXMPP creds = either (const $ return Nothing)
-	(const $ return $ Just creds)
-	=<< connectXMPP creds (const noop)
+testXMPP :: XMPPCreds -> IO (Either SomeException XMPPCreds)
+testXMPP creds = either Left (const $ Right creds)
+	<$> connectXMPP creds (const noop)
 
 #endif
 

debian/changelog

@@ -1,3 +1,9 @@
+git-annex (3.20121113) UNRELEASED; urgency=low
+
+  * Show error message to user when testing XMPP creds.
+
+ -- Joey Hess <joeyh@debian.org>  Tue, 13 Nov 2012 13:17:07 -0400
+
 git-annex (3.20121112) unstable; urgency=low
 
   * assistant: Can use XMPP to notify other nodes about pushes made to other

templates/configurators/xmpp.hamlet

@@ -9,10 +9,10 @@
     It's fine to reuse an existing jabber account; git-annex won't #
     post any messages to it.
   <p>
-    $if problem
+    $maybe msg <- problem
       <i .icon-warning-sign></i> Unable to connect to the Jabber server. #
-      Maybe you entered the wrong password?
-    $else
+      Maybe you entered the wrong password? (Error message: #{msg})
+    $nothing
       <i .icon-user></I> If you have a Gmail account, you can use #
       Google Talk. Just enter your full Gmail address #
       <small>(<tt>you@gmail.com</tt>)</small> #