diff options
| -rw-r--r-- | Assistant/Sync.hs | 10 | ||||
| -rw-r--r-- | Assistant/Threads/PushNotifier.hs | 32 | ||||
| -rw-r--r-- | doc/design/assistant/cloud.mdwn | 7 |
3 files changed, 39 insertions, 10 deletions
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index f9a513d94..e332d7856 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -48,13 +48,13 @@ reconnectRemotes threadname st dstatus scanremotes pushnotifier rs = void $ (gitremotes, _specialremotes) = partition (Git.repoIsUrl . Remote.repo) rs sync (Just branch) = do - diverged <- manualPull st (Just branch) gitremotes + diverged <- snd <$> manualPull st (Just branch) gitremotes now <- getCurrentTime ok <- pushToRemotes threadname now st pushnotifier Nothing gitremotes return (ok, diverged) {- No local branch exists yet, but we can try pulling. -} sync Nothing = do - diverged <- manualPull st Nothing gitremotes + diverged <- snd <$> manualPull st Nothing gitremotes return (True, diverged) {- Updates the local sync branch, then pushes it to all remotes, in @@ -147,15 +147,15 @@ pushToRemotes threadname now st mpushnotifier mpushmap remotes = do where s = show $ Git.Ref.base b {- Manually pull from remotes and merge their branches. -} -manualPull :: ThreadState -> Maybe Git.Ref -> [Remote] -> IO Bool +manualPull :: ThreadState -> Maybe Git.Ref -> [Remote] -> IO ([Bool], Bool) manualPull st currentbranch remotes = do g <- runThreadState st gitRepo - forM_ remotes $ \r -> + results <- forM remotes $ \r -> Git.Command.runBool "fetch" [Param $ Remote.name r] g haddiverged <- runThreadState st Annex.Branch.forceUpdate forM_ remotes $ \r -> runThreadState st $ Command.Sync.mergeRemote r currentbranch - return haddiverged + return (results, haddiverged) {- Start syncing a newly added remote, using a background thread. -} syncNewRemote :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> Remote -> IO () diff --git a/Assistant/Threads/PushNotifier.hs b/Assistant/Threads/PushNotifier.hs index 12cbb3206..8d761dc55 100644 --- a/Assistant/Threads/PushNotifier.hs +++ b/Assistant/Threads/PushNotifier.hs @@ -14,6 +14,7 @@ import Assistant.Common import Assistant.ThreadedMonad import Assistant.DaemonStatus import Assistant.Pushes +import Assistant.Sync import qualified Remote import Network.Protocol.XMPP @@ -22,6 +23,7 @@ import Control.Concurrent import qualified Data.Text as T import qualified Data.Set as S import Utility.FileMode +import qualified Git.Branch thisThread :: ThreadName thisThread = "PushNotifier" @@ -62,7 +64,7 @@ pushNotifierThread st dstatus pushnotifier = NamedThread thisThread $ do s <- getStanza case s of ReceivedPresence (Presence { presenceType = PresenceAvailable, presenceID = Just t }) -> - maybe noop (liftIO . pull dstatus) + maybe noop (liftIO . pull st dstatus) (decodePushNotification t) _ -> noop @@ -118,11 +120,31 @@ decodePushNotification :: T.Text -> Maybe [UUID] decodePushNotification t = map (toUUID . T.unpack) . T.splitOn delim <$> T.stripPrefix prefix t -pull :: DaemonStatusHandle -> [UUID] -> IO () -pull _ [] = noop -pull dstatus us = do +{- We only pull from one remote out of the set listed in the push + - notification, as an optimisation. + - + - Note that it might be possible (though very unlikely) for the push + - notification to take a while to be sent, and multiple pushes happen + - before it is sent, so it includes multiple remotes that were pushed + - to at different times. + - + - It could then be the case that the remote we choose had the earlier + - push sent to it, but then failed to get the later push, and so is not + - fully up-to-date. If that happens, the pushRetryThread will come along + - and retry the push, and we'll get another notification once it succeeds, + - and pull again. -} +pull :: ThreadState -> DaemonStatusHandle -> [UUID] -> IO () +pull _ _ [] = noop +pull st dstatus us = do rs <- filter matching . syncRemotes <$> getDaemonStatus dstatus - print ("TODO pull from", rs) + debug thisThread $ "push notification for" : + map (fromUUID . Remote.uuid ) rs + pullone rs =<< runThreadState st (inRepo Git.Branch.current) where matching r = Remote.uuid r `S.member` s s = S.fromList us + + pullone [] _ = noop + pullone (r:rs) branch = + unlessM (all id . fst <$> manualPull st branch [r]) $ + pullone rs branch diff --git a/doc/design/assistant/cloud.mdwn b/doc/design/assistant/cloud.mdwn index b815c5d2d..264011de4 100644 --- a/doc/design/assistant/cloud.mdwn +++ b/doc/design/assistant/cloud.mdwn @@ -52,6 +52,13 @@ the assistant will transfer the file from the cloud to Bob. * Make the git-annex clients invisible, so a user can use their regular account without always seeming to be present when git-annex is logged in. See <http://xmpp.org/extensions/xep-0126.html> +* webapp configuration +* After pulling from a remote, may need to scan for transfers, which + could involve other remotes (ie, S3). Since the remote client is not able to + talk to us directly, it won't be able to upload any new files to us. + Need a fast way to find new files, and get them transferring. The expensive + transfer scan may be needed to get fully in sync, but is too expensive to + run every time this happens. ### jabber security |