diff options
author | 2013-03-15 17:52:41 -0400 | |
---|---|---|
committer | 2013-03-15 17:52:41 -0400 | |
commit | 77e43ec65fff0aaaa1e08caffeb654971aee0b36 (patch) | |
tree | 4f09745fe8b3433293dd78eb74c5abf9f3154e10 | |
parent | e41db4a717f8e92c2c33704196f43224ae6a5ec8 (diff) |
webapp: Display an alert when there are XMPP remotes, and a cloud transfer repository needs to be configured.
-rw-r--r-- | Assistant/Alert.hs | 19 | ||||
-rw-r--r-- | Assistant/DaemonStatus.hs | 8 | ||||
-rw-r--r-- | Assistant/Threads/XMPPClient.hs | 2 | ||||
-rw-r--r-- | Assistant/Types/DaemonStatus.hs | 3 | ||||
-rw-r--r-- | Assistant/XMPP/Git.hs | 46 | ||||
-rw-r--r-- | debian/changelog | 2 | ||||
-rw-r--r-- | doc/assistant/cloudnudge.png | bin | 0 -> 7332 bytes |
7 files changed, 63 insertions, 17 deletions
diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs index 65f8c3e67..40c37a94a 100644 --- a/Assistant/Alert.hs +++ b/Assistant/Alert.hs @@ -34,6 +34,7 @@ data AlertName | WarningAlert String | PairAlert String | XMPPNeededAlert + | CloudRepoNeededAlert deriving (Eq) {- The first alert is the new alert, the second is an old alert. @@ -333,6 +334,24 @@ xmppNeededAlert button = Alert , alertData = [] } +cloudRepoNeededAlert :: Maybe String -> AlertButton -> Alert +cloudRepoNeededAlert friendname button = Alert + { alertHeader = Just $ fromString $ unwords + [ "Unable to download files from" + , (fromMaybe "your other devices" friendname) ++ "." + ] + , alertIcon = Just ErrorIcon + , alertPriority = High + , alertButton = Just button + , alertClosable = True + , alertClass = Message + , alertMessageRender = tenseWords + , alertBlockDisplay = True + , alertName = Just $ CloudRepoNeededAlert + , alertCombiner = Just $ dataCombiner $ \_old new -> new + , alertData = [] + } + fileAlert :: TenseChunk -> FilePath -> Alert fileAlert msg file = (activityAlert Nothing [f]) { alertName = Just $ FileAlert msg diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index ea57176b5..fcfb1a4f3 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -51,10 +51,14 @@ calcSyncRemotes = do alive <- trustExclude DeadTrusted (map Remote.uuid rs) let good r = Remote.uuid r `elem` alive let syncable = filter good rs + let nonxmpp = filter (not . isXMPPRemote) syncable return $ \dstatus -> dstatus { syncRemotes = syncable - , syncGitRemotes = filter (not . Remote.specialRemote) syncable - , syncDataRemotes = filter (not . isXMPPRemote) syncable + , syncGitRemotes = + filter (not . Remote.specialRemote) syncable + , syncDataRemotes = nonxmpp + , syncingToCloudRemote = + any (Git.repoIsUrl . Remote.repo) nonxmpp } {- Updates the sycRemotes list from the list of all remotes in Annex state. -} diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index fb7da10c7..69a886c4a 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -111,7 +111,7 @@ xmppClient urlrenderer d creds = handle _ (GotNetMessage m@(Pushing _ pushstage)) | isPushInitiation pushstage = inAssistant $ unlessM (queueNetPushMessage m) $ - void $ forkIO <~> handlePushInitiation m + void $ forkIO <~> handlePushInitiation urlrenderer m | otherwise = void $ inAssistant $ queueNetPushMessage m handle _ (Ignorable _) = noop handle _ (Unknown _) = noop diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs index df95b23c0..0fc800a37 100644 --- a/Assistant/Types/DaemonStatus.hs +++ b/Assistant/Types/DaemonStatus.hs @@ -46,6 +46,8 @@ data DaemonStatus = DaemonStatus , syncGitRemotes :: [Remote] -- Ordered list of remotes to sync data with , syncDataRemotes :: [Remote] + -- Are we syncing to any cloud remotes? + , syncingToCloudRemote :: Bool -- List of uuids of remotes that we may have gotten out of sync with. , desynced :: S.Set UUID -- Pairing request that is in progress. @@ -81,6 +83,7 @@ newDaemonStatus = DaemonStatus <*> pure [] <*> pure [] <*> pure [] + <*> pure False <*> pure S.empty <*> pure Nothing <*> newNotificationBroadcaster diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index a088f459e..74ce4b725 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Assistant.XMPP.Git where import Assistant.Common @@ -29,6 +31,10 @@ import qualified Remote as Remote import Remote.List import Utility.FileMode import Utility.Shell +#ifdef WITH_WEBAPP +import Assistant.WebApp (UrlRenderer) +import Assistant.WebApp.Configurators.XMPP +#endif import Network.Protocol.XMPP import qualified Data.Text as T @@ -80,8 +86,8 @@ makeXMPPGitRemote buddyname jid u = do - - We listen at the other end of the pipe and relay to and from XMPP. -} -xmppPush :: ClientID -> (Git.Repo -> IO Bool) -> Assistant Bool -xmppPush cid gitpush = runPush SendPack cid handleDeferred $ do +xmppPush :: ClientID -> (Git.Repo -> IO Bool) -> (NetMessage -> Assistant ()) -> Assistant Bool +xmppPush cid gitpush handledeferred = runPush SendPack cid handledeferred $ do sendNetMessage $ Pushing cid StartingPush (Fd inf, writepush) <- liftIO createPipe @@ -201,8 +207,8 @@ xmppGitRelay = do {- Relays git receive-pack stdin and stdout via XMPP, as well as propigating - its exit status to XMPP. -} -xmppReceivePack :: ClientID -> Assistant Bool -xmppReceivePack cid = runPush ReceivePack cid handleDeferred $ do +xmppReceivePack :: ClientID -> (NetMessage -> Assistant ()) -> Assistant Bool +xmppReceivePack cid handledeferred = runPush ReceivePack cid handledeferred $ do repodir <- liftAnnex $ fromRepo repoPath let p = (proc "git" ["receive-pack", repodir]) { std_in = CreatePipe @@ -250,11 +256,11 @@ xmppRemotes cid = case baseJID <$> parseJID cid of where matching loc r = repoIsUrl r && repoLocation r == loc -handlePushInitiation :: NetMessage -> Assistant () -handlePushInitiation (Pushing cid CanPush) = +handlePushInitiation :: UrlRenderer -> NetMessage -> Assistant () +handlePushInitiation _ (Pushing cid CanPush) = unlessM (null <$> xmppRemotes cid) $ sendNetMessage $ Pushing cid PushRequest -handlePushInitiation (Pushing cid PushRequest) = +handlePushInitiation urlrenderer (Pushing cid PushRequest) = go =<< liftAnnex (inRepo Git.Branch.current) where go Nothing = noop @@ -266,18 +272,30 @@ handlePushInitiation (Pushing cid PushRequest) = <*> getUUID liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) g selfjid <- ((T.unpack <$>) . xmppClientID) <$> getDaemonStatus - forM_ rs $ \r -> alertWhile (syncAlert [r]) $ - xmppPush cid $ taggedPush u selfjid branch r -handlePushInitiation (Pushing cid StartingPush) = do + forM_ rs $ \r -> do + void $ alertWhile (syncAlert [r]) $ + xmppPush cid + (taggedPush u selfjid branch r) + (handleDeferred urlrenderer) + checkCloudRepos urlrenderer r +handlePushInitiation urlrenderer (Pushing cid StartingPush) = do rs <- xmppRemotes cid - unless (null rs) $ + unless (null rs) $ do void $ alertWhile (syncAlert rs) $ - xmppReceivePack cid -handlePushInitiation _ = noop + xmppReceivePack cid (handleDeferred urlrenderer) + mapM_ (checkCloudRepos urlrenderer) rs +handlePushInitiation _ _ = noop -handleDeferred :: NetMessage -> Assistant () +handleDeferred :: UrlRenderer -> NetMessage -> Assistant () handleDeferred = handlePushInitiation +checkCloudRepos :: UrlRenderer -> Remote -> Assistant () +-- TODO only display if needed +checkCloudRepos urlrenderer r = +#ifdef WITH_WEBAPP + cloudRepoNeeded urlrenderer (Remote.uuid r) +#endif + writeChunk :: Handle -> B.ByteString -> IO () writeChunk h b = do B.hPut h b diff --git a/debian/changelog b/debian/changelog index 176234e86..2300de0d6 100644 --- a/debian/changelog +++ b/debian/changelog @@ -3,6 +3,8 @@ 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. + * webapp: Display an alert when there are XMPP remotes, and a cloud + transfer repository needs to be configured. -- Joey Hess <joeyh@debian.org> Fri, 15 Mar 2013 00:10:07 -0400 diff --git a/doc/assistant/cloudnudge.png b/doc/assistant/cloudnudge.png Binary files differnew file mode 100644 index 000000000..b6f9a657e --- /dev/null +++ b/doc/assistant/cloudnudge.png |