{- git-annex assistant network connection watcher, using dbus
 -
 - Copyright 2012 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Assistant.Threads.NetWatcher where

import Assistant.Common
import Assistant.ThreadedMonad
import Assistant.DaemonStatus
import Assistant.ScanRemotes
import Assistant.Sync
import qualified Git
import Utility.ThreadScheduler
import Remote.List
import qualified Types.Remote as Remote

import qualified Control.Exception as E

#if WITH_DBUS
import Utility.DBus
import DBus.Client
import DBus
import Data.Word (Word32)
#else
#warning Building without dbus support; will poll for network connection changes
#endif

thisThread :: ThreadName
thisThread = "NetWatcher"

netWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
netWatcherThread st handle scanremotes =
#if WITH_DBUS
	dbusThread st handle scanremotes
#else
	pollingThread st handle scanremotes
#endif

#if WITH_DBUS

dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
dbusThread st dstatus scanremotes = E.catch (go =<< connectSystem) onerr
	where
		go client = ifM (checkNetMonitor client)
			( do
				listenNMConnections client handle
				listenWicdConnections client handle
			, do
				runThreadState st $
					warning "No known network monitor available through dbus; falling back to polling"
				pollinstead
			)
		onerr :: E.SomeException -> IO ()
		onerr e = do
			runThreadState st $
				warning $ "Failed to use dbus; falling back to polling (" ++ show e ++ ")"
			pollinstead
		pollinstead = pollingThread st dstatus scanremotes
		handle = do
			debug thisThread ["detected network connection"]
			handleConnection st dstatus scanremotes

{- Examine the list of services connected to dbus, to see if there
 - are any we can use to monitor network connections. -}
checkNetMonitor :: Client -> IO Bool
checkNetMonitor client = do
	running <- filter (`elem` [networkmanager, wicd])
		<$> listServiceNames client
	case running of
		[] -> return False
		(service:_) -> do
			debug thisThread [ "Using running DBUS service"
				, service
				, "to monitor network connection events."
				]
			return True
	where
		networkmanager = "org.freedesktop.NetworkManager"
		wicd = "org.wicd.daemon"

{- Listens for new NetworkManager connections. -}
listenNMConnections :: Client -> IO () -> IO ()
listenNMConnections client callback =
	listen client matcher $ \event ->
		when (Just True == anyM activeconnection (signalBody event)) $
			callback
	where
		matcher = matchAny
			{ matchInterface = Just "org.freedesktop.NetworkManager.Connection.Active"
			, matchMember = Just "PropertiesChanged"
			}
		nm_connection_activated = toVariant (2 :: Word32)
		nm_state_key = toVariant ("State" :: String)
		activeconnection v = do
			m <- fromVariant v
			vstate <- lookup nm_state_key $ dictionaryItems m
			state <- fromVariant vstate
			return $ state == nm_connection_activated

{- Listens for new Wicd connections. -}
listenWicdConnections :: Client -> IO () -> IO ()
listenWicdConnections client callback =
	listen client matcher $ \event ->
		when (any (== wicd_success) (signalBody event)) $
			callback
	where
		matcher = matchAny
			{ matchInterface = Just "org.wicd.daemon"
			, matchMember = Just "ConnectResultsSent"
			}
		wicd_success = toVariant ("success" :: String)

#endif

pollingThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
pollingThread st dstatus scanremotes = runEvery (Seconds 3600) $
	handleConnection st dstatus scanremotes

handleConnection :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
handleConnection st dstatus scanremotes = do
	syncRemotes thisThread st dstatus scanremotes =<< 
		filter (Git.repoIsUrl . Remote.repo)
			<$> networkRemotes st

{- Finds network remotes. -}
networkRemotes :: ThreadState -> IO [Remote]
networkRemotes st = runThreadState st $ do
	rs <- remoteList
	return $ filter (isNothing . Remote.path) rs