From 098a772918110f2aa9c5f9150dc064c192265d63 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 20 Oct 2012 16:37:06 -0400
Subject: add ConfigMonitor thread

Monitors git-annex branch for changes, which are noticed by the Merger
thread whenever the branch ref is changed (either due to an incoming push,
or a local change), and refreshes cached config values for modified config
files.

Rate limited to run no more often than once per minute. This is important
because frequent git-annex branch changes happen when files are being
added, or transferred, etc.

A primary use case is that, when preferred content changes are made,
and get pushed to remotes, the remotes start honoring those settings.
Other use cases include propigating repository description and trust
changes to remotes, and learning when a remote has added a new special
remote, so the webapp can present the GUI to enable that special remote
locally.

Also added a uuid.log cache. All other config files already had caches.
---
 Assistant/Threads/Merger.hs | 27 +++++++++++++++------------
 1 file changed, 15 insertions(+), 12 deletions(-)

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

diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs
index 46f516262..e415a7562 100644
--- a/Assistant/Threads/Merger.hs
+++ b/Assistant/Threads/Merger.hs
@@ -11,6 +11,7 @@ import Assistant.Common
 import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.TransferQueue
+import Assistant.BranchChange
 import Utility.DirWatcher
 import Utility.Types.DirWatcher
 import qualified Annex.Branch
@@ -23,12 +24,12 @@ thisThread = "Merger"
 
 {- This thread watches for changes to .git/refs/, and handles incoming
  - pushes. -}
-mergeThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> NamedThread
-mergeThread st dstatus transferqueue = thread $ do
+mergeThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> BranchChangeHandle -> NamedThread
+mergeThread st dstatus transferqueue branchchange = thread $ do
 	g <- runThreadState st gitRepo
 	let dir = Git.localGitDir g </> "refs"
 	createDirectoryIfMissing True dir
-	let hook a = Just $ runHandler st dstatus transferqueue a
+	let hook a = Just $ runHandler st dstatus transferqueue branchchange a
 	let hooks = mkWatchHooks
 		{ addHook = hook onAdd
 		, errHook = hook onErr
@@ -38,21 +39,21 @@ mergeThread st dstatus transferqueue = thread $ do
 	where
 		thread = NamedThread thisThread
 
-type Handler = ThreadState -> DaemonStatusHandle -> TransferQueue -> FilePath -> Maybe FileStatus -> IO ()
+type Handler = ThreadState -> DaemonStatusHandle -> TransferQueue -> BranchChangeHandle -> FilePath -> Maybe FileStatus -> IO ()
 
 {- Runs an action handler.
  -
  - Exceptions are ignored, otherwise a whole thread could be crashed.
  -}
-runHandler :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Handler -> FilePath -> Maybe FileStatus -> IO ()
-runHandler st dstatus transferqueue handler file filestatus = void $
+runHandler :: ThreadState -> DaemonStatusHandle -> TransferQueue -> BranchChangeHandle -> Handler -> FilePath -> Maybe FileStatus -> IO ()
+runHandler st dstatus transferqueue branchchange handler file filestatus = void $
         either print (const noop) =<< tryIO go
         where
-                go = handler st dstatus transferqueue file filestatus
+                go = handler st dstatus transferqueue branchchange file filestatus
 
 {- Called when there's an error with inotify. -}
 onErr :: Handler
-onErr _ _ _ msg _ = error msg
+onErr _ _ _ _ msg _ = error msg
 
 {- Called when a new branch ref is written.
  -
@@ -66,11 +67,13 @@ onErr _ _ _ msg _ = error msg
  - ran are merged in.
  -}
 onAdd :: Handler
-onAdd st dstatus transferqueue file _
+onAdd st dstatus transferqueue branchchange file _
 	| ".lock" `isSuffixOf` file = noop
-	| isAnnexBranch file = runThreadState st $
-		whenM Annex.Branch.forceUpdate $
-			queueDeferredDownloads Later transferqueue dstatus
+	| isAnnexBranch file = do
+		branchChanged branchchange
+		runThreadState st $
+			whenM Annex.Branch.forceUpdate $
+				queueDeferredDownloads Later transferqueue dstatus
 	| "/synced/" `isInfixOf` file = runThreadState st $ do
 		mergecurrent =<< inRepo Git.Branch.current
 	| otherwise = noop
-- 
cgit v1.2.3