avoid false alert about syncing with xmpp remote
This commit is contained in:
parent
1340b9f493
commit
aaec2cbf03
2 changed files with 16 additions and 15 deletions
|
@ -62,7 +62,7 @@ reconnectRemotes notifypushes rs = void $ do
|
|||
sync (Just branch) = do
|
||||
diverged <- snd <$> manualPull (Just branch) gitremotes
|
||||
now <- liftIO getCurrentTime
|
||||
ok <- pushToRemotes now notifypushes gitremotes
|
||||
ok <- pushToRemotes' now notifypushes gitremotes
|
||||
return (ok, diverged)
|
||||
{- No local branch exists yet, but we can try pulling. -}
|
||||
sync Nothing = do
|
||||
|
@ -97,8 +97,16 @@ reconnectRemotes notifypushes rs = void $ do
|
|||
- reachable. If the fallback fails, the push is queued to be retried
|
||||
- later.
|
||||
-}
|
||||
pushToRemotes :: UTCTime -> Bool -> [Remote] -> Assistant Bool
|
||||
pushToRemotes now notifypushes remotes = do
|
||||
pushToRemotes :: Bool -> [Remote] -> Assistant Bool
|
||||
pushToRemotes notifypushes remotes = do
|
||||
now <- liftIO $ getCurrentTime
|
||||
let nonxmppremotes = snd $ partition isXMPPRemote remotes
|
||||
let go = pushToRemotes' now notifypushes remotes
|
||||
if null nonxmppremotes
|
||||
then go
|
||||
else alertWhile (pushAlert nonxmppremotes) go
|
||||
pushToRemotes' :: UTCTime -> Bool -> [Remote] -> Assistant Bool
|
||||
pushToRemotes' now notifypushes remotes = do
|
||||
(g, branch, u) <- liftAnnex $ do
|
||||
Annex.Branch.commit "update"
|
||||
(,,)
|
||||
|
|
|
@ -17,8 +17,6 @@ import Assistant.Sync
|
|||
import Utility.ThreadScheduler
|
||||
import qualified Types.Remote as Remote
|
||||
|
||||
import Data.Time.Clock
|
||||
|
||||
{- This thread retries pushes that failed before. -}
|
||||
pushRetryThread :: NamedThread
|
||||
pushRetryThread = namedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do
|
||||
|
@ -27,9 +25,8 @@ pushRetryThread = namedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do
|
|||
topush <- getFailedPushesBefore (fromIntegral halfhour)
|
||||
unless (null topush) $ do
|
||||
debug ["retrying", show (length topush), "failed pushes"]
|
||||
void $ alertWhile (pushRetryAlert topush) $ do
|
||||
now <- liftIO $ getCurrentTime
|
||||
pushToRemotes now True topush
|
||||
void $ alertWhile (pushRetryAlert topush) $
|
||||
pushToRemotes True topush
|
||||
where
|
||||
halfhour = 1800
|
||||
|
||||
|
@ -41,13 +38,9 @@ pushThread = namedThread "Pusher" $ runEvery (Seconds 2) <~> do
|
|||
commits <- getCommits
|
||||
-- Now see if now's a good time to push.
|
||||
if shouldPush commits
|
||||
then do
|
||||
remotes <- filter (not . Remote.readonly)
|
||||
. syncGitRemotes <$> getDaemonStatus
|
||||
unless (null remotes) $
|
||||
void $ alertWhile (pushAlert remotes) $ do
|
||||
now <- liftIO $ getCurrentTime
|
||||
pushToRemotes now True remotes
|
||||
then void $ pushToRemotes True
|
||||
=<< filter (not . Remote.readonly) . syncGitRemotes
|
||||
<$> getDaemonStatus
|
||||
else do
|
||||
debug ["delaying push of", show (length commits), "commits"]
|
||||
refillCommits commits
|
||||
|
|
Loading…
Add table
Reference in a new issue