ENH log internal dbus methods (kinda)
This commit is contained in:
parent
76011dc6d6
commit
e0913a461d
|
@ -128,8 +128,18 @@ methodCallBus b p i m =
|
||||||
dbusInterface :: InterfaceName
|
dbusInterface :: InterfaceName
|
||||||
dbusInterface = interfaceName_ "org.freedesktop.DBus"
|
dbusInterface = interfaceName_ "org.freedesktop.DBus"
|
||||||
|
|
||||||
callGetNameOwner :: (MonadUnliftIO m, SafeClient c) => c -> BusName -> m (Maybe BusName)
|
callGetNameOwner
|
||||||
callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||||
|
=> c
|
||||||
|
-> BusName
|
||||||
|
-> m (Maybe BusName)
|
||||||
|
callGetNameOwner cl name = do
|
||||||
|
res <- callMethod' cl mc
|
||||||
|
case res of
|
||||||
|
Left err -> do
|
||||||
|
logError $ Utf8Builder $ encodeUtf8Builder err
|
||||||
|
return Nothing
|
||||||
|
Right body -> return $ fromSingletonVariant body
|
||||||
where
|
where
|
||||||
mc =
|
mc =
|
||||||
(methodCallBus dbusName dbusPath dbusInterface mem)
|
(methodCallBus dbusName dbusPath dbusInterface mem)
|
||||||
|
@ -175,7 +185,7 @@ matchSignal b p i m =
|
||||||
}
|
}
|
||||||
|
|
||||||
matchSignalFull
|
matchSignalFull
|
||||||
:: (MonadUnliftIO m, SafeClient c)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||||
=> c
|
=> c
|
||||||
-> BusName
|
-> BusName
|
||||||
-> Maybe ObjectPath
|
-> Maybe ObjectPath
|
||||||
|
@ -213,7 +223,7 @@ matchProperty b p =
|
||||||
matchSignal b p (Just propertyInterface) (Just propertySignal)
|
matchSignal b p (Just propertyInterface) (Just propertySignal)
|
||||||
|
|
||||||
matchPropertyFull
|
matchPropertyFull
|
||||||
:: (MonadUnliftIO m, SafeClient c)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||||
=> c
|
=> c
|
||||||
-> BusName
|
-> BusName
|
||||||
-> Maybe ObjectPath
|
-> Maybe ObjectPath
|
||||||
|
@ -275,7 +285,7 @@ callGetManagedObjects cl bus path =
|
||||||
<$> callMethod cl bus path omInterface getManagedObjects
|
<$> callMethod cl bus path omInterface getManagedObjects
|
||||||
|
|
||||||
addInterfaceChangedListener
|
addInterfaceChangedListener
|
||||||
:: (MonadUnliftIO m, SafeClient c)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||||
=> BusName
|
=> BusName
|
||||||
-> MemberName
|
-> MemberName
|
||||||
-> ObjectPath
|
-> ObjectPath
|
||||||
|
@ -287,7 +297,7 @@ addInterfaceChangedListener bus prop path sc cl = do
|
||||||
forM rule $ \r -> addMatchCallback r sc cl
|
forM rule $ \r -> addMatchCallback r sc cl
|
||||||
|
|
||||||
addInterfaceAddedListener
|
addInterfaceAddedListener
|
||||||
:: (MonadUnliftIO m, SafeClient c)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||||
=> BusName
|
=> BusName
|
||||||
-> ObjectPath
|
-> ObjectPath
|
||||||
-> SignalCallback m
|
-> SignalCallback m
|
||||||
|
@ -297,7 +307,7 @@ addInterfaceAddedListener bus =
|
||||||
addInterfaceChangedListener bus omInterfacesAdded
|
addInterfaceChangedListener bus omInterfacesAdded
|
||||||
|
|
||||||
addInterfaceRemovedListener
|
addInterfaceRemovedListener
|
||||||
:: (MonadUnliftIO m, SafeClient c)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||||
=> BusName
|
=> BusName
|
||||||
-> ObjectPath
|
-> ObjectPath
|
||||||
-> SignalCallback m
|
-> SignalCallback m
|
||||||
|
|
|
@ -68,7 +68,7 @@ instance Exec Bluetooth where
|
||||||
withDBusClientConnection cb $ startAdapter icons colors cb
|
withDBusClientConnection cb $ startAdapter icons colors cb
|
||||||
|
|
||||||
startAdapter
|
startAdapter
|
||||||
:: MonadUnliftIO m
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
=> Icons
|
=> Icons
|
||||||
-> Colors
|
-> Colors
|
||||||
-> Callback
|
-> Callback
|
||||||
|
@ -170,11 +170,15 @@ getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
|
||||||
btOMPath :: ObjectPath
|
btOMPath :: ObjectPath
|
||||||
btOMPath = objectPath_ "/"
|
btOMPath = objectPath_ "/"
|
||||||
|
|
||||||
addBtOMListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
|
addBtOMListener
|
||||||
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
|
=> SignalCallback m
|
||||||
|
-> SysClient
|
||||||
|
-> m ()
|
||||||
addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
|
addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
|
||||||
|
|
||||||
addDeviceAddedListener
|
addDeviceAddedListener
|
||||||
:: MonadUnliftIO m
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
=> MutableBtState
|
=> MutableBtState
|
||||||
-> m ()
|
-> m ()
|
||||||
-> ObjectPath
|
-> ObjectPath
|
||||||
|
@ -187,7 +191,7 @@ addDeviceAddedListener state dpy adapter client =
|
||||||
addAndInitDevice state dpy d client
|
addAndInitDevice state dpy d client
|
||||||
|
|
||||||
addDeviceRemovedListener
|
addDeviceRemovedListener
|
||||||
:: (MonadUnliftIO m)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
=> MutableBtState
|
=> MutableBtState
|
||||||
-> m ()
|
-> m ()
|
||||||
-> ObjectPath
|
-> ObjectPath
|
||||||
|
@ -219,14 +223,14 @@ initAdapter state adapter client = do
|
||||||
putPowered state $ fromSingletonVariant reply
|
putPowered state $ fromSingletonVariant reply
|
||||||
|
|
||||||
matchBTProperty
|
matchBTProperty
|
||||||
:: (MonadUnliftIO m)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
=> SysClient
|
=> SysClient
|
||||||
-> ObjectPath
|
-> ObjectPath
|
||||||
-> m (Maybe MatchRule)
|
-> m (Maybe MatchRule)
|
||||||
matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
|
matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
|
||||||
|
|
||||||
addAdaptorListener
|
addAdaptorListener
|
||||||
:: MonadUnliftIO m
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
=> MutableBtState
|
=> MutableBtState
|
||||||
-> m ()
|
-> m ()
|
||||||
-> ObjectPath
|
-> ObjectPath
|
||||||
|
@ -263,7 +267,7 @@ adaptorPowered = "Powered"
|
||||||
-- Devices
|
-- Devices
|
||||||
|
|
||||||
addAndInitDevice
|
addAndInitDevice
|
||||||
:: MonadUnliftIO m
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
=> MutableBtState
|
=> MutableBtState
|
||||||
-> m ()
|
-> m ()
|
||||||
-> ObjectPath
|
-> ObjectPath
|
||||||
|
@ -291,7 +295,7 @@ initDevice state sh device sys = do
|
||||||
}
|
}
|
||||||
|
|
||||||
addDeviceListener
|
addDeviceListener
|
||||||
:: MonadUnliftIO m
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
=> MutableBtState
|
=> MutableBtState
|
||||||
-> m ()
|
-> m ()
|
||||||
-> ObjectPath
|
-> ObjectPath
|
||||||
|
|
|
@ -77,10 +77,18 @@ getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
|
||||||
findTunnels :: ObjectTree -> VPNState
|
findTunnels :: ObjectTree -> VPNState
|
||||||
findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
|
findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
|
||||||
|
|
||||||
vpnAddedListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
|
vpnAddedListener
|
||||||
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
|
=> SignalCallback m
|
||||||
|
-> SysClient
|
||||||
|
-> m ()
|
||||||
vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
|
vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
|
||||||
|
|
||||||
vpnRemovedListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
|
vpnRemovedListener
|
||||||
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
|
=> SignalCallback m
|
||||||
|
-> SysClient
|
||||||
|
-> m ()
|
||||||
vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
|
vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
|
||||||
|
|
||||||
addedCallback :: MonadUnliftIO m => MutableVPNState -> m () -> SignalCallback m
|
addedCallback :: MonadUnliftIO m => MutableVPNState -> m () -> SignalCallback m
|
||||||
|
|
Loading…
Reference in New Issue