added push notifier thread, currently a no-op

Hooked up everything that needs to notify on pushes. Note that
syncNewRemote does not notify. This is probably ok, and I'd need to thread
more state through to make it do so.

This is only set up to support a single push notification method; I didn't
use a NotificationBroadcaster. Partly because I don't yet know what info
about pushes needs to be communicated, so my data types are only
preliminary.

4 files changed, 59 insertions, 36 deletions

diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs
index 462f5843c..c36b544a7 100644
--- a/Assistant/Threads/MountWatcher.hs
+++ b/Assistant/Threads/MountWatcher.hs
@@ -15,6 +15,7 @@ import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.ScanRemotes
 import Assistant.Sync
+import Assistant.Pushes
 import qualified Annex
 import qualified Git
 import Utility.ThreadScheduler
@@ -38,20 +39,20 @@ import qualified Control.Exception as E
 thisThread :: ThreadName
 thisThread = "MountWatcher"
 
-mountWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> NamedThread
-mountWatcherThread st handle scanremotes = thread $
+mountWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> NamedThread
+mountWatcherThread st handle scanremotes pushnotifier = thread $
 #if WITH_DBUS
-	dbusThread st handle scanremotes
+	dbusThread st handle scanremotes pushnotifier
 #else
-	pollingThread st handle scanremotes
+	pollingThread st handle scanremotes pushnotifier
 #endif
 	where
 		thread = NamedThread thisThread
 
 #if WITH_DBUS
 
-dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
-dbusThread st dstatus scanremotes = E.catch (go =<< connectSession) onerr
+dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
+dbusThread st dstatus scanremotes pushnotifier = E.catch (go =<< connectSession) onerr
 	where
 		go client = ifM (checkMountMonitor client)
 			( do
@@ -64,7 +65,7 @@ dbusThread st dstatus scanremotes = E.catch (go =<< connectSession) onerr
 					listen client matcher $ \_event -> do
 						nowmounted <- currentMountPoints
 						wasmounted <- swapMVar mvar nowmounted
-						handleMounts st dstatus scanremotes wasmounted nowmounted
+						handleMounts st dstatus scanremotes pushnotifier wasmounted nowmounted
 			, do
 				runThreadState st $
 					warning "No known volume monitor available through dbus; falling back to mtab polling"
@@ -75,7 +76,7 @@ dbusThread st dstatus scanremotes = E.catch (go =<< connectSession) onerr
 			runThreadState st $
 				warning $ "Failed to use dbus; falling back to mtab polling (" ++ show e ++ ")"
 			pollinstead
-		pollinstead = pollingThread st dstatus scanremotes
+		pollinstead = pollingThread st dstatus scanremotes pushnotifier
 
 {- Examine the list of services connected to dbus, to see if there
  - are any we can use to monitor mounts. If not, will attempt to start one. -}
@@ -137,24 +138,24 @@ mountChanged = [gvfs True, gvfs False, kde, kdefallback]
 
 #endif
 
-pollingThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
-pollingThread st dstatus scanremotes = go =<< currentMountPoints
+pollingThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
+pollingThread st dstatus scanremotes pushnotifier = go =<< currentMountPoints
 	where
 		go wasmounted = do
 			threadDelaySeconds (Seconds 10)
 			nowmounted <- currentMountPoints
-			handleMounts st dstatus scanremotes wasmounted nowmounted
+			handleMounts st dstatus scanremotes pushnotifier wasmounted nowmounted
 			go nowmounted
 
-handleMounts :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> MountPoints -> MountPoints -> IO ()
-handleMounts st dstatus scanremotes wasmounted nowmounted =
-	mapM_ (handleMount st dstatus scanremotes . mnt_dir) $
+handleMounts :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> MountPoints -> MountPoints -> IO ()
+handleMounts st dstatus scanremotes pushnotifier wasmounted nowmounted =
+	mapM_ (handleMount st dstatus scanremotes pushnotifier . mnt_dir) $
 		S.toList $ newMountPoints wasmounted nowmounted
 
-handleMount :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> FilePath -> IO ()
-handleMount st dstatus scanremotes dir = do
+handleMount :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> FilePath -> IO ()
+handleMount st dstatus scanremotes pushnotifier dir = do
 	debug thisThread ["detected mount of", dir]
-	reconnectRemotes thisThread st dstatus scanremotes
+	reconnectRemotes thisThread st dstatus scanremotes (Just pushnotifier)
 		=<< filter (Git.repoIsLocal . Remote.repo)
 			<$> remotesUnder st dstatus dir
 
diff --git a/Assistant/Threads/NetWatcher.hs b/Assistant/Threads/NetWatcher.hs
index a8daa9435..2c637f414 100644
--- a/Assistant/Threads/NetWatcher.hs
+++ b/Assistant/Threads/NetWatcher.hs
@@ -15,6 +15,7 @@ import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.ScanRemotes
 import Assistant.Sync
+import Assistant.Pushes
 import Utility.ThreadScheduler
 import Remote.List
 import qualified Types.Remote as Remote
@@ -32,12 +33,12 @@ import qualified Control.Exception as E
 thisThread :: ThreadName
 thisThread = "NetWatcher"
 
-netWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> NamedThread
+netWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> NamedThread
 #if WITH_DBUS
-netWatcherThread st dstatus scanremotes = thread $
-	dbusThread st dstatus scanremotes
+netWatcherThread st dstatus scanremotes pushnotifier = thread $
+	dbusThread st dstatus scanremotes pushnotifier
 #else
-netWatcherThread _ _ _ = thread noop
+netWatcherThread _ _ _ _ = thread noop
 #endif
 	where
 		thread = NamedThread thisThread
@@ -47,17 +48,17 @@ netWatcherThread _ _ _ = thread noop
  - any networked remotes that may have not been routable for a
  - while (despite the local network staying up), are synced with
  - periodically. -}
-netWatcherFallbackThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> NamedThread
-netWatcherFallbackThread st dstatus scanremotes = thread $
+netWatcherFallbackThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> NamedThread
+netWatcherFallbackThread st dstatus scanremotes pushnotifier = thread $
 	runEvery (Seconds 3600) $
-		handleConnection st dstatus scanremotes
+		handleConnection st dstatus scanremotes pushnotifier
 	where
 		thread = NamedThread thisThread
 
 #if WITH_DBUS
 
-dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
-dbusThread st dstatus scanremotes = E.catch (go =<< connectSystem) onerr
+dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
+dbusThread st dstatus scanremotes pushnotifier = E.catch (go =<< connectSystem) onerr
 	where
 		go client = ifM (checkNetMonitor client)
 			( do
@@ -72,7 +73,7 @@ dbusThread st dstatus scanremotes = E.catch (go =<< connectSystem) onerr
 			warning $ "Failed to use dbus; falling back to polling (" ++ show e ++ ")"
 		handle = do
 			debug thisThread ["detected network connection"]
-			handleConnection st dstatus scanremotes
+			handleConnection st dstatus scanremotes pushnotifier
 
 {- Examine the list of services connected to dbus, to see if there
  - are any we can use to monitor network connections. -}
@@ -126,9 +127,9 @@ listenWicdConnections client callback =
 
 #endif
 
-handleConnection :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
-handleConnection st dstatus scanremotes =
-	reconnectRemotes thisThread st dstatus scanremotes
+handleConnection :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
+handleConnection st dstatus scanremotes pushnotifier =
+	reconnectRemotes thisThread st dstatus scanremotes (Just pushnotifier)
 		=<< networkRemotes st
 
 {- Finds network remotes. -}
diff --git a/Assistant/Threads/PushNotifier.hs b/Assistant/Threads/PushNotifier.hs
new file mode 100644
index 000000000..cc5309712
--- /dev/null
+++ b/Assistant/Threads/PushNotifier.hs
@@ -0,0 +1,21 @@
+{- git-annex assistant push notification thread
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Threads.PushNotifier where
+
+import Assistant.Common
+import Assistant.Pushes
+
+thisThread :: ThreadName
+thisThread = "PushNotifier"
+
+pushNotifierThread :: PushNotifier -> NamedThread
+pushNotifierThread pushnotifier = thread $ forever $ do
+	waitPush pushnotifier
+	-- TODO
+	where
+		thread = NamedThread thisThread
diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs
index 4f3a2dd09..295ceddc9 100644
--- a/Assistant/Threads/Pusher.hs
+++ b/Assistant/Threads/Pusher.hs
@@ -24,8 +24,8 @@ thisThread :: ThreadName
 thisThread = "Pusher"
 
 {- This thread retries pushes that failed before. -}
-pushRetryThread :: ThreadState -> DaemonStatusHandle -> FailedPushMap -> NamedThread
-pushRetryThread st dstatus pushmap = thread $ runEvery (Seconds halfhour) $ do
+pushRetryThread :: ThreadState -> DaemonStatusHandle -> FailedPushMap -> PushNotifier -> NamedThread
+pushRetryThread st dstatus pushmap pushnotifier = thread $ runEvery (Seconds halfhour) $ do
 	-- We already waited half an hour, now wait until there are failed
 	-- pushes to retry.
 	topush <- getFailedPushesBefore pushmap (fromIntegral halfhour)
@@ -37,14 +37,14 @@ pushRetryThread st dstatus pushmap = thread $ runEvery (Seconds halfhour) $ do
 			]
 		now <- getCurrentTime
 		void $ alertWhile dstatus (pushRetryAlert topush) $
-			pushToRemotes thisThread now st (Just pushmap) topush
+			pushToRemotes thisThread now st (Just pushnotifier) (Just pushmap) topush
 	where
 		halfhour = 1800
 		thread = NamedThread thisThread
 
 {- This thread pushes git commits out to remotes soon after they are made. -}
-pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> NamedThread
-pushThread st dstatus commitchan pushmap = thread $ runEvery (Seconds 2) $ do
+pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> PushNotifier -> NamedThread
+pushThread st dstatus commitchan pushmap pushnotifier = thread $ runEvery (Seconds 2) $ do
 	-- We already waited two seconds as a simple rate limiter.
 	-- Next, wait until at least one commit has been made
 	commits <- getCommits commitchan
@@ -56,7 +56,7 @@ pushThread st dstatus commitchan pushmap = thread $ runEvery (Seconds 2) $ do
 				<$> getDaemonStatus dstatus
 			unless (null remotes) $ 
 				void $ alertWhile dstatus (pushAlert remotes) $
-					pushToRemotes thisThread now st (Just pushmap) remotes
+					pushToRemotes thisThread now st (Just pushnotifier) (Just pushmap) remotes
 		else do
 			debug thisThread
 				[ "delaying push of"