webapp: Rework xmpp nudge to prompt for either xmpp or a ssh remote be set up.

This commit was sponsored by Nathan Howell.

Assistant/Alert.hs

@@ -329,10 +329,10 @@ pairRequestAcknowledgedAlert who button = baseActivityAlert
 	, alertButtons = maybeToList button
 	}
 
-xmppNeededAlert :: AlertButton -> Alert
+connectionNeededAlert :: AlertButton -> Alert
-xmppNeededAlert button = Alert
+connectionNeededAlert button = Alert
 	{ alertHeader = Just "Share with friends, and keep your devices in sync across the cloud."
-	, alertIcon = Just TheCloud
+	, alertIcon = Just ConnectionIcon
 	, alertPriority = High
 	, alertButtons = [button]
 	, alertClosable = True
@@ -340,7 +340,7 @@ xmppNeededAlert button = Alert
 	, alertMessageRender = renderData
 	, alertCounter = 0
 	, alertBlockDisplay = True
-	, alertName = Just $ XMPPNeededAlert
+	, alertName = Just ConnectionNeededAlert
 	, alertCombiner = Just $ dataCombiner $ \_old new -> new
 	, alertData = []
 	}

Assistant/Types/Alert.hs

@@ -26,7 +26,7 @@ data AlertName
 	| SanityCheckFixAlert
 	| WarningAlert String
 	| PairAlert String
-	| XMPPNeededAlert
+	| ConnectionNeededAlert
 	| RemoteRemovalAlert String
 	| CloudRepoNeededAlert
 	| SyncAlert
@@ -54,7 +54,7 @@ data Alert = Alert
 	, alertButtons :: [AlertButton]
 	}
 
-data AlertIcon = ActivityIcon | SyncIcon | SuccessIcon | ErrorIcon | InfoIcon | UpgradeIcon | TheCloud
+data AlertIcon = ActivityIcon | SyncIcon | SuccessIcon | ErrorIcon | InfoIcon | UpgradeIcon | ConnectionIcon
 
 type AlertMap = M.Map AlertId Alert
 

Assistant/WebApp/Configurators.hs

@@ -39,6 +39,14 @@ makeMiscRepositories = $(widgetFile "configurators/addrepository/misc")
 makeCloudRepositories :: Widget
 makeCloudRepositories = $(widgetFile "configurators/addrepository/cloud")
 
+makeXMPPConnection :: Widget
+makeXMPPConnection = $(widgetFile "configurators/addrepository/xmppconnection")
+
+makeSshRepository :: Widget
+makeSshRepository = $(widgetFile "configurators/addrepository/ssh")
+
+makeConnectionRepositories :: Widget
+makeConnectionRepositories = $(widgetFile "configurators/addrepository/connection")
+
 makeArchiveRepositories :: Widget
 makeArchiveRepositories = $(widgetFile "configurators/addrepository/archive")
-

Assistant/WebApp/Configurators/Edit.hs

@@ -11,11 +11,12 @@ module Assistant.WebApp.Configurators.Edit where
 
 import Assistant.WebApp.Common
 import Assistant.WebApp.Gpg
+import Assistant.WebApp.Configurators
 import Assistant.DaemonStatus
 import Assistant.WebApp.MakeRemote (uniqueRemoteName)
-import Assistant.WebApp.Configurators.XMPP (xmppNeeded)
 import Assistant.ScanRemotes
 import Assistant.Sync
+import Assistant.Alert
 import qualified Assistant.WebApp.Configurators.AWS as AWS
 import qualified Assistant.WebApp.Configurators.IA as IA
 #ifdef WITH_S3
@@ -183,7 +184,7 @@ getEditNewCloudRepositoryR :: UUID -> Handler Html
 getEditNewCloudRepositoryR = postEditNewCloudRepositoryR
 
 postEditNewCloudRepositoryR :: UUID -> Handler Html
-postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True (RepoUUID uuid)
+postEditNewCloudRepositoryR uuid = connectionNeeded >> editForm True (RepoUUID uuid)
 
 editForm :: Bool -> RepoId -> Handler Html
 editForm new (RepoUUID uuid) = page "Edit repository" (Just Configuration) $ do
@@ -275,3 +276,23 @@ getUpgradeRepositoryR r = go =<< liftAnnex (repoIdRemote r)
 		liftAssistant updateSyncRemotes
 		liftAssistant $ syncRemote rmt
 		redirect DashboardR
+
+{- If there is no currently connected remote, display an alert suggesting
+ - to set up one. -}
+connectionNeeded :: Handler ()
+connectionNeeded = whenM noconnection $ do
+	urlrender <- getUrlRender
+	void $ liftAssistant $ do
+		close <- asIO1 removeAlert
+		addAlert $ connectionNeededAlert $ AlertButton
+			{ buttonLabel = "Connnect"
+			, buttonUrl = urlrender ConnectionNeededR
+			, buttonAction = Just close
+			, buttonPrimary = True
+			}
+  where
+	noconnection = S.null . currentlyConnectedRemotes <$> liftAssistant getDaemonStatus
+
+getConnectionNeededR :: Handler Html
+getConnectionNeededR = page "Connection needed" (Just Configuration) $ do
+	$(widgetFile "configurators/needconnection")

Assistant/WebApp/Configurators/XMPP.hs

@@ -32,23 +32,6 @@ import Network
 import qualified Data.Text as T
 #endif
 
-{- Displays an alert suggesting to configure XMPP. -}
-xmppNeeded :: Handler ()
-#ifdef WITH_XMPP
-xmppNeeded = whenM (isNothing <$> liftAnnex getXMPPCreds) $ do
-	urlrender <- getUrlRender
-	void $ liftAssistant $ do
-		close <- asIO1 removeAlert
-		addAlert $ xmppNeededAlert $ AlertButton
-			{ buttonLabel = "Configure a Jabber account"
-			, buttonUrl = urlrender XMPPConfigR
-			, buttonAction = Just close
-			, buttonPrimary = True
-			}
-#else
-xmppNeeded = return ()
-#endif
-
 {- When appropriate, displays an alert suggesting to configure a cloud repo
  - to suppliment an XMPP remote. -}
 checkCloudRepos :: UrlRenderer -> Remote -> Assistant ()

Assistant/WebApp/SideBar.hs

@@ -103,8 +103,7 @@ htmlIcon InfoIcon = bootstrapIcon "info-sign"
 htmlIcon SuccessIcon = bootstrapIcon "ok"
 htmlIcon ErrorIcon = bootstrapIcon "exclamation-sign"
 htmlIcon UpgradeIcon = bootstrapIcon "arrow-up"
--- utf-8 umbrella (utf-8 cloud looks too stormy)
+htmlIcon ConnectionIcon = bootstrapIcon "signal"
-htmlIcon TheCloud = [whamlet|☂|]
 
 bootstrapIcon :: Text -> Widget
 bootstrapIcon name = [whamlet|<i .icon-#{name}></i>|]

Assistant/WebApp/routes

@@ -20,6 +20,7 @@
 /config/xmpp/for/self XMPPConfigForPairSelfR GET POST
 /config/xmpp/for/frield XMPPConfigForPairFriendR GET POST
 /config/xmpp/needcloudrepo/#UUID NeedCloudRepoR GET
+/config/needconnection ConnectionNeededR GET
 /config/fsck ConfigFsckR GET POST
 /config/fsck/preferences ConfigFsckPreferencesR POST
 /config/upgrade/start/#GitAnnexDistribution ConfigStartUpgradeR GET

debian/changelog

@@ -8,6 +8,8 @@ git-annex (5.20140406) UNRELEASED; urgency=medium
     Requires the remote server have git-annex-shell with notifychanges support.
   * webapp: Show a network signal icon next to ssh and xmpp remotes that
     it's currently connected with.
+  * webapp: Rework xmpp nudge to prompt for either xmpp or a ssh remote be
+    set up.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 07 Apr 2014 16:22:02 -0400
 

templates/configurators/addrepository/cloud.hamlet

@@ -18,9 +18,4 @@
 <p>
   Good choice for professional quality storage.
 
-<h3>
+^{makeSshRepository}
-  <a href="@{AddSshR}">
-    <i .icon-plus-sign></i> Remote server
-<p>
-  Set up a repository on a remote server using #
-  <tt>ssh</tt>.

templates/configurators/addrepository/connection.hamlet

@@ -0,0 +1,3 @@
+^{makeXMPPConnection}
+
+^{makeSshRepository}

templates/configurators/addrepository/misc.hamlet

@@ -7,17 +7,7 @@
   <a href="http://en.wikipedia.org/wiki/Sneakernet">SneakerNet</a> #
   between computers. 
 
-<h3>
+^{makeXMPPConnection}
-  <a href="@{StartXMPPPairSelfR}">
-    <i .icon-plus-sign></i> Share with your other devices
-<p>
-  Keep files in sync between your devices running git-annex.
-
-<h3>
-  <a href="@{StartXMPPPairFriendR}">
-    <i .icon-plus-sign></i> Share with a friend
-<p>
-  Combine your repository with a friend's repository, and share your files.
 
 <h3>
   <a href="@{StartLocalPairR}">
@@ -31,3 +21,5 @@
     <i .icon-plus-sign></i> Add another repository
 <p>
   Make another repository on your computer.
+
+^{makeSshRepository}

templates/configurators/addrepository/ssh.hamlet

@@ -0,0 +1,6 @@
+<h3>
+  <a href="@{AddSshR}">
+    <i .icon-plus-sign></i> Remote server
+<p>
+  Set up a repository on a remote server using #
+  <tt>ssh</tt>.

templates/configurators/addrepository/xmppconnection.hamlet

@@ -0,0 +1,11 @@
+<h3>
+  <a href="@{StartXMPPPairSelfR}">
+    <i .icon-plus-sign></i> Share with your other devices
+<p>
+  Keep files in sync between your devices running git-annex.
+
+<h3>
+  <a href="@{StartXMPPPairFriendR}">
+    <i .icon-plus-sign></i> Share with a friend
+<p>
+  Combine your repository with a friend's repository, and share your files.

templates/configurators/needconnection.hamlet

@@ -0,0 +1,12 @@
+<div .span9 .hero-unit>
+  <h2>
+    <i .icon-signal></i> Connection needed
+    <p>
+      In order to quickly sync with other repositories, #
+      a direct connection is needed to another git-annex. #
+    <p>
+      You don't currently seem to have such a connection configured -- #
+      or if you do, it's not currently connected!
+  <h2>
+    Add a connection
+  ^{makeConnectionRepositories}