diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index 9ec60c25e4..48f805655d 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -59,11 +59,11 @@ import Control.Concurrent.Async reconnectRemotes :: [Remote] -> Assistant () reconnectRemotes [] = recordExportCommit reconnectRemotes rs = void $ do - rs' <- liftIO $ filterM (Remote.checkAvailable True) rs + rs' <- liftAnnex $ filterM (Remote.checkAvailable True) rs unless (null rs') $ do failedrs <- syncAction rs' (const go) forM_ failedrs $ \r -> - whenM (liftIO $ Remote.checkAvailable False r) $ + whenM (liftAnnex $ Remote.checkAvailable False r) $ repoHasProblem (Remote.uuid r) (syncRemote r) mapM_ signal $ filter (`notElem` failedrs) rs' recordExportCommit diff --git a/Assistant/Threads/Exporter.hs b/Assistant/Threads/Exporter.hs index b5344304e9..20a252baff 100644 --- a/Assistant/Threads/Exporter.hs +++ b/Assistant/Threads/Exporter.hs @@ -51,7 +51,7 @@ exportThread = namedThread "Exporter" $ runEvery (Seconds 30) <~> do - to avoid ugly messages when a removable drive is not attached. -} exportTargets :: Assistant [Remote] -exportTargets = liftIO . filterM (Remote.checkAvailable True) +exportTargets = liftAnnex . filterM (Remote.checkAvailable True) =<< candidates <$> getDaemonStatus where candidates = filter (not . Remote.readonly) . exportRemotes diff --git a/Assistant/Threads/ProblemFixer.hs b/Assistant/Threads/ProblemFixer.hs index 0c29044dec..2b5829037f 100644 --- a/Assistant/Threads/ProblemFixer.hs +++ b/Assistant/Threads/ProblemFixer.hs @@ -56,7 +56,7 @@ handleRemoteProblem urlrenderer rmt = do handleRemoteProblem' :: Git.Repo -> UrlRenderer -> Remote -> Assistant Bool handleRemoteProblem' repo urlrenderer rmt | Git.repoIsLocal repo && not (Git.repoIsLocalUnknown repo) = - ifM (liftIO $ checkAvailable True rmt) + ifM (liftAnnex $ checkAvailable True rmt) ( do fixedlocks <- repairStaleGitLocks repo fsckresults <- showFscking urlrenderer (Just rmt) $ tryNonAsync $ diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index b4cca60d4c..3d7b6345c0 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -44,7 +44,7 @@ pushThread = namedThread "Pusher" $ runEvery (Seconds 2) <~> do - to avoid ugly messages when a removable drive is not attached. -} pushTargets :: Assistant [Remote] -pushTargets = liftIO . filterM (Remote.checkAvailable True) +pushTargets = liftAnnex . filterM (Remote.checkAvailable True) =<< candidates <$> getDaemonStatus where candidates = filter (not . Remote.readonly) . syncGitRemotes diff --git a/Remote.hs b/Remote.hs index c9d9be0827..93b2e30f87 100644 --- a/Remote.hs +++ b/Remote.hs @@ -411,9 +411,12 @@ byCost = map snd . sortBy (comparing fst) . M.toList . costmap costmap = M.fromListWith (++) . map costpair costpair r = (cost r, [r]) -checkAvailable :: Bool -> Remote -> IO Bool -checkAvailable assumenetworkavailable = - maybe (return assumenetworkavailable) doesDirectoryExist . localpath +checkAvailable :: Bool -> Remote -> Annex Bool +checkAvailable assumenetworkavailable r = tryNonAsync (availability r) >>= \case + Left _e -> return assumenetworkavailable + Right LocallyAvailable -> return True + Right GloballyAvailable -> return assumenetworkavailable + Right Unavailable -> return False hasKey :: Remote -> Key -> Annex (Either String Bool) hasKey r k = either (Left . show) Right <$> tryNonAsync (checkPresent r k)