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

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

Browse source
This commit is contained in:
Joey Hess 2013-03-15 15:05:02 -04:00
parent 48d9a3182f
commit 39e979fb65
13 changed files with 145 additions and 72 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Assistant/Threads/XMPPClient.hs
View file

@ -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)

86
Assistant/WebApp/Configurators/Pairing.hs
View file

@ -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
- XMPP account. -}
getRunningXMPPPairR :: BuddyKey -> Handler RepHtml
getStartXMPPPairSelfR :: 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
-- A buddy could have logged out, or the XMPP client restarted,
-- and there be no clients to message; handle unforseen by going back.
go _ = redirect StartXMPPPairR
xmppPairStatus True $
if selfpair then Nothing else Just exemplar
go _
{- 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
xmppPairEnd inprogress theirjid = pairPage $ do
xmppPairStatus :: Bool -> Maybe JID -> Handler RepHtml
xmppPairStatus inprogress theirjid = pairPage $ do
let friend = buddyName <$> theirjid
let cloudrepolist = repoListDisplay $ RepoSelector
{ onlyCloud = True

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

@ -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

12
Assistant/WebApp/routes
View file

@ -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/accept/#PairKey ConfirmXMPPPairR GET
/config/repository/pair/xmpp/finish/#PairKey FinishXMPPPairR GET
/config/repository/pair/xmpp/self/start StartXMPPPairSelfR GET
/config/repository/pair/xmpp/self/running RunningXMPPPairSelfR 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

1
debian/changelog vendored
View file

@ -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

33
templates/configurators/addrepository/misc.hamlet
View file

@ -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 #
removable media.
<p>
Add a USB drive, memory stick, or other removable media. #
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.

3
templates/configurators/pairing/xmpp/end.hamlet
View file

@ -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; #
no action is required on your part.
It will be answered automatically by any devices that see it.
$else
Pair request accepted.
<h2>

2
templates/configurators/pairing/xmpp/confirm.hamlet → templates/configurators/pairing/xmpp/friend/confirm.hamlet
View file

@ -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

12
templates/configurators/pairing/xmpp/friend/prompt.hamlet Normal file
View file

@ -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}

11
templates/configurators/pairing/xmpp/prompt.hamlet
View file

@ -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}

18
templates/configurators/pairing/xmpp/self/prompt.hamlet Normal file
View file

@ -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

11
templates/configurators/pairing/xmpp/self/retry.hamlet Normal file
View file

@ -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

22
templates/configurators/xmpp/buddylist.hamlet
View file

@ -7,17 +7,19 @@
$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 away
<span .muted>
#{name}
$if isself buddyid
<i .icon-star></i> #
<span :away:.muted>
your other devices
$else
#{name}
<i .icon-user></i> #
<span :away:.muted>
#{name}
<td>
$if away
<span .muted>
@ -28,7 +30,11 @@
paired
$else
$if canpair
<a .btn .btn-primary .btn-small href="@{RunningXMPPPairR buddyid}">
Start pairing
$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