{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
module StatusNotifier.Watcher.Service where

import           Control.Arrow
import           Control.Concurrent.MVar
import           Control.Monad
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           DBus
import           DBus.Client
import           DBus.Generation
import           DBus.Internal.Message as M
import           DBus.Internal.Types
import qualified DBus.Internal.Types as T
import qualified DBus.Introspection as I
import qualified DBus.TH as DBusTH
import           Data.Coerce
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.String
import qualified StatusNotifier.Item.Client as Item
import           StatusNotifier.Util
import           StatusNotifier.Watcher.Constants
import           StatusNotifier.Watcher.Signals
import           System.IO.Unsafe
import           System.Log.Logger
import           Text.Printf

buildWatcher :: WatcherParams -> IO (Interface, IO RequestNameReply)
buildWatcher WatcherParams
               { watcherNamespace :: WatcherParams -> String
watcherNamespace = String
interfaceNamespace
               , watcherStop :: WatcherParams -> IO ()
watcherStop = IO ()
stopWatcher
               , watcherPath :: WatcherParams -> String
watcherPath = String
path
               , watcherDBusClient :: WatcherParams -> Maybe Client
watcherDBusClient = Maybe Client
mclient
               } = do
  let watcherInterfaceName :: InterfaceName
watcherInterfaceName = String -> InterfaceName
getWatcherInterfaceName String
interfaceNamespace
      logNamespace :: String
logNamespace = String
"StatusNotifier.Watcher.Service"
      log :: String -> IO ()
log = String -> Priority -> String -> IO ()
logM String
logNamespace  Priority
INFO
      logError :: String -> IO ()
logError = String -> Priority -> String -> IO ()
logM String
logNamespace Priority
ERROR
      mkLogCb :: (t -> t IO b) -> t -> t IO b
mkLogCb t -> t IO b
cb t
msg = IO () -> t IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> IO ()
log (t -> String
forall a. Show a => a -> String
show t
msg)) t IO () -> t IO b -> t IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> t IO b
cb t
msg
      mkLogMethod :: Method -> Method
mkLogMethod Method
method = Method
method { methodHandler :: MethodCall -> DBusR Reply
methodHandler = (MethodCall -> DBusR Reply) -> MethodCall -> DBusR Reply
forall (t :: (* -> *) -> * -> *) t b.
(Monad (t IO), MonadTrans t, Show t) =>
(t -> t IO b) -> t -> t IO b
mkLogCb ((MethodCall -> DBusR Reply) -> MethodCall -> DBusR Reply)
-> (MethodCall -> DBusR Reply) -> MethodCall -> DBusR Reply
forall a b. (a -> b) -> a -> b
$ Method -> MethodCall -> DBusR Reply
methodHandler Method
method }
      mkLogProperty :: MemberName -> IO v -> Property
mkLogProperty MemberName
name IO v
fn =
        MemberName -> IO v -> Property
forall v. IsValue v => MemberName -> IO v -> Property
readOnlyProperty MemberName
name (IO v -> Property) -> IO v -> Property
forall a b. (a -> b) -> a -> b
$ String -> IO ()
log (MemberName -> String
coerce MemberName
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Called") IO () -> IO v -> IO v
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO v
fn

  Client
client <- IO Client -> (Client -> IO Client) -> Maybe Client -> IO Client
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Client
connectSession Client -> IO Client
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Client
mclient

  MVar [ItemEntry]
notifierItems <- [ItemEntry] -> IO (MVar [ItemEntry])
forall a. a -> IO (MVar a)
newMVar []
  MVar [ItemEntry]
notifierHosts <- [ItemEntry] -> IO (MVar [ItemEntry])
forall a. a -> IO (MVar a)
newMVar []

  let itemIsRegistered :: a -> t a -> Bool
itemIsRegistered a
item t a
items =
        Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> t a -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
item) t a
items

      registerStatusNotifierItem :: MethodCall -> String -> IO (Either Reply ())
registerStatusNotifierItem MethodCall
                                   { methodCallSender :: MethodCall -> Maybe BusName
methodCallSender = Maybe BusName
sender }
                                 String
name = ExceptT Reply IO () -> IO (Either Reply ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Reply IO () -> IO (Either Reply ()))
-> ExceptT Reply IO () -> IO (Either Reply ())
forall a b. (a -> b) -> a -> b
$ do
        let maybeBusName :: Maybe BusName
maybeBusName = First BusName -> Maybe BusName
forall a. First a -> Maybe a
getFirst (First BusName -> Maybe BusName) -> First BusName -> Maybe BusName
forall a b. (a -> b) -> a -> b
$ [First BusName] -> First BusName
forall a. Monoid a => [a] -> a
mconcat ([First BusName] -> First BusName)
-> [First BusName] -> First BusName
forall a b. (a -> b) -> a -> b
$
                           (Maybe BusName -> First BusName)
-> [Maybe BusName] -> [First BusName]
forall a b. (a -> b) -> [a] -> [b]
map Maybe BusName -> First BusName
forall a. Maybe a -> First a
First [String -> Maybe BusName
forall (m :: * -> *). MonadThrow m => String -> m BusName
T.parseBusName String
name, Maybe BusName
sender]
            parseServiceError :: Reply
parseServiceError = ErrorName -> String -> Reply
makeErrorReply ErrorName
errorInvalidParameters (String -> Reply) -> String -> Reply
forall a b. (a -> b) -> a -> b
$
              String -> String -> String
forall r. PrintfType r => String -> r
printf String
"the provided service %s could not be parsed \
                     \as a bus name or an object path." String
name
            path :: ObjectPath
path = ObjectPath -> Maybe ObjectPath -> ObjectPath
forall a. a -> Maybe a -> a
fromMaybe ObjectPath
Item.defaultPath (Maybe ObjectPath -> ObjectPath) -> Maybe ObjectPath -> ObjectPath
forall a b. (a -> b) -> a -> b
$ String -> Maybe ObjectPath
forall (m :: * -> *). MonadThrow m => String -> m ObjectPath
T.parseObjectPath String
name
            remapErrorName :: Either MethodError d -> Either Reply d
remapErrorName =
              (MethodError -> Reply) -> Either MethodError d -> Either Reply d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ((MethodError -> Reply) -> Either MethodError d -> Either Reply d)
-> (MethodError -> Reply) -> Either MethodError d -> Either Reply d
forall a b. (a -> b) -> a -> b
$ (ErrorName -> String -> Reply
`makeErrorReply` String
"Failed to verify ownership.") (ErrorName -> Reply)
-> (MethodError -> ErrorName) -> MethodError -> Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   MethodError -> ErrorName
M.methodErrorName
        BusName
busName <- IO (Either Reply BusName) -> ExceptT Reply IO BusName
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Reply BusName) -> ExceptT Reply IO BusName)
-> IO (Either Reply BusName) -> ExceptT Reply IO BusName
forall a b. (a -> b) -> a -> b
$ Either Reply BusName -> IO (Either Reply BusName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Reply BusName -> IO (Either Reply BusName))
-> Either Reply BusName -> IO (Either Reply BusName)
forall a b. (a -> b) -> a -> b
$ Reply -> Maybe BusName -> Either Reply BusName
forall b a. b -> Maybe a -> Either b a
maybeToEither Reply
parseServiceError Maybe BusName
maybeBusName
        let item :: ItemEntry
item = ItemEntry :: BusName -> ObjectPath -> ItemEntry
ItemEntry { serviceName :: BusName
serviceName = BusName
busName
                             , servicePath :: ObjectPath
servicePath = ObjectPath
path
                             }
        Bool
hasOwner <- IO (Either Reply Bool) -> ExceptT Reply IO Bool
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Reply Bool) -> ExceptT Reply IO Bool)
-> IO (Either Reply Bool) -> ExceptT Reply IO Bool
forall a b. (a -> b) -> a -> b
$ Either MethodError Bool -> Either Reply Bool
forall d. Either MethodError d -> Either Reply d
remapErrorName (Either MethodError Bool -> Either Reply Bool)
-> IO (Either MethodError Bool) -> IO (Either Reply Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    Client -> String -> IO (Either MethodError Bool)
DBusTH.nameHasOwner Client
client (BusName -> String
coerce BusName
busName)
        IO () -> ExceptT Reply IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ExceptT Reply IO ()) -> IO () -> ExceptT Reply IO ()
forall a b. (a -> b) -> a -> b
$ MVar [ItemEntry] -> ([ItemEntry] -> IO [ItemEntry]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [ItemEntry]
notifierItems (([ItemEntry] -> IO [ItemEntry]) -> IO ())
-> ([ItemEntry] -> IO [ItemEntry]) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[ItemEntry]
currentItems ->
          if ItemEntry -> [ItemEntry] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
itemIsRegistered ItemEntry
item [ItemEntry]
currentItems
          then
            [ItemEntry] -> IO [ItemEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return [ItemEntry]
currentItems
          else
            do
              Client -> String -> IO ()
emitStatusNotifierItemRegistered Client
client (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ BusName -> String
coerce BusName
busName
              [ItemEntry] -> IO [ItemEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ItemEntry] -> IO [ItemEntry]) -> [ItemEntry] -> IO [ItemEntry]
forall a b. (a -> b) -> a -> b
$ ItemEntry
item ItemEntry -> [ItemEntry] -> [ItemEntry]
forall a. a -> [a] -> [a]
: [ItemEntry]
currentItems

      registerStatusNotifierHost :: String -> IO ()
registerStatusNotifierHost String
name =
        let item :: ItemEntry
item = ItemEntry :: BusName -> ObjectPath -> ItemEntry
ItemEntry { serviceName :: BusName
serviceName = String -> BusName
busName_ String
name
                             , servicePath :: ObjectPath
servicePath = ObjectPath
"/StatusNotifierHost"
                             } in
        MVar [ItemEntry] -> ([ItemEntry] -> IO [ItemEntry]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [ItemEntry]
notifierHosts (([ItemEntry] -> IO [ItemEntry]) -> IO ())
-> ([ItemEntry] -> IO [ItemEntry]) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[ItemEntry]
currentHosts ->
          if ItemEntry -> [ItemEntry] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
itemIsRegistered ItemEntry
item [ItemEntry]
currentHosts
          then
            [ItemEntry] -> IO [ItemEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return [ItemEntry]
currentHosts
          else
            do
              Client -> IO ()
emitStatusNotifierHostRegistered Client
client
              [ItemEntry] -> IO [ItemEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ItemEntry] -> IO [ItemEntry]) -> [ItemEntry] -> IO [ItemEntry]
forall a b. (a -> b) -> a -> b
$ ItemEntry
item ItemEntry -> [ItemEntry] -> [ItemEntry]
forall a. a -> [a] -> [a]
: [ItemEntry]
currentHosts

      registeredStatusNotifierItems :: IO [String]
      registeredStatusNotifierItems :: IO [String]
registeredStatusNotifierItems =
        (ItemEntry -> String) -> [ItemEntry] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (BusName -> String
coerce (BusName -> String)
-> (ItemEntry -> BusName) -> ItemEntry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemEntry -> BusName
serviceName) ([ItemEntry] -> [String]) -> IO [ItemEntry] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar [ItemEntry] -> IO [ItemEntry]
forall a. MVar a -> IO a
readMVar MVar [ItemEntry]
notifierItems

      registeredSNIEntries :: IO [(String, String)]
      registeredSNIEntries :: IO [(String, String)]
registeredSNIEntries =
        (ItemEntry -> (String, String))
-> [ItemEntry] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ItemEntry -> (String, String)
forall a b.
(Coercible a String, Coercible b String) =>
ItemEntry -> (a, b)
getTuple ([ItemEntry] -> [(String, String)])
-> IO [ItemEntry] -> IO [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar [ItemEntry] -> IO [ItemEntry]
forall a. MVar a -> IO a
readMVar MVar [ItemEntry]
notifierItems
          where getTuple :: ItemEntry -> (a, b)
getTuple (ItemEntry BusName
bname ObjectPath
path) = (BusName -> a
coerce BusName
bname, ObjectPath -> b
coerce ObjectPath
path)

      objectPathForItem :: String -> IO (Either Reply String)
      objectPathForItem :: String -> IO (Either Reply String)
objectPathForItem String
name =
        Reply -> Maybe String -> Either Reply String
forall b a. b -> Maybe a -> Either b a
maybeToEither Reply
notFoundError (Maybe String -> Either Reply String)
-> ([ItemEntry] -> Maybe String)
-> [ItemEntry]
-> Either Reply String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (ItemEntry -> String) -> Maybe ItemEntry -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ObjectPath -> String
coerce (ObjectPath -> String)
-> (ItemEntry -> ObjectPath) -> ItemEntry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemEntry -> ObjectPath
servicePath) (Maybe ItemEntry -> Maybe String)
-> ([ItemEntry] -> Maybe ItemEntry) -> [ItemEntry] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      (ItemEntry -> Bool) -> [ItemEntry] -> Maybe ItemEntry
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((BusName -> BusName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> BusName
busName_ String
name) (BusName -> Bool) -> (ItemEntry -> BusName) -> ItemEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemEntry -> BusName
serviceName) ([ItemEntry] -> Either Reply String)
-> IO [ItemEntry] -> IO (Either Reply String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                      MVar [ItemEntry] -> IO [ItemEntry]
forall a. MVar a -> IO a
readMVar MVar [ItemEntry]
notifierItems
        where notFoundError :: Reply
notFoundError =
                ErrorName -> String -> Reply
makeErrorReply ErrorName
errorInvalidParameters (String -> Reply) -> String -> Reply
forall a b. (a -> b) -> a -> b
$
                String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Service %s is not registered." String
name

      isStatusNotifierHostRegistered :: IO Bool
isStatusNotifierHostRegistered = Bool -> Bool
not (Bool -> Bool) -> ([ItemEntry] -> Bool) -> [ItemEntry] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ItemEntry] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ItemEntry] -> Bool) -> IO [ItemEntry] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar [ItemEntry] -> IO [ItemEntry]
forall a. MVar a -> IO a
readMVar MVar [ItemEntry]
notifierHosts

      protocolVersion :: IO Int32
protocolVersion = Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0 :: IO Int32

      filterDeadService :: String -> MVar [ItemEntry] -> IO [ItemEntry]
      filterDeadService :: String -> MVar [ItemEntry] -> IO [ItemEntry]
filterDeadService String
deadService MVar [ItemEntry]
mvar = MVar [ItemEntry]
-> ([ItemEntry] -> IO ([ItemEntry], [ItemEntry])) -> IO [ItemEntry]
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar [ItemEntry]
mvar (([ItemEntry] -> IO ([ItemEntry], [ItemEntry])) -> IO [ItemEntry])
-> ([ItemEntry] -> IO ([ItemEntry], [ItemEntry])) -> IO [ItemEntry]
forall a b. (a -> b) -> a -> b
$
        ([ItemEntry], [ItemEntry]) -> IO ([ItemEntry], [ItemEntry])
forall (m :: * -> *) a. Monad m => a -> m a
return (([ItemEntry], [ItemEntry]) -> IO ([ItemEntry], [ItemEntry]))
-> ([ItemEntry] -> ([ItemEntry], [ItemEntry]))
-> [ItemEntry]
-> IO ([ItemEntry], [ItemEntry])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemEntry -> Bool) -> [ItemEntry] -> ([ItemEntry], [ItemEntry])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((BusName -> BusName -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> BusName
busName_ String
deadService) (BusName -> Bool) -> (ItemEntry -> BusName) -> ItemEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemEntry -> BusName
serviceName)

      handleNameOwnerChanged :: p -> String -> p -> a -> IO ()
handleNameOwnerChanged p
_ String
name p
oldOwner a
newOwner =
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
newOwner a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          [ItemEntry]
removedItems <- String -> MVar [ItemEntry] -> IO [ItemEntry]
filterDeadService String
name MVar [ItemEntry]
notifierItems
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ItemEntry] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ItemEntry]
removedItems) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            String -> IO ()
log (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Unregistering item %s because it disappeared." String
name
            Client -> String -> IO ()
emitStatusNotifierItemUnregistered Client
client String
name
          [ItemEntry]
removedHosts <- String -> MVar [ItemEntry] -> IO [ItemEntry]
filterDeadService String
name MVar [ItemEntry]
notifierHosts
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ItemEntry] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ItemEntry]
removedHosts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            String -> IO ()
log (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Unregistering host %s because it disappeared." String
name
          () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      watcherMethods :: [Method]
watcherMethods = (Method -> Method) -> [Method] -> [Method]
forall a b. (a -> b) -> [a] -> [b]
map Method -> Method
mkLogMethod
        [ MemberName
-> (MethodCall -> String -> IO (Either Reply ())) -> Method
forall fn.
AutoMethod fn =>
MemberName -> (MethodCall -> fn) -> Method
autoMethodWithMsg MemberName
"RegisterStatusNotifierItem"
          MethodCall -> String -> IO (Either Reply ())
registerStatusNotifierItem
        , MemberName -> (String -> IO ()) -> Method
forall fn. AutoMethod fn => MemberName -> fn -> Method
autoMethod MemberName
"RegisterStatusNotifierHost"
          String -> IO ()
registerStatusNotifierHost
        , MemberName -> IO () -> Method
forall fn. AutoMethod fn => MemberName -> fn -> Method
autoMethod MemberName
"StopWatcher"
          IO ()
stopWatcher
        , MemberName -> (String -> IO (Either Reply String)) -> Method
forall fn. AutoMethod fn => MemberName -> fn -> Method
autoMethod MemberName
"GetObjectPathForItemName"
          String -> IO (Either Reply String)
objectPathForItem
        ]

      watcherProperties :: [Property]
watcherProperties =
        [ MemberName -> IO [String] -> Property
forall v. IsValue v => MemberName -> IO v -> Property
mkLogProperty MemberName
"RegisteredStatusNotifierItems"
          IO [String]
registeredStatusNotifierItems
        , MemberName -> IO [(String, String)] -> Property
forall v. IsValue v => MemberName -> IO v -> Property
mkLogProperty MemberName
"RegisteredSNIEntries"
          IO [(String, String)]
registeredSNIEntries
        , MemberName -> IO Bool -> Property
forall v. IsValue v => MemberName -> IO v -> Property
mkLogProperty MemberName
"IsStatusNotifierHostRegistered"
          IO Bool
isStatusNotifierHostRegistered
        , MemberName -> IO Int32 -> Property
forall v. IsValue v => MemberName -> IO v -> Property
mkLogProperty MemberName
"ProtocolVersion"
          IO Int32
protocolVersion
        ]

      watcherInterface :: Interface
watcherInterface =
        Interface :: InterfaceName -> [Method] -> [Property] -> [Signal] -> Interface
Interface
        { interfaceName :: InterfaceName
interfaceName = InterfaceName
watcherInterfaceName
        , interfaceMethods :: [Method]
interfaceMethods = [Method]
watcherMethods
        , interfaceProperties :: [Property]
interfaceProperties = [Property]
watcherProperties
        , interfaceSignals :: [Signal]
interfaceSignals = [Signal]
watcherSignals
        }

      startWatcher :: IO RequestNameReply
startWatcher = do
        RequestNameReply
nameRequestResult <- Client -> BusName -> [RequestNameFlag] -> IO RequestNameReply
requestName Client
client (InterfaceName -> BusName
coerce InterfaceName
watcherInterfaceName) []
        case RequestNameReply
nameRequestResult of
          RequestNameReply
NamePrimaryOwner ->
            do
              SignalHandler
_ <- Client
-> MatchRule
-> (Signal -> String -> String -> String -> IO ())
-> IO SignalHandler
DBusTH.registerForNameOwnerChanged Client
client
                   MatchRule
matchAny Signal -> String -> String -> String -> IO ()
forall a p p. (Eq a, IsString a) => p -> String -> p -> a -> IO ()
handleNameOwnerChanged
              Client -> ObjectPath -> Interface -> IO ()
export Client
client (String -> ObjectPath
forall a. IsString a => String -> a
fromString String
path) Interface
watcherInterface
          RequestNameReply
_ -> IO ()
stopWatcher
        RequestNameReply -> IO RequestNameReply
forall (m :: * -> *) a. Monad m => a -> m a
return RequestNameReply
nameRequestResult

  (Interface, IO RequestNameReply)
-> IO (Interface, IO RequestNameReply)
forall (m :: * -> *) a. Monad m => a -> m a
return (Interface
watcherInterface, IO RequestNameReply
startWatcher)

-- For Client generation
-- TODO: get rid of unsafePerformIO here by making function that takes mvars so
-- IO isn't needed to build watcher
{-# NOINLINE watcherInterface #-}
watcherInterface :: Interface
watcherInterface = Interface -> Interface
buildIntrospectionInterface Interface
clientInterface
  where (Interface
clientInterface, IO RequestNameReply
_) =
          IO (Interface, IO RequestNameReply)
-> (Interface, IO RequestNameReply)
forall a. IO a -> a
unsafePerformIO (IO (Interface, IO RequestNameReply)
 -> (Interface, IO RequestNameReply))
-> IO (Interface, IO RequestNameReply)
-> (Interface, IO RequestNameReply)
forall a b. (a -> b) -> a -> b
$ WatcherParams -> IO (Interface, IO RequestNameReply)
buildWatcher
          WatcherParams
defaultWatcherParams { watcherDBusClient :: Maybe Client
watcherDBusClient = Client -> Maybe Client
forall a. a -> Maybe a
Just Client
forall a. HasCallStack => a
undefined }