ENH log errors when getting managed objects
This commit is contained in:
parent
5912e70526
commit
6848fbe01f
|
@ -278,14 +278,21 @@ omInterfacesRemoved :: MemberName
|
||||||
omInterfacesRemoved = memberName_ "InterfacesRemoved"
|
omInterfacesRemoved = memberName_ "InterfacesRemoved"
|
||||||
|
|
||||||
callGetManagedObjects
|
callGetManagedObjects
|
||||||
:: (MonadUnliftIO m, SafeClient c)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||||
=> c
|
=> c
|
||||||
-> BusName
|
-> BusName
|
||||||
-> ObjectPath
|
-> ObjectPath
|
||||||
-> m ObjectTree
|
-> m ObjectTree
|
||||||
callGetManagedObjects cl bus path =
|
callGetManagedObjects cl bus path = do
|
||||||
either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
|
res <- callMethod cl bus path omInterface getManagedObjects
|
||||||
<$> callMethod cl bus path omInterface getManagedObjects
|
case res of
|
||||||
|
Left err -> do
|
||||||
|
logError $ Utf8Builder $ encodeUtf8Builder err
|
||||||
|
return M.empty
|
||||||
|
Right v -> return $ fromMaybe M.empty $ fromSingletonVariant v
|
||||||
|
|
||||||
|
-- either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
|
||||||
|
-- <$>
|
||||||
|
|
||||||
addInterfaceChangedListener
|
addInterfaceChangedListener
|
||||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||||
|
|
|
@ -164,7 +164,10 @@ adaptorHasDevice adaptor device = case splitPathNoRoot device of
|
||||||
splitPathNoRoot :: ObjectPath -> [FilePath]
|
splitPathNoRoot :: ObjectPath -> [FilePath]
|
||||||
splitPathNoRoot = dropWhile (== "/") . splitDirectories . formatObjectPath
|
splitPathNoRoot = dropWhile (== "/") . splitDirectories . formatObjectPath
|
||||||
|
|
||||||
getBtObjectTree :: MonadUnliftIO m => SysClient -> m ObjectTree
|
getBtObjectTree
|
||||||
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
|
=> SysClient
|
||||||
|
-> m ObjectTree
|
||||||
getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
|
getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
|
||||||
|
|
||||||
btOMPath :: ObjectPath
|
btOMPath :: ObjectPath
|
||||||
|
|
|
@ -52,7 +52,10 @@ type VPNState = S.Set ObjectPath
|
||||||
|
|
||||||
type MutableVPNState = MVar VPNState
|
type MutableVPNState = MVar VPNState
|
||||||
|
|
||||||
initState :: MonadUnliftIO m => SysClient -> m MutableVPNState
|
initState
|
||||||
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
|
=> SysClient
|
||||||
|
-> m MutableVPNState
|
||||||
initState client = do
|
initState client = do
|
||||||
ot <- getVPNObjectTree client
|
ot <- getVPNObjectTree client
|
||||||
newMVar $ findTunnels ot
|
newMVar $ findTunnels ot
|
||||||
|
@ -71,7 +74,10 @@ updateState f state op = modifyMVar_ state $ return . f op
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Tunnel Device Detection
|
-- Tunnel Device Detection
|
||||||
|
|
||||||
getVPNObjectTree :: MonadUnliftIO m => SysClient -> m ObjectTree
|
getVPNObjectTree
|
||||||
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
|
=> SysClient
|
||||||
|
-> m ObjectTree
|
||||||
getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
|
getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
|
||||||
|
|
||||||
findTunnels :: ObjectTree -> VPNState
|
findTunnels :: ObjectTree -> VPNState
|
||||||
|
|
Loading…
Reference in New Issue