add XMPP nudge alert, displayed after making a cloud repository

Assistant/Alert.hs

@@ -34,6 +34,7 @@ data AlertName
 	| SanityCheckFixAlert
 	| WarningAlert String
 	| PairAlert String
+	| XMPPNeededAlert
 	deriving (Eq)
 
 {- The first alert is the new alert, the second is an old alert.
@@ -322,6 +323,21 @@ pairRequestAcknowledgedAlert repo button = baseActivityAlert
 	, alertButton = button
 	}
 
+xmppNeededAlert :: AlertButton -> Alert
+xmppNeededAlert button = Alert
+	{ alertHeader = Just "Keep your repositories in sync across the cloud, or share with friends."
+	, alertIcon = Just TheCloud
+	, alertPriority = High
+	, alertButton = Just button
+	, alertClosable = True
+	, alertClass = Message
+	, alertMessageRender = tenseWords
+	, alertBlockDisplay = True
+	, alertName = Just $ XMPPNeededAlert
+	, alertCombiner = Just $ dataCombiner $ \_old new -> new
+	, alertData = []
+	}
+
 fileAlert :: TenseChunk -> FilePath -> Alert
 fileAlert msg file = (activityAlert Nothing [f])
 	{ alertName = Just $ FileAlert msg

Assistant/WebApp/Configurators/Edit.hs

@@ -16,6 +16,7 @@ import Assistant.WebApp.SideBar
 import Assistant.WebApp.Utility
 import Assistant.DaemonStatus
 import Assistant.MakeRemote (uniqueRemoteName)
+import Assistant.WebApp.Configurators.XMPP (xmppNeeded)
 import Utility.Yesod
 import qualified Remote
 import qualified Remote.List as Remote
@@ -100,6 +101,9 @@ getEditRepositoryR = editForm False
 getEditNewRepositoryR :: UUID -> Handler RepHtml
 getEditNewRepositoryR = editForm True
 
+getEditNewCloudRepositoryR :: UUID -> Handler RepHtml
+getEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid
+
 editForm :: Bool -> UUID -> Handler RepHtml
 editForm new uuid = bootstrap (Just Config) $ do
 	sideBarDisplay

Assistant/WebApp/Configurators/S3.hs

@@ -125,4 +125,4 @@ makeS3Remote (S3Creds ak sk) name setup config = do
 		return remotename
 	setup r
 	liftIO $ syncNewRemote st (daemonStatus webapp) (scanRemotes webapp) r
-	redirect $ EditNewRepositoryR $ Remote.uuid r
+	redirect $ EditNewCloudRepositoryR $ Remote.uuid r

Assistant/WebApp/Configurators/Ssh.hs

@@ -290,7 +290,7 @@ makeSshRepo forcersync setup sshdata = do
 		(scanRemotes webapp)
 		forcersync sshdata
 	setup r
-	redirect $ EditNewRepositoryR $ Remote.uuid r
+	redirect $ EditNewCloudRepositoryR $ Remote.uuid r
 
 getAddRsyncNetR :: Handler RepHtml
 getAddRsyncNetR = do

Assistant/WebApp/Configurators/XMPP.hs

@@ -13,6 +13,8 @@ module Assistant.WebApp.Configurators.XMPP where
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.WebApp.SideBar
+import Assistant.Alert
+import Assistant.DaemonStatus
 import Utility.Yesod
 #ifdef WITH_XMPP
 import Assistant.Common
@@ -29,6 +31,17 @@ import Data.Text (Text)
 import qualified Data.Text as T
 #endif
 
+{- Displays an alert suggesting to configure XMPP, with a button. -}
+xmppNeeded :: Handler ()
+xmppNeeded = whenM (isNothing <$> runAnnex Nothing getXMPPCreds) $ do
+	dstatus <- daemonStatus <$> getYesod
+	urlrender <- getUrlRender
+	void $ liftIO $ addAlert dstatus $ xmppNeededAlert $ AlertButton
+		{ buttonLabel = "Configure a Jabber account"
+		, buttonUrl = urlrender XMPPR
+		, buttonAction = Just $ removeAlert dstatus
+		}
+
 getXMPPR :: Handler RepHtml
 #ifdef WITH_XMPP
 getXMPPR = xmppPage $ do

Assistant/WebApp/routes

@@ -13,6 +13,7 @@
 /config/repository/switchto/#FilePath SwitchToRepositoryR GET
 /config/repository/edit/#UUID EditRepositoryR GET
 /config/repository/edit/new/#UUID EditNewRepositoryR GET
+/config/repository/edit/new/cloud/#UUID EditNewCloudRepositoryR GET
 /config/repository/sync/disable/#UUID DisableSyncR GET
 /config/repository/sync/enable/#UUID EnableSyncR GET