summaryrefslogtreecommitdiff
path: root/Assistant/Threads/ProblemChecker.hs
blob: 1a30a337ee09142b092c41cdd09da9a7b2ad5213 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
{- git-annex assistant thread to handle reported problems with repositories
 -
 - Copyright 2013 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Assistant.Threads.ProblemChecker (
	problemCheckerThread
) where

import Assistant.Common
import Utility.ThreadScheduler
import Assistant.Types.UrlRenderer
import Assistant.Alert
import Remote
import qualified Types.Remote as Remote
import qualified Git.Fsck
import Assistant.Repair
import qualified Git
import Assistant.RepoProblem
import Assistant.Sync
import Annex.UUID

{- Waits for problems with a repo, and tries to fsck the repo and repair
 - the problem. -}
problemCheckerThread :: UrlRenderer -> NamedThread
problemCheckerThread urlrenderer = namedThread "ProblemChecker" $ forever $ do
	mapM_ (handleProblem urlrenderer)
		=<< nub <$> getRepoProblems
	liftIO $ threadDelaySeconds (Seconds 60)

handleProblem :: UrlRenderer -> UUID -> Assistant ()
handleProblem urlrenderer u = ifM ((==) u <$> liftAnnex getUUID)
	( handleLocalRepoProblem urlrenderer
	, maybe noop (handleRemoteProblem urlrenderer)
		=<< liftAnnex (remoteFromUUID u)
	)

handleRemoteProblem :: UrlRenderer -> Remote -> Assistant ()
handleRemoteProblem urlrenderer rmt
	| Git.repoIsLocal r && not (Git.repoIsLocalUnknown r) =
		whenM (liftIO $ checkAvailable True rmt) $ do
			fsckresults <- showFscking urlrenderer (Just $ Remote.name rmt) $ tryNonAsync $
				Git.Fsck.findBroken True r
			whenM (repairWhenNecessary urlrenderer (Remote.uuid rmt) (Just rmt) fsckresults) $
				syncRemote rmt
	| otherwise = noop
  where
	r = Remote.repo rmt

handleLocalRepoProblem :: UrlRenderer -> Assistant ()
handleLocalRepoProblem urlrenderer = error "TODO"