webapp: Improved UI for pairing your own devices together using XMPP.

Assistant/Threads/XMPPClient.hs

@@ -274,7 +274,8 @@ pairMsgReceived urlrenderer PairReq theiruuid selfjid theirjid
 		finishXMPPPairing theirjid theiruuid
 	-- Show an alert to let the user decide if they want to pair.
 	showalert = do
-		let route = ConfirmXMPPPairR (PairKey theiruuid $ formatJID theirjid)
+		let route = ConfirmXMPPPairFriendR $
+			PairKey theiruuid $ formatJID theirjid
 		url <- liftIO $ renderUrl urlrenderer route []
 		close <- asIO1 removeAlert
 		void $ addAlert $ pairRequestReceivedAlert (T.unpack $ buddyName theirjid)

Assistant/WebApp/Configurators/Pairing.hs

@@ -25,7 +25,6 @@ import Utility.Network
 import Annex.UUID
 #endif
 #ifdef WITH_XMPP
-import Assistant.XMPP
 import Assistant.XMPP.Client
 import Assistant.XMPP.Buddies
 import Assistant.XMPP.Git
@@ -50,45 +49,78 @@ import Control.Concurrent
 import qualified Data.Set as S
 #endif
 
-getStartXMPPPairR :: Handler RepHtml
+getStartXMPPPairFriendR :: Handler RepHtml
 #ifdef WITH_XMPP
-getStartXMPPPairR = ifM (isJust <$> liftAnnex getXMPPCreds)
+getStartXMPPPairFriendR = ifM (isJust <$> liftAnnex getXMPPCreds)
 	( do
 		{- Ask buddies to send presence info, to get
 		 - the buddy list populated. -}
 		liftAssistant $ sendNetMessage QueryPresence
 		pairPage $
-			$(widgetFile "configurators/pairing/xmpp/prompt")
+			$(widgetFile "configurators/pairing/xmpp/friend/prompt")
 	, redirect XMPPR -- go get XMPP configured, then come back
 	)
 #else
-getStartXMPPPairR = noXMPPPairing
+getStartXMPPPairFriendR = noXMPPPairing
 
 noXMPPPairing :: Handler RepHtml
 noXMPPPairing = noPairing "XMPP"
 #endif
 
-{- Does pairing with an XMPP buddy, or with other clients sharing an
+getStartXMPPPairSelfR :: Handler RepHtml
- - XMPP account. -}
-getRunningXMPPPairR :: BuddyKey -> Handler RepHtml
 #ifdef WITH_XMPP
-getRunningXMPPPairR bid = do
+getStartXMPPPairSelfR = go =<< liftAnnex getXMPPCreds
+  where
+  	go Nothing = redirect XMPPR -- go get XMPP configured, then come back
+	go (Just creds) = do
+		{- Ask buddies to send presence info, to get
+		 - the buddy list populated. -}
+		liftAssistant $ sendNetMessage QueryPresence
+		let account = xmppJID creds
+		pairPage $
+			$(widgetFile "configurators/pairing/xmpp/self/prompt")
+#else
+getStartXMPPPairSelfR = noXMPPPairing
+
+noXMPPPairing :: Handler RepHtml
+noXMPPPairing = noPairing "XMPP"
+#endif
+
+getRunningXMPPPairFriendR :: BuddyKey -> Handler RepHtml
+getRunningXMPPPairFriendR = sendXMPPPairRequest . Just
+
+getRunningXMPPPairSelfR :: Handler RepHtml
+getRunningXMPPPairSelfR = sendXMPPPairRequest Nothing
+
+{- Sends a XMPP pair request, to a buddy or to self. -}
+sendXMPPPairRequest :: Maybe BuddyKey -> Handler RepHtml
+#ifdef WITH_XMPP
+sendXMPPPairRequest mbid = do
+	bid <- maybe getself return mbid
 	buddy <- liftAssistant $ getBuddy bid <<~ buddyList
 	go $ S.toList . buddyAssistants <$> buddy
   where
 	go (Just (clients@((Client exemplar):_))) = do
-		creds <- liftAnnex getXMPPCreds
-		let ourjid = fromJust $ parseJID =<< xmppJID <$> creds
-		let samejid = baseJID ourjid == baseJID exemplar
 		u <- liftAnnex getUUID
 		liftAssistant $ forM_ clients $ \(Client c) -> sendNetMessage $
 			PairingNotification PairReq (formatJID c) u
-		xmppPairEnd True $ if samejid then Nothing else Just exemplar
+		xmppPairStatus True $
-	-- A buddy could have logged out, or the XMPP client restarted,
+			if selfpair then Nothing else Just exemplar
-	-- and there be no clients to message; handle unforseen by going back.
+	go _
-	go _ = redirect StartXMPPPairR
+		{- Nudge the user to turn on their other device. -}
+		| selfpair = do
+			liftAssistant $ sendNetMessage QueryPresence
+			pairPage $
+				$(widgetFile "configurators/pairing/xmpp/self/retry")
+		{- Buddy could have logged out, etc.
+		 - Go back to buddy list. -}
+		| otherwise = redirect StartXMPPPairFriendR
+	selfpair = isNothing mbid
+	getself = maybe (error "XMPP not configured")
+			(return . BuddyKey . xmppJID)
+				=<< liftAnnex getXMPPCreds
 #else
-getRunningXMPPPairR _ = noXMPPPairing
+sendXMPPPairRequest _ = noXMPPPairing
 #endif
 
 {- Starts local pairing. -}
@@ -122,20 +154,20 @@ getFinishLocalPairR msg = promptSecret (Just msg) $ \_ secret -> do
 getFinishLocalPairR _ = noLocalPairing
 #endif
 
-getConfirmXMPPPairR :: PairKey -> Handler RepHtml
+getConfirmXMPPPairFriendR :: PairKey -> Handler RepHtml
 #ifdef WITH_XMPP
-getConfirmXMPPPairR pairkey@(PairKey _ t) = case parseJID t of
+getConfirmXMPPPairFriendR pairkey@(PairKey _ t) = case parseJID t of
 	Nothing -> error "bad JID"
 	Just theirjid -> pairPage $ do
 		let name = buddyName theirjid
-		$(widgetFile "configurators/pairing/xmpp/confirm")
+		$(widgetFile "configurators/pairing/xmpp/friend/confirm")
 #else
-getConfirmXMPPPairR _ = noXMPPPairing
+getConfirmXMPPPairFriendR _ = noXMPPPairing
 #endif
 
-getFinishXMPPPairR :: PairKey -> Handler RepHtml
+getFinishXMPPPairFriendR :: PairKey -> Handler RepHtml
 #ifdef WITH_XMPP
-getFinishXMPPPairR (PairKey theiruuid t) = case parseJID t of
+getFinishXMPPPairFriendR (PairKey theiruuid t) = case parseJID t of
 	Nothing -> error "bad JID"
 	Just theirjid -> do
 		selfuuid <- liftAnnex getUUID
@@ -143,14 +175,16 @@ getFinishXMPPPairR (PairKey theiruuid t) = case parseJID t of
 			sendNetMessage $
 				PairingNotification PairAck (formatJID theirjid) selfuuid
 			finishXMPPPairing theirjid theiruuid
-		xmppPairEnd False $ Just theirjid
+		xmppPairStatus False $ Just theirjid
 #else
 getFinishXMPPPairR _ = noXMPPPairing
 #endif
 
+{- Displays a page indicating pairing status and 
+ - prompting to set up cloud repositories. -}
 #ifdef WITH_XMPP
-xmppPairEnd :: Bool -> Maybe JID -> Handler RepHtml
+xmppPairStatus :: Bool -> Maybe JID -> Handler RepHtml
-xmppPairEnd inprogress theirjid = pairPage $ do
+xmppPairStatus inprogress theirjid = pairPage $ do
 	let friend = buddyName <$> theirjid
 	let cloudrepolist = repoListDisplay $ RepoSelector
 		{ onlyCloud = True

Assistant/WebApp/Configurators/XMPP.hs

@@ -62,7 +62,7 @@ getXMPPR = xmppPage $ do
 	storecreds creds = do
 		void $ liftAnnex $ setXMPPCreds creds
 		liftAssistant notifyNetMessagerRestart
-		redirect StartXMPPPairR
+		redirectBack
 #else
 getXMPPR = xmppPage $
 	$(widgetFile "configurators/xmpp/disabled")
@@ -84,6 +84,7 @@ buddyListDisplay = do
 	autoUpdate ident NotifierBuddyListR (10 :: Int) (10 :: Int)
 #ifdef WITH_XMPP
 	myjid <- lift $ liftAssistant $ xmppClientID <$> getDaemonStatus
+	let isself (BuddyKey b) = Just b == myjid
 	buddies <- lift $ liftAssistant $ do
 		rs <- filter isXMPPRemote . syncGitRemotes <$> getDaemonStatus
 		let pairedwith = catMaybes $ map (parseJID . getXMPPClientID) rs

Assistant/WebApp/routes

@@ -42,10 +42,14 @@
 /config/repository/pair/local/start StartLocalPairR GET
 /config/repository/pair/local/running/#SecretReminder RunningLocalPairR GET
 /config/repository/pair/local/finish/#PairMsg FinishLocalPairR GET
-/config/repository/pair/xmpp/start StartXMPPPairR GET
+
-/config/repository/pair/xmpp/running/#BuddyKey RunningXMPPPairR GET
+/config/repository/pair/xmpp/self/start StartXMPPPairSelfR GET
-/config/repository/pair/xmpp/accept/#PairKey ConfirmXMPPPairR GET
+/config/repository/pair/xmpp/self/running RunningXMPPPairSelfR GET
-/config/repository/pair/xmpp/finish/#PairKey FinishXMPPPairR GET
+
+/config/repository/pair/xmpp/friend/start StartXMPPPairFriendR GET
+/config/repository/pair/xmpp/friend/running/#BuddyKey RunningXMPPPairFriendR GET
+/config/repository/pair/xmpp/friend/accept/#PairKey ConfirmXMPPPairFriendR GET
+/config/repository/pair/xmpp/friend/finish/#PairKey FinishXMPPPairFriendR GET
 
 /config/repository/enable/rsync/#UUID EnableRsyncR GET
 /config/repository/enable/directory/#UUID EnableDirectoryR GET

debian/changelog

@@ -2,6 +2,7 @@ git-annex (4.20130315) UNRELEASED; urgency=low
 
   * webapp: Repository list is now included in the dashboard, and other
     UI tweaks.
+  * webapp: Improved UI for pairing your own devices together using XMPP.
 
  -- Joey Hess <joeyh@debian.org>  Fri, 15 Mar 2013 00:10:07 -0400
 

templates/configurators/addrepository/misc.hamlet

@@ -2,36 +2,33 @@
   <a href="@{AddDriveR}">
     <i .icon-plus-sign></i> Removable drive
 <p>
-  Clone this repository to a USB drive, memory stick, or other #
+  Add a USB drive, memory stick, or other removable media. #
-  removable media.
-<p>
   For offline archiving, backups, or to #
   <a href="http://en.wikipedia.org/wiki/Sneakernet">SneakerNet</a> #
   between computers. 
 
+<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.
+
 <h3>
   <a href="@{StartLocalPairR}">
     <i .icon-plus-sign></i> Local computer
 <p>
-  Pair with a computer to automatically keep files in sync #
+  Pair with a computer to keep files in sync quickly, #
   over your local network.
-<p>
-  For easy sharing with friends and devices in the same location.
-
-<h3>
-  <a href="@{StartXMPPPairR}">
-    <i .icon-plus-sign></i> Share with a friend
-<p>
-  Pair with a friend's computer, to combine your repositories and #
-  share files.
-
-<p>
-
-  For easy sharing with friends and devices, over the internet.
 
 <h3>
   <a href="@{NewRepositoryR}">
-    <i .icon-plus-sign></i> Add a local repository
+    <i .icon-plus-sign></i> Add another repository
 <p>
   Make another repository on your computer.
 

templates/configurators/pairing/xmpp/end.hamlet

@@ -9,8 +9,7 @@
       $nothing
         A pair request has been sent to all other devices that #
         have been configured to use your jabber account. #
-        It will be answered automatically by any that see it; #
+        It will be answered automatically by any devices that see it.
-        no action is required on your part.
   $else
     Pair request accepted.
   <h2>

templates/configurators/pairing/xmpp/friend/confirm.hamlet

@@ -5,7 +5,7 @@
     Pairing with #{name} will combine your two git annex #
     repositories into one, allowing you to share files.
   <p>
-    <a .btn .btn-primary .btn-large href="@{FinishXMPPPairR pairkey}">
+    <a .btn .btn-primary .btn-large href="@{FinishXMPPPairFriendR pairkey}">
       Accept pair request
     <a .btn .btn-large href="@{DashboardR}">
       No thanks

templates/configurators/pairing/xmpp/friend/prompt.hamlet

@@ -0,0 +1,12 @@
+<div .span9 .hero-unit>
+  <h2>
+    Share with a friend
+  <p>
+    You can combine your repository with a friend's repository #
+    to share your files. Your repositories will automatically be kept in #
+    sync. Only do this if you want your friend to see all the files #
+    in this repository!
+  <p>
+    Here are the friends currently available via your Jabber account.
+    <p>
+      ^{buddyListDisplay}

templates/configurators/pairing/xmpp/prompt.hamlet

@@ -1,11 +0,0 @@
-<div .span9 .hero-unit>
-  <h2>
-    Pairing with another computer
-  <p>
-    Pairing with a another computer combines both git-annex repositories #
-    into a single shared repository, with changes kept in sync.
-  <p>
-    You can pair with any of your friends using jabber, or with another #
-    device that shares your own jabber account.
-    <p>
-      ^{buddyListDisplay}

templates/configurators/pairing/xmpp/self/prompt.hamlet

@@ -0,0 +1,18 @@
+<div .span9 .hero-unit>
+  <h2>
+    Sharing with your other devices
+  <p>
+    If you have multiple devices, all running git-annex, and using #
+    your Jabber account #{account}, you can configure them to share #
+    your files between themselves.
+  <p>
+    For example, you can have a computer at home, one at work, and a #
+    laptop, and their repositories will automatically be kept in sync.
+  <p>
+    Make sure your other devices are online and configured to use #
+    your Jabber account before continuing.
+  <p>
+    <a .btn .btn-primary .btn-large href="@{RunningXMPPPairSelfR}">
+      Start sharing with my other devices #
+    <a .btn .btn-large href="@{DashboardR}">
+      Cancel

templates/configurators/pairing/xmpp/self/retry.hamlet

@@ -0,0 +1,11 @@
+<div .span9 .hero-unit>
+  <h2>
+    Unable to get in touch with any other devices.
+  <p>
+    Make sure your other devices are online and configured to use #
+    your Jabber account before continuing.
+  <p>
+    <a .btn .btn-primary .btn-large href="@{RunningXMPPPairSelfR}">
+      Start sharing with my other devices #
+    <a .btn .btn-large href="@{DashboardR}">
+      Cancel

templates/configurators/xmpp/buddylist.hamlet

@@ -7,16 +7,18 @@
           $if isNothing myjid
             Not connected to the jabber server. Check your network connection ...
           $else
-            Nobody is currently available.
+            Searching...
     $else
       $forall (name, away, canpair, paired, buddyid) <- buddies
         <tr>
           <td>
-            <i .icon-user></i> #
+            $if isself buddyid
-            $if away
+              <i .icon-star></i> #
-              <span .muted>
+              <span :away:.muted>
-                #{name}
+                your other devices
             $else
+              <i .icon-user></i> #
+              <span :away:.muted>
                   #{name}
           <td>
             $if away
@@ -28,7 +30,11 @@
                   paired
               $else
                 $if canpair
-                  <a .btn .btn-primary .btn-small href="@{RunningXMPPPairR buddyid}">
+                  $if isself buddyid
+                    <a .btn .btn-primary .btn-small href="@{RunningXMPPPairSelfR}">
+                      Share pairing
+                  $else
+                    <a .btn .btn-primary .btn-small href="@{RunningXMPPPairFriendR buddyid}">
                       Start pairing
                 $else
                   not using git-annex