From 2db78797ee58e53f06bd2d104fb203c45247e7c0 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 29 Oct 2013 13:41:44 -0400
Subject: move code around and rename thread; no functional changes

---
 Assistant/Threads/ProblemChecker.hs | 53 +++++++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)
 create mode 100644 Assistant/Threads/ProblemChecker.hs

(limited to 'Assistant/Threads/ProblemChecker.hs')

diff --git a/Assistant/Threads/ProblemChecker.hs b/Assistant/Threads/ProblemChecker.hs
new file mode 100644
index 000000000..1a30a337e
--- /dev/null
+++ b/Assistant/Threads/ProblemChecker.hs
@@ -0,0 +1,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"
-- 
cgit v1.2.3